Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

refactor: use effect syntax from OCaml 5.3 #33

Open
wants to merge 1 commit into
base: main
Choose a base branch
from
Open

refactor: use effect syntax from OCaml 5.3 #33

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
1 commit
Select commit
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 1 addition & 2 deletions .github/workflows/ocaml.yml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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:
Expand Down
2 changes: 1 addition & 1 deletion algaeff.opam
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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}
Expand Down
9 changes: 2 additions & 7 deletions src/Reader.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
10 changes: 3 additions & 7 deletions src/Sequencer.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down
28 changes: 9 additions & 19 deletions src/State.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -11,35 +11,25 @@ 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)

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
Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Is open Effect.Deep needed anymore?

Copy link
Contributor Author

@favonia favonia Oct 2, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@jonsterling Yes. See ocaml/ocaml#13511 for my Thought on this.

Copy link

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Wow, that is a very nice Thought.

Copy link
Contributor Author

@favonia favonia Oct 2, 2024 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

@jonsterling It's also why we have these two helper functions:

https://github.com/RedPRL/algaeff/blob/main/src/Fun.ml

It will be great if the compiler can do it directly, avoiding the overhead of creating stupid closures.

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 ()

Expand Down
31 changes: 14 additions & 17 deletions src/UniqueID.ml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand All @@ -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)
Expand Down
Loading