blob: 90f27a8017b9f372c2c95513ae5abf4d2affb9de (
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
|
(* TEST *)
open Effect
open Effect.Shallow
(*
let handle_state init f x =
let rec loop state k x =
continue k x with
| result -> result, state
| effect Get, k -> loop state k state
| effect Set new_state, k -> loop new_state k ()
in
loop init (fiber f) x
*)
type _ t += Get : int t
| Set : int -> unit t
let handle_state init f x =
let rec loop : type a r. int -> (a, r) continuation -> a -> r * int =
fun state k x ->
continue_with k x
{ retc = (fun result -> result, state);
exnc = (fun e -> raise e);
effc = (fun (type b) (eff : b t) ->
match eff with
| Get -> Some (fun (k : (b,r) continuation) ->
loop state k state)
| Set new_state -> Some (fun (k : (b,r) continuation) ->
loop new_state k ())
| e -> None) }
in
loop init (fiber f) x
let comp () =
Printf.printf "Initial state: %d\n" (perform Get);
perform (Set 42);
Printf.printf "Updated state: %d\n" (perform Get);
perform (Set 43)
let main () =
let (), i = handle_state 0 comp () in
Printf.printf "Final state: %d\n" i
let _ = main ()
|
