summaryrefslogtreecommitdiff
path: root/testsuite/tests/effects/issue479.ml
blob: a960dcd8cce5217614889d0c5f8578f086c0acf4 (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
51
52
53
54
55
56
(* TEST
 toplevel;
*)

(* https://github.com/ocaml-multicore/ocaml-multicore/issues/479 *)

open Effect
open Effect.Deep

[@@@warning "-5-26"];;

Printexc.record_backtrace false;;

type ('a, 'container) iterator = ('a -> unit) -> 'container -> unit;;
type 'a generator = unit -> 'a option;;

type ('a,'container) iter2gen =
  ('a, 'container) iterator     (* List.iter *)
  -> 'container
  -> 'a generator;;

type _ t += Hold: unit t

let iter2gen : _ iter2gen = fun iter c ->
  let r = ref None in
  let suspending_f x =
    r:=Some x;
    perform Hold
  in
  let next =
    match_with (iter suspending_f) c
    { retc = (fun _ -> fun () -> None);
      exnc = (fun e -> raise e);
      effc = fun (type a) (e : a t) ->
        match e with
        | Hold -> Some (fun (k : (a,_) continuation) ->
            fun () ->
              let x = !r in
              Printf.printf "Hold %s\n%!" (
                match x with
                | None -> "?"
                | Some x->string_of_int x);
              continue k ();
              x)
        | e -> None }
   in
   fun () -> next();;

let f () =
  let gen = iter2gen List.iter in
  let gen = gen [1;2;3] in
  let gen() = match gen() with None->"?" | Some x-> string_of_int x in
  Printf.printf "%s\n%!" (gen());
  Printf.printf "%s\n%!" (gen());;

f ();;