blob: 2aa70126065e0855b1ccd97a727d69999d65885d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
|
(* TEST
frame_pointers;
readonly_files = "fp_backtrace.c";
all_modules = "${readonly_files} effects.ml";
native;
*)
open Printf
open Effect
open Effect.Deep
external fp_backtrace : unit -> unit = "fp_backtrace" [@@noalloc]
type _ t += E : int -> int t
let[@inline never] f () =
printf "# computation f\n%!";
fp_backtrace ();
printf "# perform effect (E 0)\n%!";
let v = perform (E 0) in
printf "# perform returns %d\n%!" v;
fp_backtrace ();
v + 1
let h (type a) (eff : a t) : ((a, 'b) continuation -> 'b) option =
let[@inline never] h_effect_e v k =
printf "# caught effect (E %d). continuing...\n%!" v;
fp_backtrace ();
let v = continue k (v + 1) in
printf "# continue returns %d\n%!" v;
fp_backtrace ();
v + 1
in
match eff with
| E v -> Some (h_effect_e v)
| e -> None
let v =
let[@inline never] v_retc v =
printf "# done %d\n%!" v;
fp_backtrace ();
v + 1
in
match_with f ()
{ retc = v_retc;
exnc = (fun e -> raise e);
effc = h }
let () = printf "# result=%d\n%!" v
|
