Skip to content

Commit 9840de7

Browse files
kayceesrkkayceesrk
committed
Port all examples to effect syntax; update CI to setup-ocaml v3
1 parent 7d1320e commit 9840de7

File tree

12 files changed

+213
-410
lines changed

12 files changed

+213
-410
lines changed

‎.github/workflows/ci.yml‎

Lines changed: 8 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -1,11 +1,10 @@
1-
name: main
1+
name: Build
22

33
on:
4-
pull_request:
54
push:
6-
schedule:
7-
# Prime the caches every Monday
8-
- cron: 0 1 * * MON
5+
branches: [ "master" ]
6+
pull_request:
7+
branches: [ "master" ]
98

109
jobs:
1110
build:
@@ -15,21 +14,19 @@ jobs:
1514
- ubuntu-latest
1615
- macos-latest
1716
ocaml-compiler:
18-
- "5.4.1"
17+
- 5.4
1918

2019
runs-on: ${{ matrix.os }}
2120

2221
steps:
2322
- name: Checkout code
24-
uses: actions/checkout@v2
23+
uses: actions/checkout@v4
2524

2625
- name: Use OCaml ${{ matrix.ocaml-compiler }}
27-
uses: ocaml/setup-ocaml@v2
26+
uses: ocaml/setup-ocaml@v3
2827
with:
2928
ocaml-compiler: ${{ matrix.ocaml-compiler }}
30-
opam-repositories: |
31-
default: https://github.com/ocaml/opam-repository.git
32-
opam-depext: false
29+
dune-cache: true
3330

3431
- run: opam install . --deps-only --with-test
3532

‎aio/aio.ml‎

Lines changed: 41 additions & 58 deletions
Original file line numberDiff line numberDiff line change
@@ -11,16 +11,16 @@ open Effect.Deep
1111
type file_descr = Unix.file_descr
1212
type sockaddr = Unix.sockaddr
1313
type msg_flag = Unix.msg_flag
14-
type _ Effect.t += Fork : (unit -> unit) -> unit Effect.t
15-
type _ Effect.t += Accept : file_descr -> (file_descr * sockaddr) Effect.t
14+
type _ eff += Fork : (unit -> unit) -> unit eff
15+
type _ eff += Accept : file_descr -> (file_descr * sockaddr) eff
1616

17-
type _ Effect.t +=
18-
| Recv : file_descr * bytes * int * int * msg_flag list -> int Effect.t
17+
type _ eff +=
18+
| Recv : file_descr * bytes * int * int * msg_flag list -> int eff
1919

20-
type _ Effect.t +=
21-
| Send : file_descr * bytes * int * int * msg_flag list -> int Effect.t
20+
type _ eff +=
21+
| Send : file_descr * bytes * int * int * msg_flag list -> int eff
2222

23-
type _ Effect.t += Sleep : float -> unit Effect.t
23+
type _ eff += Sleep : float -> unit eff
2424

2525
let fork f = perform (Fork f)
2626
let accept fd = perform (Accept fd)
@@ -151,56 +151,39 @@ and perform_io st timeout =
151151
let run main =
152152
let st = init () in
153153
let rec fork st f =
154-
match_with f ()
155-
{
156-
retc = (fun () -> schedule st);
157-
exnc =
158-
(fun exn ->
159-
print_string (Printexc.to_string exn);
160-
schedule st);
161-
effc =
162-
(fun (type a) (e : a Effect.t) ->
163-
match e with
164-
| Fork f ->
165-
Some
166-
(fun (k : (a, _) continuation) ->
167-
enqueue_thread st k ();
168-
fork st f)
169-
| Accept fd ->
170-
Some
171-
(fun k ->
172-
if poll_rd fd then
173-
let res = Unix.accept fd in
174-
continue k res
175-
else (
176-
block_accept st fd k;
177-
schedule st))
178-
| Recv (fd, buf, pos, len, mode) ->
179-
Some
180-
(fun k ->
181-
if poll_rd fd then
182-
let res = Unix.recv fd buf pos len mode in
183-
continue k res
184-
else (
185-
block_recv st fd buf pos len mode k;
186-
schedule st))
187-
| Send (fd, buf, pos, len, mode) ->
188-
Some
189-
(fun k ->
190-
if poll_wr fd then
191-
let res = Unix.send fd buf pos len mode in
192-
continue k res
193-
else (
194-
block_send st fd buf pos len mode k;
195-
schedule st))
196-
| Sleep t ->
197-
Some
198-
(fun k ->
199-
if t <= 0. then continue k ()
200-
else (
201-
block_sleep st t k;
202-
schedule st))
203-
| _ -> None);
204-
}
154+
match f () with
155+
| () -> schedule st
156+
| exception exn ->
157+
print_string (Printexc.to_string exn);
158+
schedule st
159+
| effect (Fork f), k ->
160+
enqueue_thread st k ();
161+
fork st f
162+
| effect (Accept fd), k ->
163+
if poll_rd fd then
164+
let res = Unix.accept fd in
165+
continue k res
166+
else (
167+
block_accept st fd k;
168+
schedule st)
169+
| effect (Recv (fd, buf, pos, len, mode)), k ->
170+
if poll_rd fd then
171+
let res = Unix.recv fd buf pos len mode in
172+
continue k res
173+
else (
174+
block_recv st fd buf pos len mode k;
175+
schedule st)
176+
| effect (Send (fd, buf, pos, len, mode)), k ->
177+
if poll_wr fd then
178+
let res = Unix.send fd buf pos len mode in
179+
continue k res
180+
else (
181+
block_send st fd buf pos len mode k;
182+
schedule st)
183+
| effect (Sleep t), k ->
184+
if t <= 0. then continue k ()
185+
else (
186+
block_sleep st t k;
187+
schedule st)
205188
in
206189
fork st main

