Skip to content

Commit 8fefdf3

Browse files
vouillonvouillon
committed
Draft: effects based on Typed continuation proposal
1 parent 059fbf2 commit 8fefdf3

File tree

2 files changed

+180
-0
lines changed

2 files changed

+180
-0
lines changed

‎runtime/wasm/dune

+2
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@
2525
--enable-strings
2626
--enable-multivalue
2727
--enable-bulk-memory
28+
--enable-typed-continuations
2829
%{read-lines:args}
2930
-o
3031
-)
@@ -38,6 +39,7 @@
3839
--enable-strings
3940
--enable-multivalue
4041
--enable-bulk-memory
42+
--enable-typed-continuations
4143
-
4244
-O3
4345
-o

‎runtime/wasm/effect-native.wat

+178
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,178 @@
1+
(module
2+
(import "fail" "caml_raise_constant"
3+
(func $caml_raise_constant (param (ref eq))))
4+
(import "fail" "caml_raise_with_arg"
5+
(func $caml_raise_with_arg (param $tag (ref eq)) (param $arg (ref eq))))
6+
(import "obj" "caml_fresh_oo_id"
7+
(func $caml_fresh_oo_id (param (ref eq)) (result (ref eq))))
8+
(import "stdlib" "caml_named_value"
9+
(func $caml_named_value (param (ref $string)) (result (ref null eq))))
10+
(import "fail" "ocaml_exception" (tag $ocaml_exception (param (ref eq))))
11+
(import "fail" "javascript_exception"
12+
(tag $javascript_exception (param externref)))
13+
(import "jslib" "caml_wrap_exception"
14+
(func $caml_wrap_exception (param externref) (result (ref eq))))
15+
(import "bindings" "start_fiber" (func $start_fiber (param (ref eq))))
16+
(import "bindings" "suspend_fiber"
17+
(func $suspend_fiber
18+
(param externref) (param $f funcref) (param $env eqref)
19+
(result eqref)))
20+
(import "bindings" "resume_fiber"
21+
(func $resume_fiber (param externref) (param (ref eq))))
22+
23+
(type $block (array (mut (ref eq))))
24+
(type $string (array (mut i8)))
25+
(type $function_1 (func (param (ref eq) (ref eq)) (result (ref eq))))
26+
(type $closure (sub (struct (;(field i32);) (field (ref $function_1)))))
27+
(type $function_3
28+
(func (param (ref eq) (ref eq) (ref eq) (ref eq)) (result (ref eq))))
29+
(type $closure_3
30+
(sub $closure
31+
(struct (field (ref $function_1)) (field (ref $function_3)))))
32+
33+
;; Effect types
34+
35+
(tag $effect (param (ref eq)) (result (ref eq) (ref eq)))
36+
37+
(type $cont_function (func (param (ref eq) (ref eq)) (result (ref eq))))
38+
39+
(type $cont (cont $cont_function))
40+
41+
(type $handlers
42+
(struct
43+
(field $value (ref eq))
44+
(field $exn (ref eq))
45+
(field $effect (ref eq))))
46+
47+
(type $generic_fiber (sub (struct (field $handlers (mut (ref $handlers))))))
48+
49+
(type $fiber
50+
(sub final $generic_fiber
51+
(struct
52+
(field $handlers (mut (ref $handlers)))
53+
(field $cont (ref $cont)))))
54+
55+
(type $continuation (struct (mut eqref)))
56+
57+
(;ZZZ need to install an effect handler when starting up; not sure
58+
what to do in callback
59+
60+
(data $effect_unhandled "Effect.Unhandled")
61+
62+
(func $raise_unhandled
63+
(param $eff (ref eq)) (param (ref eq)) (result (ref eq))
64+
(local $effect_unhandled (ref $string))
65+
(local.set $effect_unhandled
66+
(array.new_data $string $effect_unhandled
67+
(i32.const 0) (i32.const 16)))
68+
(block $null
69+
(call $caml_raise_with_arg
70+
(br_on_null $null
71+
(call $caml_named_value
72+
(local.get $effect_unhandled)))
73+
(local.get $eff)))
74+
(call $caml_raise_constant
75+
(array.new_fixed $block 3 (ref.i31 (i32.const 248))
76+
(local.get $effect_unhandled)
77+
(call $caml_fresh_oo_id (ref.i31 (i32.const 0)))))
78+
(ref.i31 (i32.const 0)))
79+
;)
80+
81+
;; Resume
82+
83+
(data $already_resumed "Effect.Continuation_already_resumed")
84+
85+
(func $resume (export "%resume")
86+
(param $vfiber (ref eq)) (param $f (ref eq)) (param $v (ref eq))
87+
(result (ref eq))
88+
(local $fiber (ref $fiber))
89+
(local $res (ref eq))
90+
(local $exn (ref eq))
91+
(local $resume_res (tuple (ref eq) (ref $cont)))
92+
(local.set $fiber (ref.cast (ref $fiber) (local.get $vfiber)))
93+
(if (ref.eq (local.get $fiber) (ref.i31 (i32.const 0)))
94+
(then
95+
(call $caml_raise_constant
96+
(ref.as_non_null
97+
(call $caml_named_value
98+
(array.new_data $string $already_resumed
99+
(i32.const 0) (i32.const 35)))))))
100+
(local.set $exn
101+
(block $handle_exception (result (ref eq))
102+
(local.set $resume_res
103+
(block $handle_effect (result (ref eq) (ref $cont))
104+
(local.set $res
105+
(try (result (ref eq))
106+
(do
107+
(resume $cont
108+
(tag $effect $handle_effect)
109+
(local.get $f) (local.get $v)
110+
(struct.get $fiber $cont (local.get $fiber))))
111+
(catch $javascript_exception
112+
(br $handle_exception
113+
(call $caml_wrap_exception (pop externref))))
114+
(catch $ocaml_exception
115+
(br $handle_exception (pop (ref eq))))))
116+
;; handle return
117+
(return_call_ref $function_1 (local.get $res)
118+
(local.tee $f
119+
(struct.get $handlers $value
120+
(struct.get $fiber $handlers (local.get $fiber))))
121+
(struct.get $closure 0
122+
(ref.cast (ref $closure) (local.get $f))))))
123+
;; handle effect
124+
(return_call_ref $function_3
125+
(tuple.extract 2 0 (local.get $resume_res))
126+
(struct.new $continuation
127+
(struct.new $fiber
128+
(struct.get $fiber $handlers (local.get $fiber))
129+
(tuple.extract 2 1 (local.get $resume_res))))
130+
(ref.i31 (i32.const 0)) ;; unused
131+
(local.tee $f
132+
(struct.get $handlers $effect
133+
(struct.get $fiber $handlers (local.get $fiber))))
134+
(struct.get $closure_3 1
135+
(ref.cast (ref $closure_3) (local.get $f))))))
136+
;; handle exception
137+
(return_call_ref $function_1 (local.get $exn)
138+
(local.tee $f
139+
(struct.get $handlers $value
140+
(struct.get $fiber $handlers (local.get $fiber))))
141+
(struct.get $closure 0 (ref.cast (ref $closure) (local.get $f)))))
142+
143+
;; Perform
144+
145+
(func (export "%reperform")
146+
(param $eff (ref eq)) (param $cont (ref eq)) (result (ref eq))
147+
(local $res (tuple (ref eq) (ref eq)))
148+
(local.set $res (suspend $effect (local.get $eff)))
149+
(return_call $resume
150+
(ref.as_non_null
151+
(struct.get $continuation 0
152+
(ref.cast (ref $continuation) (local.get $cont))))
153+
(tuple.extract 2 0 (local.get $res))
154+
(tuple.extract 2 1 (local.get $res))))
155+
156+
(func (export "%perform") (param $eff (ref eq)) (result (ref eq))
157+
(local $res (tuple (ref eq) (ref eq)))
158+
(local.set $res (suspend $effect (local.get $eff)))
159+
(return_call_ref $function_1 (tuple.extract 2 1 (local.get $res))
160+
(tuple.extract 2 0 (local.get $res))
161+
(struct.get $closure 0
162+
(ref.cast (ref $closure) (tuple.extract 2 0 (local.get $res))))))
163+
164+
;; Allocate a stack
165+
166+
(func $initial_cont
167+
(param $f (ref $closure)) (param $x (ref eq)) (result (ref eq))
168+
(return_call_ref $function_1 (local.get $x)
169+
(local.get $f)
170+
(struct.get $closure 0 (local.get $f))))
171+
172+
(func (export "caml_alloc_stack")
173+
(param $hv (ref eq)) (param $hx (ref eq)) (param $hf (ref eq))
174+
(result (ref eq))
175+
(struct.new $fiber
176+
(struct.new $handlers (local.get $hv) (local.get $hx) (local.get $hf))
177+
(cont.new $cont (ref.func $initial_cont))))
178+
)

0 commit comments

Comments
 (0)