summaryrefslogtreecommitdiff
path: root/testsuite/tests/backtrace/backtrace_effects_nested.ml
blob: 37638a200a3191630c6949f61537852bdb3b9b75 (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
(* TEST

flags = "-g"
* bytecode
* no-flambda
** native
* flambda
reference = "${test_source_directory}/backtrace_effects_nested.flambda.reference"
** native

*)

open Effect
open Effect.Deep

type _ t += E : unit t
          | Inc : unit t

let blorp () =
  perform Inc;
  perform E;
  42

let baz () =
    try_with blorp ()
    { effc = fun (type a) (e : a t) ->
        match e with
        | Inc -> Some (fun (k : (a, _) continuation) ->
            1 + continue k ())
        | _ -> None }

let f () =
  match_with baz ()
  { retc = (fun x -> Printf.printf "%d\n" x);
    exnc = (fun e -> raise e);
    effc = fun (type a) (e : a t) ->
          match e with
          | E -> Some (fun (k : (a, _) continuation) ->
              Deep.get_callstack k 100 |>
              Printexc.raw_backtrace_to_string |>
              print_string;
              continue k ())
          | _ -> None }

let () = f ()