diff --git a/.github/workflows/ocaml.yml b/.github/workflows/ocaml.yml index 8680d82..51dd5d1 100644 --- a/.github/workflows/ocaml.yml +++ b/.github/workflows/ocaml.yml @@ -9,8 +9,7 @@ jobs: strategy: matrix: include: - - ocaml-compiler: "ocaml-base-compiler.5.0.0" - - ocaml-compiler: "ocaml-base-compiler.5.1.1" + - ocaml-compiler: "ocaml-base-compiler.5.3.0~alpha1" with-doc: true runs-on: ubuntu-latest steps: diff --git a/algaeff.opam b/algaeff.opam index 9773024..1b003bb 100644 --- a/algaeff.opam +++ b/algaeff.opam @@ -12,7 +12,7 @@ bug-reports: "https://github.com/RedPRL/algaeff/issues" dev-repo: "git+https://github.com/RedPRL/algaeff.git" depends: [ "dune" {>= "2.0"} - "ocaml" {>= "5.0"} + "ocaml" {>= "5.3"} "alcotest" {>= "1.5" & with-test} "qcheck-core" {>= "0.18" & with-test} "odoc" {with-doc} diff --git a/src/Reader.ml b/src/Reader.ml index 6faabd9..5d078d2 100644 --- a/src/Reader.ml +++ b/src/Reader.ml @@ -9,18 +9,13 @@ end module Make (Env : Sigs.Type) = struct - type _ Effect.t += Read : Env.t Effect.t + type _ eff += Read : Env.t eff let read () = Effect.perform Read let run ~(env:Env.t) f = let open Effect.Deep in - try_with f () - { effc = fun (type a) (eff : a Effect.t) -> - match eff with - | Read -> Option.some @@ fun (k : (a, _) continuation) -> - continue k env - | _ -> None } + try f () with effect Read, k -> continue k env let scope f c = run ~env:(f @@ read ()) c diff --git a/src/Sequencer.ml b/src/Sequencer.ml index c2f89b6..9896b2f 100644 --- a/src/Sequencer.ml +++ b/src/Sequencer.ml @@ -8,18 +8,14 @@ end module Make (Elt : Sigs.Type) = struct - type _ Effect.t += Yield : Elt.t -> unit Effect.t + type _ eff += Yield : Elt.t -> unit eff let yield x = Effect.perform (Yield x) let run f () = let open Effect.Deep in - try_with (fun () -> f (); Seq.Nil) () - { effc = fun (type a) (eff : a Effect.t) -> - match eff with - | Yield x -> Option.some @@ fun (k : (a, _) continuation) -> - Seq.Cons (x, continue k) - | _ -> None } + try f (); Seq.Nil with + | effect Yield x, k -> Seq.Cons (x, continue k) let register_printer f = Printexc.register_printer @@ function | Effect.Unhandled (Yield elt) -> f (`Yield elt) diff --git a/src/State.ml b/src/State.ml index 88331be..4e2f46b 100644 --- a/src/State.ml +++ b/src/State.ml @@ -11,9 +11,9 @@ end module Make (State : Sigs.Type) = struct - type _ Effect.t += - | Get : State.t Effect.t - | Set : State.t -> unit Effect.t + type _ eff += + | Get : State.t eff + | Set : State.t -> unit eff let get () = Effect.perform Get let set st = Effect.perform (Set st) @@ -21,25 +21,15 @@ struct let run ~(init:State.t) f = let open Effect.Deep in let st = ref init in - try_with f () - { effc = fun (type a) (eff : a Effect.t) -> - match eff with - | Get -> Option.some @@ fun (k : (a, _) continuation) -> - continue k !st - | Set v -> Option.some @@ fun (k : (a, _) continuation) -> - st := v; continue k () - | _ -> None } + try f () with + | effect Get, k -> continue k !st + | effect Set v, k -> st := v; continue k () let try_with ?(get=get) ?(set=set) f = let open Effect.Deep in - try_with f () - { effc = fun (type a) (eff : a Effect.t) -> - match eff with - | Get -> Option.some @@ fun (k : (a, _) continuation) -> - continue k (get ()) - | Set v -> Option.some @@ fun (k : (a, _) continuation) -> - set v; continue k () - | _ -> None } + try f () with + | effect Get, k -> continue k (get ()) + | effect Set v, k -> set v; continue k () let modify f = set @@ f @@ get () diff --git a/src/UniqueID.ml b/src/UniqueID.ml index eb0b5e8..557e183 100644 --- a/src/UniqueID.ml +++ b/src/UniqueID.ml @@ -31,10 +31,10 @@ struct end type id = int - type _ Effect.t += - | Register : Elt.t -> id Effect.t - | Retrieve : id -> Elt.t Effect.t - | Export : Elt.t Seq.t Effect.t + type _ eff += + | Register : Elt.t -> id eff + | Retrieve : id -> Elt.t eff + | Export : Elt.t Seq.t eff let register x = Effect.perform (Register x) let retrieve i = Effect.perform (Retrieve i) @@ -47,19 +47,16 @@ struct let init = M.of_seq @@ Seq.zip (Seq.ints 0) init in Eff.run ~init @@ fun () -> let open Effect.Deep in - try_with f () - { effc = fun (type a) (eff : a Effect.t) -> - match eff with - | Register x -> Option.some @@ fun (k : (a, _) continuation) -> - let st = Eff.get () in - let next = M.cardinal st in - Eff.set @@ M.add next x st; - continue k next - | Retrieve i -> Option.some @@ fun (k : (a, _) continuation) -> - continue k @@ M.find i @@ Eff.get () - | Export -> Option.some @@ fun (k : (a, _) continuation) -> - continue k @@ Seq.map snd @@ M.to_seq @@ Eff.get () - | _ -> None } + try f () with + | effect Register x, k -> + let st = Eff.get () in + let next = M.cardinal st in + Eff.set @@ M.add next x st; + continue k next + | effect Retrieve i, k -> + continue k @@ M.find i @@ Eff.get () + | effect Export, k -> + continue k @@ Seq.map snd @@ M.to_seq @@ Eff.get () let register_printer f = Printexc.register_printer @@ function | Effect.Unhandled (Register elt) -> f (`Register elt)