‎callbacks/bar.ml‎

Lines changed: 6 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@
2424
open Effect
2525
open Effect.Deep
2626

27-
type _ Effect.t += E : unit Effect.t
27+
type _ eff += E : unit eff
2828

2929
let printf = Printf.printf
3030

@@ -43,15 +43,8 @@ let _ =
4343
caml_to_c ();
4444
printf "[Caml] Return from caml_to_c\n%!"
4545
in
46-
try_with f ()
47-
{
48-
effc =
49-
(fun (type a) (e : a Effect.t) ->
50-
match e with
51-
| E ->
52-
Some
53-
(fun (k : (a, _) continuation) ->
54-
printf "[Caml] Handle effect E. Continuing..\n%!";
55-
continue k ())
56-
| _ -> None);
57-
}
46+
match f () with
47+
| () -> ()
48+
| effect E, k ->
49+
printf "[Caml] Handle effect E. Continuing..\n%!";
50+
continue k ()

‎multishot/clone_is_tricky.ml‎

Lines changed: 11 additions & 25 deletions
Original file line numberDiff line numberDiff line change
@@ -1,35 +1,21 @@
11
(* Multi-shot continuations don't play nicely with linear resources.
2-
* This program illustrates that resuming an inner one-shot continuation
2+
* This program illustrates that resuming an inner one-shot continuation
33
* within an outer multi-shot context causes a runtime error.
44
*)
55
open Effect
66
open Effect.Deep
77

8-
type _ Effect.t += Foo : unit Effect.t
9-
type _ Effect.t += Bar : unit Effect.t
8+
type _ eff += Foo : unit eff
9+
type _ eff += Bar : unit eff
1010

1111
let _ =
1212
let run () =
13-
try_with perform Foo
14-
{
15-
effc =
16-
(fun (type a) (e : a Effect.t) ->
17-
match e with
18-
| Foo ->
19-
Some (fun (k : (a, _) continuation) -> continue k (perform Bar))
20-
(* This continuation is resumed twice *)
21-
| _ -> None);
22-
}
13+
match perform Foo with
14+
| x -> x
15+
| effect Foo, k -> continue k (perform Bar)
2316
in
24-
try_with run ()
25-
{
26-
effc =
27-
(fun (type a) (e : a Effect.t) ->
28-
match e with
29-
| Bar ->
30-
Some
31-
(fun (k : (a, _) continuation) ->
32-
continue (Multicont.Deep.clone_continuation k) ();
33-
continue k ())
34-
| _ -> None);
35-
}
17+
match run () with
18+
| () -> ()
19+
| effect Bar, k ->
20+
continue (Multicont.Deep.clone_continuation k) ();
21+
continue k ()

‎multishot/delimcc.ml‎

Lines changed: 4 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -33,16 +33,13 @@ module M : S = struct
3333

3434
let new_prompt (type a) () : a prompt =
3535
let module M = struct
36-
type _ Effect.t += Prompt : (('b, a) subcont -> a) -> 'b Effect.t
36+
type _ eff += Prompt : (('b, a) subcont -> a) -> 'b eff
3737
end in
3838
let take f = perform (M.Prompt f) in
3939
let push f =
40-
try_with f ()
41-
{
42-
effc =
43-
(fun (type a) (e : a Effect.t) ->
44-
match e with M.Prompt f -> Some (fun k -> f k) | _ -> None);
45-
}
40+
match f () with
41+
| x -> x
42+
| effect (M.Prompt f), k -> f k
4643
in
4744
{ take; push }
4845

0 commit comments

Comments
 (0)