Skip to content

Instantly share code, notes, and snippets.

@halcat0x15a
Last active January 11, 2023 08:45
Show Gist options
  • Save halcat0x15a/e604626492a58d12022967e80486c133 to your computer and use it in GitHub Desktop.
Save halcat0x15a/e604626492a58d12022967e80486c133 to your computer and use it in GitHub Desktop.
open Effect
open Effect.Deep
open Effect.Shallow
type _ Effect.t += Get: int t
| Put: int -> unit t
| Exc: string -> unit t
let run_reader (i : int) e =
try_with e ()
{ effc = fun (type a) (eff: a t) ->
match eff with
| Get -> Some (fun (k: (a, _) Deep.continuation) -> continue k i)
| _ -> None }
let run_state (s : int) (e : unit -> _) =
let rec loop : type a. int -> (a, _) Shallow.continuation -> a -> (int * _) = fun s k v ->
continue_with k v
{ retc = (fun (v) -> (s, v));
exnc = raise;
effc = fun (type a) (eff: a t) ->
match eff with
| Get -> Some (fun (k: (a, _) Shallow.continuation) -> loop s k s)
| Put s' -> Some (fun (k: (a, _) Shallow.continuation) -> loop s' k ())
| _ -> None }
in
loop s (fiber e) ()
let run_error e =
match_with e ()
{ retc = (fun (v) -> Either.Right v);
exnc = raise;
effc = fun (type a) (eff: a t) ->
match eff with
| Exc s -> Some (fun _ -> Either.Left s)
| _ -> None }
let eval_state (s : int) e = let (_, v) = run_state s e in v
let exec_state (s : int) e = let (s, _) = run_state s e in s
let modify f = perform (Put (f (perform Get)))
let transaction e =
let (s, v) = run_state (perform Get) e in
perform (Put s);
v
let p1 () = (perform Get) + 1
let p2 () =
modify (fun (v) -> v * 2);
string_of_int (p1 ())
let p3 () =
modify (fun (v) -> v + 1);
perform (Exc "interrupted!")
let () =
Printf.printf "run_reader: %d\n" (run_reader 0 p1);
Printf.printf "eval_state: %s\n" (eval_state 1 p2);
Printf.printf "exec_state: %d\n" (exec_state 1 p2);
Printf.printf "without transaction: %d\n" (exec_state 0 (fun () -> (run_error p3)));
Printf.printf "with transaction: %d\n" (exec_state 0 (fun () -> (run_error (fun () -> transaction p3))));
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment