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
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
(* TEST *)
open Printf
open Effect
open Effect.Deep
(* Some examples from Matija Pretnar's MFPS 2015 tutorial,
"An introduction to algebraic effects and handlers". *)
type _ eff += Print : string -> unit eff
let print s = perform (Print s)
let abc () = print "a"; print "b"; print "c"
let output f =
match f () with
| () -> print_newline()
| effect Print s, k -> print_string s; continue k ()
let reverse f =
match f () with
| () -> ()
| effect Print s, k -> continue k (); print s
let collect f =
match f () with
| () -> ""
| effect Print s, k -> s ^ continue k ()
let _ =
output abc;
output (fun () -> reverse abc);
printf "%s\n" (collect abc);
printf "%s\n" (collect (fun () -> reverse abc))
type _ eff += Get : int eff
| Set : int -> unit eff
let get () = perform Get
let set n = perform (Set n)
let incr () = set (get () + 1)
let run_state (f : unit -> 'a) : int -> 'a * int =
match f () with
| v -> (fun s -> (v, s))
| effect Get, k -> (fun s -> continue k s s)
| effect Set n, k -> (fun _ -> continue k () n)
let _ =
run_state
(fun () ->
printf "%d " (get()); incr();
printf "%d " (get()); incr();
printf "%d\n" (get()))
10
exception Abort
let transaction (f : unit -> unit) : unit =
begin match f () with
| () -> (fun s -> set s)
| effect Get, k -> (fun s -> continue k s s)
| effect Set n, k -> (fun _ -> continue k () n)
| exception Abort -> (fun _ -> ())
end (get ())
let _ =
run_state
(fun () ->
printf "%d " (get());
transaction (fun () -> incr(); incr());
printf "%d " (get());
transaction (fun () -> incr(); raise Abort);
printf "%d " (get());
transaction (fun () -> incr(); incr());
printf "%d\n" (get()))
10
|
