Skip to content

Navigation Menu

Sign in
Sign up

refactor: use effect syntax from OCaml 5.3 #33

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.

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

Open
favonia wants to merge 1 commit into main
base: main
Choose a base branch
Loading
from ocaml5.3
Open
Show file tree
Hide file tree
Changes from all commits
Commits
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

@jonsterling jonsterling Oct 2, 2024

Copy link
Copy Markdown

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?

@favonia favonia Oct 2, 2024 •
edited
Loading

Copy link
Copy Markdown
Contributor Author

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.

jonsterling reacted with heart emoji

@jonsterling jonsterling Oct 2, 2024

Copy link
Copy Markdown

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.

favonia reacted with heart emoji

@favonia favonia Oct 2, 2024 •
edited
Loading

Copy link
Copy Markdown
Contributor Author

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.

jonsterling reacted with heart emoji
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

AltStyle によって変換されたページ (->オリジナル) /