From 41d0c6e2667b71f963b66cc3b6548952727c52d5 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Sun, 14 Feb 2021 23:12:37 +0000 Subject: [PATCH 01/82] Minimal exception handling extension This patch extends the interpreter with a minimal exception handling facility. It is minimal in the sense that it supports only a single exception which can be thrown and caught. --- interpreter/binary/encode.ml | 2 ++ interpreter/exec/eval.ml | 39 +++++++++++++++++++++++++++--- interpreter/syntax/ast.ml | 2 ++ interpreter/syntax/free.ml | 2 ++ interpreter/syntax/operators.ml | 3 +++ interpreter/text/arrange.ml | 4 +++ interpreter/text/parser.mly | 43 +++++++++++++++++++++++++++++++++ interpreter/valid/valid.ml | 10 ++++++++ 8 files changed, 102 insertions(+), 3 deletions(-) diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 99ab22cde..845f5525c 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -428,6 +428,8 @@ let encode m = | Convert (F64 F64Op.DemoteF64) -> assert false | Convert (F64 F64Op.ReinterpretInt) -> op 0xbf + | Try _ | Throw -> failwith "encode.ml: not yet implemented" + let const c = list instr c.it; end_ () diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 76bb1a847..1f7063e47 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -11,6 +11,7 @@ module Link = Error.Make () module Trap = Error.Make () module Crash = Error.Make () module Exhaustion = Error.Make () +module Uncaught = Error.Make () exception Link = Link.Error exception Trap = Trap.Error @@ -66,6 +67,8 @@ and admin_instr' = | Label of int * instr list * code | Local of int * value list * code | Frame of int * frame * code + | Catch of int * instr list * code + | Throwing type config = { @@ -525,7 +528,17 @@ let rec step (c : config) : config = | Convert cvtop, Num n :: vs' -> (try Num (Eval_numeric.eval_cvtop cvtop n) :: vs', [] - with exn -> vs', [Trapping (numeric_error e.at exn) @@ e.at]) + with exn -> vs', [Trapping (numeric_error e.at exn) @@ e.at]) + + | Try (bt, es1, es2), vs -> + let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in + let n1 = List.length ts1 in + let n2 = List.length ts2 in + let args, vs' = take n1 vs e.at, drop n1 vs e.at in + vs', [Catch (n2, es2, ([], [Label (n2, [], (args, List.map plain es1)) @@ e.at])) @@ e.at] + + | Throw, vs -> + vs, [Throwing @@ e.at] | _ -> let s1 = string_of_values (List.rev vs) in @@ -554,7 +567,10 @@ let rec step (c : config) : config = take n vs0 e.at @ vs, List.map plain es0 | Label (n, es0, (vs', {it = Breaking (k, vs0); at} :: es')), vs -> - vs, [Breaking (Int32.sub k 1l, vs0) @@ at] + vs, [Breaking (Int32.sub k 1l, vs0) @@ at] + + | Label (n, es0, (vs', {it = Throwing; at} :: _)), vs -> + vs, [Throwing @@ at] | Label (n, es0, (vs', e' :: es')), vs when is_jumping e' -> vs, [e'] @@ -582,7 +598,10 @@ let rec step (c : config) : config = vs, [Trapping msg @@ at] | Frame (n, frame', (vs', {it = Returning vs0; at} :: es')), vs -> - take n vs0 e.at @ vs, [] + take n vs0 e.at @ vs, [] + + | Frame (n, frame', (vs', {it = Throwing; at} :: _)), vs -> + vs, [Throwing @@ at] | Frame (n, frame', (vs', {it = ReturningInvoke (vs0, f); at} :: es')), vs -> let FuncType (ts1, _) = Func.type_of f in @@ -616,6 +635,20 @@ let rec step (c : config) : config = | Func.ClosureFunc (_, f', args') -> args @ args' @ vs', [Invoke f' @@ e.at] ) + + | Throwing, _ -> + Uncaught.error e.at "uncaught exception" + + | Catch (_, _, (_, ({it = Trapping _ | Breaking _ | Returning _; _} as e) :: _)), vs -> + vs, [e] + + | Catch (n, es1, (_, { it = Throwing; at} :: _)), vs -> + let exn = [] in + vs, [Label (n, [], (exn, List.map plain es1)) @@ e.at] + + | Catch (n, es', code'), vs -> + let c' = step {c with code = code'} in + vs, [Catch (n, es', c'.code) @@ e.at] in {c with code = vs', es' @ List.tl es} diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml index 108315489..d501efc89 100644 --- a/interpreter/syntax/ast.ml +++ b/interpreter/syntax/ast.ml @@ -125,6 +125,8 @@ and instr' = | Unary of unop (* unary numeric operator *) | Binary of binop (* binary numeric operator *) | Convert of cvtop (* conversion *) + | Try of block_type * instr list * instr list + | Throw (* Globals & Functions *) diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml index 8b99f1aa0..c16c08725 100644 --- a/interpreter/syntax/free.ml +++ b/interpreter/syntax/free.ml @@ -123,6 +123,8 @@ let rec instr (e : instr) = memories zero | MemoryInit x -> memories zero ++ datas (idx x) | DataDrop x -> datas (idx x) + | Try (_, es1, es2) -> block es1 ++ block es2 + | Throw -> empty and block (es : instr list) = let free = list instr es in {free with labels = shift free.labels} diff --git a/interpreter/syntax/operators.ml b/interpreter/syntax/operators.ml index b38d61ab4..26844f9e4 100644 --- a/interpreter/syntax/operators.ml +++ b/interpreter/syntax/operators.ml @@ -238,3 +238,6 @@ let i32_reinterpret_f32 = Convert (I32 I32Op.ReinterpretFloat) let i64_reinterpret_f64 = Convert (I64 I64Op.ReinterpretFloat) let f32_reinterpret_i32 = Convert (F32 F32Op.ReinterpretInt) let f64_reinterpret_i64 = Convert (F64 F64Op.ReinterpretInt) + +let try_ bt es1 es2 = Try (bt, es1, es2) +let throw = Throw diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index 87f1f4615..11bcc2b8f 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -288,6 +288,10 @@ let rec instr e = | Unary op -> unop op, [] | Binary op -> binop op, [] | Convert op -> cvtop op, [] + | Try (bt, es1, es2) -> + "try", block_type bt @ + [Node ("then", list instr es1); Node ("catch", list instr es2)] + | Throw -> "throw", [] in Node (head, inner) let const head c = diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index c06e24ece..06087f4e7 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -228,6 +228,7 @@ let inline_func_type_explicit (c : context) x ft at = %token NAN %token INPUT OUTPUT %token EOF +%token TRY CATCH THROW %token NAT %token INT @@ -442,6 +443,7 @@ plain_instr : | UNARY { fun c -> $1 } | BINARY { fun c -> $1 } | CONVERT { fun c -> $1 } + | THROW { fun c -> throw } select_instr : @@ -660,6 +662,10 @@ expr1 : /* Sugar */ { let at = at () in fun c -> let c' = enter_let ($2 c []) at in let bt, ls, es = $3 c c' in [], let_ bt ls es } + | TRY try_block + { fun c -> + let bt, (es1, es2) = $2 c in + [], try_ bt es1 es2 } select_expr_results : | LPAR RESULT value_type_list RPAR select_expr_results @@ -692,6 +698,43 @@ call_expr_results : { fun c -> [], $1 c } +try_block : + | type_use try_block_param_body + { let at = at () in + fun c -> + let t = $1 c type_ in + let ft, es = $2 c in + let x = SynVar (inline_func_type_explicit c t ft at).it in + VarBlockType x, es } + | try_block_param_body /* Sugar */ + { let at = at () in + fun c -> + let bt = + match fst ($1 c) with + | FuncType ([], []) -> ValBlockType None + | FuncType ([], [t]) -> ValBlockType (Some t) + | ft -> VarBlockType (SynVar (inline_func_type c ft at).it) + in bt, snd ($1 c) } +try_block_param_body : + | try_block_result_body { $1 } + | LPAR PARAM value_type_list RPAR try_block_param_body + { fun c -> + let FuncType (ins, out), es = $5 c in + let ins' = snd $3 c in + FuncType (ins' @ ins, out), es } +try_block_result_body : + | try_ { fun c -> FuncType ([], []), $1 c } + | LPAR RESULT value_type_list RPAR try_block_result_body + { fun c -> + let FuncType (ins, out), es = $5 c in + let out' = snd $3 c in + FuncType (ins, out' @ out), es } +try_ : + | LPAR THEN instr_list RPAR LPAR CATCH instr_list RPAR + { fun c -> + let es1, es2 = $3 c, $7 c in + (es1, es2) } + if_block : | type_use if_block_param_body { let at = at () in diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index ac7b27431..d804ae3fa 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -538,6 +538,16 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type = let t1, t2 = type_cvtop e.at cvtop in [NumType t1] --> [NumType t2] + | Try (bt, es1, es2) -> + let FuncType (ts1, ts2) as ft1 = check_block_type c bt e.at in + check_block {c with labels = ts2 :: c.labels} es1 ft1 e.at; + let ft2 = FuncType ([], ts2) in + check_block {c with labels = ts2 :: c.labels} es2 ft2 e.at; + ts1 --> ts2 + + | Throw -> + [] -->... [] + and check_seq (c : context) (s : infer_stack_type) (es : instr list) : infer_stack_type = match es with From f81d04a5b3a7e8965629772a7105ad7e114b3670 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= <1827113+dhil@users.noreply.github.com> Date: Tue, 16 Feb 2021 11:10:27 +0000 Subject: [PATCH 02/82] Update interpreter/syntax/free.ml Co-authored-by: Andreas Rossberg --- interpreter/syntax/free.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml index c16c08725..ceeedec24 100644 --- a/interpreter/syntax/free.ml +++ b/interpreter/syntax/free.ml @@ -123,7 +123,7 @@ let rec instr (e : instr) = memories zero | MemoryInit x -> memories zero ++ datas (idx x) | DataDrop x -> datas (idx x) - | Try (_, es1, es2) -> block es1 ++ block es2 + | Try (bt, es1, es2) -> block_type bt ++ block es1 ++ block es2 | Throw -> empty and block (es : instr list) = From 1572421d83655157a1cb82a42bbfce77fc4892b0 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= <1827113+dhil@users.noreply.github.com> Date: Tue, 16 Feb 2021 11:10:39 +0000 Subject: [PATCH 03/82] Update interpreter/text/arrange.ml Co-authored-by: Andreas Rossberg --- interpreter/text/arrange.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index 11bcc2b8f..4c131c9cc 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -290,7 +290,7 @@ let rec instr e = | Convert op -> cvtop op, [] | Try (bt, es1, es2) -> "try", block_type bt @ - [Node ("then", list instr es1); Node ("catch", list instr es2)] + [Node ("do", list instr es1); Node ("catch", list instr es2)] | Throw -> "throw", [] in Node (head, inner) From 7fe3e8980dbcbaad83f4a43c9c8832793260b04c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= <1827113+dhil@users.noreply.github.com> Date: Tue, 16 Feb 2021 11:10:48 +0000 Subject: [PATCH 04/82] Update interpreter/text/parser.mly Co-authored-by: Andreas Rossberg --- interpreter/text/parser.mly | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index 06087f4e7..e442452dc 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -730,7 +730,7 @@ try_block_result_body : let out' = snd $3 c in FuncType (ins, out' @ out), es } try_ : - | LPAR THEN instr_list RPAR LPAR CATCH instr_list RPAR + | LPAR DO instr_list RPAR LPAR CATCH instr_list RPAR { fun c -> let es1, es2 = $3 c, $7 c in (es1, es2) } From f293c249fa19b0784a32b5c6b556ed7cbe4f222d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= <1827113+dhil@users.noreply.github.com> Date: Tue, 16 Feb 2021 11:10:56 +0000 Subject: [PATCH 05/82] Update interpreter/exec/eval.ml Co-authored-by: Andreas Rossberg --- interpreter/exec/eval.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 1f7063e47..67a664ce5 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -534,7 +534,7 @@ let rec step (c : config) : config = let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in let n1 = List.length ts1 in let n2 = List.length ts2 in - let args, vs' = take n1 vs e.at, drop n1 vs e.at in + let args, vs' = split n1 vs e.at in vs', [Catch (n2, es2, ([], [Label (n2, [], (args, List.map plain es1)) @@ e.at])) @@ e.at] | Throw, vs -> From ad622f36476cddb2409881a233cb6a784b23813b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= <1827113+dhil@users.noreply.github.com> Date: Tue, 16 Feb 2021 11:11:05 +0000 Subject: [PATCH 06/82] Update interpreter/exec/eval.ml Co-authored-by: Andreas Rossberg --- interpreter/exec/eval.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 67a664ce5..6986793d1 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -642,7 +642,7 @@ let rec step (c : config) : config = | Catch (_, _, (_, ({it = Trapping _ | Breaking _ | Returning _; _} as e) :: _)), vs -> vs, [e] - | Catch (n, es1, (_, { it = Throwing; at} :: _)), vs -> + | Catch (n, es1, (_, {it = Throwing; _} :: _)), vs -> let exn = [] in vs, [Label (n, [], (exn, List.map plain es1)) @@ e.at] From 449e17608cb8d4739a8396477884dcabf65ee738 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= <1827113+dhil@users.noreply.github.com> Date: Tue, 16 Feb 2021 11:11:13 +0000 Subject: [PATCH 07/82] Update interpreter/binary/encode.ml Co-authored-by: Andreas Rossberg --- interpreter/binary/encode.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 845f5525c..7e4235dad 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -428,7 +428,7 @@ let encode m = | Convert (F64 F64Op.DemoteF64) -> assert false | Convert (F64 F64Op.ReinterpretInt) -> op 0xbf - | Try _ | Throw -> failwith "encode.ml: not yet implemented" + | Try _ | Throw -> failwith "encode: not yet implemented" let const c = list instr c.it; end_ () From 8e0a3785c4c2b30b220bf5fac4bad1ee2c658669 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= <1827113+dhil@users.noreply.github.com> Date: Tue, 16 Feb 2021 11:11:30 +0000 Subject: [PATCH 08/82] Update interpreter/exec/eval.ml Co-authored-by: Andreas Rossberg --- interpreter/exec/eval.ml | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 6986793d1..9f255206e 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -643,8 +643,7 @@ let rec step (c : config) : config = vs, [e] | Catch (n, es1, (_, {it = Throwing; _} :: _)), vs -> - let exn = [] in - vs, [Label (n, [], (exn, List.map plain es1)) @@ e.at] + vs, [Label (n, [], ([], List.map plain es1)) @@ e.at] | Catch (n, es', code'), vs -> let c' = step {c with code = code'} in From 147024b4c6b7b0a74dcaaecb1bde58bb69e06203 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Tue, 16 Feb 2021 11:47:34 +0000 Subject: [PATCH 09/82] Declare DO as a token. --- interpreter/text/parser.mly | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index e442452dc..d457dc049 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -228,7 +228,7 @@ let inline_func_type_explicit (c : context) x ft at = %token NAN %token INPUT OUTPUT %token EOF -%token TRY CATCH THROW +%token TRY CATCH DO THROW %token NAT %token INT From bd8a6111220bdde9ce9a91e2207673ac35d755e2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Tue, 16 Feb 2021 12:07:26 +0000 Subject: [PATCH 10/82] Add lexical rules for try/catch/do/throw. --- interpreter/text/lexer.mll | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index e2895df31..1b3b57988 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -392,6 +392,11 @@ rule token = parse | "input" { INPUT } | "output" { OUTPUT } + | "try" { TRY } + | "catch" { CATCH } + | "do" { DO } + | "throw" { THROW } + | name as s { VAR s } | ";;"utf8_no_nl*eof { EOF } From b0fcf75b5398c1770997b837a6cbc18e7c001006 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Tue, 16 Feb 2021 12:27:34 +0000 Subject: [PATCH 11/82] Add a few test cases. --- interpreter/exec/eval.ml | 1 + interpreter/exec/eval.mli | 1 + interpreter/script/js.ml | 2 ++ interpreter/script/run.ml | 8 ++++++++ interpreter/script/script.ml | 1 + interpreter/text/arrange.ml | 2 ++ interpreter/text/lexer.mll | 1 + interpreter/text/parser.mly | 3 ++- test/core/tinyexn.wast | 31 +++++++++++++++++++++++++++++++ 9 files changed, 49 insertions(+), 1 deletion(-) create mode 100644 test/core/tinyexn.wast diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 9f255206e..68e4b2e7e 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -17,6 +17,7 @@ exception Link = Link.Error exception Trap = Trap.Error exception Crash = Crash.Error (* failure that cannot happen in valid code *) exception Exhaustion = Exhaustion.Error +exception Uncaught = Uncaught.Error let table_error at = function | Table.Bounds -> "out of bounds table access" diff --git a/interpreter/exec/eval.mli b/interpreter/exec/eval.mli index 056fc05fe..250576801 100644 --- a/interpreter/exec/eval.mli +++ b/interpreter/exec/eval.mli @@ -5,6 +5,7 @@ exception Link of Source.region * string exception Trap of Source.region * string exception Crash of Source.region * string exception Exhaustion of Source.region * string +exception Uncaught of Source.region * string val init : Ast.module_ -> extern list -> module_inst (* raises Link, Trap *) val invoke : func_inst -> value list -> value list (* raises Trap *) diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml index fcdbcfa06..829050aea 100644 --- a/interpreter/script/js.ml +++ b/interpreter/script/js.ml @@ -529,6 +529,8 @@ let of_assertion mods ass = of_assertion' mods act "assert_trap" [] None | AssertExhaustion (act, _) -> of_assertion' mods act "assert_exhaustion" [] None + | AssertUncaught (act, _) -> + of_assertion' mods act "assert_uncaught" [] None let of_command mods cmd = "\n// " ^ Filename.basename cmd.at.left.file ^ diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml index e95907245..40fc8b256 100644 --- a/interpreter/script/run.ml +++ b/interpreter/script/run.ml @@ -112,6 +112,7 @@ let input_from get_script run = | Eval.Trap (at, msg) -> error at "runtime trap" msg | Eval.Exhaustion (at, msg) -> error at "resource exhaustion" msg | Eval.Crash (at, msg) -> error at "runtime crash" msg + | Eval.Uncaught (at, msg) -> error at "runtime uncaught" msg | Encode.Code (at, msg) -> error at "encoding error" msg | Script.Error (at, msg) -> error at "script error" msg | IO (at, msg) -> error at "i/o error" msg @@ -446,6 +447,13 @@ let run_assertion ass = | _ -> Assert.error ass.at "expected exhaustion error" ) + | AssertUncaught (act, re) -> + trace ("Asserting trap..."); + (match run_action act with + | exception Eval.Uncaught (_, msg) -> assert_message ass.at "runtime" msg re + | _ -> Assert.error ass.at "expected runtime error" + ) + let rec run_command cmd = match cmd.it with | Module (x_opt, def) -> diff --git a/interpreter/script/script.ml b/interpreter/script/script.ml index 82c73be91..d95e5b7a7 100644 --- a/interpreter/script/script.ml +++ b/interpreter/script/script.ml @@ -34,6 +34,7 @@ and assertion' = | AssertReturn of action * result list | AssertTrap of action * string | AssertExhaustion of action * string + | AssertUncaught of action * string type command = command' Source.phrase and command' = diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index 4c131c9cc..b0849000e 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -538,6 +538,8 @@ let assertion mode ass = [Node ("assert_trap", [action mode act; Atom (string re)])] | AssertExhaustion (act, re) -> [Node ("assert_exhaustion", [action mode act; Atom (string re)])] + | AssertUncaught (act, re) -> + [Node ("assert_uncaught", [action mode act; Atom (string re)])] let command mode cmd = match cmd.it with diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index 1b3b57988..4b0576e04 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -396,6 +396,7 @@ rule token = parse | "catch" { CATCH } | "do" { DO } | "throw" { THROW } + | "assert_uncaught" { ASSERT_UNCAUGHT } | name as s { VAR s } diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index d457dc049..2b57c3f82 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -228,7 +228,7 @@ let inline_func_type_explicit (c : context) x ft at = %token NAN %token INPUT OUTPUT %token EOF -%token TRY CATCH DO THROW +%token TRY CATCH DO THROW ASSERT_UNCAUGHT %token NAT %token INT @@ -1207,6 +1207,7 @@ assertion : | LPAR ASSERT_RETURN action result_list RPAR { AssertReturn ($3, $4) @@ at () } | LPAR ASSERT_TRAP action STRING RPAR { AssertTrap ($3, $4) @@ at () } | LPAR ASSERT_EXHAUSTION action STRING RPAR { AssertExhaustion ($3, $4) @@ at () } + | LPAR ASSERT_UNCAUGHT action STRING RPAR { AssertUncaught ($3, $4) @@ at () } cmd : | action { Action $1 @@ at () } diff --git a/test/core/tinyexn.wast b/test/core/tinyexn.wast new file mode 100644 index 000000000..3c9f2db04 --- /dev/null +++ b/test/core/tinyexn.wast @@ -0,0 +1,31 @@ +;; Test the minimal "exception handling" extension + +(module + (func (export "catch-1") (result i32) + (try (result i32) + (do + throw + i32.const 0) + (catch + (i32.const 1)))) + + (func (export "catch-2") (result i32) + (try (result i32) + (do + (try (result i32) + (do + throw + i32.const 0) + (catch + throw + i32.const 1))) + (catch + (i32.const 2)))) + + (func (export "uncaught") + (throw)) +) + +(assert_return (invoke "catch-1") (i32.const 1)) +(assert_return (invoke "catch-2") (i32.const 2)) +(assert_uncaught (invoke "uncaught") "uncaught exception") From 62fc2d9cfcbdc947596b84c45553657d645add31 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Tue, 16 Feb 2021 13:58:24 +0000 Subject: [PATCH 12/82] Implement binary encoding and decoding. The opcodes for try/catch/throw are taken from the provisional exception-handling proposal. --- interpreter/binary/decode.ml | 14 ++++++++++++-- interpreter/binary/encode.ml | 5 ++++- 2 files changed, 16 insertions(+), 3 deletions(-) diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index 0a1768583..e3d92c422 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -270,7 +270,17 @@ let rec instr s = end | 0x05 -> error s pos "misplaced ELSE opcode" - | 0x06| 0x07 | 0x08 | 0x09 | 0x0a as b -> illegal s pos b + | 0x06 -> + let bt = block_type s in + let es1 = instr_block s in + expect 0x07 s "CATCH opcode expected"; + let es2 = instr_block s in + end_ s; + try_ bt es1 es2 + | 0x07 -> error s pos "misplaced CATCH opcode" + | 0x08 -> throw + + | 0x09 | 0x0a as b -> illegal s pos b | 0x0b -> error s pos "misplaced END opcode" | 0x0c -> br (at var s) @@ -538,7 +548,7 @@ let rec instr s = and instr_block s = List.rev (instr_block' s []) and instr_block' s es = match peek s with - | None | Some (0x05 | 0x0b) -> es + | None | Some (0x05 | 0x07 | 0x0b) -> es | _ -> let pos = pos s in let e' = instr s in diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 7e4235dad..6017cf2ff 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -428,7 +428,10 @@ let encode m = | Convert (F64 F64Op.DemoteF64) -> assert false | Convert (F64 F64Op.ReinterpretInt) -> op 0xbf - | Try _ | Throw -> failwith "encode: not yet implemented" + | Try (bt, es1, es2) -> + op 0x06; block_type bt; list instr es1; + op 0x07; list instr es2; end_ () + | Throw -> op 0x08 let const c = list instr c.it; end_ () From 4d2b207a83a2aab60911229e3e3df0426d1e7b37 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= <1827113+dhil@users.noreply.github.com> Date: Tue, 16 Feb 2021 14:57:04 +0000 Subject: [PATCH 13/82] Update interpreter/script/run.ml Co-authored-by: Andreas Rossberg --- interpreter/script/run.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml index 40fc8b256..49b5c1ee2 100644 --- a/interpreter/script/run.ml +++ b/interpreter/script/run.ml @@ -448,7 +448,7 @@ let run_assertion ass = ) | AssertUncaught (act, re) -> - trace ("Asserting trap..."); + trace ("Asserting exception..."); (match run_action act with | exception Eval.Uncaught (_, msg) -> assert_message ass.at "runtime" msg re | _ -> Assert.error ass.at "expected runtime error" From bc83c41c1abe067f37e1bae529d3a9e3d00e8656 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= <1827113+dhil@users.noreply.github.com> Date: Tue, 16 Feb 2021 14:57:10 +0000 Subject: [PATCH 14/82] Update interpreter/script/run.ml Co-authored-by: Andreas Rossberg --- interpreter/script/run.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml index 49b5c1ee2..77c42a9d5 100644 --- a/interpreter/script/run.ml +++ b/interpreter/script/run.ml @@ -451,7 +451,7 @@ let run_assertion ass = trace ("Asserting exception..."); (match run_action act with | exception Eval.Uncaught (_, msg) -> assert_message ass.at "runtime" msg re - | _ -> Assert.error ass.at "expected runtime error" + | _ -> Assert.error ass.at "expected exception" ) let rec run_command cmd = From 5d4602a797f67943fb8dd5fdc4bd917ad6fbb543 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Tue, 16 Feb 2021 15:30:24 +0000 Subject: [PATCH 15/82] Address @rossberg's comments. --- interpreter/binary/decode.ml | 13 +++++++------ interpreter/script/js.ml | 7 +++++++ interpreter/text/lexer.mll | 2 +- interpreter/text/parser.mly | 4 ++-- 4 files changed, 17 insertions(+), 9 deletions(-) diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index e3d92c422..62aca4fc7 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -270,13 +270,14 @@ let rec instr s = end | 0x05 -> error s pos "misplaced ELSE opcode" + | 0x06 -> - let bt = block_type s in - let es1 = instr_block s in - expect 0x07 s "CATCH opcode expected"; - let es2 = instr_block s in - end_ s; - try_ bt es1 es2 + let bt = block_type s in + let es1 = instr_block s in + expect 0x07 s "CATCH opcode expected"; + let es2 = instr_block s in + end_ s; + try_ bt es1 es2 | 0x07 -> error s pos "misplaced CATCH opcode" | 0x08 -> throw diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml index 829050aea..16e422cf5 100644 --- a/interpreter/script/js.ml +++ b/interpreter/script/js.ml @@ -189,6 +189,13 @@ function assert_return(action, ...expected) { } } } + +function assert_uncaught(action) { + try { action() } catch (e) { + if (e instanceof WebAssembly.RuntimeError) return; + } + throw new Error("Wasm uncaught exception expected"); +} |} diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index 4b0576e04..e0fa22a77 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -387,6 +387,7 @@ rule token = parse | "assert_return" { ASSERT_RETURN } | "assert_trap" { ASSERT_TRAP } | "assert_exhaustion" { ASSERT_EXHAUSTION } + | "assert_uncaught" { ASSERT_UNCAUGHT } | "nan:canonical" { NAN Script.CanonicalNan } | "nan:arithmetic" { NAN Script.ArithmeticNan } | "input" { INPUT } @@ -396,7 +397,6 @@ rule token = parse | "catch" { CATCH } | "do" { DO } | "throw" { THROW } - | "assert_uncaught" { ASSERT_UNCAUGHT } | name as s { VAR s } diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index 2b57c3f82..5dcd290de 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -224,11 +224,11 @@ let inline_func_type_explicit (c : context) x ft at = %token MODULE BIN QUOTE %token SCRIPT REGISTER INVOKE GET %token ASSERT_MALFORMED ASSERT_INVALID ASSERT_SOFT_INVALID ASSERT_UNLINKABLE -%token ASSERT_RETURN ASSERT_TRAP ASSERT_EXHAUSTION +%token ASSERT_RETURN ASSERT_TRAP ASSERT_EXHAUSTION ASSERT_UNCAUGHT %token NAN %token INPUT OUTPUT %token EOF -%token TRY CATCH DO THROW ASSERT_UNCAUGHT +%token TRY CATCH DO THROW %token NAT %token INT From 1b59e24699a80030c317672d163da099500b9893 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Tue, 16 Feb 2021 16:27:41 +0000 Subject: [PATCH 16/82] Adds missing success reduction for `catch`. Extends test suite too. --- interpreter/exec/eval.ml | 3 +++ test/core/tinyexn.wast | 22 ++++++++++++++++++++-- 2 files changed, 23 insertions(+), 2 deletions(-) diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 68e4b2e7e..c44dd72de 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -646,6 +646,9 @@ let rec step (c : config) : config = | Catch (n, es1, (_, {it = Throwing; _} :: _)), vs -> vs, [Label (n, [], ([], List.map plain es1)) @@ e.at] + | Catch (_, _, (vs', [])), vs -> + vs' @ vs, [] + | Catch (n, es', code'), vs -> let c' = step {c with code = code'} in vs, [Catch (n, es', c'.code) @@ e.at] diff --git a/test/core/tinyexn.wast b/test/core/tinyexn.wast index 3c9f2db04..278b834c4 100644 --- a/test/core/tinyexn.wast +++ b/test/core/tinyexn.wast @@ -7,7 +7,7 @@ throw i32.const 0) (catch - (i32.const 1)))) + i32.const 1))) (func (export "catch-2") (result i32) (try (result i32) @@ -20,7 +20,23 @@ throw i32.const 1))) (catch - (i32.const 2)))) + i32.const 2))) + + (func (export "success-0") (result i32) + (try (result i32) + (do i32.const 0) + (catch i32.const 1))) + + (func (export "success-1") (result i32) + (try (result i32) + (do + (try (result i32) + (do + throw + i32.const 0) + (catch + i32.const 1))) + (catch i32.const 2))) (func (export "uncaught") (throw)) @@ -28,4 +44,6 @@ (assert_return (invoke "catch-1") (i32.const 1)) (assert_return (invoke "catch-2") (i32.const 2)) +(assert_return (invoke "success-0") (i32.const 0)) +(assert_return (invoke "success-1") (i32.const 1)) (assert_uncaught (invoke "uncaught") "uncaught exception") From 68e69ecc2f75994cd6f0c6baa4cc0f13d36cf10c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= <1827113+dhil@users.noreply.github.com> Date: Tue, 16 Feb 2021 17:46:36 +0000 Subject: [PATCH 17/82] Update interpreter/script/js.ml Co-authored-by: Andreas Rossberg --- interpreter/script/js.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml index 16e422cf5..00e2c2d36 100644 --- a/interpreter/script/js.ml +++ b/interpreter/script/js.ml @@ -192,7 +192,7 @@ function assert_return(action, ...expected) { function assert_uncaught(action) { try { action() } catch (e) { - if (e instanceof WebAssembly.RuntimeError) return; + if (!(e instanceof WebAssembly.RuntimeError)) return; } throw new Error("Wasm uncaught exception expected"); } From ce612e89ef4dec223721bb0299ec23897fa49c6f Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Wed, 17 Feb 2021 18:25:37 +0100 Subject: [PATCH 18/82] Implement events --- interpreter/binary/decode.ml | 47 +++++++++++-- interpreter/binary/encode.ml | 32 +++++++-- interpreter/exec/eval.ml | 115 ++++++++++++++++++-------------- interpreter/exec/eval.mli | 4 +- interpreter/host/spectest.ml | 6 ++ interpreter/runtime/event.ml | 10 +++ interpreter/runtime/event.mli | 7 ++ interpreter/runtime/instance.ml | 6 +- interpreter/script/js.ml | 18 ++--- interpreter/script/run.ml | 16 ++--- interpreter/script/script.ml | 2 +- interpreter/syntax/ast.ml | 21 +++++- interpreter/syntax/free.ml | 15 ++++- interpreter/syntax/free.mli | 2 + interpreter/syntax/operators.ml | 6 +- interpreter/syntax/types.ml | 15 ++++- interpreter/text/arrange.ml | 37 +++++++--- interpreter/text/lexer.mll | 15 +++-- interpreter/text/parser.mly | 89 ++++++++++++++++++++---- interpreter/valid/valid.ml | 56 ++++++++++++---- test/core/binary.wast | 2 +- test/core/catch.wast | 86 ++++++++++++++++++++++++ test/core/tinyexn.wast | 49 -------------- 23 files changed, 472 insertions(+), 184 deletions(-) create mode 100644 interpreter/runtime/event.ml create mode 100644 interpreter/runtime/event.mli create mode 100644 test/core/catch.wast delete mode 100644 test/core/tinyexn.wast diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index 62aca4fc7..fc1f85cad 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -189,6 +189,17 @@ let memory_type s = let lim = limits vu32 s in MemoryType lim +let resumability s = + match u8 s with + | 0 -> Terminal + | 1 -> Resumable + | _ -> error s (pos s - 1) "malformed resumability" + +let event_type s = + let res = resumability s in + let ft = func_type s in (* TODO *) + EventType (ft, res) + let mutability s = match u8 s with | 0 -> Immutable @@ -274,12 +285,21 @@ let rec instr s = | 0x06 -> let bt = block_type s in let es1 = instr_block s in - expect 0x07 s "CATCH opcode expected"; + let xo = + if peek s = Some 0x07 then begin + expect 0x07 s "CATCH or CATCH_ALL opcode expected"; + Some (at var s) + end + else begin + expect 0x19 s "CATCH or CATCH_ALL opcode expected"; + None + end + in let es2 = instr_block s in end_ s; - try_ bt es1 es2 + try_ bt es1 xo es2 | 0x07 -> error s pos "misplaced CATCH opcode" - | 0x08 -> throw + | 0x08 -> throw (at var s) | 0x09 | 0x0a as b -> illegal s pos b | 0x0b -> error s pos "misplaced END opcode" @@ -311,7 +331,9 @@ let rec instr s = end_ s; let_ bt locs es - | 0x18 | 0x19 as b -> illegal s pos b + | 0x18 as b -> illegal s pos b + + | 0x19 -> error s pos "misplaced CATCH_ALL opcode" | 0x1a -> drop | 0x1b -> select None @@ -549,7 +571,7 @@ let rec instr s = and instr_block s = List.rev (instr_block' s []) and instr_block' s es = match peek s with - | None | Some (0x05 | 0x07 | 0x0b) -> es + | None | Some (0x05 | 0x07 | 0x0b | 0x19) -> es | _ -> let pos = pos s in let e' = instr s in @@ -580,6 +602,7 @@ let id s = | 10 -> `CodeSection | 11 -> `DataSection | 12 -> `DataCountSection + | 13 -> `EventSection | _ -> error s (pos s) "malformed section id" ) bo @@ -646,6 +669,16 @@ let memory_section s = section `MemorySection (vec (at memory)) [] s +(* Event section *) + +let event s = + let evtype = event_type s in + {evtype} + +let event_section s = + section `EventSection (vec (at event)) [] s + + (* Global section *) let global s = @@ -830,6 +863,8 @@ let module_ s = iterate custom_section s; let memories = memory_section s in iterate custom_section s; + let events = event_section s in + iterate custom_section s; let globals = global_section s in iterate custom_section s; let exports = export_section s in @@ -855,7 +890,7 @@ let module_ s = let funcs = List.map2 Source.(fun t f -> {f.it with ftype = t} @@ f.at) func_types func_bodies - in {types; tables; memories; globals; funcs; imports; exports; elems; datas; start} + in {types; tables; memories; events; globals; funcs; imports; exports; elems; datas; start} let decode name bs = at module_ (stream name bs) diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 6017cf2ff..0a9c2773c 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -128,6 +128,13 @@ let encode m = let memory_type = function | MemoryType lim -> limits vu32 lim + let resumability = function + | Terminal -> u8 0 + | Resumable -> u8 1 + + let event_type = function + | EventType (ft, res) -> resumability res; func_type ft (* TODO *) + let mutability = function | Immutable -> u8 0 | Mutable -> u8 1 @@ -179,6 +186,15 @@ let encode m = | Let (bt, locs, es) -> op 0x17; block_type bt; locals locs; list instr es; end_ () + | Try (bt, es1, xo, es2) -> + op 0x06; block_type bt; list instr es1; + (match xo with + | Some x -> op 0x07; var x + | None -> op 0x19 + ); + list instr es2; end_ () + | Throw x -> op 0x08; var x + | Br x -> op 0x0c; var x | BrIf x -> op 0x0d; var x | BrTable (xs, x) -> op 0x0e; vec var xs; var x @@ -428,11 +444,6 @@ let encode m = | Convert (F64 F64Op.DemoteF64) -> assert false | Convert (F64 F64Op.ReinterpretInt) -> op 0xbf - | Try (bt, es1, es2) -> - op 0x06; block_type bt; list instr es1; - op 0x07; list instr es2; end_ () - | Throw -> op 0x08 - let const c = list instr c.it; end_ () @@ -460,6 +471,7 @@ let encode m = | TableImport t -> u8 0x01; table_type t | MemoryImport t -> u8 0x02; memory_type t | GlobalImport t -> u8 0x03; global_type t + | EventImport t -> u8 0x04; event_type t let import im = let {module_name; item_name; idesc} = im.it in @@ -498,6 +510,14 @@ let encode m = let global_section gs = section 6 (vec global) gs (gs <> []) + (* Event section *) + let event evt = + let {evtype} = evt.it in + event_type evtype + + let event_section es = + section 13 (vec event) es (es <> []) + (* Export section *) let export_desc d = match d.it with @@ -505,6 +525,7 @@ let encode m = | TableExport x -> u8 1; var x | MemoryExport x -> u8 2; var x | GlobalExport x -> u8 3; var x + | EventExport x -> u8 4; var x let export ex = let {name = n; edesc} = ex.it in @@ -605,6 +626,7 @@ let encode m = func_section m.it.funcs; table_section m.it.tables; memory_section m.it.memories; + event_section m.it.events; global_section m.it.globals; export_section m.it.exports; start_section m.it.start; diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index c44dd72de..491ef4072 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -9,15 +9,15 @@ open Source module Link = Error.Make () module Trap = Error.Make () -module Crash = Error.Make () +module Exception = Error.Make () module Exhaustion = Error.Make () -module Uncaught = Error.Make () +module Crash = Error.Make () exception Link = Link.Error exception Trap = Trap.Error -exception Crash = Crash.Error (* failure that cannot happen in valid code *) +exception Exception = Exception.Error exception Exhaustion = Exhaustion.Error -exception Uncaught = Uncaught.Error +exception Crash = Crash.Error (* failure that cannot happen in valid code *) let table_error at = function | Table.Bounds -> "out of bounds table access" @@ -62,14 +62,14 @@ and admin_instr' = | Refer of ref_ | Invoke of func_inst | Trapping of string + | Throwing of event_inst * value stack | Returning of value stack | ReturningInvoke of value stack * func_inst | Breaking of int32 * value stack | Label of int * instr list * code | Local of int * value list * code | Frame of int * frame * code - | Catch of int * instr list * code - | Throwing + | Catch of int * event_inst option * instr list * code type config = { @@ -85,7 +85,8 @@ let plain e = Plain e.it @@ e.at let is_jumping e = match e.it with - | Trapping _ | Returning _ | ReturningInvoke _ | Breaking _ -> true + | Trapping _ | Throwing _ | Returning _ | ReturningInvoke _ | Breaking _ -> + true | _ -> false let lookup category list x = @@ -97,6 +98,7 @@ let func (inst : module_inst) x = lookup "function" inst.funcs x let table (inst : module_inst) x = lookup "table" inst.tables x let memory (inst : module_inst) x = lookup "memory" inst.memories x let global (inst : module_inst) x = lookup "global" inst.globals x +let event (inst : module_inst) x = lookup "event" inst.events x let elem (inst : module_inst) x = lookup "element segment" inst.elems x let data (inst : module_inst) x = lookup "data segment" inst.datas x let local (frame : frame) x = lookup "local" frame.locals x @@ -198,6 +200,17 @@ let rec step (c : config) : config = ) @@ e.at ] + | Try (bt, es1, xo, es2), vs -> + let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in + let n1 = List.length ts1 in + let n2 = List.length ts2 in + let args, vs' = split n1 vs e.at in + let exno = Option.map (event c.frame.inst) xo in + vs', [Catch (n2, exno, es2, ([], [Label (n2, [], (args, List.map plain es1)) @@ e.at])) @@ e.at] + + | Throw x, vs -> + [], [Throwing (event c.frame.inst x, vs) @@ e.at] + | Br x, vs -> [], [Breaking (x.it, vs) @@ e.at] @@ -531,16 +544,6 @@ let rec step (c : config) : config = (try Num (Eval_numeric.eval_cvtop cvtop n) :: vs', [] with exn -> vs', [Trapping (numeric_error e.at exn) @@ e.at]) - | Try (bt, es1, es2), vs -> - let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in - let n1 = List.length ts1 in - let n2 = List.length ts2 in - let args, vs' = split n1 vs e.at in - vs', [Catch (n2, es2, ([], [Label (n2, [], (args, List.map plain es1)) @@ e.at])) @@ e.at] - - | Throw, vs -> - vs, [Throwing @@ e.at] - | _ -> let s1 = string_of_values (List.rev vs) in let s2 = string_of_stack_type (List.map type_of_value (List.rev vs)) in @@ -551,16 +554,6 @@ let rec step (c : config) : config = | Refer r, vs -> Ref r :: vs, [] - | Trapping msg, vs -> - assert false - - | Returning _, vs - | ReturningInvoke _, vs -> - Crash.error e.at "undefined frame" - - | Breaking (k, vs'), vs -> - Crash.error e.at "undefined label" - | Label (n, es0, (vs', [])), vs -> vs' @ vs, [] @@ -568,10 +561,7 @@ let rec step (c : config) : config = take n vs0 e.at @ vs, List.map plain es0 | Label (n, es0, (vs', {it = Breaking (k, vs0); at} :: es')), vs -> - vs, [Breaking (Int32.sub k 1l, vs0) @@ at] - - | Label (n, es0, (vs', {it = Throwing; at} :: _)), vs -> - vs, [Throwing @@ at] + vs, [Breaking (Int32.sub k 1l, vs0) @@ at] | Label (n, es0, (vs', e' :: es')), vs when is_jumping e' -> vs, [e'] @@ -584,7 +574,7 @@ let rec step (c : config) : config = vs' @ vs, [] | Local (n, vs0, (vs', e' :: es')), vs when is_jumping e' -> - vs' @ vs, [e'] + vs, [e'] | Local (n, vs0, code'), vs -> let frame' = {c.frame with locals = List.map ref vs0 @ c.frame.locals} in @@ -595,19 +585,19 @@ let rec step (c : config) : config = | Frame (n, frame', (vs', [])), vs -> vs' @ vs, [] - | Frame (n, frame', (vs', {it = Trapping msg; at} :: es')), vs -> - vs, [Trapping msg @@ at] - | Frame (n, frame', (vs', {it = Returning vs0; at} :: es')), vs -> - take n vs0 e.at @ vs, [] - - | Frame (n, frame', (vs', {it = Throwing; at} :: _)), vs -> - vs, [Throwing @@ at] + take n vs0 e.at @ vs, [] | Frame (n, frame', (vs', {it = ReturningInvoke (vs0, f); at} :: es')), vs -> let FuncType (ts1, _) = Func.type_of f in take (List.length ts1) vs0 e.at @ vs, [Invoke f @@ at] + | Frame (n, fame', (vs', {it = Breaking _; at} :: es')), vs -> + Crash.error at "undefined label" + + | Frame (n, frame', (vs', e' :: es')), vs when is_jumping e' -> + vs, [e'] + | Frame (n, frame', code'), vs -> let c' = step {frame = frame'; code = code'; budget = c.budget - 1} in vs, [Frame (n, frame', c'.code) @@ e.at] @@ -637,21 +627,36 @@ let rec step (c : config) : config = args @ args' @ vs', [Invoke f' @@ e.at] ) - | Throwing, _ -> - Uncaught.error e.at "uncaught exception" + | Catch (n, exno, es0, (vs', [])), vs -> + vs' @ vs, [] - | Catch (_, _, (_, ({it = Trapping _ | Breaking _ | Returning _; _} as e) :: _)), vs -> - vs, [e] + | Catch (n, None, es0, (vs', {it = Throwing (exn, vs0); at} :: _)), vs -> + vs, [Label (n, [], ([], List.map plain es0)) @@ e.at] - | Catch (n, es1, (_, {it = Throwing; _} :: _)), vs -> - vs, [Label (n, [], ([], List.map plain es1)) @@ e.at] + | Catch (n, Some exn, es0, (vs', {it = Throwing (exn0, vs0); at} :: _)), vs + when exn0 == exn -> + let EventType (FuncType (ts, _), _) = Event.type_of exn in + let n' = List.length ts in + vs, [Label (n, [], (take n' vs0 at, List.map plain es0)) @@ e.at] - | Catch (_, _, (vs', [])), vs -> - vs' @ vs, [] + | Catch (n, exno, es0, (vs', e' :: es')), vs when is_jumping e' -> + vs, [e'] - | Catch (n, es', code'), vs -> + | Catch (n, exno, es0, code'), vs -> let c' = step {c with code = code'} in - vs, [Catch (n, es', c'.code) @@ e.at] + vs, [Catch (n, exno, es0, c'.code) @@ e.at] + + | Returning _, vs + | ReturningInvoke _, vs -> + Crash.error e.at "undefined frame" + + | Breaking (k, vs'), vs -> + Crash.error e.at "undefined label" + + | Trapping _, vs + | Throwing _, vs -> + assert false + in {c with code = vs', es' @ List.tl es} @@ -663,6 +668,9 @@ let rec eval (c : config) : value stack = | vs, {it = Trapping msg; at} :: _ -> Trap.error at msg + | vs, {it = Throwing _; at} :: _ -> + Exception.error at "uncaught exception" + | vs, es -> eval (step c) @@ -714,6 +722,10 @@ let create_global (inst : module_inst) (glob : global) : global_inst = let v = eval_const inst ginit in Global.alloc (Types.sem_global_type inst.types gtype) v +let create_event (inst : module_inst) (evt : event) : event_inst = + let {evtype} = evt.it in + Event.alloc (Types.sem_event_type inst.types evtype) + let create_export (inst : module_inst) (ex : export) : export_inst = let {name; edesc} = ex.it in let ext = @@ -722,6 +734,7 @@ let create_export (inst : module_inst) (ex : export) : export_inst = | TableExport x -> ExternTable (table inst x) | MemoryExport x -> ExternMemory (memory inst x) | GlobalExport x -> ExternGlobal (global inst x) + | EventExport x -> ExternEvent (event inst x) in (name, ext) let create_elem (inst : module_inst) (seg : elem_segment) : elem_inst = @@ -745,6 +758,7 @@ let add_import (m : module_) (ext : extern) (im : import) (inst : module_inst) | ExternTable tab -> {inst with tables = tab :: inst.tables} | ExternMemory mem -> {inst with memories = mem :: inst.memories} | ExternGlobal glob -> {inst with globals = glob :: inst.globals} + | ExternEvent evt -> {inst with events = evt :: inst.events} let init_type (inst : module_inst) (type_ : type_) (x : type_inst) = @@ -790,7 +804,7 @@ let run_start start = let init (m : module_) (exts : extern list) : module_inst = let - { imports; tables; memories; globals; funcs; types; + { types; imports; tables; memories; globals; funcs; events; exports; elems; datas; start } = m.it in @@ -806,6 +820,7 @@ let init (m : module_) (exts : extern list) : module_inst = tables = inst2.tables @ List.map (create_table inst2) tables; memories = inst2.memories @ List.map (create_memory inst2) memories; globals = inst2.globals @ List.map (create_global inst2) globals; + events = inst2.events @ List.map (create_event inst2) events; } in let inst = diff --git a/interpreter/exec/eval.mli b/interpreter/exec/eval.mli index 250576801..05617e098 100644 --- a/interpreter/exec/eval.mli +++ b/interpreter/exec/eval.mli @@ -3,9 +3,9 @@ open Instance exception Link of Source.region * string exception Trap of Source.region * string -exception Crash of Source.region * string +exception Exception of Source.region * string exception Exhaustion of Source.region * string -exception Uncaught of Source.region * string +exception Crash of Source.region * string val init : Ast.module_ -> extern list -> module_inst (* raises Link, Trap *) val invoke : func_inst -> value list -> value list (* raises Trap *) diff --git a/interpreter/host/spectest.ml b/interpreter/host/spectest.ml index 168fb9ff3..162734d4b 100644 --- a/interpreter/host/spectest.ml +++ b/interpreter/host/spectest.ml @@ -21,9 +21,13 @@ let global (GlobalType (t, _) as gt) = let table = Table.alloc (TableType ({min = 10l; max = Some 20l}, (Nullable, FuncHeapType))) (NullRef FuncHeapType) + let memory = Memory.alloc (MemoryType {min = 1l; max = Some 2l}) let func f ft = Func.alloc_host (Types.alloc (FuncDefType ft)) (f ft) +let event = Event.alloc (EventType (FuncType ([NumType I32Type], [NumType I32Type]), Resumable)) +let except = Event.alloc (EventType (FuncType ([NumType I32Type], []), Terminal)) + let print_value v = Printf.printf "%s : %s\n" (string_of_value v) (string_of_value_type (type_of_value v)) @@ -51,4 +55,6 @@ let lookup name t = | "global_f64", _ -> ExternGlobal (global (GlobalType (NumType F64Type, Immutable))) | "table", _ -> ExternTable table | "memory", _ -> ExternMemory memory + | "event", _ -> ExternEvent event + | "exception", _ -> ExternEvent except | _ -> raise Not_found diff --git a/interpreter/runtime/event.ml b/interpreter/runtime/event.ml new file mode 100644 index 000000000..852261579 --- /dev/null +++ b/interpreter/runtime/event.ml @@ -0,0 +1,10 @@ +open Types + +type event = {ty : event_type} +type t = event + +let alloc ty = + {ty} + +let type_of evt = + evt.ty diff --git a/interpreter/runtime/event.mli b/interpreter/runtime/event.mli new file mode 100644 index 000000000..a1aa74541 --- /dev/null +++ b/interpreter/runtime/event.mli @@ -0,0 +1,7 @@ +open Types + +type event +type t = event + +val alloc : event_type -> event +val type_of : event -> event_type diff --git a/interpreter/runtime/instance.ml b/interpreter/runtime/instance.ml index 30727c260..8899aa45d 100644 --- a/interpreter/runtime/instance.ml +++ b/interpreter/runtime/instance.ml @@ -7,6 +7,7 @@ type module_inst = tables : table_inst list; memories : memory_inst list; globals : global_inst list; + events : event_inst list; exports : export_inst list; elems : elem_inst list; datas : data_inst list; @@ -17,6 +18,7 @@ and func_inst = module_inst Lib.Promise.t Func.t and table_inst = Table.t and memory_inst = Memory.t and global_inst = Global.t +and event_inst = Event.t and export_inst = Ast.name * extern and elem_inst = Value.ref_ list ref and data_inst = string ref @@ -26,6 +28,7 @@ and extern = | ExternTable of table_inst | ExternMemory of memory_inst | ExternGlobal of global_inst + | ExternEvent of event_inst (* Reference types *) @@ -48,7 +51,7 @@ let () = (* Auxiliary functions *) let empty_module_inst = - { types = []; funcs = []; tables = []; memories = []; globals = []; + { types = []; funcs = []; tables = []; memories = []; globals = []; events = []; exports = []; elems = []; datas = [] } let extern_type_of c = function @@ -56,6 +59,7 @@ let extern_type_of c = function | ExternTable tab -> ExternTableType (Table.type_of tab) | ExternMemory mem -> ExternMemoryType (Memory.type_of mem) | ExternGlobal glob -> ExternGlobalType (Global.type_of glob) + | ExternEvent evt -> ExternEventType (Event.type_of evt) let export inst name = try Some (List.assoc name inst.exports) with Not_found -> None diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml index 00e2c2d36..f9ca7f41c 100644 --- a/interpreter/script/js.ml +++ b/interpreter/script/js.ml @@ -136,6 +136,13 @@ function assert_trap(action) { throw new Error("Wasm trap expected"); } +function assert_exception(action) { + try { action() } catch (e) { + if (!(e instanceof WebAssembly.RuntimeError)) return; + } + throw new Error("Wasm exception expected"); +} + let StackOverflow; try { (function f() { 1 + f() })() } catch (e) { StackOverflow = e.constructor } @@ -189,13 +196,6 @@ function assert_return(action, ...expected) { } } } - -function assert_uncaught(action) { - try { action() } catch (e) { - if (!(e instanceof WebAssembly.RuntimeError)) return; - } - throw new Error("Wasm uncaught exception expected"); -} |} @@ -534,10 +534,10 @@ let of_assertion mods ass = (Some (assert_return ress)) | AssertTrap (act, _) -> of_assertion' mods act "assert_trap" [] None + | AssertException (act, _) -> + of_assertion' mods act "assert_exception" [] None | AssertExhaustion (act, _) -> of_assertion' mods act "assert_exhaustion" [] None - | AssertUncaught (act, _) -> - of_assertion' mods act "assert_uncaught" [] None let of_command mods cmd = "\n// " ^ Filename.basename cmd.at.left.file ^ diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml index 77c42a9d5..fde16d882 100644 --- a/interpreter/script/run.ml +++ b/interpreter/script/run.ml @@ -110,9 +110,9 @@ let input_from get_script run = | Import.Unknown (at, msg) -> error at "link failure" msg | Eval.Link (at, msg) -> error at "link failure" msg | Eval.Trap (at, msg) -> error at "runtime trap" msg + | Eval.Exception (at, msg) -> error at "runtime exception" msg | Eval.Exhaustion (at, msg) -> error at "resource exhaustion" msg | Eval.Crash (at, msg) -> error at "runtime crash" msg - | Eval.Uncaught (at, msg) -> error at "runtime uncaught" msg | Encode.Code (at, msg) -> error at "encoding error" msg | Script.Error (at, msg) -> error at "script error" msg | IO (at, msg) -> error at "i/o error" msg @@ -439,6 +439,13 @@ let run_assertion ass = | _ -> Assert.error ass.at "expected runtime error" ) + | AssertException (act, re) -> + trace ("Asserting exception..."); + (match run_action act with + | exception Eval.Exception (_, msg) -> assert_message ass.at "runtime" msg re + | _ -> Assert.error ass.at "expected exception" + ) + | AssertExhaustion (act, re) -> trace ("Asserting exhaustion..."); (match run_action act with @@ -447,13 +454,6 @@ let run_assertion ass = | _ -> Assert.error ass.at "expected exhaustion error" ) - | AssertUncaught (act, re) -> - trace ("Asserting exception..."); - (match run_action act with - | exception Eval.Uncaught (_, msg) -> assert_message ass.at "runtime" msg re - | _ -> Assert.error ass.at "expected exception" - ) - let rec run_command cmd = match cmd.it with | Module (x_opt, def) -> diff --git a/interpreter/script/script.ml b/interpreter/script/script.ml index d95e5b7a7..baff09e0e 100644 --- a/interpreter/script/script.ml +++ b/interpreter/script/script.ml @@ -33,8 +33,8 @@ and assertion' = | AssertUninstantiable of definition * string | AssertReturn of action * result list | AssertTrap of action * string + | AssertException of action * string | AssertExhaustion of action * string - | AssertUncaught of action * string type command = command' Source.phrase and command' = diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml index d501efc89..951ac5670 100644 --- a/interpreter/syntax/ast.ml +++ b/interpreter/syntax/ast.ml @@ -84,6 +84,8 @@ and instr' = | Loop of block_type * instr list (* loop header *) | If of block_type * instr list * instr list (* conditional *) | Let of block_type * local list * instr list (* local bindings *) + | Try of block_type * instr list * idx option * instr list (* handle exception *) + | Throw of idx (* throw exception *) | Br of idx (* break to n-th surrounding label *) | BrIf of idx (* conditional break *) | BrTable of idx list * idx (* indexed break *) @@ -125,8 +127,6 @@ and instr' = | Unary of unop (* unary numeric operator *) | Binary of binop (* binary numeric operator *) | Convert of cvtop (* conversion *) - | Try of block_type * instr list * instr list - | Throw (* Globals & Functions *) @@ -149,6 +149,15 @@ and func' = } +(* Events *) + +type event = event' Source.phrase +and event' = +{ + evtype : event_type; +} + + (* Tables & Memories *) type table = table' Source.phrase @@ -195,6 +204,7 @@ and export_desc' = | TableExport of idx | MemoryExport of idx | GlobalExport of idx + | EventExport of idx type export = export' Source.phrase and export' = @@ -209,6 +219,7 @@ and import_desc' = | TableImport of table_type | MemoryImport of memory_type | GlobalImport of global_type + | EventImport of event_type type import = import' Source.phrase and import' = @@ -225,6 +236,7 @@ and module_' = globals : global list; tables : table list; memories : memory list; + events : event list; funcs : func list; start : idx option; elems : elem_segment list; @@ -242,6 +254,7 @@ let empty_module = globals = []; tables = []; memories = []; + events = []; funcs = []; start = None; elems = []; @@ -263,6 +276,7 @@ let import_type_of (m : module_) (im : import) : import_type = | TableImport t -> ExternTableType t | MemoryImport t -> ExternMemoryType t | GlobalImport t -> ExternGlobalType t + | EventImport t -> ExternEventType t in ImportType (et, module_name, item_name) let export_type_of (m : module_) (ex : export) : export_type = @@ -285,6 +299,9 @@ let export_type_of (m : module_) (ex : export) : export_type = | GlobalExport x -> let gts = globals ets @ List.map (fun g -> g.it.gtype) m.it.globals in ExternGlobalType (nth gts x.it) + | EventExport x -> + let evts = events ets @ List.map (fun e -> e.it.evtype) m.it.events in + ExternEventType (nth evts x.it) in ExportType (et, name) let module_type_of (m : module_) : module_type = diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml index ceeedec24..669236cda 100644 --- a/interpreter/syntax/free.ml +++ b/interpreter/syntax/free.ml @@ -10,6 +10,7 @@ type t = globals : Set.t; tables : Set.t; memories : Set.t; + events : Set.t; funcs : Set.t; elems : Set.t; datas : Set.t; @@ -23,6 +24,7 @@ let empty : t = globals = Set.empty; tables = Set.empty; memories = Set.empty; + events = Set.empty; funcs = Set.empty; elems = Set.empty; datas = Set.empty; @@ -36,6 +38,7 @@ let union (s1 : t) (s2 : t) : t = globals = Set.union s1.globals s2.globals; tables = Set.union s1.tables s2.tables; memories = Set.union s1.memories s2.memories; + events = Set.union s1.events s2.events; funcs = Set.union s1.funcs s2.funcs; elems = Set.union s1.elems s2.elems; datas = Set.union s1.datas s2.datas; @@ -47,6 +50,7 @@ let types s = {empty with types = s} let globals s = {empty with globals = s} let tables s = {empty with tables = s} let memories s = {empty with memories = s} +let events s = {empty with events = s} let funcs s = {empty with funcs = s} let elems s = {empty with elems = s} let datas s = {empty with datas = s} @@ -59,6 +63,7 @@ let zero = Set.singleton 0l let shift s = Set.map (Int32.add (-1l)) (Set.remove 0l s) let (++) = union +let opt free xo = Lib.Option.get (Option.map free xo) empty let list free xs = List.fold_left union empty (List.map free xs) let var_type = function @@ -89,6 +94,7 @@ let func_type (FuncType (ins, out)) = let global_type (GlobalType (t, _mut)) = value_type t let table_type (TableType (_lim, t)) = ref_type t let memory_type (MemoryType (_lim)) = empty +let event_type (EventType (ft, _res)) = func_type ft let def_type = function | FuncDefType ft -> func_type ft @@ -106,6 +112,9 @@ let rec instr (e : instr) = | Let (bt, ts, es) -> let free = block_type bt ++ block es in {free with locals = Lib.Fun.repeat (List.length ts) shift free.locals} + | Try (bt, es1, xo, es2) -> + block_type bt ++ block es1 ++ opt (fun x -> events (idx x)) xo ++ block es2 + | Throw x -> events (idx x) | Br x | BrIf x | BrOnNull x -> labels (idx x) | BrTable (xs, x) -> list (fun x -> labels (idx x)) (x::xs) | Return | CallRef | ReturnCallRef -> empty @@ -123,8 +132,6 @@ let rec instr (e : instr) = memories zero | MemoryInit x -> memories zero ++ datas (idx x) | DataDrop x -> datas (idx x) - | Try (bt, es1, es2) -> block_type bt ++ block es1 ++ block es2 - | Throw -> empty and block (es : instr list) = let free = list instr es in {free with labels = shift free.labels} @@ -136,6 +143,7 @@ let func (f : func) = {(types (idx f.it.ftype) ++ block f.it.body) with locals = Set.empty} let table (t : table) = table_type t.it.ttype let memory (m : memory) = memory_type m.it.mtype +let event (e : event) = event_type e.it.evtype let segment_mode f (m : segment_mode) = match m.it with @@ -156,6 +164,7 @@ let export_desc (d : export_desc) = | TableExport x -> tables (idx x) | MemoryExport x -> memories (idx x) | GlobalExport x -> globals (idx x) + | EventExport x -> events (idx x) let import_desc (d : import_desc) = match d.it with @@ -163,6 +172,7 @@ let import_desc (d : import_desc) = | TableImport tt -> table_type tt | MemoryImport mt -> memory_type mt | GlobalImport gt -> global_type gt + | EventImport et -> event_type et let export (e : export) = export_desc e.it.edesc let import (i : import) = import_desc i.it.idesc @@ -175,6 +185,7 @@ let module_ (m : module_) = list global m.it.globals ++ list table m.it.tables ++ list memory m.it.memories ++ + list event m.it.events ++ list func m.it.funcs ++ start m.it.start ++ list elem m.it.elems ++ diff --git a/interpreter/syntax/free.mli b/interpreter/syntax/free.mli index 71456c8d4..870056731 100644 --- a/interpreter/syntax/free.mli +++ b/interpreter/syntax/free.mli @@ -6,6 +6,7 @@ type t = globals : Set.t; tables : Set.t; memories : Set.t; + events : Set.t; funcs : Set.t; elems : Set.t; datas : Set.t; @@ -25,6 +26,7 @@ val global : Ast.global -> t val func : Ast.func -> t val table : Ast.table -> t val memory : Ast.memory -> t +val event : Ast.event -> t val elem : Ast.elem_segment -> t val data : Ast.data_segment -> t val export : Ast.export -> t diff --git a/interpreter/syntax/operators.ml b/interpreter/syntax/operators.ml index 26844f9e4..61c41a358 100644 --- a/interpreter/syntax/operators.ml +++ b/interpreter/syntax/operators.ml @@ -23,6 +23,9 @@ let loop bt es = Loop (bt, es) let if_ bt es1 es2 = If (bt, es1, es2) let let_ bt ts es = Let (bt, ts, es) +let try_ bt es1 xo es2 = Try (bt, es1, xo, es2) +let throw x = Throw x + let br x = Br x let br_if x = BrIf x let br_table xs x = BrTable (xs, x) @@ -238,6 +241,3 @@ let i32_reinterpret_f32 = Convert (I32 I32Op.ReinterpretFloat) let i64_reinterpret_f64 = Convert (I64 I64Op.ReinterpretFloat) let f32_reinterpret_i32 = Convert (F32 F32Op.ReinterpretInt) let f64_reinterpret_i64 = Convert (F64 F64Op.ReinterpretInt) - -let try_ bt es1 es2 = Try (bt, es1, es2) -let throw = Throw diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml index 23d139c5a..0510553e0 100644 --- a/interpreter/syntax/types.ml +++ b/interpreter/syntax/types.ml @@ -19,14 +19,17 @@ and def_type = FuncDefType of func_type type 'a limits = {min : 'a; max : 'a option} type mutability = Immutable | Mutable +type resumability = Terminal | Resumable type table_type = TableType of Int32.t limits * ref_type type memory_type = MemoryType of Int32.t limits type global_type = GlobalType of value_type * mutability +type event_type = EventType of func_type * resumability (* TODO: use index *) type extern_type = | ExternFuncType of func_type | ExternTableType of table_type | ExternMemoryType of memory_type | ExternGlobalType of global_type + | ExternEventType of event_type type export_type = ExportType of extern_type * name type import_type = ImportType of extern_type * name * name @@ -91,6 +94,8 @@ let memories = Lib.List.map_filter (function ExternMemoryType t -> Some t | _ -> None) let globals = Lib.List.map_filter (function ExternGlobalType t -> Some t | _ -> None) +let events = + Lib.List.map_filter (function ExternEventType t -> Some t | _ -> None) (* Allocation *) @@ -140,11 +145,15 @@ let sem_global_type c (GlobalType (t, mut)) = let sem_func_type c (FuncType (ins, out)) = FuncType (sem_stack_type c ins, sem_stack_type c out) +let sem_event_type c (EventType (ft, res)) = + EventType (sem_func_type c ft, res) + let sem_extern_type c = function | ExternFuncType ft -> ExternFuncType (sem_func_type c ft) | ExternTableType tt -> ExternTableType (sem_table_type c tt) | ExternMemoryType mt -> ExternMemoryType (sem_memory_type c mt) | ExternGlobalType gt -> ExternGlobalType (sem_global_type c gt) + | ExternEventType et -> ExternEventType (sem_event_type c et) let sem_def_type c = function @@ -246,12 +255,16 @@ let string_of_global_type = function | GlobalType (t, Immutable) -> string_of_value_type t | GlobalType (t, Mutable) -> "(mut " ^ string_of_value_type t ^ ")" +let string_of_event_type = function + | EventType (ft, Terminal) -> "exception " ^ string_of_func_type ft + | EventType (ft, Resumable) -> string_of_func_type ft + let string_of_extern_type = function | ExternFuncType ft -> "func " ^ string_of_func_type ft | ExternTableType tt -> "table " ^ string_of_table_type tt | ExternMemoryType mt -> "memory " ^ string_of_memory_type mt | ExternGlobalType gt -> "global " ^ string_of_global_type gt - + | ExternEventType et -> "event " ^ string_of_event_type et let string_of_export_type (ExportType (et, name)) = "\"" ^ string_of_name name ^ "\" : " ^ string_of_extern_type et diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index b0849000e..fb0f53ade 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -69,6 +69,10 @@ let def_type dt = match dt with | FuncDefType ft -> func_type ft +let resumability = function + | Terminal -> " exception" + | Resumable -> "" + let limits nat {min; max} = String.concat " " (nat min :: opt nat max) @@ -245,6 +249,12 @@ let rec instr e = | Let (bt, locals, es) -> "let", block_type bt @ decls "local" (List.map Source.it locals) @ list instr es + | Try (bt, es1, xo, es2) -> + let catch = + match xo with Some x -> "catch " ^ var x | None -> "catch_all" in + "try", block_type bt @ + [Node ("do", list instr es1); Node (catch, list instr es2)] + | Throw x -> "throw " ^ var x, [] | Br x -> "br " ^ var x, [] | BrIf x -> "br_if " ^ var x, [] | BrTable (xs, x) -> @@ -288,10 +298,6 @@ let rec instr e = | Unary op -> unop op, [] | Binary op -> binop op, [] | Convert op -> cvtop op, [] - | Try (bt, es1, es2) -> - "try", block_type bt @ - [Node ("do", list instr es1); Node ("catch", list instr es2)] - | Throw -> "throw", [] in Node (head, inner) let const head c = @@ -331,6 +337,12 @@ let memory off i mem = let {mtype = MemoryType lim} = mem.it in Node ("memory $" ^ nat (off + i) ^ " " ^ limits nat32 lim, []) +let event off i evt = + let {evtype = EventType (FuncType (ins, out), res)} = evt.it in + Node ("event $" ^ nat (off + i) ^ resumability res, + decls "param" ins @ decls "result" out + ) + let is_elem_kind = function | (NonNullable, FuncHeapType) -> true | _ -> false @@ -377,7 +389,7 @@ let data i seg = let type_ i ty = Node ("type $" ^ nat i, [def_type ty.it]) -let import_desc fx tx mx gx d = +let import_desc fx tx mx ex gx d = match d.it with | FuncImport x -> incr fx; Node ("func $" ^ nat (!fx - 1), [Node ("type", [atom var x])]) @@ -385,13 +397,15 @@ let import_desc fx tx mx gx d = incr tx; table 0 (!tx - 1) ({ttype = t} @@ d.at) | MemoryImport t -> incr mx; memory 0 (!mx - 1) ({mtype = t} @@ d.at) + | EventImport t -> + incr ex; event 0 (!ex - 1) ({evtype = t} @@ d.at) | GlobalImport t -> incr gx; Node ("global $" ^ nat (!gx - 1), [global_type t]) -let import fx tx mx gx im = +let import fx tx mx ex gx im = let {module_name; item_name; idesc} = im.it in Node ("import", - [atom name module_name; atom name item_name; import_desc fx tx mx gx idesc] + [atom name module_name; atom name item_name; import_desc fx tx mx ex gx idesc] ) let export_desc d = @@ -400,6 +414,7 @@ let export_desc d = | TableExport x -> Node ("table", [atom var x]) | MemoryExport x -> Node ("memory", [atom var x]) | GlobalExport x -> Node ("global", [atom var x]) + | EventExport x -> Node ("event", [atom var x]) let export ex = let {name = n; edesc} = ex.it in @@ -420,13 +435,15 @@ let module_with_var_opt x_opt m = let fx = ref 0 in let tx = ref 0 in let mx = ref 0 in + let ex = ref 0 in let gx = ref 0 in - let imports = list (import fx tx mx gx) m.it.imports in + let imports = list (import fx tx mx ex gx) m.it.imports in Node ("module" ^ var_opt x_opt, listi type_ m.it.types @ imports @ listi (table !tx) m.it.tables @ listi (memory !mx) m.it.memories @ + listi (event !ex) m.it.events @ listi (global !gx) m.it.globals @ listi (func_with_index !fx) m.it.funcs @ list export m.it.exports @ @@ -538,8 +555,8 @@ let assertion mode ass = [Node ("assert_trap", [action mode act; Atom (string re)])] | AssertExhaustion (act, re) -> [Node ("assert_exhaustion", [action mode act; Atom (string re)])] - | AssertUncaught (act, re) -> - [Node ("assert_uncaught", [action mode act; Atom (string re)])] + | AssertException (act, re) -> + [Node ("assert_exception", [action mode act; Atom (string re)])] let command mode cmd = match cmd.it with diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index e0fa22a77..9d0a4e75b 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -208,6 +208,12 @@ rule token = parse | "return_call_ref" { RETURN_CALL_REF } | "func.bind" { FUNC_BIND } + | "throw" { THROW } + | "try" { TRY } + | "do" { DO } + | "catch" { CATCH } + | "catch_all" { CATCH_ALL } + | "local.get" { LOCAL_GET } | "local.set" { LOCAL_SET } | "local.tee" { LOCAL_TEE } @@ -365,6 +371,8 @@ rule token = parse | "global" { GLOBAL } | "table" { TABLE } | "memory" { MEMORY } + | "event" { EVENT } + | "exception" { EXCEPTION } | "elem" { ELEM } | "data" { DATA } | "declare" { DECLARE } @@ -386,18 +394,13 @@ rule token = parse | "assert_unlinkable" { ASSERT_UNLINKABLE } | "assert_return" { ASSERT_RETURN } | "assert_trap" { ASSERT_TRAP } + | "assert_exception" { ASSERT_EXCEPTION } | "assert_exhaustion" { ASSERT_EXHAUSTION } - | "assert_uncaught" { ASSERT_UNCAUGHT } | "nan:canonical" { NAN Script.CanonicalNan } | "nan:arithmetic" { NAN Script.ArithmeticNan } | "input" { INPUT } | "output" { OUTPUT } - | "try" { TRY } - | "catch" { CATCH } - | "do" { DO } - | "throw" { THROW } - | name as s { VAR s } | ";;"utf8_no_nl*eof { EOF } diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index 5dcd290de..2d2b62993 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -86,14 +86,16 @@ type types = {space : space; mutable list : type_ list} let empty_types () = {space = empty (); list = []} type context = - { types : types; tables : space; memories : space; + { types : types; + tables : space; memories : space; events : space; funcs : space; locals : space; globals : space; datas : space; elems : space; labels : space; deferred_locals : (unit -> unit) list ref } let empty_context () = - { types = empty_types (); tables = empty (); memories = empty (); + { types = empty_types (); + tables = empty (); memories = empty (); events = empty (); funcs = empty (); locals = empty (); globals = empty (); datas = empty (); elems = empty (); labels = empty (); deferred_locals = ref [] @@ -134,6 +136,7 @@ let local (c : context) x = lookup "local" c.locals x let global (c : context) x = lookup "global" c.globals x let table (c : context) x = lookup "table" c.tables x let memory (c : context) x = lookup "memory" c.memories x +let event (c : context) x = lookup "event" c.events x let elem (c : context) x = lookup "elem segment" c.elems x let data (c : context) x = lookup "data segment" c.datas x let label (c : context) x = lookup "label " c.labels x @@ -162,6 +165,7 @@ let bind_local (c : context) x = force_locals c; bind_abs "local" c.locals x let bind_global (c : context) x = bind_abs "global" c.globals x let bind_table (c : context) x = bind_abs "table" c.tables x let bind_memory (c : context) x = bind_abs "memory" c.memories x +let bind_event (c : context) x = bind_abs "event" c.events x let bind_elem (c : context) x = bind_abs "elem segment" c.elems x let bind_data (c : context) x = bind_abs "data segment" c.datas x let bind_label (c : context) x = bind_rel "label" c.labels x @@ -178,6 +182,7 @@ let anon_locals (c : context) n at = let anon_global (c : context) at = bind "global" c.globals 1l at let anon_table (c : context) at = bind "table" c.tables 1l at let anon_memory (c : context) at = bind "memory" c.memories 1l at +let anon_event (c : context) at = bind "event" c.events 1l at let anon_elem (c : context) at = bind "elem segment" c.elems 1l at let anon_data (c : context) at = bind "data segment" c.datas 1l at let anon_label (c : context) at = bind "label" c.labels 1l at @@ -210,6 +215,7 @@ let inline_func_type_explicit (c : context) x ft at = %token NUM_TYPE FUNCREF EXTERNREF REF EXTERN NULL MUT %token UNREACHABLE NOP DROP SELECT %token BLOCK END IF THEN ELSE LOOP LET +%token THROW TRY DO CATCH CATCH_ALL %token BR BR_IF BR_TABLE BR_ON_NULL %token CALL CALL_REF CALL_INDIRECT RETURN RETURN_CALL_REF FUNC_BIND %token LOCAL_GET LOCAL_SET LOCAL_TEE GLOBAL_GET GLOBAL_SET @@ -219,16 +225,15 @@ let inline_func_type_explicit (c : context) x ft at = %token LOAD STORE OFFSET_EQ_NAT ALIGN_EQ_NAT %token CONST UNARY BINARY TEST COMPARE CONVERT %token REF_NULL REF_FUNC REF_EXTERN REF_IS_NULL REF_AS_NON_NULL -%token FUNC START TYPE PARAM RESULT LOCAL GLOBAL +%token FUNC START TYPE PARAM RESULT LOCAL GLOBAL EVENT EXCEPTION %token TABLE ELEM MEMORY DATA DECLARE OFFSET ITEM IMPORT EXPORT %token MODULE BIN QUOTE %token SCRIPT REGISTER INVOKE GET %token ASSERT_MALFORMED ASSERT_INVALID ASSERT_SOFT_INVALID ASSERT_UNLINKABLE -%token ASSERT_RETURN ASSERT_TRAP ASSERT_EXHAUSTION ASSERT_UNCAUGHT +%token ASSERT_RETURN ASSERT_TRAP ASSERT_EXCEPTION ASSERT_EXHAUSTION %token NAN %token INPUT OUTPUT %token EOF -%token TRY CATCH DO THROW %token NAT %token INT @@ -314,6 +319,12 @@ func_type : { fun c -> let FuncType (ins, out) = $6 c in FuncType ($4 c :: ins, out) } +event_type : + | func_type + { fun c -> EventType ($1 c, Resumable) } + | EXCEPTION func_type + { fun c -> EventType ($2 c, Terminal) } + table_type : | limits ref_type { fun c -> TableType ($1, $2 c) } @@ -393,6 +404,7 @@ plain_instr : | UNREACHABLE { fun c -> unreachable } | NOP { fun c -> nop } | DROP { fun c -> drop } + | THROW var { fun c -> throw ($2 c event) } | BR var { fun c -> br ($2 c label) } | BR_IF var { fun c -> br_if ($2 c label) } | BR_TABLE var var_list @@ -443,7 +455,6 @@ plain_instr : | UNARY { fun c -> $1 } | BINARY { fun c -> $1 } | CONVERT { fun c -> $1 } - | THROW { fun c -> throw } select_instr : @@ -664,8 +675,8 @@ expr1 : /* Sugar */ let bt, ls, es = $3 c c' in [], let_ bt ls es } | TRY try_block { fun c -> - let bt, (es1, es2) = $2 c in - [], try_ bt es1 es2 } + let bt, (es1, xo, es2) = $2 c in + [], try_ bt es1 xo es2 } select_expr_results : | LPAR RESULT value_type_list RPAR select_expr_results @@ -730,10 +741,10 @@ try_block_result_body : let out' = snd $3 c in FuncType (ins, out' @ out), es } try_ : - | LPAR DO instr_list RPAR LPAR CATCH instr_list RPAR - { fun c -> - let es1, es2 = $3 c, $7 c in - (es1, es2) } + | LPAR DO instr_list RPAR LPAR CATCH var instr_list RPAR + { fun c -> $3 c, Some ($7 c event), $8 c } + | LPAR DO instr_list RPAR LPAR CATCH_ALL instr_list RPAR + { fun c -> $3 c, None, $7 c } if_block : | type_use if_block_param_body @@ -867,7 +878,7 @@ func_body : {f with locals = $4 c :: f.locals} } -/* Tables, Memories & Globals */ +/* Tables, Memories, Globals, Events */ table_use : | LPAR TABLE var RPAR { fun c -> $3 c } @@ -1029,6 +1040,40 @@ global_fields : { fun c x at -> let globs, ims, exs = $2 c x at in globs, ims, $1 (GlobalExport x) c :: exs } +event : + | LPAR EVENT bind_var_opt event_fields RPAR + { let at = at () in + fun c -> let x = $3 c anon_event bind_event @@ at in + fun () -> $4 c x at } + | LPAR EXCEPTION bind_var_opt exception_fields RPAR /* Sugar */ + { let at = at () in + fun c -> let x = $3 c anon_event bind_event @@ at in + fun () -> $4 c x at } + +event_fields : + | event_type + { fun c x at -> [{evtype = $1 c} @@ at], [], [] } + | inline_import event_type /* Sugar */ + { fun c x at -> + [], + [{ module_name = fst $1; item_name = snd $1; + idesc = EventImport ($2 c) @@ at } @@ at], [] } + | inline_export event_fields /* Sugar */ + { fun c x at -> let evts, ims, exs = $2 c x at in + evts, ims, $1 (EventExport x) c :: exs } + +exception_fields : /* Sugar */ + | func_type + { fun c x at -> [{evtype = EventType ($1 c, Terminal)} @@ at], [], [] } + | inline_import func_type + { fun c x at -> + [], + [{ module_name = fst $1; item_name = snd $1; + idesc = EventImport (EventType ($2 c, Terminal)) @@ at } @@ at], [] } + | inline_export exception_fields + { fun c x at -> let evts, ims, exs = $2 c x at in + evts, ims, $1 (EventExport x) c :: exs } + /* Imports & Exports */ @@ -1049,6 +1094,12 @@ import_desc : | LPAR GLOBAL bind_var_opt global_type RPAR { fun c -> ignore ($3 c anon_global bind_global); fun () -> GlobalImport ($4 c) } + | LPAR EVENT bind_var_opt event_type RPAR + { fun c -> ignore ($3 c anon_event bind_event); + fun () -> EventImport ($4 c) } + | LPAR EXCEPTION bind_var_opt func_type RPAR /* Sugar */ + { fun c -> ignore ($3 c anon_event bind_event); + fun () -> EventImport (EventType ($4 c, Terminal)) } import : | LPAR IMPORT name name import_desc RPAR @@ -1064,6 +1115,8 @@ export_desc : | LPAR TABLE var RPAR { fun c -> TableExport ($3 c table) } | LPAR MEMORY var RPAR { fun c -> MemoryExport ($3 c memory) } | LPAR GLOBAL var RPAR { fun c -> GlobalExport ($3 c global) } + | LPAR EVENT var RPAR { fun c -> EventExport ($3 c event) } + | LPAR EXCEPTION var RPAR { fun c -> EventExport ($3 c event) } /* Sugar */ export : | LPAR EXPORT name export_desc RPAR @@ -1124,6 +1177,14 @@ module_fields1 : error (List.hd m.imports).at "import after memory definition"; { m with memories = mems @ m.memories; datas = data @ m.datas; imports = ims @ m.imports; exports = exs @ m.exports } } + | event module_fields + { fun c -> let ef = $1 c in let mff = $2 c in + fun () -> let mf = mff () in + fun () -> let evts, ims, exs = ef () in let m = mf () in + if evts <> [] && m.imports <> [] then + error (List.hd m.imports).at "import after event definition"; + { m with events = evts @ m.events; + imports = ims @ m.imports; exports = exs @ m.exports } } | func module_fields { fun c -> let ff = $1 c in let mff = $2 c in fun () -> let mf = mff () in @@ -1206,8 +1267,8 @@ assertion : { AssertUninstantiable (snd $3, $4) @@ at () } | LPAR ASSERT_RETURN action result_list RPAR { AssertReturn ($3, $4) @@ at () } | LPAR ASSERT_TRAP action STRING RPAR { AssertTrap ($3, $4) @@ at () } + | LPAR ASSERT_EXCEPTION action STRING RPAR { AssertException ($3, $4) @@ at () } | LPAR ASSERT_EXHAUSTION action STRING RPAR { AssertExhaustion ($3, $4) @@ at () } - | LPAR ASSERT_UNCAUGHT action STRING RPAR { AssertUncaught ($3, $4) @@ at () } cmd : | action { Action $1 @@ at () } diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index d804ae3fa..87b77e2c7 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -22,6 +22,7 @@ type context = tables : table_type list; memories : memory_type list; globals : global_type list; + events : event_type list; elems : ref_type list; datas : unit list; locals : value_type list; @@ -32,7 +33,7 @@ type context = let empty_context = { types = []; funcs = []; tables = []; memories = []; - globals = []; elems = []; datas = []; + globals = []; events = []; elems = []; datas = []; locals = []; results = []; labels = []; refs = Free.empty } @@ -46,6 +47,7 @@ let func_var (c : context) x = lookup "function" c.funcs x let table (c : context) x = lookup "table" c.tables x let memory (c : context) x = lookup "memory" c.memories x let global (c : context) x = lookup "global" c.globals x +let event (c : context) x = lookup "event" c.events x let elem (c : context) x = lookup "elem segment" c.elems x let data (c : context) x = lookup "data segment" c.datas x let local (c : context) x = lookup "local" c.locals x @@ -111,6 +113,12 @@ let check_memory_type (c : context) (mt : memory_type) at = check_limits lim 0x1_0000l at "memory size must be at most 65536 pages (4GiB)" +let check_event_type (c : context) (et : event_type) at = + let EventType (ft, res) = et in + let FuncType (_, ts2) = ft in + check_func_type c ft at; + require (res = Resumable || ts2 = []) at "exception type must not have results" + let check_global_type (c : context) (gt : global_type) at = let GlobalType (t, mut) = gt in check_value_type c t at @@ -331,6 +339,26 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type = in check_block c' es ft e.at; (ts1 @ List.map Source.it locals) --> ts2 + | Try (bt, es1, xo, es2) -> + let FuncType (ts1, ts2) as ft1 = check_block_type c bt e.at in + check_block {c with labels = ts2 :: c.labels} es1 ft1 e.at; + let ts1' = + match xo with + | None -> [] + | Some x -> + let EventType (FuncType (ts1', _), res) = event c x in + require (res = Terminal) e.at "catching a non-exception event"; + ts1' + in + let ft2 = FuncType (ts1', ts2) in + check_block {c with labels = ts2 :: c.labels} es2 ft2 e.at; + ts1 --> ts2 + + | Throw x -> + let EventType (FuncType (ts1, ts2), res) = event c x in + require (res = Terminal) e.at "throwing a non-exception event"; + ts1 -->... ts2 + | Br x -> label c x -->... [] @@ -538,16 +566,6 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type = let t1, t2 = type_cvtop e.at cvtop in [NumType t1] --> [NumType t2] - | Try (bt, es1, es2) -> - let FuncType (ts1, ts2) as ft1 = check_block_type c bt e.at in - check_block {c with labels = ts2 :: c.labels} es1 ft1 e.at; - let ft2 = FuncType ([], ts2) in - check_block {c with labels = ts2 :: c.labels} es2 ft2 e.at; - ts1 --> ts2 - - | Throw -> - [] -->... [] - and check_seq (c : context) (s : infer_stack_type) (es : instr list) : infer_stack_type = match es with @@ -610,7 +628,7 @@ let check_const (c : context) (const : const) (t : value_type) = check_block c const.it (FuncType ([], [t])) const.at -(* Tables, Memories, & Globals *) +(* Tables, Memories, Globals, Events *) let check_table (c : context) (tab : table) = let {ttype} = tab.it in @@ -655,6 +673,10 @@ let check_global (c : context) (glob : global) = let GlobalType (t, mut) = gtype in check_const c ginit t +let check_event (c : context) (evt : event) = + let {evtype} = evt.it in + check_event_type c evtype evt.at + (* Modules *) @@ -679,6 +701,9 @@ let check_import (im : import) (c : context) : context = | GlobalImport gt -> check_global_type c gt idesc.at; {c with globals = gt :: c.globals} + | EventImport et -> + check_event_type c et idesc.at; + {c with events = et :: c.events} module NameSet = Set.Make(struct type t = Ast.name let compare = compare end) @@ -689,6 +714,7 @@ let check_export (c : context) (set : NameSet.t) (ex : export) : NameSet.t = | TableExport x -> ignore (table c x) | MemoryExport x -> ignore (memory c x) | GlobalExport x -> ignore (global c x) + | EventExport x -> ignore (event c x) ); require (not (NameSet.mem name set)) ex.at "duplicate export name"; NameSet.add name set @@ -696,8 +722,8 @@ let check_export (c : context) (set : NameSet.t) (ex : export) : NameSet.t = let check_module (m : module_) = let - { types; imports; tables; memories; globals; funcs; start; elems; datas; - exports } = m.it + { types; imports; tables; memories; globals; events; funcs; + start; elems; datas; exports } = m.it in let c0 = List.fold_right check_import imports @@ -711,6 +737,7 @@ let check_module (m : module_) = funcs = c0.funcs @ List.map (fun f -> ignore (func_type c0 f.it.ftype); f.it.ftype.it) funcs; tables = c0.tables @ List.map (fun tab -> tab.it.ttype) tables; memories = c0.memories @ List.map (fun mem -> mem.it.mtype) memories; + events = c0.events @ List.map (fun evt -> evt.it.evtype) events; elems = List.map (fun elem -> elem.it.etype) elems; datas = List.map (fun _data -> ()) datas; } @@ -722,6 +749,7 @@ let check_module (m : module_) = List.iter (check_global c1) globals; List.iter (check_table c1) tables; List.iter (check_memory c1) memories; + List.iter (check_event c1) events; List.iter (check_elem c1) elems; List.iter (check_data c1) datas; List.iter (check_func c) funcs; diff --git a/test/core/binary.wast b/test/core/binary.wast index 7e6c3e76b..d20d25f01 100644 --- a/test/core/binary.wast +++ b/test/core/binary.wast @@ -45,7 +45,7 @@ (assert_malformed (module binary "\00asm\00\00\00\01") "unknown binary version") ;; Invalid section id. -(assert_malformed (module binary "\00asm" "\01\00\00\00" "\0d\00") "malformed section id") +(assert_malformed (module binary "\00asm" "\01\00\00\00" "\0e\00") "malformed section id") (assert_malformed (module binary "\00asm" "\01\00\00\00" "\7f\00") "malformed section id") (assert_malformed (module binary "\00asm" "\01\00\00\00" "\80\00\01\00") "malformed section id") (assert_malformed (module binary "\00asm" "\01\00\00\00" "\81\00\01\00") "malformed section id") diff --git a/test/core/catch.wast b/test/core/catch.wast new file mode 100644 index 000000000..74b269376 --- /dev/null +++ b/test/core/catch.wast @@ -0,0 +1,86 @@ +;; Test the minimal "exception handling" extension + +(module + (exception $e0) + (exception $e1 (param i32)) + + (func (export "catch-1") (result i32) + (try (result i32) + (do (i32.const -1) (throw $e0) (i32.const 0)) + (catch_all (i32.const 1)) + ) + ) + + (func (export "catch-2") (result i32) + (try (result i32) + (do + (try (result i32) + (do + (throw $e0) + (i32.const 0) + ) + (catch_all + (throw $e0) + (i32.const 1) + ) + ) + ) + (catch_all + (i32.const 2) + ) + ) + ) + + (func (export "catch-3") (result i32) + (try (result i32) + (do (throw $e1 (i32.const 66)) (i32.const 0)) + (catch_all (i32.const 1)) + ) + ) + + (func (export "catch-4") (result i32) + (try (result i32) + (do (throw $e1 (i32.const 66)) (i32.const 0)) + (catch $e1) + ) + ) + + (func (export "success-0") (result i32) + (try (result i32) + (do (i32.const 0)) + (catch_all (i32.const 1)) + ) + ) + + (func (export "success-1") (result i32) + (try (result i32) + (do + (try (result i32) + (do (throw $e0) (i32.const 0)) + (catch_all (i32.const 1)) + ) + ) + (catch_all (i32.const 2)) + ) + ) + + (func (export "uncaught-1") + (throw $e0) + ) + + (func (export "uncaught-2") (result i32) + (try (result i32) + (do (throw $e0) (i32.const 0)) + (catch $e1) + ) + ) +) + +(assert_return (invoke "catch-1") (i32.const 1)) +(assert_return (invoke "catch-2") (i32.const 2)) +(assert_return (invoke "catch-3") (i32.const 1)) +(assert_return (invoke "catch-4") (i32.const 66)) +(assert_return (invoke "success-0") (i32.const 0)) +(assert_return (invoke "success-1") (i32.const 1)) +(assert_exception (invoke "uncaught-1") "uncaught exception") +(assert_exception (invoke "uncaught-2") "uncaught exception") diff --git a/test/core/tinyexn.wast b/test/core/tinyexn.wast deleted file mode 100644 index 278b834c4..000000000 --- a/test/core/tinyexn.wast +++ /dev/null @@ -1,49 +0,0 @@ -;; Test the minimal "exception handling" extension - -(module - (func (export "catch-1") (result i32) - (try (result i32) - (do - throw - i32.const 0) - (catch - i32.const 1))) - - (func (export "catch-2") (result i32) - (try (result i32) - (do - (try (result i32) - (do - throw - i32.const 0) - (catch - throw - i32.const 1))) - (catch - i32.const 2))) - - (func (export "success-0") (result i32) - (try (result i32) - (do i32.const 0) - (catch i32.const 1))) - - (func (export "success-1") (result i32) - (try (result i32) - (do - (try (result i32) - (do - throw - i32.const 0) - (catch - i32.const 1))) - (catch i32.const 2))) - - (func (export "uncaught") - (throw)) -) - -(assert_return (invoke "catch-1") (i32.const 1)) -(assert_return (invoke "catch-2") (i32.const 2)) -(assert_return (invoke "success-0") (i32.const 0)) -(assert_return (invoke "success-1") (i32.const 1)) -(assert_uncaught (invoke "uncaught") "uncaught exception") From ac039dbb3f47d13dd6a6575042b13895cfc688c3 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Thu, 18 Feb 2021 11:26:42 +0100 Subject: [PATCH 19/82] Add cont type and instructions; validation, en/decoding --- interpreter/binary/decode.ml | 27 ++++++++++++- interpreter/binary/encode.ml | 17 +++++++- interpreter/syntax/ast.ml | 6 ++- interpreter/syntax/free.ml | 7 +++- interpreter/syntax/operators.ml | 5 +++ interpreter/syntax/types.ml | 16 +++++++- interpreter/text/arrange.ml | 13 +++++++ interpreter/text/parser.mly | 1 + interpreter/valid/match.ml | 6 +++ interpreter/valid/valid.ml | 69 +++++++++++++++++++++++++++++---- test/core/binary.wast | 2 +- 11 files changed, 153 insertions(+), 16 deletions(-) diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index fc1f85cad..e7a0cc007 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -135,6 +135,12 @@ let sized f s = open Types +let var_type s = + let pos = pos s in + match vs33 s with + | i when i >= 0l -> SynVar i + | _ -> error s pos "malformed type index" + let num_type s = match vs7 s with | -0x01 -> I32Type @@ -174,6 +180,11 @@ let func_type s = FuncType (ins, out) | _ -> error s (pos s - 1) "malformed function type" +let cont_type s = + match vs7 s with + | -0x21 -> ContType (var_type s) + | _ -> error s (pos s - 1) "malformed continuation type" + let limits vu s = let has_max = bool s in let min = vu s in @@ -212,7 +223,11 @@ let global_type s = GlobalType (t, mut) let def_type s = - FuncDefType (func_type s) + match peek s with + | Some 0x60 -> FuncDefType (func_type s) + | Some 0x61 -> ContDefType (cont_type s) + | None -> ignore (vs7 s); assert false (* force error *) + | _ -> error s (pos s) "malformed type definition" (* Decode instructions *) @@ -238,6 +253,11 @@ let block_type s = | Some b when b land 0xc0 = 0x40 -> ValBlockType (Some (value_type s)) | _ -> VarBlockType (SynVar (vs33 s)) +let var_pair s = + let x = at var s in + let y = at var s in + x, y + let local s = let n = vu32 s in let t = at value_type s in @@ -532,6 +552,11 @@ let rec instr s = | 0xd3 -> ref_as_non_null | 0xd4 -> br_on_null (at var s) + | 0xe0 -> cont_new (at var s) + | 0xe1 -> cont_suspend (at var s) + | 0xe2 -> cont_throw (at var s) + | 0xe3 -> cont_resume (vec var_pair s) + | 0xfc as b -> (match vu32 s with | 0x00l -> i32_trunc_sat_f32_s diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 0a9c2773c..44ee669e2 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -91,6 +91,10 @@ let encode m = open Types + let var_type = function + | SynVar x -> vs33 x + | SemVar _ -> assert false + let num_type = function | I32Type -> vs7 (-0x01) | I64Type -> vs7 (-0x02) @@ -100,8 +104,7 @@ let encode m = let heap_type = function | FuncHeapType -> vs7 (-0x10) | ExternHeapType -> vs7 (-0x11) - | DefHeapType (SynVar x) -> vs33 x - | DefHeapType (SemVar _) -> assert false + | DefHeapType x -> var_type x | BotHeapType -> assert false let ref_type = function @@ -119,6 +122,9 @@ let encode m = | FuncType (ts1, ts2) -> vs7 (-0x20); vec value_type ts1; vec value_type ts2 + let cont_type = function + | ContType x -> vs7 (-0x21); var_type x + let limits vu {min; max} = bool (max <> None); vu min; opt vu max @@ -144,6 +150,7 @@ let encode m = let def_type = function | FuncDefType ft -> func_type ft + | ContDefType ct -> cont_type ct (* Expressions *) @@ -158,6 +165,7 @@ let encode m = let memop {align; offset; _} = vu32 (Int32.of_int align); vu32 offset let var x = vu32 x.it + let var_pair (x, y) = var x; var y let block_type = function | ValBlockType None -> vs33 (-0x40l) @@ -206,6 +214,11 @@ let encode m = | ReturnCallRef -> op 0x15 | FuncBind x -> op 0x16; var x + | ContNew x -> op 0xe0; var x + | ContSuspend x -> op 0xe1; var x + | ContThrow x -> op 0xe2; var x + | ContResume xls -> op 0xe3; vec var_pair xls + | Drop -> op 0x1a | Select None -> op 0x1b | Select (Some ts) -> op 0x1c; vec value_type ts diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml index 951ac5670..26685a2f3 100644 --- a/interpreter/syntax/ast.ml +++ b/interpreter/syntax/ast.ml @@ -95,7 +95,11 @@ and instr' = | CallRef (* call function through reference *) | CallIndirect of idx * idx (* call function through table *) | ReturnCallRef (* tail call through reference *) - | FuncBind of idx (* closure creation *) + | FuncBind of idx (* create closure *) + | ContNew of idx (* create continuation *) + | ContSuspend of idx (* suspend continuation *) + | ContThrow of idx (* abort continuation *) + | ContResume of (idx * idx) list (* resume continuation *) | LocalGet of idx (* read local idxiable *) | LocalSet of idx (* write local idxiable *) | LocalTee of idx (* write local idxiable and keep value *) diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml index 669236cda..17a7d408c 100644 --- a/interpreter/syntax/free.ml +++ b/interpreter/syntax/free.ml @@ -91,6 +91,7 @@ let block_type = function let func_type (FuncType (ins, out)) = list value_type ins ++ list value_type out +let cont_type (ContType x) = var_type x let global_type (GlobalType (t, _mut)) = value_type t let table_type (TableType (_lim, t)) = ref_type t let memory_type (MemoryType (_lim)) = empty @@ -98,6 +99,7 @@ let event_type (EventType (ft, _res)) = func_type ft let def_type = function | FuncDefType ft -> func_type ft + | ContDefType ct -> cont_type ct let rec instr (e : instr) = match e.it with @@ -114,13 +116,14 @@ let rec instr (e : instr) = {free with locals = Lib.Fun.repeat (List.length ts) shift free.locals} | Try (bt, es1, xo, es2) -> block_type bt ++ block es1 ++ opt (fun x -> events (idx x)) xo ++ block es2 - | Throw x -> events (idx x) + | Throw x | ContThrow x | ContSuspend x -> events (idx x) | Br x | BrIf x | BrOnNull x -> labels (idx x) | BrTable (xs, x) -> list (fun x -> labels (idx x)) (x::xs) | Return | CallRef | ReturnCallRef -> empty | Call x -> funcs (idx x) | CallIndirect (x, y) -> tables (idx x) ++ types (idx y) - | FuncBind x -> types (idx x) + | FuncBind x | ContNew x -> types (idx x) + | ContResume xys -> list (fun (x, y) -> events (idx x) ++ labels (idx y)) xys | LocalGet x | LocalSet x | LocalTee x -> locals (idx x) | GlobalGet x | GlobalSet x -> globals (idx x) | TableGet x | TableSet x | TableSize x | TableGrow x | TableFill x -> diff --git a/interpreter/syntax/operators.ml b/interpreter/syntax/operators.ml index 61c41a358..66454eddf 100644 --- a/interpreter/syntax/operators.ml +++ b/interpreter/syntax/operators.ml @@ -38,6 +38,11 @@ let call_indirect x y = CallIndirect (x, y) let return_call_ref = ReturnCallRef let func_bind x = FuncBind x +let cont_new x = ContNew x +let cont_suspend x = ContSuspend x +let cont_throw x = ContThrow x +let cont_resume xys = ContResume xys + let local_get x = LocalGet x let local_set x = LocalSet x let local_tee x = LocalTee x diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml index 0510553e0..15a286acb 100644 --- a/interpreter/syntax/types.ml +++ b/interpreter/syntax/types.ml @@ -15,7 +15,8 @@ and heap_type = and value_type = NumType of num_type | RefType of ref_type | BotType and stack_type = value_type list and func_type = FuncType of stack_type * stack_type -and def_type = FuncDefType of func_type +and cont_type = ContType of var +and def_type = FuncDefType of func_type | ContDefType of cont_type type 'a limits = {min : 'a; max : 'a option} type mutability = Immutable | Mutable @@ -76,9 +77,14 @@ let defaultable_value_type = function (* Projections *) +let as_syn_var = function + | SynVar x -> x + | SemVar _ -> assert false + let as_func_def_type (dt : def_type) : func_type = match dt with | FuncDefType ft -> ft + | _ -> assert false let extern_type_of_import_type (ImportType (et, _, _)) = et let extern_type_of_export_type (ExportType (et, _)) = et @@ -145,6 +151,9 @@ let sem_global_type c (GlobalType (t, mut)) = let sem_func_type c (FuncType (ins, out)) = FuncType (sem_stack_type c ins, sem_stack_type c out) +let sem_cont_type c (ContType x) = + ContType (sem_var_type c x) + let sem_event_type c (EventType (ft, res)) = EventType (sem_func_type c ft, res) @@ -158,6 +167,7 @@ let sem_extern_type c = function let sem_def_type c = function | FuncDefType ft -> FuncDefType (sem_func_type c ft) + | ContDefType ct -> ContDefType (sem_cont_type c ct) let sem_export_type c (ExportType (et, name)) = @@ -237,8 +247,12 @@ and string_of_func_type = function | FuncType (ins, out) -> string_of_stack_type ins ^ " -> " ^ string_of_stack_type out +and string_of_cont_type = function + | ContType x -> string_of_var x + and string_of_def_type = function | FuncDefType ft -> "func " ^ string_of_func_type ft + | ContDefType ct -> "cont " ^ string_of_cont_type ct let string_of_limits {min; max} = diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index fb0f53ade..cf980cf5c 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -55,6 +55,7 @@ let break_string s = (* Types *) +let var_type t = string_of_var t let num_type t = string_of_num_type t let ref_type t = string_of_ref_type t let heap_type t = string_of_heap_type t @@ -65,9 +66,13 @@ let decls kind ts = tab kind (atom value_type) ts let func_type (FuncType (ins, out)) = Node ("func", decls "param" ins @ decls "result" out) +let cont_type (ContType x) = + Node ("cont", [Atom (var_type x)]) + let def_type dt = match dt with | FuncDefType ft -> func_type ft + | ContDefType ct -> cont_type ct let resumability = function | Terminal -> " exception" @@ -267,6 +272,14 @@ let rec instr e = "call_indirect " ^ var x, [Node ("type " ^ var y, [])] | ReturnCallRef -> "return_call_ref", [] | FuncBind x -> "func.bind", [Node ("type " ^ var x, [])] + | ContNew x -> "cont.new", [Node ("type " ^ var x, [])] + | ContResume xys -> + "cont.resume", + List.concat_map (fun (x, y) -> + [Node ("event " ^ var x, []); Atom (var y)] + ) xys + | ContSuspend x -> "cont.suspend", [Node ("event" ^ var x, [])] + | ContThrow x -> "cont.throw", [Node ("exception" ^ var x, [])] | LocalGet x -> "local.get " ^ var x, [] | LocalSet x -> "local.set " ^ var x, [] | LocalTee x -> "local.tee " ^ var x, [] diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index 2d2b62993..f00851793 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -144,6 +144,7 @@ let label (c : context) x = lookup "label " c.labels x let func_type (c : context) x = match (Lib.List32.nth c.types.list x.it).it with | FuncDefType ft -> ft + | _ -> error x.at ("non-function type " ^ Int32.to_string x.it) | exception Failure _ -> error x.at ("unknown type " ^ Int32.to_string x.it) diff --git a/interpreter/valid/match.ml b/interpreter/valid/match.ml index ab1912f60..be1133934 100644 --- a/interpreter/valid/match.ml +++ b/interpreter/valid/match.ml @@ -55,9 +55,14 @@ and eq_stack_type c a ts1 ts2 = and eq_func_type c a (FuncType (ts11, ts12)) (FuncType (ts21, ts22)) = eq_stack_type c a ts11 ts21 && eq_stack_type c a ts12 ts22 +and eq_cont_type c a (ContType x1) (ContType x2) = + eq_var_type c a x1 x1 + and eq_def_type c a dt1 dt2 = match dt1, dt2 with | FuncDefType ft1, FuncDefType ft2 -> eq_func_type c a ft1 ft2 + | ContDefType ct1, ContDefType ct2 -> eq_cont_type c a ct1 ct2 + | _, _ -> false and eq_var_type c a x1 x2 = equal_var x1 x2 || assuming a (x1, x2) || @@ -104,6 +109,7 @@ and match_heap_type c a t1 t2 = | DefHeapType x1, FuncHeapType -> (match lookup c x1 with | FuncDefType _ -> true + | _ -> false ) | DefHeapType x1, DefHeapType x2 -> match_var_type c a x1 x2 | BotHeapType, _ -> true diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 87b77e2c7..820fbb786 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -56,6 +56,13 @@ let label (c : context) x = lookup "label" c.labels x let func_type (c : context) x = match type_ c x with | FuncDefType ft -> ft + | _ -> error x.at ("non-function type " ^ Int32.to_string x.it) + +let cont_type (c : context) x = + match type_ c x with + | ContDefType ct -> ct + | _ -> error x.at ("non-continuation type " ^ Int32.to_string x.it) + let func (c : context) x = func_type c (func_var c x @@ x.at) @@ -84,8 +91,8 @@ let check_num_type (c : context) (t : num_type) at = let check_heap_type (c : context) (t : heap_type) at = match t with | FuncHeapType | ExternHeapType -> () - | DefHeapType (SynVar x) -> ignore (func_type c (x @@ at)) - | DefHeapType (SemVar _) | BotHeapType -> assert false + | DefHeapType x -> ignore (type_ c (as_syn_var x @@ at)) + | BotHeapType -> assert false let check_ref_type (c : context) (t : ref_type) at = match t with @@ -102,6 +109,10 @@ let check_func_type (c : context) (ft : func_type) at = List.iter (fun t -> check_value_type c t at) ts1; List.iter (fun t -> check_value_type c t at) ts2 +let check_cont_type (c : context) (ct : cont_type) at = + let ContType x = ct in + ignore (func_type c (as_syn_var x @@ at)) + let check_table_type (c : context) (tt : table_type) at = let TableType (lim, t) = tt in check_limits lim 0xffff_ffffl at "table size must be at most 2^32-1"; @@ -126,6 +137,7 @@ let check_global_type (c : context) (gt : global_type) at = let check_def_type (c : context) (dt : def_type) at = match dt with | FuncDefType ft -> check_func_type c ft at + | ContDefType ct -> check_cont_type c ct at let check_type (c : context) (t : type_) = @@ -386,10 +398,10 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type = | CallRef -> (match peek_ref 0 s e.at with - | (nul, DefHeapType (SynVar x)) -> + | nul, DefHeapType (SynVar x) -> let FuncType (ts1, ts2) = func_type c (x @@ e.at) in (ts1 @ [RefType (nul, DefHeapType (SynVar x))]) --> ts2 - | (_, BotHeapType) -> + | _, BotHeapType -> [] -->... [] | _ -> assert false ) @@ -404,21 +416,21 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type = | ReturnCallRef -> (match peek_ref 0 s e.at with - | (nul, DefHeapType (SynVar x)) -> + | nul, DefHeapType (SynVar x) -> let FuncType (ts1, ts2) = func_type c (x @@ e.at) in require (match_stack_type c.types [] ts2 c.results) e.at ("type mismatch: current function requires result type " ^ string_of_stack_type c.results ^ " but callee returns " ^ string_of_stack_type ts2); (ts1 @ [RefType (nul, DefHeapType (SynVar x))]) -->... [] - | (_, BotHeapType) -> + | _, BotHeapType -> [] -->... [] | _ -> assert false ) | FuncBind x -> (match peek_ref 0 s e.at with - | (nul, DefHeapType (SynVar y)) -> + | nul, DefHeapType (SynVar y) -> let FuncType (ts1, ts2) = func_type c (y @@ e.at) in let FuncType (ts1', _) as ft' = func_type c x in require (List.length ts1 >= List.length ts1') x.at @@ -428,11 +440,52 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type = "type mismatch in function type"; (ts11 @ [RefType (nul, DefHeapType (SynVar y))]) --> [RefType (NonNullable, DefHeapType (SynVar x.it))] - | (_, BotHeapType) -> + | _, BotHeapType -> [] -->... [RefType (NonNullable, DefHeapType (SynVar x.it))] | _ -> assert false ) + | ContNew x -> + let ContType y = cont_type c x in + [RefType (NonNullable, DefHeapType y)] --> + [RefType (NonNullable, DefHeapType (SynVar x.it))] + + | ContSuspend x -> + let EventType (FuncType (ts1, ts2), res) = event c x in + require (res = Resumable) e.at "suspending with a non-resumable event"; + ts1 --> ts2 + + | ContThrow x -> + let EventType (FuncType (ts0, _), res) = event c x in + require (res = Terminal) e.at "throwing a non-exception event"; + (match peek_ref 0 s e.at with + | nul, DefHeapType (SynVar y) -> + let ContType z = cont_type c (y @@ e.at) in + let FuncType (ts1, ts2) = func_type c (as_syn_var z @@ e.at) in + (ts0 @ [RefType (nul, DefHeapType (SynVar y))]) --> ts2 + | _, BotHeapType -> + [] -->... [] + | _ -> assert false + ) + + | ContResume xys -> + (match peek_ref 0 s e.at with + | nul, DefHeapType (SynVar y) -> + let ContType z = cont_type c (y @@ e.at) in + let FuncType (ts1, ts2) = func_type c (as_syn_var z @@ e.at) in + List.iter (fun (x1, x2) -> + let EventType (FuncType (ts3, ts4), res) = event c x1 in + require (res = Resumable) x1.at "handling a non-resumable event"; + (* TODO: check label; problem: we don't have a type idx to produce here + check_stack c (ts3 @ [RefType (NonNullable, DefHeapType (SynVar ?))]) (label c x2) x2.at + *) + ) xys; + (ts1 @ [RefType (nul, DefHeapType (SynVar y))]) --> ts2 + | _, BotHeapType -> + [] -->... [] + | _ -> assert false + ) + | LocalGet x -> [] --> [local c x] diff --git a/test/core/binary.wast b/test/core/binary.wast index d20d25f01..ca80f2933 100644 --- a/test/core/binary.wast +++ b/test/core/binary.wast @@ -170,7 +170,7 @@ "\e0\7f" ;; Malformed functype, -0x20 in signed LEB128 encoding "\00\00" ) - "integer representation too long" + "malformed type definition" ) ;; Unsigned LEB128 must not be overlong From fb297a0bd60268eeb091f965d0ed293a6fd971df Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Thu, 18 Feb 2021 13:50:08 +0100 Subject: [PATCH 20/82] Typos --- interpreter/text/arrange.ml | 4 +--- interpreter/valid/match.ml | 2 +- 2 files changed, 2 insertions(+), 4 deletions(-) diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index cf980cf5c..12db2baf2 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -275,9 +275,7 @@ let rec instr e = | ContNew x -> "cont.new", [Node ("type " ^ var x, [])] | ContResume xys -> "cont.resume", - List.concat_map (fun (x, y) -> - [Node ("event " ^ var x, []); Atom (var y)] - ) xys + List.map (fun (x, y) -> [Node ("event " ^ var x ^ " " ^ var y, [])]) xys | ContSuspend x -> "cont.suspend", [Node ("event" ^ var x, [])] | ContThrow x -> "cont.throw", [Node ("exception" ^ var x, [])] | LocalGet x -> "local.get " ^ var x, [] diff --git a/interpreter/valid/match.ml b/interpreter/valid/match.ml index be1133934..013afb112 100644 --- a/interpreter/valid/match.ml +++ b/interpreter/valid/match.ml @@ -56,7 +56,7 @@ and eq_func_type c a (FuncType (ts11, ts12)) (FuncType (ts21, ts22)) = eq_stack_type c a ts11 ts21 && eq_stack_type c a ts12 ts22 and eq_cont_type c a (ContType x1) (ContType x2) = - eq_var_type c a x1 x1 + eq_var_type c a x1 x2 and eq_def_type c a dt1 dt2 = match dt1, dt2 with From c9f369b6349fee623dc993e808729dc6b292a8c8 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Thu, 18 Feb 2021 19:30:39 +0100 Subject: [PATCH 21/82] First semantics --- interpreter/exec/eval.ml | 103 +++++++++++++++++++++++++++++++++--- interpreter/text/arrange.ml | 2 +- test/core/catch.wast | 4 +- 3 files changed, 99 insertions(+), 10 deletions(-) diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 491ef4072..fad50f59a 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -63,6 +63,7 @@ and admin_instr' = | Invoke of func_inst | Trapping of string | Throwing of event_inst * value stack + | Suspending of event_inst * value stack * admin_instr | Returning of value stack | ReturningInvoke of value stack * func_inst | Breaking of int32 * value stack @@ -70,6 +71,12 @@ and admin_instr' = | Local of int * value list * code | Frame of int * frame * code | Catch of int * event_inst option * instr list * code + | Resume of (event_inst * idx) list * code + | Hole + +type cont = int * code + +type ref_ += ContRef of cont type config = { @@ -130,6 +137,23 @@ let drop n (vs : 'a stack) at = let split n (vs : 'a stack) at = take n vs at, drop n vs at +let compose (vs1, es1) (vs2, es2) = vs1 @ vs2, es1 @ es2 +let rec plug c (vs, es) = + match es with + | {it = Label (n, es, c'); at} :: es' -> + vs, (Label (n, es, plug c c') @@ at) :: es' + | {it = Local (n, vs, c'); at} :: es' -> + vs, (Local (n, vs, plug c c') @@ at) :: es' + | {it = Frame (n, frame, c'); at} :: es' -> + vs, (Frame (n, frame, plug c c') @@ at) :: es' + | {it = Catch (n, evo, es, c'); at} :: es' -> + vs, (Catch (n, evo, es, plug c c') @@ at) :: es' + | {it = Resume (hs, c'); at} :: es' -> + vs, (Resume (hs, plug c c') @@ at) :: es' + | {it = Hole; at} :: es' -> + compose c (vs, es') + | _ -> assert false + (* Evaluation *) @@ -209,7 +233,10 @@ let rec step (c : config) : config = vs', [Catch (n2, exno, es2, ([], [Label (n2, [], (args, List.map plain es1)) @@ e.at])) @@ e.at] | Throw x, vs -> - [], [Throwing (event c.frame.inst x, vs) @@ e.at] + let evt = event c.frame.inst x in + let EventType (FuncType (ts, _), _) = Event.type_of evt in + let vs0, vs' = split (List.length ts) vs e.at in + vs', [Throwing (evt, vs0) @@ e.at] | Br x, vs -> [], [Breaking (x.it, vs) @@ e.at] @@ -278,6 +305,37 @@ let rec step (c : config) : config = let f' = Func.alloc_closure (type_ c.frame.inst x) f args in Ref (FuncRef f') :: vs', [] + | ContNew x, Ref (NullRef _) :: vs -> + vs, [Trapping "null function reference" @@ e.at] + + | ContNew x, Ref (FuncRef f) :: vs -> + let FuncType (ts, _) = Func.type_of f in + Ref (ContRef (List.length ts, ([], [Invoke f @@ e.at]))) :: vs, [] + + | ContSuspend x, vs -> + let evt = event c.frame.inst x in + let EventType (FuncType (ts, _), _) = Event.type_of evt in + let vs0, vs' = split (List.length ts) vs e.at in + vs', [Suspending (evt, vs0, Hole @@ e.at) @@ e.at] + + | ContThrow x, Ref (NullRef _) :: vs -> + vs, [Trapping "null continuation reference" @@ e.at] + + | ContThrow x, Ref (ContRef (n, code)) :: vs -> + let evt = event c.frame.inst x in + let EventType (FuncType (ts, _), _) = Event.type_of evt in + let vs0, vs' = split (List.length ts) vs e.at in + let vs1', es1' = plug (vs0, [Plain (Throw x) @@ e.at]) code in + vs1' @ vs', es1' + + | ContResume xls, Ref (NullRef _) :: vs -> + vs, [Trapping "null continuation reference" @@ e.at] + + | ContResume xls, Ref (ContRef (n, code)) :: vs -> + let hs = List.map (fun (x, l) -> event c.frame.inst x, l) xls in + let vs0, vs' = split n vs e.at in + vs', [Resume (hs, plug (vs0, []) code) @@ e.at] + | Drop, v :: vs' -> vs', [] @@ -557,6 +615,9 @@ let rec step (c : config) : config = | Label (n, es0, (vs', [])), vs -> vs' @ vs, [] + | Label (n, es0, (vs', {it = Suspending (evt, vs1, e1); at} :: es')), vs -> + vs, [Suspending (evt, vs1, Label (n, es0, (vs', e1 :: es')) @@ e.at) @@ at] + | Label (n, es0, (vs', {it = Breaking (0l, vs0); at} :: es')), vs -> take n vs0 e.at @ vs, List.map plain es0 @@ -573,6 +634,9 @@ let rec step (c : config) : config = | Local (n, vs0, (vs', [])), vs -> vs' @ vs, [] + | Local (n, vs0, (vs', {it = Suspending (evt, vs1, e1); at} :: es')), vs -> + vs, [Suspending (evt, vs1, Local (n, vs0, (vs', e1 :: es')) @@ e.at) @@ at] + | Local (n, vs0, (vs', e' :: es')), vs when is_jumping e' -> vs, [e'] @@ -585,6 +649,9 @@ let rec step (c : config) : config = | Frame (n, frame', (vs', [])), vs -> vs' @ vs, [] + | Frame (n, frame', (vs', {it = Suspending (evt, vs1, e1); at} :: es')), vs -> + vs, [Suspending (evt, vs1, Frame (n, frame', (vs', e1 :: es')) @@ e.at) @@ at] + | Frame (n, frame', (vs', {it = Returning vs0; at} :: es')), vs -> take n vs0 e.at @ vs, [] @@ -630,14 +697,15 @@ let rec step (c : config) : config = | Catch (n, exno, es0, (vs', [])), vs -> vs' @ vs, [] + | Catch (n, exno, es0, (vs', {it = Suspending (evt, vs1, e1); at} :: es')), vs -> + vs, [Suspending (evt, vs1, Catch (n, exno, es0, (vs', e1 :: es')) @@ e.at) @@ at] + | Catch (n, None, es0, (vs', {it = Throwing (exn, vs0); at} :: _)), vs -> vs, [Label (n, [], ([], List.map plain es0)) @@ e.at] | Catch (n, Some exn, es0, (vs', {it = Throwing (exn0, vs0); at} :: _)), vs when exn0 == exn -> - let EventType (FuncType (ts, _), _) = Event.type_of exn in - let n' = List.length ts in - vs, [Label (n, [], (take n' vs0 at, List.map plain es0)) @@ e.at] + vs, [Label (n, [], (vs0, List.map plain es0)) @@ e.at] | Catch (n, exno, es0, (vs', e' :: es')), vs when is_jumping e' -> vs, [e'] @@ -646,6 +714,22 @@ let rec step (c : config) : config = let c' = step {c with code = code'} in vs, [Catch (n, exno, es0, c'.code) @@ e.at] + | Resume (hs, (vs', [])), vs -> + vs' @ vs, [] + + | Resume (hs, (vs', {it = Suspending (evt, vs1, e1); at} :: es')), vs + when List.mem_assq evt hs -> + let EventType (FuncType (_, ts), _) = Event.type_of evt in + [Ref (ContRef (List.length ts, (vs', e1 :: es')))] @ vs1 @ vs, + [Plain (Br (List.assq evt hs)) @@ e.at] + + | Resume (hs, (vs', e' :: es')), vs when is_jumping e' -> + vs, [e'] + + | Resume (hs, code'), vs -> + let c' = step {c with code = code'} in + vs, [Resume (hs, c'.code) @@ e.at] + | Returning _, vs | ReturningInvoke _, vs -> Crash.error e.at "undefined frame" @@ -653,8 +737,10 @@ let rec step (c : config) : config = | Breaking (k, vs'), vs -> Crash.error e.at "undefined label" - | Trapping _, vs - | Throwing _, vs -> + | Trapping _, _ + | Throwing _, _ + | Suspending _, _ + | Hole, _ -> assert false in {c with code = vs', es' @ List.tl es} @@ -669,7 +755,10 @@ let rec eval (c : config) : value stack = Trap.error at msg | vs, {it = Throwing _; at} :: _ -> - Exception.error at "uncaught exception" + Exception.error at "unhandled exception" + + | vs, {it = Suspending _; at} :: _ -> + Exception.error at "unhandled event" | vs, es -> eval (step c) diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index 12db2baf2..acf63eecb 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -275,7 +275,7 @@ let rec instr e = | ContNew x -> "cont.new", [Node ("type " ^ var x, [])] | ContResume xys -> "cont.resume", - List.map (fun (x, y) -> [Node ("event " ^ var x ^ " " ^ var y, [])]) xys + List.map (fun (x, y) -> Node ("event " ^ var x ^ " " ^ var y, [])) xys | ContSuspend x -> "cont.suspend", [Node ("event" ^ var x, [])] | ContThrow x -> "cont.throw", [Node ("exception" ^ var x, [])] | LocalGet x -> "local.get " ^ var x, [] diff --git a/test/core/catch.wast b/test/core/catch.wast index 74b269376..081614f51 100644 --- a/test/core/catch.wast +++ b/test/core/catch.wast @@ -82,5 +82,5 @@ (assert_return (invoke "catch-4") (i32.const 66)) (assert_return (invoke "success-0") (i32.const 0)) (assert_return (invoke "success-1") (i32.const 1)) -(assert_exception (invoke "uncaught-1") "uncaught exception") -(assert_exception (invoke "uncaught-2") "uncaught exception") +(assert_exception (invoke "uncaught-1") "unhandled") +(assert_exception (invoke "uncaught-2") "unhandled") From 7f092d05fd8db419e200614587e5491e88acb6f1 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Thu, 18 Feb 2021 23:39:21 +0100 Subject: [PATCH 22/82] Simplify --- interpreter/exec/eval.ml | 127 ++++++++++++++++++--------------------- 1 file changed, 59 insertions(+), 68 deletions(-) diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index fad50f59a..6e2d5d828 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -44,7 +44,7 @@ let numeric_error at = function | exn -> raise exn -(* Administrative Expressions & Configurations *) +(* Administrative Expressions & Continuations *) type 'a stack = 'a list @@ -61,23 +61,37 @@ and admin_instr' = | Plain of instr' | Refer of ref_ | Invoke of func_inst - | Trapping of string - | Throwing of event_inst * value stack - | Suspending of event_inst * value stack * admin_instr - | Returning of value stack - | ReturningInvoke of value stack * func_inst - | Breaking of int32 * value stack | Label of int * instr list * code | Local of int * value list * code | Frame of int * frame * code | Catch of int * event_inst option * instr list * code | Resume of (event_inst * idx) list * code - | Hole -type cont = int * code + | Trapping of string + | Throwing of event_inst * value stack + | Suspending of event_inst * value stack * ctxt + | Returning of value stack + | ReturningInvoke of value stack * func_inst + | Breaking of int32 * value stack + +and ctxt = code -> code +type cont = int * ctxt type ref_ += ContRef of cont +let plain e = Plain e.it @@ e.at + +let is_jumping e = + match e.it with + | Trapping _ | Throwing _ | Returning _ | ReturningInvoke _ | Breaking _ -> + true + | _ -> false + +let compose (vs1, es1) (vs2, es2) = vs1 @ vs2, es1 @ es2 + + +(* Configurations *) + type config = { frame : frame; @@ -88,14 +102,6 @@ type config = let frame inst = {inst; locals = []} let config inst vs es = {frame = frame inst; code = vs, es; budget = 300} -let plain e = Plain e.it @@ e.at - -let is_jumping e = - match e.it with - | Trapping _ | Throwing _ | Returning _ | ReturningInvoke _ | Breaking _ -> - true - | _ -> false - let lookup category list x = try Lib.List32.nth list x.it with Failure _ -> Crash.error x.at ("undefined " ^ category ^ " " ^ Int32.to_string x.it) @@ -137,23 +143,6 @@ let drop n (vs : 'a stack) at = let split n (vs : 'a stack) at = take n vs at, drop n vs at -let compose (vs1, es1) (vs2, es2) = vs1 @ vs2, es1 @ es2 -let rec plug c (vs, es) = - match es with - | {it = Label (n, es, c'); at} :: es' -> - vs, (Label (n, es, plug c c') @@ at) :: es' - | {it = Local (n, vs, c'); at} :: es' -> - vs, (Local (n, vs, plug c c') @@ at) :: es' - | {it = Frame (n, frame, c'); at} :: es' -> - vs, (Frame (n, frame, plug c c') @@ at) :: es' - | {it = Catch (n, evo, es, c'); at} :: es' -> - vs, (Catch (n, evo, es, plug c c') @@ at) :: es' - | {it = Resume (hs, c'); at} :: es' -> - vs, (Resume (hs, plug c c') @@ at) :: es' - | {it = Hole; at} :: es' -> - compose c (vs, es') - | _ -> assert false - (* Evaluation *) @@ -310,31 +299,32 @@ let rec step (c : config) : config = | ContNew x, Ref (FuncRef f) :: vs -> let FuncType (ts, _) = Func.type_of f in - Ref (ContRef (List.length ts, ([], [Invoke f @@ e.at]))) :: vs, [] + let ctxt code = compose code ([], [Invoke f @@ e.at]) in + Ref (ContRef (List.length ts, ctxt)) :: vs, [] | ContSuspend x, vs -> let evt = event c.frame.inst x in let EventType (FuncType (ts, _), _) = Event.type_of evt in let vs0, vs' = split (List.length ts) vs e.at in - vs', [Suspending (evt, vs0, Hole @@ e.at) @@ e.at] + vs', [Suspending (evt, vs0, fun code -> code) @@ e.at] | ContThrow x, Ref (NullRef _) :: vs -> vs, [Trapping "null continuation reference" @@ e.at] - | ContThrow x, Ref (ContRef (n, code)) :: vs -> + | ContThrow x, Ref (ContRef (n, ctxt)) :: vs -> let evt = event c.frame.inst x in let EventType (FuncType (ts, _), _) = Event.type_of evt in let vs0, vs' = split (List.length ts) vs e.at in - let vs1', es1' = plug (vs0, [Plain (Throw x) @@ e.at]) code in + let vs1', es1' = ctxt (vs0, [Plain (Throw x) @@ e.at]) in vs1' @ vs', es1' | ContResume xls, Ref (NullRef _) :: vs -> vs, [Trapping "null continuation reference" @@ e.at] - | ContResume xls, Ref (ContRef (n, code)) :: vs -> + | ContResume xls, Ref (ContRef (n, ctxt)) :: vs -> let hs = List.map (fun (x, l) -> event c.frame.inst x, l) xls in let vs0, vs' = split n vs e.at in - vs', [Resume (hs, plug (vs0, []) code) @@ e.at] + vs', [Resume (hs, ctxt (vs0, [])) @@ e.at] | Drop, v :: vs' -> vs', [] @@ -615,8 +605,9 @@ let rec step (c : config) : config = | Label (n, es0, (vs', [])), vs -> vs' @ vs, [] - | Label (n, es0, (vs', {it = Suspending (evt, vs1, e1); at} :: es')), vs -> - vs, [Suspending (evt, vs1, Label (n, es0, (vs', e1 :: es')) @@ e.at) @@ at] + | Label (n, es0, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs -> + let ctxt' code = [], [Label (n, es0, compose (ctxt code) (vs', es')) @@ e.at] in + vs, [Suspending (evt, vs1, ctxt') @@ at] | Label (n, es0, (vs', {it = Breaking (0l, vs0); at} :: es')), vs -> take n vs0 e.at @ vs, List.map plain es0 @@ -634,8 +625,9 @@ let rec step (c : config) : config = | Local (n, vs0, (vs', [])), vs -> vs' @ vs, [] - | Local (n, vs0, (vs', {it = Suspending (evt, vs1, e1); at} :: es')), vs -> - vs, [Suspending (evt, vs1, Local (n, vs0, (vs', e1 :: es')) @@ e.at) @@ at] + | Local (n, vs0, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs -> + let ctxt' code = [], [Local (n, vs0, compose (ctxt code) (vs', es')) @@ e.at] in + vs, [Suspending (evt, vs1, ctxt') @@ at] | Local (n, vs0, (vs', e' :: es')), vs when is_jumping e' -> vs, [e'] @@ -649,8 +641,9 @@ let rec step (c : config) : config = | Frame (n, frame', (vs', [])), vs -> vs' @ vs, [] - | Frame (n, frame', (vs', {it = Suspending (evt, vs1, e1); at} :: es')), vs -> - vs, [Suspending (evt, vs1, Frame (n, frame', (vs', e1 :: es')) @@ e.at) @@ at] + | Frame (n, frame', (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs -> + let ctxt' code = [], [Frame (n, frame', compose (ctxt code) (vs', es')) @@ e.at] in + vs, [Suspending (evt, vs1, ctxt') @@ at] | Frame (n, frame', (vs', {it = Returning vs0; at} :: es')), vs -> take n vs0 e.at @ vs, [] @@ -697,8 +690,9 @@ let rec step (c : config) : config = | Catch (n, exno, es0, (vs', [])), vs -> vs' @ vs, [] - | Catch (n, exno, es0, (vs', {it = Suspending (evt, vs1, e1); at} :: es')), vs -> - vs, [Suspending (evt, vs1, Catch (n, exno, es0, (vs', e1 :: es')) @@ e.at) @@ at] + | Catch (n, exno, es0, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs -> + let ctxt' code = [], [Catch (n, exno, es0, compose (ctxt code) (vs', es')) @@ e.at] in + vs, [Suspending (evt, vs1, ctxt') @@ at] | Catch (n, None, es0, (vs', {it = Throwing (exn, vs0); at} :: _)), vs -> vs, [Label (n, [], ([], List.map plain es0)) @@ e.at] @@ -717,10 +711,11 @@ let rec step (c : config) : config = | Resume (hs, (vs', [])), vs -> vs' @ vs, [] - | Resume (hs, (vs', {it = Suspending (evt, vs1, e1); at} :: es')), vs + | Resume (hs, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs when List.mem_assq evt hs -> let EventType (FuncType (_, ts), _) = Event.type_of evt in - [Ref (ContRef (List.length ts, (vs', e1 :: es')))] @ vs1 @ vs, + let ctxt' code = compose (ctxt code) (vs', es') in + [Ref (ContRef (List.length ts, ctxt'))] @ vs1 @ vs, [Plain (Br (List.assq evt hs)) @@ e.at] | Resume (hs, (vs', e' :: es')), vs when is_jumping e' -> @@ -730,17 +725,12 @@ let rec step (c : config) : config = let c' = step {c with code = code'} in vs, [Resume (hs, c'.code) @@ e.at] - | Returning _, vs - | ReturningInvoke _, vs -> - Crash.error e.at "undefined frame" - - | Breaking (k, vs'), vs -> - Crash.error e.at "undefined label" - | Trapping _, _ | Throwing _, _ | Suspending _, _ - | Hole, _ -> + | Returning _, _ + | ReturningInvoke _, _ + | Breaking _, _ -> assert false in {c with code = vs', es' @ List.tl es} @@ -751,16 +741,17 @@ let rec eval (c : config) : value stack = | vs, [] -> vs - | vs, {it = Trapping msg; at} :: _ -> - Trap.error at msg - - | vs, {it = Throwing _; at} :: _ -> - Exception.error at "unhandled exception" - - | vs, {it = Suspending _; at} :: _ -> - Exception.error at "unhandled event" - - | vs, es -> + | vs, e::_ when is_jumping e -> + (match e.it with + | Trapping msg -> Trap.error e.at msg + | Throwing _ -> Exception.error e.at "unhandled exception" + | Suspending _ -> Exception.error e.at "unhandled event" + | Returning _ | ReturningInvoke _ -> Crash.error e.at "undefined frame" + | Breaking _ -> Crash.error e.at "undefined label" + | _ -> assert false + ) + + | _ -> eval (step c) From 5e510eefde10b2ef4caedb18f8fc39ef57839f27 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Fri, 19 Feb 2021 09:29:55 +0100 Subject: [PATCH 23/82] Text, simple test --- interpreter/exec/eval.ml | 8 ++-- interpreter/exec/eval.mli | 1 + interpreter/script/js.ml | 10 +++++ interpreter/script/run.ml | 7 +++ interpreter/script/script.ml | 1 + interpreter/text/arrange.ml | 6 ++- interpreter/text/lexer.mll | 7 +++ interpreter/text/parser.mly | 69 +++++++++++++++++++++++++++++- test/core/cont.wast | 82 ++++++++++++++++++++++++++++++++++++ 9 files changed, 184 insertions(+), 7 deletions(-) create mode 100644 test/core/cont.wast diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 6e2d5d828..d0a521e74 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -10,12 +10,14 @@ open Source module Link = Error.Make () module Trap = Error.Make () module Exception = Error.Make () +module Suspension = Error.Make () module Exhaustion = Error.Make () module Crash = Error.Make () exception Link = Link.Error exception Trap = Trap.Error exception Exception = Exception.Error +exception Suspension = Suspension.Error exception Exhaustion = Exhaustion.Error exception Crash = Crash.Error (* failure that cannot happen in valid code *) @@ -66,7 +68,6 @@ and admin_instr' = | Frame of int * frame * code | Catch of int * event_inst option * instr list * code | Resume of (event_inst * idx) list * code - | Trapping of string | Throwing of event_inst * value stack | Suspending of event_inst * value stack * ctxt @@ -83,7 +84,8 @@ let plain e = Plain e.it @@ e.at let is_jumping e = match e.it with - | Trapping _ | Throwing _ | Returning _ | ReturningInvoke _ | Breaking _ -> + | Trapping _ | Throwing _ | Suspending _ + | Returning _ | ReturningInvoke _ | Breaking _ -> true | _ -> false @@ -745,7 +747,7 @@ let rec eval (c : config) : value stack = (match e.it with | Trapping msg -> Trap.error e.at msg | Throwing _ -> Exception.error e.at "unhandled exception" - | Suspending _ -> Exception.error e.at "unhandled event" + | Suspending _ -> Suspension.error e.at "unhandled event" | Returning _ | ReturningInvoke _ -> Crash.error e.at "undefined frame" | Breaking _ -> Crash.error e.at "undefined label" | _ -> assert false diff --git a/interpreter/exec/eval.mli b/interpreter/exec/eval.mli index 05617e098..089aaeca4 100644 --- a/interpreter/exec/eval.mli +++ b/interpreter/exec/eval.mli @@ -4,6 +4,7 @@ open Instance exception Link of Source.region * string exception Trap of Source.region * string exception Exception of Source.region * string +exception Suspension of Source.region * string exception Exhaustion of Source.region * string exception Crash of Source.region * string diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml index f9ca7f41c..4ee89a264 100644 --- a/interpreter/script/js.ml +++ b/interpreter/script/js.ml @@ -143,6 +143,14 @@ function assert_exception(action) { throw new Error("Wasm exception expected"); } +function assert_suspension(action) { + try { action() } catch (e) { + /* TODO: Not clear how to observe form JS */ + return; + } + throw new Error("Wasm exception expected"); +} + let StackOverflow; try { (function f() { 1 + f() })() } catch (e) { StackOverflow = e.constructor } @@ -536,6 +544,8 @@ let of_assertion mods ass = of_assertion' mods act "assert_trap" [] None | AssertException (act, _) -> of_assertion' mods act "assert_exception" [] None + | AssertSuspension (act, _) -> + of_assertion' mods act "assert_suspension" [] None | AssertExhaustion (act, _) -> of_assertion' mods act "assert_exhaustion" [] None diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml index fde16d882..cc6f0d3a1 100644 --- a/interpreter/script/run.ml +++ b/interpreter/script/run.ml @@ -446,6 +446,13 @@ let run_assertion ass = | _ -> Assert.error ass.at "expected exception" ) + | AssertSuspension (act, re) -> + trace ("Asserting suspension..."); + (match run_action act with + | exception Eval.Suspension (_, msg) -> assert_message ass.at "runtime" msg re + | _ -> Assert.error ass.at "expected suspension" + ) + | AssertExhaustion (act, re) -> trace ("Asserting exhaustion..."); (match run_action act with diff --git a/interpreter/script/script.ml b/interpreter/script/script.ml index baff09e0e..d0abe6be2 100644 --- a/interpreter/script/script.ml +++ b/interpreter/script/script.ml @@ -34,6 +34,7 @@ and assertion' = | AssertReturn of action * result list | AssertTrap of action * string | AssertException of action * string + | AssertSuspension of action * string | AssertExhaustion of action * string type command = command' Source.phrase diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index acf63eecb..e6a8fe1ce 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -564,10 +564,12 @@ let assertion mode ass = [Node ("assert_return", action mode act :: List.map (result mode) results)] | AssertTrap (act, re) -> [Node ("assert_trap", [action mode act; Atom (string re)])] - | AssertExhaustion (act, re) -> - [Node ("assert_exhaustion", [action mode act; Atom (string re)])] | AssertException (act, re) -> [Node ("assert_exception", [action mode act; Atom (string re)])] + | AssertSuspension (act, re) -> + [Node ("assert_suspension", [action mode act; Atom (string re)])] + | AssertExhaustion (act, re) -> + [Node ("assert_exhaustion", [action mode act; Atom (string re)])] let command mode cmd = match cmd.it with diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index 9d0a4e75b..4bec43b3d 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -167,6 +167,7 @@ rule token = parse | "funcref" { FUNCREF } | (nxx as t) { NUM_TYPE (num_type t) } | "mut" { MUT } + | "cont" { CONT } | (nxx as t)".const" { let open Source in @@ -214,6 +215,11 @@ rule token = parse | "catch" { CATCH } | "catch_all" { CATCH_ALL } + | "cont.new" { CONT_NEW } + | "cont.suspend" { CONT_SUSPEND } + | "cont.throw" { CONT_THROW } + | "cont.resume" { CONT_RESUME } + | "local.get" { LOCAL_GET } | "local.set" { LOCAL_SET } | "local.tee" { LOCAL_TEE } @@ -395,6 +401,7 @@ rule token = parse | "assert_return" { ASSERT_RETURN } | "assert_trap" { ASSERT_TRAP } | "assert_exception" { ASSERT_EXCEPTION } + | "assert_suspension" { ASSERT_SUSPENSION } | "assert_exhaustion" { ASSERT_EXHAUSTION } | "nan:canonical" { NAN Script.CanonicalNan } | "nan:arithmetic" { NAN Script.ArithmeticNan } diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index f00851793..a97439c22 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -213,10 +213,11 @@ let inline_func_type_explicit (c : context) x ft at = %token LPAR RPAR %token NAT INT FLOAT STRING VAR -%token NUM_TYPE FUNCREF EXTERNREF REF EXTERN NULL MUT +%token NUM_TYPE FUNCREF EXTERNREF REF EXTERN NULL MUT CONT %token UNREACHABLE NOP DROP SELECT %token BLOCK END IF THEN ELSE LOOP LET %token THROW TRY DO CATCH CATCH_ALL +%token CONT_NEW CONT_SUSPEND CONT_THROW CONT_RESUME %token BR BR_IF BR_TABLE BR_ON_NULL %token CALL CALL_REF CALL_INDIRECT RETURN RETURN_CALL_REF FUNC_BIND %token LOCAL_GET LOCAL_SET LOCAL_TEE GLOBAL_GET GLOBAL_SET @@ -231,7 +232,7 @@ let inline_func_type_explicit (c : context) x ft at = %token MODULE BIN QUOTE %token SCRIPT REGISTER INVOKE GET %token ASSERT_MALFORMED ASSERT_INVALID ASSERT_SOFT_INVALID ASSERT_UNLINKABLE -%token ASSERT_RETURN ASSERT_TRAP ASSERT_EXCEPTION ASSERT_EXHAUSTION +%token ASSERT_RETURN ASSERT_TRAP ASSERT_EXCEPTION ASSERT_SUSPENSION ASSERT_EXHAUSTION %token NAN %token INPUT OUTPUT %token EOF @@ -305,6 +306,32 @@ global_type : def_type : | LPAR FUNC func_type RPAR { fun c -> FuncDefType ($3 c) } + | LPAR CONT cont_type RPAR { fun c -> ContDefType (ContType (SynVar ($3 c).it)) } + +cont_type : + | type_use cont_type_params + { let at1 = ati 1 in + fun c -> + match $2 c with + | FuncType ([], []) -> $1 c type_ + | ft -> inline_func_type_explicit c ($1 c type_) ft at1 } + | cont_type_params + /* TODO: the inline type is broken for now */ + { let at = at () in fun c -> inline_func_type c ($1 c) at } + +cont_type_params : + | LPAR PARAM value_type_list RPAR cont_type_params + { fun c -> let FuncType (ts1, ts2) = $5 c in + FuncType (snd $3 c @ ts1, ts2) } + | cont_type_results + { fun c -> FuncType ([], $1 c) } + +cont_type_results : + | LPAR RESULT value_type_list RPAR cont_type_results + { fun c -> snd $3 c @ $5 c } + | /* empty */ + { fun c -> [] } + func_type : | /* empty */ @@ -398,6 +425,7 @@ instr : | plain_instr { let at = at () in fun c -> [$1 c @@ at] } | select_instr_instr { fun c -> let e, es = $1 c in e :: es } | call_instr_instr { fun c -> let e, es = $1 c in e :: es } + | resume_instr_instr { fun c -> let e, es = $1 c in e :: es } | block_instr { let at = at () in fun c -> [$1 c @@ at] } | expr { $1 } /* Sugar */ @@ -416,6 +444,9 @@ plain_instr : | CALL var { fun c -> call ($2 c func) } | CALL_REF { fun c -> call_ref } | RETURN_CALL_REF { fun c -> return_call_ref } + | CONT_NEW LPAR TYPE var RPAR { fun c -> cont_new ($4 c type_) } + | CONT_SUSPEND var { fun c -> cont_suspend ($2 c event) } + | CONT_THROW var { fun c -> cont_throw ($2 c event) } | LOCAL_GET var { fun c -> local_get ($2 c local) } | LOCAL_SET var { fun c -> local_set ($2 c local) } | LOCAL_TEE var { fun c -> local_tee ($2 c local) } @@ -550,6 +581,29 @@ call_instr_results_instr : { fun c -> [], $1 c } +resume_instr : + | CONT_RESUME resume_instr_handler + { let at = at () in fun c -> cont_resume ($2 c) @@ at } + +resume_instr_handler : + | LPAR EVENT var var RPAR resume_instr_handler + { fun c -> ($3 c event, $4 c label) :: $6 c } + | /* empty */ + { fun c -> [] } + + +resume_instr_instr : + | CONT_RESUME resume_instr_handler_instr + { let at1 = ati 1 in + fun c -> let hs, es = $2 c in cont_resume hs @@ at1, es } + +resume_instr_handler_instr : + | LPAR EVENT var var RPAR resume_instr_handler_instr + { fun c -> let hs, es = $6 c in ($3 c event, $4 c label) :: hs, es } + | instr + { fun c -> [], $1 c } + + block_instr : | BLOCK labeling_opt block END labeling_end_opt { fun c -> let c' = $2 c $5 in let bt, es = $3 c' in block bt es } @@ -663,6 +717,8 @@ expr1 : /* Sugar */ fun c -> let x, es = $2 c in es, call_indirect (0l @@ at1) x } | FUNC_BIND call_expr_type { fun c -> let x, es = $2 c in es, func_bind x } + | CONT_RESUME resume_expr_handler + { fun c -> let hs, es = $2 c in es, cont_resume hs } | BLOCK labeling_opt block { fun c -> let c' = $2 c [] in let bt, es = $3 c' in [], block bt es } | LOOP labeling_opt block @@ -709,6 +765,13 @@ call_expr_results : | expr_list { fun c -> [], $1 c } +resume_expr_handler : + | LPAR EVENT var var RPAR resume_expr_handler + { fun c -> let hs, es = $6 c in ($3 c event, $4 c label) :: hs, es } + | expr_list + { fun c -> [], $1 c } + + try_block : | type_use try_block_param_body @@ -790,6 +853,7 @@ instr_list : | /* empty */ { fun c -> [] } | select_instr { fun c -> [$1 c] } | call_instr { fun c -> [$1 c] } + | resume_instr { fun c -> [$1 c] } | instr instr_list { fun c -> $1 c @ $2 c } expr_list : @@ -1269,6 +1333,7 @@ assertion : | LPAR ASSERT_RETURN action result_list RPAR { AssertReturn ($3, $4) @@ at () } | LPAR ASSERT_TRAP action STRING RPAR { AssertTrap ($3, $4) @@ at () } | LPAR ASSERT_EXCEPTION action STRING RPAR { AssertException ($3, $4) @@ at () } + | LPAR ASSERT_SUSPENSION action STRING RPAR { AssertSuspension ($3, $4) @@ at () } | LPAR ASSERT_EXHAUSTION action STRING RPAR { AssertExhaustion ($3, $4) @@ at () } cmd : diff --git a/test/core/cont.wast b/test/core/cont.wast new file mode 100644 index 000000000..e816e3a46 --- /dev/null +++ b/test/core/cont.wast @@ -0,0 +1,82 @@ +(module + (event $e1) + (event $e2) + + (type $f1 (func)) + (type $k1 (cont (type $f1))) + + (func $f1 (export "unhandled-1") + (cont.suspend $e1) + ) + + (func (export "unhandled-2") + (block $h (result (ref $k1)) + (cont.resume (event $e2 $h) (cont.new (type $k1) (ref.func $f1))) + (unreachable) + ) + (drop) + ) + + (func (export "handled") + (block $h (result (ref $k1)) + (cont.resume (event $e1 $h) (cont.new (type $k1) (ref.func $f1))) + (unreachable) + ) + (drop) + ) +) + +(assert_suspension (invoke "unhandled-1") "unhandled") +(assert_suspension (invoke "unhandled-2") "unhandled") +(assert_return (invoke "handled")) + + +(module $state + (event $get (result i32)) + (event $set (param i32) (result i32)) + + (type $f (func (param i32) (result i32))) + (type $k (cont (type $f))) + + (func $runner (param $s i32) (param $k (ref $k)) (result i32) + (loop $loop + (block $on_get (result (ref $k)) + (block $on_set (result i32 (ref $k)) + (cont.resume (event $get $on_get) (event $set $on_set) + (local.get $s) (local.get $k) + ) + (return) + ) + ;; on set + (local.set $k) + (local.set $s) + (br $loop) + ) + ;; on get + (local.set $k) + (br $loop) + ) + (unreachable) + ) + + (func $f (param i32) (result i32) + (drop (cont.suspend $set (i32.const 7))) + (i32.add + (cont.suspend $get) + (i32.mul + (i32.const 2) + (i32.add + (cont.suspend $set (i32.const 3)) + (cont.suspend $get) + ) + ) + ) + ) + + (elem declare func $f) + (func (export "run") (result i32) + (call $runner (i32.const 0) (cont.new (type $k) (ref.func $f))) + ) +) + +(assert_return (invoke "run") (i32.const 19)) From a44c070d029f57d9b1639e077019462d10a14314 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Fri, 19 Feb 2021 09:37:50 +0100 Subject: [PATCH 24/82] Missing rule --- interpreter/exec/eval.ml | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index d0a521e74..9594fdf1b 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -720,6 +720,10 @@ let rec step (c : config) : config = [Ref (ContRef (List.length ts, ctxt'))] @ vs1 @ vs, [Plain (Br (List.assq evt hs)) @@ e.at] + | Resume (hs, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs -> + let ctxt' code = [], [Resume (hs, compose (ctxt code) (vs', es')) @@ e.at] in + vs, [Suspending (evt, vs1, ctxt') @@ at] + | Resume (hs, (vs', e' :: es')), vs when is_jumping e' -> vs, [e'] From e10edf6424788d27fbdd49e3581e1b731d81bba1 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Fri, 19 Feb 2021 09:56:44 +0100 Subject: [PATCH 25/82] Minor grammar tweak --- interpreter/text/parser.mly | 2 ++ test/core/cont.wast | 4 ++-- 2 files changed, 4 insertions(+), 2 deletions(-) diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index a97439c22..3fda8e132 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -318,6 +318,8 @@ cont_type : | cont_type_params /* TODO: the inline type is broken for now */ { let at = at () in fun c -> inline_func_type c ($1 c) at } + | var /* Sugar */ + { fun c -> $1 c type_ } cont_type_params : | LPAR PARAM value_type_list RPAR cont_type_params diff --git a/test/core/cont.wast b/test/core/cont.wast index e816e3a46..d089bd7bf 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -3,7 +3,7 @@ (event $e2) (type $f1 (func)) - (type $k1 (cont (type $f1))) + (type $k1 (cont $f1)) (func $f1 (export "unhandled-1") (cont.suspend $e1) @@ -36,7 +36,7 @@ (event $set (param i32) (result i32)) (type $f (func (param i32) (result i32))) - (type $k (cont (type $f))) + (type $k (cont $f)) (func $runner (param $s i32) (param $k (ref $k)) (result i32) (loop $loop From e235dac90130c2293ad75f4d0c52c06290acb53b Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Fri, 19 Feb 2021 10:49:24 +0100 Subject: [PATCH 26/82] Test exns --- test/core/cont.wast | 24 ++++++++++++++++++++++++ 1 file changed, 24 insertions(+) diff --git a/test/core/cont.wast b/test/core/cont.wast index d089bd7bf..c22d326a4 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -1,4 +1,5 @@ (module + (exception $exn) (event $e1) (event $e2) @@ -24,11 +25,34 @@ ) (drop) ) + + (elem declare func $f2) + (func $f2 + (throw $exn) + ) + + (func (export "uncaught-1") + (block $h (result (ref $k1)) + (cont.resume (event $e1 $h) (cont.new (type $k1) (ref.func $f2))) + (unreachable) + ) + (drop) + ) + + (func (export "uncaught-2") + (block $h (result (ref $k1)) + (cont.resume (event $e1 $h) (cont.new (type $k1) (ref.func $f1))) + (unreachable) + ) + (cont.throw $exn) + ) ) (assert_suspension (invoke "unhandled-1") "unhandled") (assert_suspension (invoke "unhandled-2") "unhandled") (assert_return (invoke "handled")) +(assert_exception (invoke "uncaught-1") "unhandled") +(assert_exception (invoke "uncaught-2") "unhandled") (module $state From 1b478efc53784780334859bd983195b4fdee0a16 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Fri, 19 Feb 2021 13:14:32 +0100 Subject: [PATCH 27/82] Scheduler example --- interpreter/exec/eval.ml | 14 +++- interpreter/valid/match.ml | 11 +++ test/core/cont.wast | 148 +++++++++++++++++++++++++++++++++++++ 3 files changed, 172 insertions(+), 1 deletion(-) diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 9594fdf1b..cb6c5094a 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -77,9 +77,21 @@ and admin_instr' = and ctxt = code -> code -type cont = int * ctxt +type cont = int * ctxt (* TODO: represent type properly *) type ref_ += ContRef of cont +let () = + let type_of_ref' = !Value.type_of_ref' in + Value.type_of_ref' := function + | ContRef _ -> BotHeapType (* TODO *) + | r -> type_of_ref' r + +let () = + let string_of_ref' = !Value.string_of_ref' in + Value.string_of_ref' := function + | ContRef _ -> "cont" + | r -> string_of_ref' r + let plain e = Plain e.it @@ e.at let is_jumping e = diff --git a/interpreter/valid/match.ml b/interpreter/valid/match.ml index 013afb112..9e6d9d847 100644 --- a/interpreter/valid/match.ml +++ b/interpreter/valid/match.ml @@ -26,6 +26,9 @@ let eq_nullability c a nul1 nul2 = let eq_mutability c a mut1 mut2 = mut1 = mut2 +let eq_resumability c a res1 res2 = + res1 = res2 + let eq_limits c a lim1 lim2 = lim1.min = lim2.min && lim1.max = lim2.max @@ -78,12 +81,16 @@ and eq_memory_type c a (MemoryType lim1) (MemoryType lim2) = and eq_global_type c a (GlobalType (t1, mut1)) (GlobalType (t2, mut2)) = eq_mutability c a mut1 mut2 && eq_value_type c a t1 t2 +and eq_event_type c a (EventType (ft1, res1)) (EventType (ft2, res2)) = + eq_resumability c a res1 res2 && eq_func_type c [] ft1 ft2 + and eq_extern_type c a et1 et2 = match et1, et2 with | ExternFuncType ft1, ExternFuncType ft2 -> eq_func_type c a ft1 ft2 | ExternTableType tt1, ExternTableType tt2 -> eq_table_type c a tt1 tt2 | ExternMemoryType mt1, ExternMemoryType mt2 -> eq_memory_type c a mt1 mt2 | ExternGlobalType gt1, ExternGlobalType gt2 -> eq_global_type c a gt1 gt2 + | ExternEventType et1, ExternEventType et2 -> eq_event_type c a et1 et2 | _, _ -> false @@ -146,12 +153,16 @@ and match_global_type c a (GlobalType (t1, mut1)) (GlobalType (t2, mut2)) = | Immutable -> match_value_type c a t1 t2 | Mutable -> eq_value_type c [] t1 t2 +and match_event_type c a (EventType (ft1, res1)) (EventType (ft2, res2)) = + eq_resumability c [] res1 res2 && match_func_type c [] ft1 ft2 + and match_extern_type c a et1 et2 = match et1, et2 with | ExternFuncType ft1, ExternFuncType ft2 -> match_func_type c a ft1 ft2 | ExternTableType tt1, ExternTableType tt2 -> match_table_type c a tt1 tt2 | ExternMemoryType mt1, ExternMemoryType mt2 -> match_memory_type c a mt1 mt2 | ExternGlobalType gt1, ExternGlobalType gt2 -> match_global_type c a gt1 gt2 + | ExternEventType et1, ExternEventType et2 -> match_event_type c a et1 et2 | _, _ -> false and match_def_type c a dt1 dt2 = diff --git a/test/core/cont.wast b/test/core/cont.wast index c22d326a4..d115aa195 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -1,3 +1,5 @@ +;; Unhandled events + (module (exception $exn) (event $e1) @@ -55,6 +57,8 @@ (assert_exception (invoke "uncaught-2") "unhandled") +;; Simple state example + (module $state (event $get (result i32)) (event $set (param i32) (result i32)) @@ -104,3 +108,147 @@ ) (assert_return (invoke "run") (i32.const 19)) + + +;; Simple scheduler example + +(module $scheduler + (type $proc (func)) + (type $cont (cont $proc)) + + (event $yield (export "yield")) + (event $spawn (export "spawn") (param (ref $proc))) + + (table $queue 0 (ref null $cont)) + (global $qdelta i32 (i32.const 10)) + (global $qback (mut i32) (i32.const 0)) + (global $qfront (mut i32) (i32.const 0)) + + (func $queue-empty (result i32) + (i32.eq (global.get $qfront) (global.get $qback)) + ) + + (func $dequeue (result (ref null $cont)) + (local $k (ref null $cont)) + ;; Check if queue is empty + (if (call $queue-empty) + (then (return (ref.null $cont))) + ) + (local.set $k (table.get $queue (global.get $qfront))) + (global.set $qfront (i32.add (global.get $qfront) (i32.const 1))) + (local.get $k) + ) + + (func $enqueue (param $k (ref $cont)) + (local $qlen i32) + ;; Check if queue is full + (if (i32.eq (global.get $qback) (table.size $queue)) + (then + ;; Check if there is enough space in the front to compact + (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) + (then + ;; Not enough room, grow table + (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) + ) + (else + ;; Enough room, move entries down + (local.set $qlen (i32.sub (global.get $qback) (global.get $qfront))) + (table.copy $queue $queue + (i32.const 0) + (global.get $qfront) + (local.get $qlen) + ) + (table.fill $queue + (local.get $qlen) + (ref.null $cont) + (global.get $qfront) + ) + (global.set $qfront (i32.const 0)) + (global.set $qback (local.get $qlen)) + ) + ) + ) + ) + (table.set $queue (global.get $qback) (local.get $k)) + (global.set $qback (i32.add (global.get $qback) (i32.const 1))) + ) + + (func $scheduler (export "scheduler") (param $main (ref $proc)) + (call $enqueue (cont.new (type $cont) (local.get $main))) + (loop $l + (if (call $queue-empty) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_spawn (result (ref $proc) (ref $cont)) + (cont.resume (event $yield $on_yield) (event $spawn $on_spawn) + (call $dequeue) + ) + (br $l) ;; thread terminated + ) + ;; on $spawn, proc and cont on stack + (call $enqueue) ;; continuation of old thread + (cont.new (type $cont)) + (call $enqueue) ;; new thread + (br $l) + ) + ;; on $yield, cont on stack + (call $enqueue) + (br $l) + ) + ) +) + +(register "scheduler") + +(module + (type $proc (func)) + (type $cont (cont $proc)) + (event $yield (import "scheduler" "yield")) + (event $spawn (import "scheduler" "spawn") (param (ref $proc))) + (func $scheduler (import "scheduler" "scheduler") (param $main (ref $proc))) + + (func $log (import "spectest" "print_i32") (param i32)) + + (elem declare func $main $thread1 $thread2 $thread3) + + (func $main + (call $log (i32.const 0)) + (cont.suspend $spawn (ref.func $thread1)) + (call $log (i32.const 1)) + (cont.suspend $spawn (ref.func $thread2)) + (call $log (i32.const 2)) + (cont.suspend $spawn (ref.func $thread3)) + (call $log (i32.const 3)) + ) + + (func $thread1 + (call $log (i32.const 10)) + (cont.suspend $yield) + (call $log (i32.const 11)) + (cont.suspend $yield) + (call $log (i32.const 12)) + (cont.suspend $yield) + (call $log (i32.const 13)) + ) + + (func $thread2 + (call $log (i32.const 20)) + (cont.suspend $yield) + (call $log (i32.const 21)) + ) + + (func $thread3 + (call $log (i32.const 30)) + (cont.suspend $yield) + (call $log (i32.const 31)) + (cont.suspend $yield) + (call $log (i32.const 32)) + ) + + (func (export "run") + (call $log (i32.const -1)) + (call $scheduler (ref.func $main)) + (call $log (i32.const -2)) + ) +) + +(assert_return (invoke "run")) From 8349beeae60522ba935e0af52bada4c4714daa26 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Fri, 19 Feb 2021 15:14:31 +0100 Subject: [PATCH 28/82] Generator example; make threads more interesting --- test/core/cont.wast | 86 ++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 81 insertions(+), 5 deletions(-) diff --git a/test/core/cont.wast b/test/core/cont.wast index d115aa195..544a2d28e 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -110,6 +110,52 @@ (assert_return (invoke "run") (i32.const 19)) +;; Simple generator example + +(module $generator + (type $gen (func (param i64))) + (type $geny (func (param i32))) + (type $cont0 (cont $gen)) + (type $cont (cont $geny)) + + (event $yield (param i64) (result i32)) + + (elem declare func $gen) + (func $gen (param $i i64) + (loop $l + (br_if 1 (cont.suspend $yield (local.get $i))) + (local.set $i (i64.add (local.get $i) (i64.const 1))) + (br $l) + ) + ) + + (func (export "sum") (param $i i64) (param $j i64) (result i64) + (local $sum i64) + (local.get $i) + (cont.new (type $cont0) (ref.func $gen)) + (block $on_first_yield (param i64 (ref $cont0)) (result i64 (ref $cont)) + (cont.resume (event $yield $on_first_yield)) + (unreachable) + ) + (loop $on_yield (param i64) (param (ref $cont)) + (let (result i32 (ref $cont)) + (local $n i64) (local $k (ref $cont)) + (local.set $sum (i64.add (local.get $sum) (local.get $n))) + (i64.eq (local.get $n) (local.get $j)) (local.get $k) + ) + (cont.resume (event $yield $on_yield)) + ) + (return (local.get $sum)) + ) +) + +(assert_return (invoke "sum" (i64.const 0) (i64.const 0)) (i64.const 0)) +(assert_return (invoke "sum" (i64.const 2) (i64.const 2)) (i64.const 2)) +(assert_return (invoke "sum" (i64.const 0) (i64.const 3)) (i64.const 6)) +(assert_return (invoke "sum" (i64.const 1) (i64.const 10)) (i64.const 55)) +(assert_return (invoke "sum" (i64.const 100) (i64.const 2000)) (i64.const 1_996_050)) + + ;; Simple scheduler example (module $scheduler @@ -208,13 +254,16 @@ (func $log (import "spectest" "print_i32") (param i32)) + (global $width (mut i32) (i32.const 0)) + (global $depth (mut i32) (i32.const 0)) + (elem declare func $main $thread1 $thread2 $thread3) (func $main (call $log (i32.const 0)) (cont.suspend $spawn (ref.func $thread1)) (call $log (i32.const 1)) - (cont.suspend $spawn (ref.func $thread2)) + (cont.suspend $spawn (func.bind (type $proc) (global.get $depth) (ref.func $thread2))) (call $log (i32.const 2)) (cont.suspend $spawn (ref.func $thread3)) (call $log (i32.const 3)) @@ -230,10 +279,31 @@ (call $log (i32.const 13)) ) - (func $thread2 + (func $thread2 (param $d i32) + (local $w i32) + (local.set $w (global.get $width)) (call $log (i32.const 20)) - (cont.suspend $yield) + (br_if 0 (i32.eqz (local.get $d))) (call $log (i32.const 21)) + (loop $l + (if (local.get $w) + (then + (call $log (i32.const 22)) + (cont.suspend $yield) + (call $log (i32.const 23)) + (cont.suspend $spawn + (func.bind (type $proc) + (i32.sub (local.get $d) (i32.const 1)) + (ref.func $thread2) + ) + ) + (call $log (i32.const 24)) + (local.set $w (i32.sub (local.get $w) (i32.const 1))) + (br $l) + ) + ) + ) + (call $log (i32.const 25)) ) (func $thread3 @@ -244,11 +314,17 @@ (call $log (i32.const 32)) ) - (func (export "run") + (func (export "run") (param $width i32) (param $depth i32) + (global.set $depth (local.get $depth)) + (global.set $width (local.get $width)) (call $log (i32.const -1)) (call $scheduler (ref.func $main)) (call $log (i32.const -2)) ) ) -(assert_return (invoke "run")) +(assert_return (invoke "run" (i32.const 0) (i32.const 0))) +(assert_return (invoke "run" (i32.const 0) (i32.const 1))) +(assert_return (invoke "run" (i32.const 1) (i32.const 0))) +(assert_return (invoke "run" (i32.const 1) (i32.const 1))) +(assert_return (invoke "run" (i32.const 3) (i32.const 4))) From 34ebc1902d1dc34afb8efba17979ccb821a58729 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Fri, 19 Feb 2021 21:49:41 +0100 Subject: [PATCH 29/82] Avoid code duplication --- test/core/cont.wast | 98 ++++++++++++++++++++++++++++++++++++--------- 1 file changed, 79 insertions(+), 19 deletions(-) diff --git a/test/core/cont.wast b/test/core/cont.wast index 544a2d28e..df9818388 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -120,15 +120,21 @@ (event $yield (param i64) (result i32)) - (elem declare func $gen) - (func $gen (param $i i64) + ;; Hook for logging purposes + (global $hook (export "hook") (mut (ref $gen)) (ref.func $dummy)) + (func $dummy (param i64)) + + (func $gen (export "start") (param $i i64) (loop $l (br_if 1 (cont.suspend $yield (local.get $i))) + (call_ref (local.get $i) (global.get $hook)) (local.set $i (i64.add (local.get $i) (i64.const 1))) (br $l) ) ) + (elem declare func $gen) + (func (export "sum") (param $i i64) (param $j i64) (result i64) (local $sum i64) (local.get $i) @@ -149,6 +155,8 @@ ) ) +(register "generator") + (assert_return (invoke "sum" (i64.const 0) (i64.const 0)) (i64.const 0)) (assert_return (invoke "sum" (i64.const 2) (i64.const 2)) (i64.const 2)) (assert_return (invoke "sum" (i64.const 0) (i64.const 3)) (i64.const 6)) @@ -165,6 +173,7 @@ (event $yield (export "yield")) (event $spawn (export "spawn") (param (ref $proc))) + ;; Table as simple queue (keeping it simple, no ring buffer) (table $queue 0 (ref null $cont)) (global $qdelta i32 (i32.const 10)) (global $qback (mut i32) (i32.const 0)) @@ -175,42 +184,39 @@ ) (func $dequeue (result (ref null $cont)) - (local $k (ref null $cont)) - ;; Check if queue is empty + (local $i i32) (if (call $queue-empty) (then (return (ref.null $cont))) ) - (local.set $k (table.get $queue (global.get $qfront))) - (global.set $qfront (i32.add (global.get $qfront) (i32.const 1))) - (local.get $k) + (local.set $i (global.get $qfront)) + (global.set $qfront (i32.add (local.get $i) (i32.const 1))) + (table.get $queue (local.get $i)) ) (func $enqueue (param $k (ref $cont)) - (local $qlen i32) ;; Check if queue is full (if (i32.eq (global.get $qback) (table.size $queue)) (then ;; Check if there is enough space in the front to compact (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) (then - ;; Not enough room, grow table + ;; Space is below threshold, grow table instead (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) ) (else - ;; Enough room, move entries down - (local.set $qlen (i32.sub (global.get $qback) (global.get $qfront))) + ;; Enough space, move entries up to head of table + (global.set $qback (i32.sub (global.get $qback) (global.get $qfront))) (table.copy $queue $queue - (i32.const 0) - (global.get $qfront) - (local.get $qlen) + (i32.const 0) ;; dest = new front = 0 + (global.get $qfront) ;; src = old front + (global.get $qback) ;; len = new back = old back - old front ) - (table.fill $queue - (local.get $qlen) - (ref.null $cont) - (global.get $qfront) + (table.fill $queue ;; null out old entries to avoid leaks + (global.get $qback) ;; start = new back + (ref.null $cont) ;; init value + (global.get $qfront) ;; len = old front = old front - new front ) (global.set $qfront (i32.const 0)) - (global.set $qback (local.get $qlen)) ) ) ) @@ -328,3 +334,57 @@ (assert_return (invoke "run" (i32.const 1) (i32.const 0))) (assert_return (invoke "run" (i32.const 1) (i32.const 1))) (assert_return (invoke "run" (i32.const 3) (i32.const 4))) + + +;; Nested example: generator in a thread + +(module $concurrent-generator + (func $log (import "spectest" "print_i64") (param i64)) + + (event $syield (import "scheduler" "yield")) + (event $spawn (import "scheduler" "spawn") (param (ref $proc))) + (func $scheduler (import "scheduler" "scheduler") (param $main (ref $proc))) + + (type $hook (func (param i64))) + (func $sum (import "generator" "sum") (param i64 i64) (result i64)) + (global $hook (import "generator" "hook") (mut (ref $hook))) + + (global $result (mut i64) (i64.const 0)) + (global $done (mut i32) (i32.const 0)) + + (elem declare func $main $bg-thread $syield) + + (func $syield (param $i i64) + (call $log (local.get $i)) + (cont.suspend $syield) + ) + + (func $bg-thread + (call $log (i64.const -10)) + (loop $l + (call $log (i64.const -11)) + (cont.suspend $syield) + (br_if $l (i32.eqz (global.get $done))) + ) + (call $log (i64.const -12)) + ) + + (func $main (param $i i64) (param $j i64) + (cont.suspend $spawn (ref.func $bg-thread)) + (global.set $hook (ref.func $syield)) + (global.set $result (call $sum (local.get $i) (local.get $j))) + (global.set $done (i32.const 1)) + ) + + (type $proc (func)) + (func (export "sum") (param $i i64) (param $j i64) (result i64) + (call $log (i64.const -1)) + (call $scheduler + (func.bind (type $proc) (local.get $i) (local.get $j) (ref.func $main)) + ) + (call $log (i64.const -2)) + (global.get $result) + ) +) + +(assert_return (invoke "sum" (i64.const 10) (i64.const 20)) (i64.const 165)) From 39398284a04ca9d2fbccc322335615b9abbb5343 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Fri, 19 Feb 2021 21:52:41 +0100 Subject: [PATCH 30/82] Eps --- test/core/cont.wast | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/test/core/cont.wast b/test/core/cont.wast index df9818388..22134eadf 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -345,9 +345,9 @@ (event $spawn (import "scheduler" "spawn") (param (ref $proc))) (func $scheduler (import "scheduler" "scheduler") (param $main (ref $proc))) - (type $hook (func (param i64))) - (func $sum (import "generator" "sum") (param i64 i64) (result i64)) - (global $hook (import "generator" "hook") (mut (ref $hook))) + (type $ghook (func (param i64))) + (func $gsum (import "generator" "sum") (param i64 i64) (result i64)) + (global $ghook (import "generator" "hook") (mut (ref $ghook))) (global $result (mut i64) (i64.const 0)) (global $done (mut i32) (i32.const 0)) @@ -371,8 +371,8 @@ (func $main (param $i i64) (param $j i64) (cont.suspend $spawn (ref.func $bg-thread)) - (global.set $hook (ref.func $syield)) - (global.set $result (call $sum (local.get $i) (local.get $j))) + (global.set $ghook (ref.func $syield)) + (global.set $result (call $gsum (local.get $i) (local.get $j))) (global.set $done (i32.const 1)) ) From 92fd88f166697f127691de1268dccec9f677b51c Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Sat, 20 Feb 2021 08:42:54 +0100 Subject: [PATCH 31/82] Renames; fixes; add guard instruction --- interpreter/binary/decode.ml | 15 +++++-- interpreter/binary/encode.ml | 7 +-- interpreter/exec/eval.ml | 77 +++++++++++++++++++++------------ interpreter/syntax/ast.ml | 7 +-- interpreter/syntax/free.ml | 6 +-- interpreter/syntax/operators.ml | 7 +-- interpreter/text/arrange.ml | 18 +++++--- interpreter/text/lexer.mll | 7 +-- interpreter/text/parser.mly | 32 +++++++++----- interpreter/valid/valid.ml | 33 ++++++++------ test/core/binary.wast | 4 +- test/core/catch.wast | 4 +- test/core/cont.wast | 74 ++++++++++++++++++------------- 13 files changed, 180 insertions(+), 111 deletions(-) diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index e7a0cc007..6cdb0b3ee 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -225,7 +225,7 @@ let global_type s = let def_type s = match peek s with | Some 0x60 -> FuncDefType (func_type s) - | Some 0x61 -> ContDefType (cont_type s) + | Some 0x5f -> ContDefType (cont_type s) | None -> ignore (vs7 s); assert false (* force error *) | _ -> error s (pos s) "malformed type definition" @@ -553,9 +553,14 @@ let rec instr s = | 0xd4 -> br_on_null (at var s) | 0xe0 -> cont_new (at var s) - | 0xe1 -> cont_suspend (at var s) - | 0xe2 -> cont_throw (at var s) - | 0xe3 -> cont_resume (vec var_pair s) + | 0xe1 -> suspend (at var s) + | 0xe2 -> resume (vec var_pair s) + | 0xe3 -> resume_throw (at var s) + | 0xe4 -> + let bt = block_type s in + let es' = instr_block s in + end_ s; + guard bt es' | 0xfc as b -> (match vu32 s with @@ -656,6 +661,7 @@ let import_desc s = | 0x01 -> TableImport (table_type s) | 0x02 -> MemoryImport (memory_type s) | 0x03 -> GlobalImport (global_type s) + | 0x04 -> EventImport (event_type s) | _ -> error s (pos s - 1) "malformed import kind" let import s = @@ -723,6 +729,7 @@ let export_desc s = | 0x01 -> TableExport (at var s) | 0x02 -> MemoryExport (at var s) | 0x03 -> GlobalExport (at var s) + | 0x04 -> EventExport (at var s) | _ -> error s (pos s - 1) "malformed export kind" let export s = diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 44ee669e2..009b63f43 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -215,9 +215,10 @@ let encode m = | FuncBind x -> op 0x16; var x | ContNew x -> op 0xe0; var x - | ContSuspend x -> op 0xe1; var x - | ContThrow x -> op 0xe2; var x - | ContResume xls -> op 0xe3; vec var_pair xls + | Suspend x -> op 0xe1; var x + | Resume xls -> op 0xe2; vec var_pair xls + | ResumeThrow x -> op 0xe3; var x + | Guard (bt, es) -> op 0xe4; block_type bt; list instr es; end_ () | Drop -> op 0x1a | Select None -> op 0x1b diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index cb6c5094a..834762ca6 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -67,7 +67,8 @@ and admin_instr' = | Local of int * value list * code | Frame of int * frame * code | Catch of int * event_inst option * instr list * code - | Resume of (event_inst * idx) list * code + | Handle of (event_inst * idx) list * code + | Guarded of int * code | Trapping of string | Throwing of event_inst * value stack | Suspending of event_inst * value stack * ctxt @@ -218,12 +219,12 @@ let rec step (c : config) : config = vs', [Plain (Block (bt, es1)) @@ e.at] | Let (bt, locals, es'), vs -> - let vs0, vs' = split (List.length locals) vs e.at in + let locs, vs' = split (List.length locals) vs e.at in let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in - let vs1, vs2 = split (List.length ts1) vs' e.at in - vs2, [ - Local (List.length ts2, List.rev vs0, - (vs1, [Plain (Block (bt, es')) @@ e.at]) + let args, vs'' = split (List.length ts1) vs' e.at in + vs'', [ + Local (List.length ts2, List.rev locs, + (args, [Plain (Block (bt, es')) @@ e.at]) ) @@ e.at ] @@ -316,29 +317,38 @@ let rec step (c : config) : config = let ctxt code = compose code ([], [Invoke f @@ e.at]) in Ref (ContRef (List.length ts, ctxt)) :: vs, [] - | ContSuspend x, vs -> + | Suspend x, vs -> let evt = event c.frame.inst x in let EventType (FuncType (ts, _), _) = Event.type_of evt in - let vs0, vs' = split (List.length ts) vs e.at in - vs', [Suspending (evt, vs0, fun code -> code) @@ e.at] + let args, vs' = split (List.length ts) vs e.at in + vs', [Suspending (evt, args, fun code -> code) @@ e.at] + + | Resume xls, Ref (NullRef _) :: vs -> + vs, [Trapping "null continuation reference" @@ e.at] + + | Resume xls, Ref (ContRef (n, ctxt)) :: vs -> + let hs = List.map (fun (x, l) -> event c.frame.inst x, l) xls in + let args, vs' = split n vs e.at in + vs', [Handle (hs, ctxt (args, [])) @@ e.at] - | ContThrow x, Ref (NullRef _) :: vs -> + | ResumeThrow x, Ref (NullRef _) :: vs -> vs, [Trapping "null continuation reference" @@ e.at] - | ContThrow x, Ref (ContRef (n, ctxt)) :: vs -> + | ResumeThrow x, Ref (ContRef (n, ctxt)) :: vs -> let evt = event c.frame.inst x in let EventType (FuncType (ts, _), _) = Event.type_of evt in - let vs0, vs' = split (List.length ts) vs e.at in - let vs1', es1' = ctxt (vs0, [Plain (Throw x) @@ e.at]) in + let args, vs' = split (List.length ts) vs e.at in + let vs1', es1' = ctxt (args, [Plain (Throw x) @@ e.at]) in vs1' @ vs', es1' - | ContResume xls, Ref (NullRef _) :: vs -> - vs, [Trapping "null continuation reference" @@ e.at] - - | ContResume xls, Ref (ContRef (n, ctxt)) :: vs -> - let hs = List.map (fun (x, l) -> event c.frame.inst x, l) xls in - let vs0, vs' = split n vs e.at in - vs', [Resume (hs, ctxt (vs0, [])) @@ e.at] + | Guard (bt, es'), vs -> + let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in + let args, vs' = split (List.length ts1) vs e.at in + vs', [ + Guarded (List.length ts2, + (args, [Plain (Block (bt, es')) @@ e.at]) + ) @@ e.at + ] | Drop, v :: vs' -> vs', [] @@ -722,26 +732,39 @@ let rec step (c : config) : config = let c' = step {c with code = code'} in vs, [Catch (n, exno, es0, c'.code) @@ e.at] - | Resume (hs, (vs', [])), vs -> + | Handle (hs, (vs', [])), vs -> vs' @ vs, [] - | Resume (hs, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs + | Handle (hs, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs when List.mem_assq evt hs -> let EventType (FuncType (_, ts), _) = Event.type_of evt in let ctxt' code = compose (ctxt code) (vs', es') in [Ref (ContRef (List.length ts, ctxt'))] @ vs1 @ vs, [Plain (Br (List.assq evt hs)) @@ e.at] - | Resume (hs, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs -> - let ctxt' code = [], [Resume (hs, compose (ctxt code) (vs', es')) @@ e.at] in + | Handle (hs, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs -> + let ctxt' code = [], [Handle (hs, compose (ctxt code) (vs', es')) @@ e.at] in vs, [Suspending (evt, vs1, ctxt') @@ at] - | Resume (hs, (vs', e' :: es')), vs when is_jumping e' -> + | Handle (hs, (vs', e' :: es')), vs when is_jumping e' -> + vs, [e'] + + | Handle (hs, code'), vs -> + let c' = step {c with code = code'} in + vs, [Handle (hs, c'.code) @@ e.at] + + | Guarded (n, (vs', [])), vs -> + vs' @ vs, [] + + | Guarded (n, (vs', {it = Suspending _; at} :: es')), vs -> + vs, [Trapping "guard suspended" @@ at] + + | Guarded (n, (vs', e' :: es')), vs when is_jumping e' -> vs, [e'] - | Resume (hs, code'), vs -> + | Guarded (n, code'), vs -> let c' = step {c with code = code'} in - vs, [Resume (hs, c'.code) @@ e.at] + vs, [Guarded (n, c'.code) @@ e.at] | Trapping _, _ | Throwing _, _ diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml index 26685a2f3..33f972130 100644 --- a/interpreter/syntax/ast.ml +++ b/interpreter/syntax/ast.ml @@ -97,9 +97,10 @@ and instr' = | ReturnCallRef (* tail call through reference *) | FuncBind of idx (* create closure *) | ContNew of idx (* create continuation *) - | ContSuspend of idx (* suspend continuation *) - | ContThrow of idx (* abort continuation *) - | ContResume of (idx * idx) list (* resume continuation *) + | Suspend of idx (* suspend continuation *) + | Resume of (idx * idx) list (* resume continuation *) + | ResumeThrow of idx (* abort continuation *) + | Guard of block_type * instr list (* guard against suspension *) | LocalGet of idx (* read local idxiable *) | LocalSet of idx (* write local idxiable *) | LocalTee of idx (* write local idxiable and keep value *) diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml index 17a7d408c..f0c5aca94 100644 --- a/interpreter/syntax/free.ml +++ b/interpreter/syntax/free.ml @@ -109,21 +109,21 @@ let rec instr (e : instr) = | RefNull t -> heap_type t | RefFunc x -> funcs (idx x) | Const _ | Test _ | Compare _ | Unary _ | Binary _ | Convert _ -> empty - | Block (bt, es) | Loop (bt, es) -> block_type bt ++ block es + | Block (bt, es) | Loop (bt, es) | Guard (bt, es) -> block_type bt ++ block es | If (bt, es1, es2) -> block_type bt ++ block es1 ++ block es2 | Let (bt, ts, es) -> let free = block_type bt ++ block es in {free with locals = Lib.Fun.repeat (List.length ts) shift free.locals} | Try (bt, es1, xo, es2) -> block_type bt ++ block es1 ++ opt (fun x -> events (idx x)) xo ++ block es2 - | Throw x | ContThrow x | ContSuspend x -> events (idx x) + | Throw x | ResumeThrow x | Suspend x -> events (idx x) | Br x | BrIf x | BrOnNull x -> labels (idx x) | BrTable (xs, x) -> list (fun x -> labels (idx x)) (x::xs) | Return | CallRef | ReturnCallRef -> empty | Call x -> funcs (idx x) | CallIndirect (x, y) -> tables (idx x) ++ types (idx y) | FuncBind x | ContNew x -> types (idx x) - | ContResume xys -> list (fun (x, y) -> events (idx x) ++ labels (idx y)) xys + | Resume xys -> list (fun (x, y) -> events (idx x) ++ labels (idx y)) xys | LocalGet x | LocalSet x | LocalTee x -> locals (idx x) | GlobalGet x | GlobalSet x -> globals (idx x) | TableGet x | TableSet x | TableSize x | TableGrow x | TableFill x -> diff --git a/interpreter/syntax/operators.ml b/interpreter/syntax/operators.ml index 66454eddf..56c99c7ff 100644 --- a/interpreter/syntax/operators.ml +++ b/interpreter/syntax/operators.ml @@ -39,9 +39,10 @@ let return_call_ref = ReturnCallRef let func_bind x = FuncBind x let cont_new x = ContNew x -let cont_suspend x = ContSuspend x -let cont_throw x = ContThrow x -let cont_resume xys = ContResume xys +let suspend x = Suspend x +let resume xys = Resume xys +let resume_throw x = ResumeThrow x +let guard bt es = Guard (bt, es) let local_get x = LocalGet x let local_set x = LocalSet x diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index e6a8fe1ce..c7d767fc9 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -255,10 +255,13 @@ let rec instr e = "let", block_type bt @ decls "local" (List.map Source.it locals) @ list instr es | Try (bt, es1, xo, es2) -> - let catch = - match xo with Some x -> "catch " ^ var x | None -> "catch_all" in + let catch, exn = + match xo with + | Some x -> "catch", [Node ("exception " ^ var x, [])] + | None -> "catch_all", [] + in "try", block_type bt @ - [Node ("do", list instr es1); Node (catch, list instr es2)] + [Node ("do", list instr es1); Node (catch, exn @ list instr es2)] | Throw x -> "throw " ^ var x, [] | Br x -> "br " ^ var x, [] | BrIf x -> "br_if " ^ var x, [] @@ -273,11 +276,12 @@ let rec instr e = | ReturnCallRef -> "return_call_ref", [] | FuncBind x -> "func.bind", [Node ("type " ^ var x, [])] | ContNew x -> "cont.new", [Node ("type " ^ var x, [])] - | ContResume xys -> - "cont.resume", + | Suspend x -> "suspend " ^ var x, [] + | Resume xys -> + "resume", List.map (fun (x, y) -> Node ("event " ^ var x ^ " " ^ var y, [])) xys - | ContSuspend x -> "cont.suspend", [Node ("event" ^ var x, [])] - | ContThrow x -> "cont.throw", [Node ("exception" ^ var x, [])] + | ResumeThrow x -> "resume_throw " ^ var x, [] + | Guard (bt, es) -> "guard", block_type bt @ list instr es | LocalGet x -> "local.get " ^ var x, [] | LocalSet x -> "local.set " ^ var x, [] | LocalTee x -> "local.tee " ^ var x, [] diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index 4bec43b3d..5ce6528e8 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -216,9 +216,10 @@ rule token = parse | "catch_all" { CATCH_ALL } | "cont.new" { CONT_NEW } - | "cont.suspend" { CONT_SUSPEND } - | "cont.throw" { CONT_THROW } - | "cont.resume" { CONT_RESUME } + | "suspend" { SUSPEND } + | "resume" { RESUME } + | "resume_throw" { RESUME_THROW } + | "guard" { GUARD } | "local.get" { LOCAL_GET } | "local.set" { LOCAL_SET } diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index 3fda8e132..efed76434 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -217,7 +217,7 @@ let inline_func_type_explicit (c : context) x ft at = %token UNREACHABLE NOP DROP SELECT %token BLOCK END IF THEN ELSE LOOP LET %token THROW TRY DO CATCH CATCH_ALL -%token CONT_NEW CONT_SUSPEND CONT_THROW CONT_RESUME +%token CONT_NEW SUSPEND RESUME RESUME_THROW GUARD %token BR BR_IF BR_TABLE BR_ON_NULL %token CALL CALL_REF CALL_INDIRECT RETURN RETURN_CALL_REF FUNC_BIND %token LOCAL_GET LOCAL_SET LOCAL_TEE GLOBAL_GET GLOBAL_SET @@ -447,8 +447,8 @@ plain_instr : | CALL_REF { fun c -> call_ref } | RETURN_CALL_REF { fun c -> return_call_ref } | CONT_NEW LPAR TYPE var RPAR { fun c -> cont_new ($4 c type_) } - | CONT_SUSPEND var { fun c -> cont_suspend ($2 c event) } - | CONT_THROW var { fun c -> cont_throw ($2 c event) } + | SUSPEND var { fun c -> suspend ($2 c event) } + | RESUME_THROW var { fun c -> resume_throw ($2 c event) } | LOCAL_GET var { fun c -> local_get ($2 c local) } | LOCAL_SET var { fun c -> local_set ($2 c local) } | LOCAL_TEE var { fun c -> local_tee ($2 c local) } @@ -584,8 +584,8 @@ call_instr_results_instr : resume_instr : - | CONT_RESUME resume_instr_handler - { let at = at () in fun c -> cont_resume ($2 c) @@ at } + | RESUME resume_instr_handler + { let at = at () in fun c -> resume ($2 c) @@ at } resume_instr_handler : | LPAR EVENT var var RPAR resume_instr_handler @@ -595,9 +595,9 @@ resume_instr_handler : resume_instr_instr : - | CONT_RESUME resume_instr_handler_instr + | RESUME resume_instr_handler_instr { let at1 = ati 1 in - fun c -> let hs, es = $2 c in cont_resume hs @@ at1, es } + fun c -> let hs, es = $2 c in resume hs @@ at1, es } resume_instr_handler_instr : | LPAR EVENT var var RPAR resume_instr_handler_instr @@ -620,6 +620,14 @@ block_instr : { let at = at () in fun c -> let c' = enter_let ($2 c $5) at in let ts, ls, es = $3 c c' in let_ ts ls es } + | TRY labeling_opt block CATCH_ALL labeling_end_opt instr_list END labeling_end_opt + { fun c -> let c' = $2 c ($5 @ $8) in + let ts, es1 = $3 c' in try_ ts es1 None ($6 c') } + | TRY labeling_opt block CATCH labeling_end_opt LPAR EXCEPTION var RPAR instr_list END labeling_end_opt + { fun c -> let c' = $2 c ($5 @ $12) in + let ts, es1 = $3 c' in try_ ts es1 (Some ($8 c' event)) ($10 c') } + | GUARD labeling_opt block END labeling_end_opt + { fun c -> let c' = $2 c $5 in let bt, es = $3 c' in guard bt es } block : | type_use block_param_body @@ -719,8 +727,8 @@ expr1 : /* Sugar */ fun c -> let x, es = $2 c in es, call_indirect (0l @@ at1) x } | FUNC_BIND call_expr_type { fun c -> let x, es = $2 c in es, func_bind x } - | CONT_RESUME resume_expr_handler - { fun c -> let hs, es = $2 c in es, cont_resume hs } + | RESUME resume_expr_handler + { fun c -> let hs, es = $2 c in es, resume hs } | BLOCK labeling_opt block { fun c -> let c' = $2 c [] in let bt, es = $3 c' in [], block bt es } | LOOP labeling_opt block @@ -736,6 +744,8 @@ expr1 : /* Sugar */ { fun c -> let bt, (es1, xo, es2) = $2 c in [], try_ bt es1 xo es2 } + | GUARD labeling_opt block + { fun c -> let c' = $2 c [] in let bt, es = $3 c' in [], guard bt es } select_expr_results : | LPAR RESULT value_type_list RPAR select_expr_results @@ -807,8 +817,8 @@ try_block_result_body : let out' = snd $3 c in FuncType (ins, out' @ out), es } try_ : - | LPAR DO instr_list RPAR LPAR CATCH var instr_list RPAR - { fun c -> $3 c, Some ($7 c event), $8 c } + | LPAR DO instr_list RPAR LPAR CATCH LPAR EXCEPTION var RPAR instr_list RPAR + { fun c -> $3 c, Some ($9 c event), $11 c } | LPAR DO instr_list RPAR LPAR CATCH_ALL instr_list RPAR { fun c -> $3 c, None, $7 c } diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 820fbb786..fe2aefcec 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -450,42 +450,47 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type = [RefType (NonNullable, DefHeapType y)] --> [RefType (NonNullable, DefHeapType (SynVar x.it))] - | ContSuspend x -> + | Suspend x -> let EventType (FuncType (ts1, ts2), res) = event c x in require (res = Resumable) e.at "suspending with a non-resumable event"; ts1 --> ts2 - | ContThrow x -> - let EventType (FuncType (ts0, _), res) = event c x in - require (res = Terminal) e.at "throwing a non-exception event"; + | Resume xys -> (match peek_ref 0 s e.at with | nul, DefHeapType (SynVar y) -> let ContType z = cont_type c (y @@ e.at) in let FuncType (ts1, ts2) = func_type c (as_syn_var z @@ e.at) in - (ts0 @ [RefType (nul, DefHeapType (SynVar y))]) --> ts2 + List.iter (fun (x1, x2) -> + let EventType (FuncType (ts3, ts4), res) = event c x1 in + require (res = Resumable) x1.at "handling a non-resumable event"; + (* TODO: check label; problem: we don't have a type idx to produce here + check_stack c (ts3 @ [RefType (NonNullable, DefHeapType (SynVar ?))]) (label c x2) x2.at + *) + ) xys; + (ts1 @ [RefType (nul, DefHeapType (SynVar y))]) --> ts2 | _, BotHeapType -> [] -->... [] | _ -> assert false ) - | ContResume xys -> + | ResumeThrow x -> + let EventType (FuncType (ts0, _), res) = event c x in + require (res = Terminal) e.at "throwing a non-exception event"; (match peek_ref 0 s e.at with | nul, DefHeapType (SynVar y) -> let ContType z = cont_type c (y @@ e.at) in let FuncType (ts1, ts2) = func_type c (as_syn_var z @@ e.at) in - List.iter (fun (x1, x2) -> - let EventType (FuncType (ts3, ts4), res) = event c x1 in - require (res = Resumable) x1.at "handling a non-resumable event"; - (* TODO: check label; problem: we don't have a type idx to produce here - check_stack c (ts3 @ [RefType (NonNullable, DefHeapType (SynVar ?))]) (label c x2) x2.at - *) - ) xys; - (ts1 @ [RefType (nul, DefHeapType (SynVar y))]) --> ts2 + (ts0 @ [RefType (nul, DefHeapType (SynVar y))]) --> ts2 | _, BotHeapType -> [] -->... [] | _ -> assert false ) + | Guard (bt, es) -> + let FuncType (ts1, ts2) as ft = check_block_type c bt e.at in + check_block {c with labels = ts2 :: c.labels} es ft e.at; + ts1 --> ts2 + | LocalGet x -> [] --> [local c x] diff --git a/test/core/binary.wast b/test/core/binary.wast index ca80f2933..77ae2a506 100644 --- a/test/core/binary.wast +++ b/test/core/binary.wast @@ -1284,7 +1284,7 @@ "\02\04\01" ;; import section with single entry "\00" ;; string length 0 "\00" ;; string length 0 - "\04" ;; malformed import kind + "\05" ;; malformed import kind ) "malformed import kind" ) @@ -1294,7 +1294,7 @@ "\02\05\01" ;; import section with single entry "\00" ;; string length 0 "\00" ;; string length 0 - "\04" ;; malformed import kind + "\05" ;; malformed import kind "\00" ;; dummy byte ) "malformed import kind" diff --git a/test/core/catch.wast b/test/core/catch.wast index 081614f51..34815415a 100644 --- a/test/core/catch.wast +++ b/test/core/catch.wast @@ -41,7 +41,7 @@ (func (export "catch-4") (result i32) (try (result i32) (do (throw $e1 (i32.const 66)) (i32.const 0)) - (catch $e1) + (catch (exception $e1)) ) ) @@ -71,7 +71,7 @@ (func (export "uncaught-2") (result i32) (try (result i32) (do (throw $e0) (i32.const 0)) - (catch $e1) + (catch (exception $e1)) ) ) ) diff --git a/test/core/cont.wast b/test/core/cont.wast index 22134eadf..b758ed8a9 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -1,4 +1,4 @@ -;; Unhandled events +;; Unhandled events & guards (module (exception $exn) @@ -9,12 +9,12 @@ (type $k1 (cont $f1)) (func $f1 (export "unhandled-1") - (cont.suspend $e1) + (suspend $e1) ) (func (export "unhandled-2") (block $h (result (ref $k1)) - (cont.resume (event $e2 $h) (cont.new (type $k1) (ref.func $f1))) + (resume (event $e2 $h) (cont.new (type $k1) (ref.func $f1))) (unreachable) ) (drop) @@ -22,7 +22,7 @@ (func (export "handled") (block $h (result (ref $k1)) - (cont.resume (event $e1 $h) (cont.new (type $k1) (ref.func $f1))) + (resume (event $e1 $h) (cont.new (type $k1) (ref.func $f1))) (unreachable) ) (drop) @@ -35,7 +35,7 @@ (func (export "uncaught-1") (block $h (result (ref $k1)) - (cont.resume (event $e1 $h) (cont.new (type $k1) (ref.func $f2))) + (resume (event $e1 $h) (cont.new (type $k1) (ref.func $f2))) (unreachable) ) (drop) @@ -43,10 +43,26 @@ (func (export "uncaught-2") (block $h (result (ref $k1)) - (cont.resume (event $e1 $h) (cont.new (type $k1) (ref.func $f1))) + (resume (event $e1 $h) (cont.new (type $k1) (ref.func $f1))) (unreachable) ) - (cont.throw $exn) + (resume_throw $exn) + ) + + (elem declare func $f3) + (func $f3 + (guard (call $f4)) + ) + (func $f4 + (suspend $e1) + ) + + (func (export "guarded") + (block $h (result (ref $k1)) + (resume (event $e1 $h) (cont.new (type $k1) (ref.func $f3))) + (unreachable) + ) + (resume_throw $exn) ) ) @@ -70,7 +86,7 @@ (loop $loop (block $on_get (result (ref $k)) (block $on_set (result i32 (ref $k)) - (cont.resume (event $get $on_get) (event $set $on_set) + (resume (event $get $on_get) (event $set $on_set) (local.get $s) (local.get $k) ) (return) @@ -88,14 +104,14 @@ ) (func $f (param i32) (result i32) - (drop (cont.suspend $set (i32.const 7))) + (drop (suspend $set (i32.const 7))) (i32.add - (cont.suspend $get) + (suspend $get) (i32.mul (i32.const 2) (i32.add - (cont.suspend $set (i32.const 3)) - (cont.suspend $get) + (suspend $set (i32.const 3)) + (suspend $get) ) ) ) @@ -126,7 +142,7 @@ (func $gen (export "start") (param $i i64) (loop $l - (br_if 1 (cont.suspend $yield (local.get $i))) + (br_if 1 (suspend $yield (local.get $i))) (call_ref (local.get $i) (global.get $hook)) (local.set $i (i64.add (local.get $i) (i64.const 1))) (br $l) @@ -140,7 +156,7 @@ (local.get $i) (cont.new (type $cont0) (ref.func $gen)) (block $on_first_yield (param i64 (ref $cont0)) (result i64 (ref $cont)) - (cont.resume (event $yield $on_first_yield)) + (resume (event $yield $on_first_yield)) (unreachable) ) (loop $on_yield (param i64) (param (ref $cont)) @@ -149,7 +165,7 @@ (local.set $sum (i64.add (local.get $sum) (local.get $n))) (i64.eq (local.get $n) (local.get $j)) (local.get $k) ) - (cont.resume (event $yield $on_yield)) + (resume (event $yield $on_yield)) ) (return (local.get $sum)) ) @@ -231,7 +247,7 @@ (if (call $queue-empty) (then (return))) (block $on_yield (result (ref $cont)) (block $on_spawn (result (ref $proc) (ref $cont)) - (cont.resume (event $yield $on_yield) (event $spawn $on_spawn) + (resume (event $yield $on_yield) (event $spawn $on_spawn) (call $dequeue) ) (br $l) ;; thread terminated @@ -267,21 +283,21 @@ (func $main (call $log (i32.const 0)) - (cont.suspend $spawn (ref.func $thread1)) + (suspend $spawn (ref.func $thread1)) (call $log (i32.const 1)) - (cont.suspend $spawn (func.bind (type $proc) (global.get $depth) (ref.func $thread2))) + (suspend $spawn (func.bind (type $proc) (global.get $depth) (ref.func $thread2))) (call $log (i32.const 2)) - (cont.suspend $spawn (ref.func $thread3)) + (suspend $spawn (ref.func $thread3)) (call $log (i32.const 3)) ) (func $thread1 (call $log (i32.const 10)) - (cont.suspend $yield) + (suspend $yield) (call $log (i32.const 11)) - (cont.suspend $yield) + (suspend $yield) (call $log (i32.const 12)) - (cont.suspend $yield) + (suspend $yield) (call $log (i32.const 13)) ) @@ -295,9 +311,9 @@ (if (local.get $w) (then (call $log (i32.const 22)) - (cont.suspend $yield) + (suspend $yield) (call $log (i32.const 23)) - (cont.suspend $spawn + (suspend $spawn (func.bind (type $proc) (i32.sub (local.get $d) (i32.const 1)) (ref.func $thread2) @@ -314,9 +330,9 @@ (func $thread3 (call $log (i32.const 30)) - (cont.suspend $yield) + (suspend $yield) (call $log (i32.const 31)) - (cont.suspend $yield) + (suspend $yield) (call $log (i32.const 32)) ) @@ -356,21 +372,21 @@ (func $syield (param $i i64) (call $log (local.get $i)) - (cont.suspend $syield) + (suspend $syield) ) (func $bg-thread (call $log (i64.const -10)) (loop $l (call $log (i64.const -11)) - (cont.suspend $syield) + (suspend $syield) (br_if $l (i32.eqz (global.get $done))) ) (call $log (i64.const -12)) ) (func $main (param $i i64) (param $j i64) - (cont.suspend $spawn (ref.func $bg-thread)) + (suspend $spawn (ref.func $bg-thread)) (global.set $ghook (ref.func $syield)) (global.set $result (call $gsum (local.get $i) (local.get $j))) (global.set $done (i32.const 1)) From 6f1aed80212956f96a8c70f5a7897bafc5eaa70a Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Sat, 20 Feb 2021 08:46:07 +0100 Subject: [PATCH 32/82] Actually invoke test --- test/core/cont.wast | 3 +++ 1 file changed, 3 insertions(+) diff --git a/test/core/cont.wast b/test/core/cont.wast index b758ed8a9..c047e15cc 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -69,9 +69,12 @@ (assert_suspension (invoke "unhandled-1") "unhandled") (assert_suspension (invoke "unhandled-2") "unhandled") (assert_return (invoke "handled")) + (assert_exception (invoke "uncaught-1") "unhandled") (assert_exception (invoke "uncaught-2") "unhandled") +(assert_trap (invoke "guarded") "guard suspended") + ;; Simple state example From c3a3a3d66ee3bad9dec55f5748783d1b9bf73928 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Mon, 22 Feb 2021 10:43:34 +0100 Subject: [PATCH 33/82] Unify Guarded admin instr with Handle --- interpreter/exec/eval.ml | 39 ++++++++++++++------------------------- 1 file changed, 14 insertions(+), 25 deletions(-) diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 834762ca6..7ae637a42 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -67,8 +67,7 @@ and admin_instr' = | Local of int * value list * code | Frame of int * frame * code | Catch of int * event_inst option * instr list * code - | Handle of (event_inst * idx) list * code - | Guarded of int * code + | Handle of (event_inst * idx) list option * code | Trapping of string | Throwing of event_inst * value stack | Suspending of event_inst * value stack * ctxt @@ -329,7 +328,7 @@ let rec step (c : config) : config = | Resume xls, Ref (ContRef (n, ctxt)) :: vs -> let hs = List.map (fun (x, l) -> event c.frame.inst x, l) xls in let args, vs' = split n vs e.at in - vs', [Handle (hs, ctxt (args, [])) @@ e.at] + vs', [Handle (Some hs, ctxt (args, [])) @@ e.at] | ResumeThrow x, Ref (NullRef _) :: vs -> vs, [Trapping "null continuation reference" @@ e.at] @@ -342,10 +341,10 @@ let rec step (c : config) : config = vs1' @ vs', es1' | Guard (bt, es'), vs -> - let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in + let FuncType (ts1, _) = block_type c.frame.inst bt e.at in let args, vs' = split (List.length ts1) vs e.at in vs', [ - Guarded (List.length ts2, + Handle (None, (args, [Plain (Block (bt, es')) @@ e.at]) ) @@ e.at ] @@ -732,39 +731,29 @@ let rec step (c : config) : config = let c' = step {c with code = code'} in vs, [Catch (n, exno, es0, c'.code) @@ e.at] - | Handle (hs, (vs', [])), vs -> + | Handle (hso, (vs', [])), vs -> vs' @ vs, [] - | Handle (hs, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs + | Handle (None, (vs', {it = Suspending _; at} :: es')), vs -> + vs, [Trapping "guard suspended" @@ at] + + | Handle (Some hs, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs when List.mem_assq evt hs -> let EventType (FuncType (_, ts), _) = Event.type_of evt in let ctxt' code = compose (ctxt code) (vs', es') in [Ref (ContRef (List.length ts, ctxt'))] @ vs1 @ vs, [Plain (Br (List.assq evt hs)) @@ e.at] - | Handle (hs, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs -> - let ctxt' code = [], [Handle (hs, compose (ctxt code) (vs', es')) @@ e.at] in + | Handle (hso, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs -> + let ctxt' code = [], [Handle (hso, compose (ctxt code) (vs', es')) @@ e.at] in vs, [Suspending (evt, vs1, ctxt') @@ at] - | Handle (hs, (vs', e' :: es')), vs when is_jumping e' -> - vs, [e'] - - | Handle (hs, code'), vs -> - let c' = step {c with code = code'} in - vs, [Handle (hs, c'.code) @@ e.at] - - | Guarded (n, (vs', [])), vs -> - vs' @ vs, [] - - | Guarded (n, (vs', {it = Suspending _; at} :: es')), vs -> - vs, [Trapping "guard suspended" @@ at] - - | Guarded (n, (vs', e' :: es')), vs when is_jumping e' -> + | Handle (hso, (vs', e' :: es')), vs when is_jumping e' -> vs, [e'] - | Guarded (n, code'), vs -> + | Handle (hso, code'), vs -> let c' = step {c with code = code'} in - vs, [Guarded (n, c'.code) @@ e.at] + vs, [Handle (hso, c'.code) @@ e.at] | Trapping _, _ | Throwing _, _ From be2c1c04ae926b677b92c00607ffce996cc5558e Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Mon, 22 Feb 2021 11:21:51 +0100 Subject: [PATCH 34/82] Test empty handler --- test/core/cont.wast | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/test/core/cont.wast b/test/core/cont.wast index c047e15cc..4871822ec 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -13,6 +13,10 @@ ) (func (export "unhandled-2") + (resume (cont.new (type $k1) (ref.func $f1))) + ) + + (func (export "unhandled-3") (block $h (result (ref $k1)) (resume (event $e2 $h) (cont.new (type $k1) (ref.func $f1))) (unreachable) @@ -68,6 +72,7 @@ (assert_suspension (invoke "unhandled-1") "unhandled") (assert_suspension (invoke "unhandled-2") "unhandled") +(assert_suspension (invoke "unhandled-3") "unhandled") (assert_return (invoke "handled")) (assert_exception (invoke "uncaught-1") "unhandled") From dfb8dadf9550b1378034cb12bc00b42486204b48 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Mon, 22 Feb 2021 14:37:15 +0100 Subject: [PATCH 35/82] Comment --- interpreter/valid/match.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interpreter/valid/match.ml b/interpreter/valid/match.ml index 9e6d9d847..cd7c605e7 100644 --- a/interpreter/valid/match.ml +++ b/interpreter/valid/match.ml @@ -154,7 +154,7 @@ and match_global_type c a (GlobalType (t1, mut1)) (GlobalType (t2, mut2)) = | Mutable -> eq_value_type c [] t1 t2 and match_event_type c a (EventType (ft1, res1)) (EventType (ft2, res2)) = - eq_resumability c [] res1 res2 && match_func_type c [] ft1 ft2 + eq_resumability c [] res1 res2 && match_func_type c a ft1 ft2 and match_extern_type c a et1 et2 = match et1, et2 with From f775ff5fa3c2d1df7ed192104562220339cff210 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Mon, 22 Feb 2021 19:24:06 +0100 Subject: [PATCH 36/82] Implement single-shot semantics --- interpreter/binary/decode.ml | 2 +- interpreter/binary/encode.ml | 2 +- interpreter/exec/eval.ml | 22 +++++++++----- interpreter/syntax/ast.ml | 2 +- interpreter/syntax/free.ml | 2 +- interpreter/syntax/operators.ml | 2 +- interpreter/text/arrange.ml | 2 +- interpreter/text/lexer.mll | 2 +- interpreter/text/parser.mly | 10 +++---- interpreter/valid/valid.ml | 2 +- test/core/cont.wast | 51 +++++++++++++++++++++++++++++++-- 11 files changed, 76 insertions(+), 23 deletions(-) diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index 6cdb0b3ee..d6e0857af 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -560,7 +560,7 @@ let rec instr s = let bt = block_type s in let es' = instr_block s in end_ s; - guard bt es' + barrier bt es' | 0xfc as b -> (match vu32 s with diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 009b63f43..a5e71e9a1 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -218,7 +218,7 @@ let encode m = | Suspend x -> op 0xe1; var x | Resume xls -> op 0xe2; vec var_pair xls | ResumeThrow x -> op 0xe3; var x - | Guard (bt, es) -> op 0xe4; block_type bt; list instr es; end_ () + | Barrier (bt, es) -> op 0xe4; block_type bt; list instr es; end_ () | Drop -> op 0x1a | Select None -> op 0x1b diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 7ae637a42..1d9c02d59 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -78,7 +78,7 @@ and admin_instr' = and ctxt = code -> code type cont = int * ctxt (* TODO: represent type properly *) -type ref_ += ContRef of cont +type ref_ += ContRef of cont option ref let () = let type_of_ref' = !Value.type_of_ref' in @@ -314,7 +314,7 @@ let rec step (c : config) : config = | ContNew x, Ref (FuncRef f) :: vs -> let FuncType (ts, _) = Func.type_of f in let ctxt code = compose code ([], [Invoke f @@ e.at]) in - Ref (ContRef (List.length ts, ctxt)) :: vs, [] + Ref (ContRef (ref (Some (List.length ts, ctxt)))) :: vs, [] | Suspend x, vs -> let evt = event c.frame.inst x in @@ -325,22 +325,30 @@ let rec step (c : config) : config = | Resume xls, Ref (NullRef _) :: vs -> vs, [Trapping "null continuation reference" @@ e.at] - | Resume xls, Ref (ContRef (n, ctxt)) :: vs -> + | Resume xls, Ref (ContRef {contents = None}) :: vs -> + vs, [Trapping "continuation resumed twice" @@ e.at] + + | Resume xls, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> let hs = List.map (fun (x, l) -> event c.frame.inst x, l) xls in let args, vs' = split n vs e.at in + cont := None; vs', [Handle (Some hs, ctxt (args, [])) @@ e.at] | ResumeThrow x, Ref (NullRef _) :: vs -> vs, [Trapping "null continuation reference" @@ e.at] - | ResumeThrow x, Ref (ContRef (n, ctxt)) :: vs -> + | ResumeThrow x, Ref (ContRef {contents = None}) :: vs -> + vs, [Trapping "continuation resumed twice" @@ e.at] + + | ResumeThrow x, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> let evt = event c.frame.inst x in let EventType (FuncType (ts, _), _) = Event.type_of evt in let args, vs' = split (List.length ts) vs e.at in let vs1', es1' = ctxt (args, [Plain (Throw x) @@ e.at]) in + cont := None; vs1' @ vs', es1' - | Guard (bt, es'), vs -> + | Barrier (bt, es'), vs -> let FuncType (ts1, _) = block_type c.frame.inst bt e.at in let args, vs' = split (List.length ts1) vs e.at in vs', [ @@ -735,13 +743,13 @@ let rec step (c : config) : config = vs' @ vs, [] | Handle (None, (vs', {it = Suspending _; at} :: es')), vs -> - vs, [Trapping "guard suspended" @@ at] + vs, [Trapping "barrier hit by suspension" @@ at] | Handle (Some hs, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs when List.mem_assq evt hs -> let EventType (FuncType (_, ts), _) = Event.type_of evt in let ctxt' code = compose (ctxt code) (vs', es') in - [Ref (ContRef (List.length ts, ctxt'))] @ vs1 @ vs, + [Ref (ContRef (ref (Some (List.length ts, ctxt'))))] @ vs1 @ vs, [Plain (Br (List.assq evt hs)) @@ e.at] | Handle (hso, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs -> diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml index 33f972130..7517eaea0 100644 --- a/interpreter/syntax/ast.ml +++ b/interpreter/syntax/ast.ml @@ -100,7 +100,7 @@ and instr' = | Suspend of idx (* suspend continuation *) | Resume of (idx * idx) list (* resume continuation *) | ResumeThrow of idx (* abort continuation *) - | Guard of block_type * instr list (* guard against suspension *) + | Barrier of block_type * instr list (* guard against suspension *) | LocalGet of idx (* read local idxiable *) | LocalSet of idx (* write local idxiable *) | LocalTee of idx (* write local idxiable and keep value *) diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml index f0c5aca94..c323083ed 100644 --- a/interpreter/syntax/free.ml +++ b/interpreter/syntax/free.ml @@ -109,7 +109,7 @@ let rec instr (e : instr) = | RefNull t -> heap_type t | RefFunc x -> funcs (idx x) | Const _ | Test _ | Compare _ | Unary _ | Binary _ | Convert _ -> empty - | Block (bt, es) | Loop (bt, es) | Guard (bt, es) -> block_type bt ++ block es + | Block (bt, es) | Loop (bt, es) | Barrier (bt, es) -> block_type bt ++ block es | If (bt, es1, es2) -> block_type bt ++ block es1 ++ block es2 | Let (bt, ts, es) -> let free = block_type bt ++ block es in diff --git a/interpreter/syntax/operators.ml b/interpreter/syntax/operators.ml index 56c99c7ff..e53af9c70 100644 --- a/interpreter/syntax/operators.ml +++ b/interpreter/syntax/operators.ml @@ -42,7 +42,7 @@ let cont_new x = ContNew x let suspend x = Suspend x let resume xys = Resume xys let resume_throw x = ResumeThrow x -let guard bt es = Guard (bt, es) +let barrier bt es = Barrier (bt, es) let local_get x = LocalGet x let local_set x = LocalSet x diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index c7d767fc9..9a1ddfc28 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -281,7 +281,7 @@ let rec instr e = "resume", List.map (fun (x, y) -> Node ("event " ^ var x ^ " " ^ var y, [])) xys | ResumeThrow x -> "resume_throw " ^ var x, [] - | Guard (bt, es) -> "guard", block_type bt @ list instr es + | Barrier (bt, es) -> "barrier", block_type bt @ list instr es | LocalGet x -> "local.get " ^ var x, [] | LocalSet x -> "local.set " ^ var x, [] | LocalTee x -> "local.tee " ^ var x, [] diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index 5ce6528e8..98923dee9 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -219,7 +219,7 @@ rule token = parse | "suspend" { SUSPEND } | "resume" { RESUME } | "resume_throw" { RESUME_THROW } - | "guard" { GUARD } + | "barrier" { BARRIER } | "local.get" { LOCAL_GET } | "local.set" { LOCAL_SET } diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index efed76434..28aaa9a25 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -217,7 +217,7 @@ let inline_func_type_explicit (c : context) x ft at = %token UNREACHABLE NOP DROP SELECT %token BLOCK END IF THEN ELSE LOOP LET %token THROW TRY DO CATCH CATCH_ALL -%token CONT_NEW SUSPEND RESUME RESUME_THROW GUARD +%token CONT_NEW SUSPEND RESUME RESUME_THROW BARRIER %token BR BR_IF BR_TABLE BR_ON_NULL %token CALL CALL_REF CALL_INDIRECT RETURN RETURN_CALL_REF FUNC_BIND %token LOCAL_GET LOCAL_SET LOCAL_TEE GLOBAL_GET GLOBAL_SET @@ -626,8 +626,8 @@ block_instr : | TRY labeling_opt block CATCH labeling_end_opt LPAR EXCEPTION var RPAR instr_list END labeling_end_opt { fun c -> let c' = $2 c ($5 @ $12) in let ts, es1 = $3 c' in try_ ts es1 (Some ($8 c' event)) ($10 c') } - | GUARD labeling_opt block END labeling_end_opt - { fun c -> let c' = $2 c $5 in let bt, es = $3 c' in guard bt es } + | BARRIER labeling_opt block END labeling_end_opt + { fun c -> let c' = $2 c $5 in let bt, es = $3 c' in barrier bt es } block : | type_use block_param_body @@ -744,8 +744,8 @@ expr1 : /* Sugar */ { fun c -> let bt, (es1, xo, es2) = $2 c in [], try_ bt es1 xo es2 } - | GUARD labeling_opt block - { fun c -> let c' = $2 c [] in let bt, es = $3 c' in [], guard bt es } + | BARRIER labeling_opt block + { fun c -> let c' = $2 c [] in let bt, es = $3 c' in [], barrier bt es } select_expr_results : | LPAR RESULT value_type_list RPAR select_expr_results diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index fe2aefcec..eeb98271a 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -486,7 +486,7 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type = | _ -> assert false ) - | Guard (bt, es) -> + | Barrier (bt, es) -> let FuncType (ts1, ts2) as ft = check_block_type c bt e.at in check_block {c with labels = ts2 :: c.labels} es ft e.at; ts1 --> ts2 diff --git a/test/core/cont.wast b/test/core/cont.wast index 4871822ec..6b3c1277e 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -55,19 +55,60 @@ (elem declare func $f3) (func $f3 - (guard (call $f4)) + (barrier (call $f4)) ) (func $f4 (suspend $e1) ) - (func (export "guarded") + (func (export "barrier") (block $h (result (ref $k1)) (resume (event $e1 $h) (cont.new (type $k1) (ref.func $f3))) (unreachable) ) (resume_throw $exn) ) + + (elem declare func $r0 $r1) + (func $r0) + (func $r1 (suspend $e1)) + + (func $nl0 (param $k (ref $k1)) + (resume (local.get $k)) + (resume (local.get $k)) + ) + (func $nl1 (param $k (ref $k1)) + (block $h (result (ref $k1)) + (resume (event $e1 $h) (local.get $k)) + (unreachable) + ) + (resume (local.get $k)) + (unreachable) + ) + (func $nl2 (param $k (ref $k1)) + (block $h1 (result (ref $k1)) + (resume (event $e1 $h1) (local.get $k)) + (unreachable) + ) + (let (local $k' (ref $k1)) + (block $h2 (result (ref $k1)) + (resume (event $e1 $h2) (local.get $k')) + (unreachable) + ) + (resume (local.get $k')) + (unreachable) + ) + ) + + (func (export "non-linear-1") + (call $nl0 (cont.new (type $k1) (ref.func $r0))) + ) + (func (export "non-linear-2") + (call $nl1 (cont.new (type $k1) (ref.func $r1))) + ) + (func (export "non-linear-3") + (call $nl1 (cont.new (type $k1) (ref.func $r1))) + ) ) (assert_suspension (invoke "unhandled-1") "unhandled") @@ -78,7 +119,11 @@ (assert_exception (invoke "uncaught-1") "unhandled") (assert_exception (invoke "uncaught-2") "unhandled") -(assert_trap (invoke "guarded") "guard suspended") +(assert_trap (invoke "barrier") "barrier") + +(assert_trap (invoke "non-linear-1") "continuation resumed twice") +(assert_trap (invoke "non-linear-2") "continuation resumed twice") +(assert_trap (invoke "non-linear-3") "continuation resumed twice") ;; Simple state example From 707dec07cb2a7529dac80c9278172ad3524461f4 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Thu, 25 Feb 2021 10:36:09 +0100 Subject: [PATCH 37/82] Implement single-shot semantics (#7) --- interpreter/binary/decode.ml | 2 +- interpreter/binary/encode.ml | 2 +- interpreter/exec/eval.ml | 22 +++++++++----- interpreter/syntax/ast.ml | 2 +- interpreter/syntax/free.ml | 2 +- interpreter/syntax/operators.ml | 2 +- interpreter/text/arrange.ml | 2 +- interpreter/text/lexer.mll | 2 +- interpreter/text/parser.mly | 10 +++---- interpreter/valid/valid.ml | 2 +- test/core/cont.wast | 51 +++++++++++++++++++++++++++++++-- 11 files changed, 76 insertions(+), 23 deletions(-) diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index 6cdb0b3ee..d6e0857af 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -560,7 +560,7 @@ let rec instr s = let bt = block_type s in let es' = instr_block s in end_ s; - guard bt es' + barrier bt es' | 0xfc as b -> (match vu32 s with diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 009b63f43..a5e71e9a1 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -218,7 +218,7 @@ let encode m = | Suspend x -> op 0xe1; var x | Resume xls -> op 0xe2; vec var_pair xls | ResumeThrow x -> op 0xe3; var x - | Guard (bt, es) -> op 0xe4; block_type bt; list instr es; end_ () + | Barrier (bt, es) -> op 0xe4; block_type bt; list instr es; end_ () | Drop -> op 0x1a | Select None -> op 0x1b diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 7ae637a42..1d9c02d59 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -78,7 +78,7 @@ and admin_instr' = and ctxt = code -> code type cont = int * ctxt (* TODO: represent type properly *) -type ref_ += ContRef of cont +type ref_ += ContRef of cont option ref let () = let type_of_ref' = !Value.type_of_ref' in @@ -314,7 +314,7 @@ let rec step (c : config) : config = | ContNew x, Ref (FuncRef f) :: vs -> let FuncType (ts, _) = Func.type_of f in let ctxt code = compose code ([], [Invoke f @@ e.at]) in - Ref (ContRef (List.length ts, ctxt)) :: vs, [] + Ref (ContRef (ref (Some (List.length ts, ctxt)))) :: vs, [] | Suspend x, vs -> let evt = event c.frame.inst x in @@ -325,22 +325,30 @@ let rec step (c : config) : config = | Resume xls, Ref (NullRef _) :: vs -> vs, [Trapping "null continuation reference" @@ e.at] - | Resume xls, Ref (ContRef (n, ctxt)) :: vs -> + | Resume xls, Ref (ContRef {contents = None}) :: vs -> + vs, [Trapping "continuation resumed twice" @@ e.at] + + | Resume xls, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> let hs = List.map (fun (x, l) -> event c.frame.inst x, l) xls in let args, vs' = split n vs e.at in + cont := None; vs', [Handle (Some hs, ctxt (args, [])) @@ e.at] | ResumeThrow x, Ref (NullRef _) :: vs -> vs, [Trapping "null continuation reference" @@ e.at] - | ResumeThrow x, Ref (ContRef (n, ctxt)) :: vs -> + | ResumeThrow x, Ref (ContRef {contents = None}) :: vs -> + vs, [Trapping "continuation resumed twice" @@ e.at] + + | ResumeThrow x, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> let evt = event c.frame.inst x in let EventType (FuncType (ts, _), _) = Event.type_of evt in let args, vs' = split (List.length ts) vs e.at in let vs1', es1' = ctxt (args, [Plain (Throw x) @@ e.at]) in + cont := None; vs1' @ vs', es1' - | Guard (bt, es'), vs -> + | Barrier (bt, es'), vs -> let FuncType (ts1, _) = block_type c.frame.inst bt e.at in let args, vs' = split (List.length ts1) vs e.at in vs', [ @@ -735,13 +743,13 @@ let rec step (c : config) : config = vs' @ vs, [] | Handle (None, (vs', {it = Suspending _; at} :: es')), vs -> - vs, [Trapping "guard suspended" @@ at] + vs, [Trapping "barrier hit by suspension" @@ at] | Handle (Some hs, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs when List.mem_assq evt hs -> let EventType (FuncType (_, ts), _) = Event.type_of evt in let ctxt' code = compose (ctxt code) (vs', es') in - [Ref (ContRef (List.length ts, ctxt'))] @ vs1 @ vs, + [Ref (ContRef (ref (Some (List.length ts, ctxt'))))] @ vs1 @ vs, [Plain (Br (List.assq evt hs)) @@ e.at] | Handle (hso, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs -> diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml index 33f972130..7517eaea0 100644 --- a/interpreter/syntax/ast.ml +++ b/interpreter/syntax/ast.ml @@ -100,7 +100,7 @@ and instr' = | Suspend of idx (* suspend continuation *) | Resume of (idx * idx) list (* resume continuation *) | ResumeThrow of idx (* abort continuation *) - | Guard of block_type * instr list (* guard against suspension *) + | Barrier of block_type * instr list (* guard against suspension *) | LocalGet of idx (* read local idxiable *) | LocalSet of idx (* write local idxiable *) | LocalTee of idx (* write local idxiable and keep value *) diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml index f0c5aca94..c323083ed 100644 --- a/interpreter/syntax/free.ml +++ b/interpreter/syntax/free.ml @@ -109,7 +109,7 @@ let rec instr (e : instr) = | RefNull t -> heap_type t | RefFunc x -> funcs (idx x) | Const _ | Test _ | Compare _ | Unary _ | Binary _ | Convert _ -> empty - | Block (bt, es) | Loop (bt, es) | Guard (bt, es) -> block_type bt ++ block es + | Block (bt, es) | Loop (bt, es) | Barrier (bt, es) -> block_type bt ++ block es | If (bt, es1, es2) -> block_type bt ++ block es1 ++ block es2 | Let (bt, ts, es) -> let free = block_type bt ++ block es in diff --git a/interpreter/syntax/operators.ml b/interpreter/syntax/operators.ml index 56c99c7ff..e53af9c70 100644 --- a/interpreter/syntax/operators.ml +++ b/interpreter/syntax/operators.ml @@ -42,7 +42,7 @@ let cont_new x = ContNew x let suspend x = Suspend x let resume xys = Resume xys let resume_throw x = ResumeThrow x -let guard bt es = Guard (bt, es) +let barrier bt es = Barrier (bt, es) let local_get x = LocalGet x let local_set x = LocalSet x diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index c7d767fc9..9a1ddfc28 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -281,7 +281,7 @@ let rec instr e = "resume", List.map (fun (x, y) -> Node ("event " ^ var x ^ " " ^ var y, [])) xys | ResumeThrow x -> "resume_throw " ^ var x, [] - | Guard (bt, es) -> "guard", block_type bt @ list instr es + | Barrier (bt, es) -> "barrier", block_type bt @ list instr es | LocalGet x -> "local.get " ^ var x, [] | LocalSet x -> "local.set " ^ var x, [] | LocalTee x -> "local.tee " ^ var x, [] diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index 5ce6528e8..98923dee9 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -219,7 +219,7 @@ rule token = parse | "suspend" { SUSPEND } | "resume" { RESUME } | "resume_throw" { RESUME_THROW } - | "guard" { GUARD } + | "barrier" { BARRIER } | "local.get" { LOCAL_GET } | "local.set" { LOCAL_SET } diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index efed76434..28aaa9a25 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -217,7 +217,7 @@ let inline_func_type_explicit (c : context) x ft at = %token UNREACHABLE NOP DROP SELECT %token BLOCK END IF THEN ELSE LOOP LET %token THROW TRY DO CATCH CATCH_ALL -%token CONT_NEW SUSPEND RESUME RESUME_THROW GUARD +%token CONT_NEW SUSPEND RESUME RESUME_THROW BARRIER %token BR BR_IF BR_TABLE BR_ON_NULL %token CALL CALL_REF CALL_INDIRECT RETURN RETURN_CALL_REF FUNC_BIND %token LOCAL_GET LOCAL_SET LOCAL_TEE GLOBAL_GET GLOBAL_SET @@ -626,8 +626,8 @@ block_instr : | TRY labeling_opt block CATCH labeling_end_opt LPAR EXCEPTION var RPAR instr_list END labeling_end_opt { fun c -> let c' = $2 c ($5 @ $12) in let ts, es1 = $3 c' in try_ ts es1 (Some ($8 c' event)) ($10 c') } - | GUARD labeling_opt block END labeling_end_opt - { fun c -> let c' = $2 c $5 in let bt, es = $3 c' in guard bt es } + | BARRIER labeling_opt block END labeling_end_opt + { fun c -> let c' = $2 c $5 in let bt, es = $3 c' in barrier bt es } block : | type_use block_param_body @@ -744,8 +744,8 @@ expr1 : /* Sugar */ { fun c -> let bt, (es1, xo, es2) = $2 c in [], try_ bt es1 xo es2 } - | GUARD labeling_opt block - { fun c -> let c' = $2 c [] in let bt, es = $3 c' in [], guard bt es } + | BARRIER labeling_opt block + { fun c -> let c' = $2 c [] in let bt, es = $3 c' in [], barrier bt es } select_expr_results : | LPAR RESULT value_type_list RPAR select_expr_results diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index fe2aefcec..eeb98271a 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -486,7 +486,7 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type = | _ -> assert false ) - | Guard (bt, es) -> + | Barrier (bt, es) -> let FuncType (ts1, ts2) as ft = check_block_type c bt e.at in check_block {c with labels = ts2 :: c.labels} es ft e.at; ts1 --> ts2 diff --git a/test/core/cont.wast b/test/core/cont.wast index 4871822ec..6b3c1277e 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -55,19 +55,60 @@ (elem declare func $f3) (func $f3 - (guard (call $f4)) + (barrier (call $f4)) ) (func $f4 (suspend $e1) ) - (func (export "guarded") + (func (export "barrier") (block $h (result (ref $k1)) (resume (event $e1 $h) (cont.new (type $k1) (ref.func $f3))) (unreachable) ) (resume_throw $exn) ) + + (elem declare func $r0 $r1) + (func $r0) + (func $r1 (suspend $e1)) + + (func $nl0 (param $k (ref $k1)) + (resume (local.get $k)) + (resume (local.get $k)) + ) + (func $nl1 (param $k (ref $k1)) + (block $h (result (ref $k1)) + (resume (event $e1 $h) (local.get $k)) + (unreachable) + ) + (resume (local.get $k)) + (unreachable) + ) + (func $nl2 (param $k (ref $k1)) + (block $h1 (result (ref $k1)) + (resume (event $e1 $h1) (local.get $k)) + (unreachable) + ) + (let (local $k' (ref $k1)) + (block $h2 (result (ref $k1)) + (resume (event $e1 $h2) (local.get $k')) + (unreachable) + ) + (resume (local.get $k')) + (unreachable) + ) + ) + + (func (export "non-linear-1") + (call $nl0 (cont.new (type $k1) (ref.func $r0))) + ) + (func (export "non-linear-2") + (call $nl1 (cont.new (type $k1) (ref.func $r1))) + ) + (func (export "non-linear-3") + (call $nl1 (cont.new (type $k1) (ref.func $r1))) + ) ) (assert_suspension (invoke "unhandled-1") "unhandled") @@ -78,7 +119,11 @@ (assert_exception (invoke "uncaught-1") "unhandled") (assert_exception (invoke "uncaught-2") "unhandled") -(assert_trap (invoke "guarded") "guard suspended") +(assert_trap (invoke "barrier") "barrier") + +(assert_trap (invoke "non-linear-1") "continuation resumed twice") +(assert_trap (invoke "non-linear-2") "continuation resumed twice") +(assert_trap (invoke "non-linear-3") "continuation resumed twice") ;; Simple state example From ee429efb72ebb1a6c73f1a2f3d9c199950a92b70 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Thu, 8 Apr 2021 16:39:06 +0200 Subject: [PATCH 38/82] Add cont.bind; check handler types --- interpreter/binary/decode.ml | 9 +++++---- interpreter/binary/encode.ml | 9 +++++---- interpreter/exec/eval.ml | 22 ++++++++++++++++++-- interpreter/syntax/ast.ml | 1 + interpreter/syntax/free.ml | 2 +- interpreter/syntax/operators.ml | 1 + interpreter/syntax/types.ml | 9 +++++++++ interpreter/text/arrange.ml | 1 + interpreter/text/lexer.mll | 1 + interpreter/text/parser.mly | 3 ++- interpreter/util/lib.ml | 5 +++++ interpreter/util/lib.mli | 1 + interpreter/valid/valid.ml | 36 ++++++++++++++++++++++++++++++--- test/core/cont.wast | 28 ++++++++++++++++--------- 14 files changed, 103 insertions(+), 25 deletions(-) diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index a82dae8fb..2ed751c1d 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -553,10 +553,11 @@ let rec instr s = | 0xd4 -> br_on_null (at var s) | 0xe0 -> cont_new (at var s) - | 0xe1 -> suspend (at var s) - | 0xe2 -> resume (vec var_pair s) - | 0xe3 -> resume_throw (at var s) - | 0xe4 -> + | 0xe1 -> cont_bind (at var s) + | 0xe2 -> suspend (at var s) + | 0xe3 -> resume (vec var_pair s) + | 0xe4 -> resume_throw (at var s) + | 0xe5 -> let bt = block_type s in let es' = instr_block s in end_ s; diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index f9dec6ff0..f2df56e43 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -215,10 +215,11 @@ struct | FuncBind x -> op 0x16; var x | ContNew x -> op 0xe0; var x - | Suspend x -> op 0xe1; var x - | Resume xls -> op 0xe2; vec var_pair xls - | ResumeThrow x -> op 0xe3; var x - | Barrier (bt, es) -> op 0xe4; block_type bt; list instr es; end_ () + | ContBind x -> op 0xe1; var x + | Suspend x -> op 0xe2; var x + | Resume xls -> op 0xe3; vec var_pair xls + | ResumeThrow x -> op 0xe4; var x + | Barrier (bt, es) -> op 0xe5; block_type bt; list instr es; end_ () | Drop -> op 0x1a | Select None -> op 0x1b diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 423db9951..cc4fbecd4 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -131,6 +131,7 @@ let data (inst : module_inst) x = lookup "data segment" inst.datas x let local (frame : frame) x = lookup "local" frame.locals x let func_type (inst : module_inst) x = as_func_def_type (def_of (type_ inst x)) +let cont_type (inst : module_inst) x = as_cont_def_type (def_of (type_ inst x)) let any_ref inst x i at = try Table.load (table inst x) i with Table.Bounds -> @@ -316,6 +317,23 @@ let rec step (c : config) : config = let ctxt code = compose code ([], [Invoke f @@ e.at]) in Ref (ContRef (ref (Some (List.length ts, ctxt)))) :: vs, [] + | ContBind x, Ref (NullRef _) :: vs -> + vs, [Trapping "null continuation reference" @@ e.at] + + | ContBind x, Ref (ContRef {contents = None}) :: vs -> + vs, [Trapping "continuation already consumed" @@ e.at] + + | ContBind x, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> + let ContType z = cont_type c.frame.inst x in + let FuncType (ts', _) = as_func_def_type (def_of (as_sem_var z)) in + let args, vs' = + try split (n - List.length ts') vs e.at + with Failure _ -> Crash.error e.at "type mismatch at continuation bind" + in + cont := None; + let ctxt' code = ctxt (compose (args, []) code) in + Ref (ContRef (ref (Some (n - List.length args, ctxt')))) :: vs, [] + | Suspend x, vs -> let evt = event c.frame.inst x in let EventType (FuncType (ts, _), _) = Event.type_of evt in @@ -326,7 +344,7 @@ let rec step (c : config) : config = vs, [Trapping "null continuation reference" @@ e.at] | Resume xls, Ref (ContRef {contents = None}) :: vs -> - vs, [Trapping "continuation resumed twice" @@ e.at] + vs, [Trapping "continuation already consumed" @@ e.at] | Resume xls, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> let hs = List.map (fun (x, l) -> event c.frame.inst x, l) xls in @@ -338,7 +356,7 @@ let rec step (c : config) : config = vs, [Trapping "null continuation reference" @@ e.at] | ResumeThrow x, Ref (ContRef {contents = None}) :: vs -> - vs, [Trapping "continuation resumed twice" @@ e.at] + vs, [Trapping "continuation already consumed" @@ e.at] | ResumeThrow x, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> let evt = event c.frame.inst x in diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml index 00ff25b51..cd7b805a9 100644 --- a/interpreter/syntax/ast.ml +++ b/interpreter/syntax/ast.ml @@ -99,6 +99,7 @@ and instr' = | ReturnCallIndirect of idx * idx (* tail-call function through table *) | FuncBind of idx (* create closure *) | ContNew of idx (* create continuation *) + | ContBind of idx (* bind continuation arguments *) | Suspend of idx (* suspend continuation *) | Resume of (idx * idx) list (* resume continuation *) | ResumeThrow of idx (* abort continuation *) diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml index 9d9f82478..467902d57 100644 --- a/interpreter/syntax/free.ml +++ b/interpreter/syntax/free.ml @@ -123,7 +123,7 @@ let rec instr (e : instr) = | Call x | ReturnCall x -> funcs (idx x) | CallIndirect (x, y) | ReturnCallIndirect (x, y) -> tables (idx x) ++ types (idx y) - | FuncBind x | ContNew x -> types (idx x) + | FuncBind x | ContNew x | ContBind x -> types (idx x) | Resume xys -> list (fun (x, y) -> events (idx x) ++ labels (idx y)) xys | LocalGet x | LocalSet x | LocalTee x -> locals (idx x) | GlobalGet x | GlobalSet x -> globals (idx x) diff --git a/interpreter/syntax/operators.ml b/interpreter/syntax/operators.ml index 0710bda96..d996c2b77 100644 --- a/interpreter/syntax/operators.ml +++ b/interpreter/syntax/operators.ml @@ -39,6 +39,7 @@ let return_call_indirect x y = ReturnCallIndirect (x, y) let func_bind x = FuncBind x let cont_new x = ContNew x +let cont_bind x = ContBind x let suspend x = Suspend x let resume xys = Resume xys let resume_throw x = ResumeThrow x diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml index 57fb4aa42..dc9794bdb 100644 --- a/interpreter/syntax/types.ml +++ b/interpreter/syntax/types.ml @@ -81,11 +81,20 @@ let as_syn_var = function | SynVar x -> x | SemVar _ -> assert false +let as_sem_var = function + | SynVar _ -> assert false + | SemVar x -> x + let as_func_def_type (dt : def_type) : func_type = match dt with | FuncDefType ft -> ft | _ -> assert false +let as_cont_def_type (dt : def_type) : cont_type = + match dt with + | ContDefType x -> x + | _ -> assert false + let extern_type_of_import_type (ImportType (et, _, _)) = et let extern_type_of_export_type (ExportType (et, _)) = et diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index fceb82f60..1268f0b1c 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -279,6 +279,7 @@ let rec instr e = "return_call_indirect " ^ var x, [Node ("type " ^ var y, [])] | FuncBind x -> "func.bind", [Node ("type " ^ var x, [])] | ContNew x -> "cont.new", [Node ("type " ^ var x, [])] + | ContBind x -> "cont.bind", [Node ("type " ^ var x, [])] | Suspend x -> "suspend " ^ var x, [] | Resume xys -> "resume", diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index 4949cdbf0..dd508a8f2 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -218,6 +218,7 @@ rule token = parse | "catch_all" { CATCH_ALL } | "cont.new" { CONT_NEW } + | "cont.bind" { CONT_BIND } | "suspend" { SUSPEND } | "resume" { RESUME } | "resume_throw" { RESUME_THROW } diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index b6834d82b..938dbd0da 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -217,7 +217,7 @@ let inline_func_type_explicit (c : context) x ft at = %token UNREACHABLE NOP DROP SELECT %token BLOCK END IF THEN ELSE LOOP LET %token THROW TRY DO CATCH CATCH_ALL -%token CONT_NEW SUSPEND RESUME RESUME_THROW BARRIER +%token CONT_NEW CONT_BIND SUSPEND RESUME RESUME_THROW BARRIER %token BR BR_IF BR_TABLE BR_ON_NULL %token CALL CALL_REF CALL_INDIRECT %token RETURN RETURN_CALL RETURN_CALL_REF RETURN_CALL_INDIRECT @@ -450,6 +450,7 @@ plain_instr : | RETURN_CALL var { fun c -> return_call ($2 c func) } | RETURN_CALL_REF { fun c -> return_call_ref } | CONT_NEW LPAR TYPE var RPAR { fun c -> cont_new ($4 c type_) } + | CONT_BIND LPAR TYPE var RPAR { fun c -> cont_bind ($4 c type_) } | SUSPEND var { fun c -> suspend ($2 c event) } | RESUME_THROW var { fun c -> resume_throw ($2 c event) } | LOCAL_GET var { fun c -> local_get ($2 c local) } diff --git a/interpreter/util/lib.ml b/interpreter/util/lib.ml index 23bace335..5446c3fd2 100644 --- a/interpreter/util/lib.ml +++ b/interpreter/util/lib.ml @@ -87,6 +87,11 @@ struct | n, y::ys' when n > 0 -> split' (n - 1) (y::xs) ys' | _ -> failwith "split" + let rec last_opt = function + | x::[] -> Some x + | _::xs -> last_opt xs + | [] -> None + let rec last = function | x::[] -> x | _::xs -> last xs diff --git a/interpreter/util/lib.mli b/interpreter/util/lib.mli index bde64f1da..c6acfa94d 100644 --- a/interpreter/util/lib.mli +++ b/interpreter/util/lib.mli @@ -20,6 +20,7 @@ sig val drop : int -> 'a list -> 'a list (* raises Failure *) val split : int -> 'a list -> 'a list * 'a list (* raises Failure *) + val last_opt : 'a list -> 'a option val last : 'a list -> 'a (* raises Failure *) val split_last : 'a list -> 'a list * 'a (* raises Failure *) diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 4234e653b..a934daf74 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -480,6 +480,28 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : op_type [RefType (NonNullable, DefHeapType y)] --> [RefType (NonNullable, DefHeapType (SynVar x.it))] + | ContBind x -> + (match peek_ref 0 s e.at with + | nul, DefHeapType (SynVar y) -> + let ContType z = cont_type c (y @@ e.at) in + let FuncType (ts1, ts2) = func_type c (as_syn_var z @@ e.at) in + let ContType z' = cont_type c x in + let FuncType (ts1', _) as ft' = func_type c (as_syn_var z' @@ x.at) in + require (List.length ts1 >= List.length ts1') x.at + "type mismatch in continuation arguments"; + let ts11, ts12 = Lib.List.split (List.length ts1 - List.length ts1') ts1 in + require (match_func_type c.types [] (FuncType (ts12, ts2)) ft') e.at + "type mismatch in continuation type"; + (ts11 @ [RefType (nul, DefHeapType (SynVar y))]) --> + [RefType (NonNullable, DefHeapType (SynVar x.it))] + | (_, BotHeapType) as rt -> + [RefType rt] -->.. [RefType (NonNullable, DefHeapType (SynVar x.it))] + | rt -> + error e.at + ("type mismatch: instruction requires continuation reference type" ^ + " but stack has " ^ string_of_value_type (RefType rt)) + ) + | Suspend x -> let EventType (FuncType (ts1, ts2), res) = event c x in require (res = Resumable) e.at "suspending with a non-resumable event"; @@ -493,9 +515,17 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : op_type List.iter (fun (x1, x2) -> let EventType (FuncType (ts3, ts4), res) = event c x1 in require (res = Resumable) x1.at "handling a non-resumable event"; - (* TODO: check label; problem: we don't have a type idx to produce here - check_stack c (ts3 @ [RefType (NonNullable, DefHeapType (SynVar ?))]) (label c x2) x2.at - *) + match Lib.List.last_opt (label c x2) with + | Some (RefType (NonNullable, DefHeapType (SynVar y'))) -> + let ContType z' = cont_type c (y' @@ x2.at) in + let FuncType (ts1', ts2') = func_type c (as_syn_var z' @@ x2.at) in + check_stack c ts4 ts1' x2.at; + check_stack c ts2 ts2' x2.at; + check_stack c (ts3 @ [RefType (NonNullable, DefHeapType (SynVar y'))]) (label c x2) x2.at + | _ -> + error e.at + ("type mismatch: instruction requires continuation reference type" ^ + " but label has " ^ string_of_result_type (label c x2)) ) xys; (ts1 @ [RefType (nul, DefHeapType (SynVar y))]) --> ts2 | _, BotHeapType -> diff --git a/test/core/cont.wast b/test/core/cont.wast index 6b3c1277e..0fb990108 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -71,13 +71,13 @@ (elem declare func $r0 $r1) (func $r0) - (func $r1 (suspend $e1)) + (func $r1 (suspend $e1) (suspend $e1)) - (func $nl0 (param $k (ref $k1)) + (func $nl1 (param $k (ref $k1)) (resume (local.get $k)) (resume (local.get $k)) ) - (func $nl1 (param $k (ref $k1)) + (func $nl2 (param $k (ref $k1)) (block $h (result (ref $k1)) (resume (event $e1 $h) (local.get $k)) (unreachable) @@ -85,7 +85,7 @@ (resume (local.get $k)) (unreachable) ) - (func $nl2 (param $k (ref $k1)) + (func $nl3 (param $k (ref $k1)) (block $h1 (result (ref $k1)) (resume (event $e1 $h1) (local.get $k)) (unreachable) @@ -99,15 +99,22 @@ (unreachable) ) ) + (func $nl4 (param $k (ref $k1)) + (drop (cont.bind (type $k1) (local.get $k))) + (resume (local.get $k)) + ) (func (export "non-linear-1") - (call $nl0 (cont.new (type $k1) (ref.func $r0))) + (call $nl1 (cont.new (type $k1) (ref.func $r0))) ) (func (export "non-linear-2") - (call $nl1 (cont.new (type $k1) (ref.func $r1))) + (call $nl2 (cont.new (type $k1) (ref.func $r1))) ) (func (export "non-linear-3") - (call $nl1 (cont.new (type $k1) (ref.func $r1))) + (call $nl3 (cont.new (type $k1) (ref.func $r1))) + ) + (func (export "non-linear-4") + (call $nl4 (cont.new (type $k1) (ref.func $r1))) ) ) @@ -121,9 +128,10 @@ (assert_trap (invoke "barrier") "barrier") -(assert_trap (invoke "non-linear-1") "continuation resumed twice") -(assert_trap (invoke "non-linear-2") "continuation resumed twice") -(assert_trap (invoke "non-linear-3") "continuation resumed twice") +(assert_trap (invoke "non-linear-1") "continuation already consumed") +(assert_trap (invoke "non-linear-2") "continuation already consumed") +(assert_trap (invoke "non-linear-3") "continuation already consumed") +(assert_trap (invoke "non-linear-4") "continuation already consumed") ;; Simple state example From 03a1e4cdc1ce5241d8273b4610df09b69c92858e Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Thu, 8 Apr 2021 19:55:32 +0200 Subject: [PATCH 39/82] Nit --- interpreter/syntax/types.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml index dc9794bdb..40b1837f2 100644 --- a/interpreter/syntax/types.ml +++ b/interpreter/syntax/types.ml @@ -92,7 +92,7 @@ let as_func_def_type (dt : def_type) : func_type = let as_cont_def_type (dt : def_type) : cont_type = match dt with - | ContDefType x -> x + | ContDefType ct -> ct | _ -> assert false let extern_type_of_import_type (ImportType (et, _, _)) = et From eef1931cca3b65ff5c69b5ceb16e9617d6c33f9e Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Thu, 8 Apr 2021 21:06:50 +0200 Subject: [PATCH 40/82] Fix --- interpreter/exec/eval.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index cc4fbecd4..1aa438438 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -332,7 +332,7 @@ let rec step (c : config) : config = in cont := None; let ctxt' code = ctxt (compose (args, []) code) in - Ref (ContRef (ref (Some (n - List.length args, ctxt')))) :: vs, [] + Ref (ContRef (ref (Some (n - List.length args, ctxt')))) :: vs', [] | Suspend x, vs -> let evt = event c.frame.inst x in From 650e0f0c92315993a2fe58202e648c256d5e9ae1 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Thu, 8 Apr 2021 21:33:40 +0200 Subject: [PATCH 41/82] Add cont.bind; check handler types (#10) Add cont.bind; check handler types --- interpreter/binary/decode.ml | 9 +++++---- interpreter/binary/encode.ml | 9 +++++---- interpreter/exec/eval.ml | 22 ++++++++++++++++++-- interpreter/syntax/ast.ml | 1 + interpreter/syntax/free.ml | 2 +- interpreter/syntax/operators.ml | 1 + interpreter/syntax/types.ml | 9 +++++++++ interpreter/text/arrange.ml | 1 + interpreter/text/lexer.mll | 1 + interpreter/text/parser.mly | 3 ++- interpreter/util/lib.ml | 5 +++++ interpreter/util/lib.mli | 1 + interpreter/valid/valid.ml | 36 ++++++++++++++++++++++++++++++--- test/core/cont.wast | 28 ++++++++++++++++--------- 14 files changed, 103 insertions(+), 25 deletions(-) diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index a82dae8fb..2ed751c1d 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -553,10 +553,11 @@ let rec instr s = | 0xd4 -> br_on_null (at var s) | 0xe0 -> cont_new (at var s) - | 0xe1 -> suspend (at var s) - | 0xe2 -> resume (vec var_pair s) - | 0xe3 -> resume_throw (at var s) - | 0xe4 -> + | 0xe1 -> cont_bind (at var s) + | 0xe2 -> suspend (at var s) + | 0xe3 -> resume (vec var_pair s) + | 0xe4 -> resume_throw (at var s) + | 0xe5 -> let bt = block_type s in let es' = instr_block s in end_ s; diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index f9dec6ff0..f2df56e43 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -215,10 +215,11 @@ struct | FuncBind x -> op 0x16; var x | ContNew x -> op 0xe0; var x - | Suspend x -> op 0xe1; var x - | Resume xls -> op 0xe2; vec var_pair xls - | ResumeThrow x -> op 0xe3; var x - | Barrier (bt, es) -> op 0xe4; block_type bt; list instr es; end_ () + | ContBind x -> op 0xe1; var x + | Suspend x -> op 0xe2; var x + | Resume xls -> op 0xe3; vec var_pair xls + | ResumeThrow x -> op 0xe4; var x + | Barrier (bt, es) -> op 0xe5; block_type bt; list instr es; end_ () | Drop -> op 0x1a | Select None -> op 0x1b diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 423db9951..1aa438438 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -131,6 +131,7 @@ let data (inst : module_inst) x = lookup "data segment" inst.datas x let local (frame : frame) x = lookup "local" frame.locals x let func_type (inst : module_inst) x = as_func_def_type (def_of (type_ inst x)) +let cont_type (inst : module_inst) x = as_cont_def_type (def_of (type_ inst x)) let any_ref inst x i at = try Table.load (table inst x) i with Table.Bounds -> @@ -316,6 +317,23 @@ let rec step (c : config) : config = let ctxt code = compose code ([], [Invoke f @@ e.at]) in Ref (ContRef (ref (Some (List.length ts, ctxt)))) :: vs, [] + | ContBind x, Ref (NullRef _) :: vs -> + vs, [Trapping "null continuation reference" @@ e.at] + + | ContBind x, Ref (ContRef {contents = None}) :: vs -> + vs, [Trapping "continuation already consumed" @@ e.at] + + | ContBind x, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> + let ContType z = cont_type c.frame.inst x in + let FuncType (ts', _) = as_func_def_type (def_of (as_sem_var z)) in + let args, vs' = + try split (n - List.length ts') vs e.at + with Failure _ -> Crash.error e.at "type mismatch at continuation bind" + in + cont := None; + let ctxt' code = ctxt (compose (args, []) code) in + Ref (ContRef (ref (Some (n - List.length args, ctxt')))) :: vs', [] + | Suspend x, vs -> let evt = event c.frame.inst x in let EventType (FuncType (ts, _), _) = Event.type_of evt in @@ -326,7 +344,7 @@ let rec step (c : config) : config = vs, [Trapping "null continuation reference" @@ e.at] | Resume xls, Ref (ContRef {contents = None}) :: vs -> - vs, [Trapping "continuation resumed twice" @@ e.at] + vs, [Trapping "continuation already consumed" @@ e.at] | Resume xls, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> let hs = List.map (fun (x, l) -> event c.frame.inst x, l) xls in @@ -338,7 +356,7 @@ let rec step (c : config) : config = vs, [Trapping "null continuation reference" @@ e.at] | ResumeThrow x, Ref (ContRef {contents = None}) :: vs -> - vs, [Trapping "continuation resumed twice" @@ e.at] + vs, [Trapping "continuation already consumed" @@ e.at] | ResumeThrow x, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> let evt = event c.frame.inst x in diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml index 00ff25b51..cd7b805a9 100644 --- a/interpreter/syntax/ast.ml +++ b/interpreter/syntax/ast.ml @@ -99,6 +99,7 @@ and instr' = | ReturnCallIndirect of idx * idx (* tail-call function through table *) | FuncBind of idx (* create closure *) | ContNew of idx (* create continuation *) + | ContBind of idx (* bind continuation arguments *) | Suspend of idx (* suspend continuation *) | Resume of (idx * idx) list (* resume continuation *) | ResumeThrow of idx (* abort continuation *) diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml index 9d9f82478..467902d57 100644 --- a/interpreter/syntax/free.ml +++ b/interpreter/syntax/free.ml @@ -123,7 +123,7 @@ let rec instr (e : instr) = | Call x | ReturnCall x -> funcs (idx x) | CallIndirect (x, y) | ReturnCallIndirect (x, y) -> tables (idx x) ++ types (idx y) - | FuncBind x | ContNew x -> types (idx x) + | FuncBind x | ContNew x | ContBind x -> types (idx x) | Resume xys -> list (fun (x, y) -> events (idx x) ++ labels (idx y)) xys | LocalGet x | LocalSet x | LocalTee x -> locals (idx x) | GlobalGet x | GlobalSet x -> globals (idx x) diff --git a/interpreter/syntax/operators.ml b/interpreter/syntax/operators.ml index 0710bda96..d996c2b77 100644 --- a/interpreter/syntax/operators.ml +++ b/interpreter/syntax/operators.ml @@ -39,6 +39,7 @@ let return_call_indirect x y = ReturnCallIndirect (x, y) let func_bind x = FuncBind x let cont_new x = ContNew x +let cont_bind x = ContBind x let suspend x = Suspend x let resume xys = Resume xys let resume_throw x = ResumeThrow x diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml index 57fb4aa42..40b1837f2 100644 --- a/interpreter/syntax/types.ml +++ b/interpreter/syntax/types.ml @@ -81,11 +81,20 @@ let as_syn_var = function | SynVar x -> x | SemVar _ -> assert false +let as_sem_var = function + | SynVar _ -> assert false + | SemVar x -> x + let as_func_def_type (dt : def_type) : func_type = match dt with | FuncDefType ft -> ft | _ -> assert false +let as_cont_def_type (dt : def_type) : cont_type = + match dt with + | ContDefType ct -> ct + | _ -> assert false + let extern_type_of_import_type (ImportType (et, _, _)) = et let extern_type_of_export_type (ExportType (et, _)) = et diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index fceb82f60..1268f0b1c 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -279,6 +279,7 @@ let rec instr e = "return_call_indirect " ^ var x, [Node ("type " ^ var y, [])] | FuncBind x -> "func.bind", [Node ("type " ^ var x, [])] | ContNew x -> "cont.new", [Node ("type " ^ var x, [])] + | ContBind x -> "cont.bind", [Node ("type " ^ var x, [])] | Suspend x -> "suspend " ^ var x, [] | Resume xys -> "resume", diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index 4949cdbf0..dd508a8f2 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -218,6 +218,7 @@ rule token = parse | "catch_all" { CATCH_ALL } | "cont.new" { CONT_NEW } + | "cont.bind" { CONT_BIND } | "suspend" { SUSPEND } | "resume" { RESUME } | "resume_throw" { RESUME_THROW } diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index b6834d82b..938dbd0da 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -217,7 +217,7 @@ let inline_func_type_explicit (c : context) x ft at = %token UNREACHABLE NOP DROP SELECT %token BLOCK END IF THEN ELSE LOOP LET %token THROW TRY DO CATCH CATCH_ALL -%token CONT_NEW SUSPEND RESUME RESUME_THROW BARRIER +%token CONT_NEW CONT_BIND SUSPEND RESUME RESUME_THROW BARRIER %token BR BR_IF BR_TABLE BR_ON_NULL %token CALL CALL_REF CALL_INDIRECT %token RETURN RETURN_CALL RETURN_CALL_REF RETURN_CALL_INDIRECT @@ -450,6 +450,7 @@ plain_instr : | RETURN_CALL var { fun c -> return_call ($2 c func) } | RETURN_CALL_REF { fun c -> return_call_ref } | CONT_NEW LPAR TYPE var RPAR { fun c -> cont_new ($4 c type_) } + | CONT_BIND LPAR TYPE var RPAR { fun c -> cont_bind ($4 c type_) } | SUSPEND var { fun c -> suspend ($2 c event) } | RESUME_THROW var { fun c -> resume_throw ($2 c event) } | LOCAL_GET var { fun c -> local_get ($2 c local) } diff --git a/interpreter/util/lib.ml b/interpreter/util/lib.ml index 23bace335..5446c3fd2 100644 --- a/interpreter/util/lib.ml +++ b/interpreter/util/lib.ml @@ -87,6 +87,11 @@ struct | n, y::ys' when n > 0 -> split' (n - 1) (y::xs) ys' | _ -> failwith "split" + let rec last_opt = function + | x::[] -> Some x + | _::xs -> last_opt xs + | [] -> None + let rec last = function | x::[] -> x | _::xs -> last xs diff --git a/interpreter/util/lib.mli b/interpreter/util/lib.mli index bde64f1da..c6acfa94d 100644 --- a/interpreter/util/lib.mli +++ b/interpreter/util/lib.mli @@ -20,6 +20,7 @@ sig val drop : int -> 'a list -> 'a list (* raises Failure *) val split : int -> 'a list -> 'a list * 'a list (* raises Failure *) + val last_opt : 'a list -> 'a option val last : 'a list -> 'a (* raises Failure *) val split_last : 'a list -> 'a list * 'a (* raises Failure *) diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 4234e653b..a934daf74 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -480,6 +480,28 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : op_type [RefType (NonNullable, DefHeapType y)] --> [RefType (NonNullable, DefHeapType (SynVar x.it))] + | ContBind x -> + (match peek_ref 0 s e.at with + | nul, DefHeapType (SynVar y) -> + let ContType z = cont_type c (y @@ e.at) in + let FuncType (ts1, ts2) = func_type c (as_syn_var z @@ e.at) in + let ContType z' = cont_type c x in + let FuncType (ts1', _) as ft' = func_type c (as_syn_var z' @@ x.at) in + require (List.length ts1 >= List.length ts1') x.at + "type mismatch in continuation arguments"; + let ts11, ts12 = Lib.List.split (List.length ts1 - List.length ts1') ts1 in + require (match_func_type c.types [] (FuncType (ts12, ts2)) ft') e.at + "type mismatch in continuation type"; + (ts11 @ [RefType (nul, DefHeapType (SynVar y))]) --> + [RefType (NonNullable, DefHeapType (SynVar x.it))] + | (_, BotHeapType) as rt -> + [RefType rt] -->.. [RefType (NonNullable, DefHeapType (SynVar x.it))] + | rt -> + error e.at + ("type mismatch: instruction requires continuation reference type" ^ + " but stack has " ^ string_of_value_type (RefType rt)) + ) + | Suspend x -> let EventType (FuncType (ts1, ts2), res) = event c x in require (res = Resumable) e.at "suspending with a non-resumable event"; @@ -493,9 +515,17 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : op_type List.iter (fun (x1, x2) -> let EventType (FuncType (ts3, ts4), res) = event c x1 in require (res = Resumable) x1.at "handling a non-resumable event"; - (* TODO: check label; problem: we don't have a type idx to produce here - check_stack c (ts3 @ [RefType (NonNullable, DefHeapType (SynVar ?))]) (label c x2) x2.at - *) + match Lib.List.last_opt (label c x2) with + | Some (RefType (NonNullable, DefHeapType (SynVar y'))) -> + let ContType z' = cont_type c (y' @@ x2.at) in + let FuncType (ts1', ts2') = func_type c (as_syn_var z' @@ x2.at) in + check_stack c ts4 ts1' x2.at; + check_stack c ts2 ts2' x2.at; + check_stack c (ts3 @ [RefType (NonNullable, DefHeapType (SynVar y'))]) (label c x2) x2.at + | _ -> + error e.at + ("type mismatch: instruction requires continuation reference type" ^ + " but label has " ^ string_of_result_type (label c x2)) ) xys; (ts1 @ [RefType (nul, DefHeapType (SynVar y))]) --> ts2 | _, BotHeapType -> diff --git a/test/core/cont.wast b/test/core/cont.wast index 6b3c1277e..0fb990108 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -71,13 +71,13 @@ (elem declare func $r0 $r1) (func $r0) - (func $r1 (suspend $e1)) + (func $r1 (suspend $e1) (suspend $e1)) - (func $nl0 (param $k (ref $k1)) + (func $nl1 (param $k (ref $k1)) (resume (local.get $k)) (resume (local.get $k)) ) - (func $nl1 (param $k (ref $k1)) + (func $nl2 (param $k (ref $k1)) (block $h (result (ref $k1)) (resume (event $e1 $h) (local.get $k)) (unreachable) @@ -85,7 +85,7 @@ (resume (local.get $k)) (unreachable) ) - (func $nl2 (param $k (ref $k1)) + (func $nl3 (param $k (ref $k1)) (block $h1 (result (ref $k1)) (resume (event $e1 $h1) (local.get $k)) (unreachable) @@ -99,15 +99,22 @@ (unreachable) ) ) + (func $nl4 (param $k (ref $k1)) + (drop (cont.bind (type $k1) (local.get $k))) + (resume (local.get $k)) + ) (func (export "non-linear-1") - (call $nl0 (cont.new (type $k1) (ref.func $r0))) + (call $nl1 (cont.new (type $k1) (ref.func $r0))) ) (func (export "non-linear-2") - (call $nl1 (cont.new (type $k1) (ref.func $r1))) + (call $nl2 (cont.new (type $k1) (ref.func $r1))) ) (func (export "non-linear-3") - (call $nl1 (cont.new (type $k1) (ref.func $r1))) + (call $nl3 (cont.new (type $k1) (ref.func $r1))) + ) + (func (export "non-linear-4") + (call $nl4 (cont.new (type $k1) (ref.func $r1))) ) ) @@ -121,9 +128,10 @@ (assert_trap (invoke "barrier") "barrier") -(assert_trap (invoke "non-linear-1") "continuation resumed twice") -(assert_trap (invoke "non-linear-2") "continuation resumed twice") -(assert_trap (invoke "non-linear-3") "continuation resumed twice") +(assert_trap (invoke "non-linear-1") "continuation already consumed") +(assert_trap (invoke "non-linear-2") "continuation already consumed") +(assert_trap (invoke "non-linear-3") "continuation already consumed") +(assert_trap (invoke "non-linear-4") "continuation already consumed") ;; Simple state example From 3d81921474d91255ba395f944063d74b764960c5 Mon Sep 17 00:00:00 2001 From: Sam Lindley Date: Mon, 12 Apr 2021 00:01:58 +0100 Subject: [PATCH 42/82] fix cont.bind to bind arguments in the correct order (fixes #12) --- interpreter/exec/eval.ml | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 1aa438438..8cf2563be 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -331,7 +331,11 @@ let rec step (c : config) : config = with Failure _ -> Crash.error e.at "type mismatch at continuation bind" in cont := None; - let ctxt' code = ctxt (compose (args, []) code) in + let ctxt' (vs, es) = + let vs', vs'' = + try split (n - List.length args) vs e.at + with Failure _ -> Crash.error e.at "type mismatch after continuation bind" in + ctxt (compose (vs' @ args, []) (vs'', es)) in Ref (ContRef (ref (Some (n - List.length args, ctxt')))) :: vs', [] | Suspend x, vs -> From 611a37e6c9fb814927a005a7a1fe5f2463f7c4af Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Mon, 12 Apr 2021 10:27:59 +0200 Subject: [PATCH 43/82] Fix composiiton order --- interpreter/exec/eval.ml | 2 +- test/core/cont.wast | 73 ++++++++++++++++++++++++++++++++++++++++ 2 files changed, 74 insertions(+), 1 deletion(-) diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 1aa438438..aa9a7d15e 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -331,7 +331,7 @@ let rec step (c : config) : config = with Failure _ -> Crash.error e.at "type mismatch at continuation bind" in cont := None; - let ctxt' code = ctxt (compose (args, []) code) in + let ctxt' code = ctxt (compose code (args, [])) in Ref (ContRef (ref (Some (n - List.length args, ctxt')))) :: vs', [] | Suspend x, vs -> diff --git a/test/core/cont.wast b/test/core/cont.wast index 0fb990108..55a5923aa 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -465,3 +465,76 @@ ) (assert_return (invoke "sum" (i64.const 10) (i64.const 20)) (i64.const 165)) + + +;; cont.bind + +(module + (type $f2 (func (param i32 i32) (result i32 i32 i32 i32 i32 i32))) + (type $f4 (func (param i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32))) + (type $f6 (func (param i32 i32 i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32))) + + (type $k2 (cont $f2)) + (type $k4 (cont $f4)) + (type $k6 (cont $f6)) + + (elem declare func $f) + (func $f (param i32 i32 i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32) + (local.get 0) (local.get 1) (local.get 2) + (local.get 3) (local.get 4) (local.get 5) + ) + + (func (export "run") (result i32 i32 i32 i32 i32 i32) + (local $k6 (ref null $k6)) + (local $k4 (ref null $k4)) + (local $k2 (ref null $k2)) + (local.set $k6 (cont.new (type $k6) (ref.func $f))) + (local.set $k4 (cont.bind (type $k4) (i32.const 1) (i32.const 2) (local.get $k6))) + (local.set $k2 (cont.bind (type $k2) (i32.const 3) (i32.const 4) (local.get $k4))) + (resume (i32.const 5) (i32.const 6) (local.get $k2)) + ) +) + +(assert_return (invoke "run") + (i32.const 1) (i32.const 2) (i32.const 3) + (i32.const 4) (i32.const 5) (i32.const 6) +) + + +(module + (event $e (result i32 i32 i32 i32 i32 i32)) + + (type $f0 (func (result i32 i32 i32 i32 i32 i32 i32))) + (type $f2 (func (param i32 i32) (result i32 i32 i32 i32 i32 i32 i32))) + (type $f4 (func (param i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32 i32))) + (type $f6 (func (param i32 i32 i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32 i32))) + + (type $k0 (cont $f0)) + (type $k2 (cont $f2)) + (type $k4 (cont $f4)) + (type $k6 (cont $f6)) + + (elem declare func $f) + (func $f (result i32 i32 i32 i32 i32 i32 i32) + (i32.const 0) (suspend $e) + ) + + (func (export "run") (result i32 i32 i32 i32 i32 i32 i32) + (local $k6 (ref null $k6)) + (local $k4 (ref null $k4)) + (local $k2 (ref null $k2)) + (block $l (result (ref $k6)) + (resume (event $e $l) (cont.new (type $k0) (ref.func $f))) + (unreachable) + ) + (local.set $k6) + (local.set $k4 (cont.bind (type $k4) (i32.const 1) (i32.const 2) (local.get $k6))) + (local.set $k2 (cont.bind (type $k2) (i32.const 3) (i32.const 4) (local.get $k4))) + (resume (i32.const 5) (i32.const 6) (local.get $k2)) + ) +) + +(assert_return (invoke "run") + (i32.const 0) (i32.const 1) (i32.const 2) (i32.const 3) + (i32.const 4) (i32.const 5) (i32.const 6) +) From 60d2c28d7a09cf10f4713e6e4599d4f9fe2c69d7 Mon Sep 17 00:00:00 2001 From: Sam Lindley Date: Tue, 13 Apr 2021 00:02:02 +0100 Subject: [PATCH 44/82] Examples (#8) --- .../continuations/examples/actor-lwt.wast | 351 +++++++++++++++ proposals/continuations/examples/actor.wast | 384 +++++++++++++++++ .../continuations/examples/async-await.wast | 318 ++++++++++++++ .../continuations/examples/fun-actor-lwt.wast | 404 ++++++++++++++++++ proposals/continuations/examples/fun-lwt.wast | 255 +++++++++++ .../continuations/examples/fun-pipes.wast | 88 ++++ .../continuations/examples/fun-state.wast | 61 +++ proposals/continuations/examples/lwt.wast | 293 +++++++++++++ proposals/continuations/examples/pipes.wast | 95 ++++ .../continuations/examples/static-lwt.wast | 151 +++++++ 10 files changed, 2400 insertions(+) create mode 100644 proposals/continuations/examples/actor-lwt.wast create mode 100644 proposals/continuations/examples/actor.wast create mode 100644 proposals/continuations/examples/async-await.wast create mode 100644 proposals/continuations/examples/fun-actor-lwt.wast create mode 100644 proposals/continuations/examples/fun-lwt.wast create mode 100644 proposals/continuations/examples/fun-pipes.wast create mode 100644 proposals/continuations/examples/fun-state.wast create mode 100644 proposals/continuations/examples/lwt.wast create mode 100644 proposals/continuations/examples/pipes.wast create mode 100644 proposals/continuations/examples/static-lwt.wast diff --git a/proposals/continuations/examples/actor-lwt.wast b/proposals/continuations/examples/actor-lwt.wast new file mode 100644 index 000000000..2526a3d7f --- /dev/null +++ b/proposals/continuations/examples/actor-lwt.wast @@ -0,0 +1,351 @@ +;; Actors via lightweight threads + +;; actor interface +(module $actor + (type $func (func)) + (type $cont (cont $func)) + + (event $self (export "self") (result i32)) + (event $spawn (export "spawn") (param (ref $cont)) (result i32)) + (event $send (export "send") (param i32 i32)) + (event $recv (export "recv") (result i32)) +) +(register "actor") + +;; a simple example - pass a message through a chain of actors +(module $chain + (type $func (func)) + (type $cont (cont $func)) + + (type $i-func (func (param i32))) + (type $i-cont (cont $i-func)) + + (event $self (import "actor" "self") (result i32)) + (event $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) + (event $send (import "actor" "send") (param i32 i32)) + (event $recv (import "actor" "recv") (result i32)) + + (elem declare func $next) + + (func $log (import "spectest" "print_i32") (param i32)) + + (func $next (param $p i32) + (local $s i32) + (local.set $s (suspend $recv)) + (call $log (i32.const -1)) + (suspend $send (local.get $s) (local.get $p)) + ) + + ;; send the message 42 through a chain of n actors + (func $chain (export "chain") (param $n i32) + (local $p i32) + (local.set $p (suspend $self)) + + (loop $l + (if (i32.eqz (local.get $n)) + (then (suspend $send (i32.const 42) (local.get $p))) + (else (local.set $p (suspend $spawn (cont.bind (type $cont) (local.get $p) (cont.new (type $i-cont) (ref.func $next))))) + (local.set $n (i32.sub (local.get $n) (i32.const 1))) + (br $l)) + ) + ) + (call $log (suspend $recv)) + ) +) +(register "chain") + +;; interface to lightweight threads +(module $lwt + (type $func (func)) + (type $cont (cont $func)) + + (event $yield (export "yield")) + (event $fork (export "fork") (param (ref $cont))) +) +(register "lwt") + +;; queue of threads +(module $queue + (type $func (func)) + (type $cont (cont $func)) + + ;; Table as simple queue (keeping it simple, no ring buffer) + (table $queue 0 (ref null $cont)) + (global $qdelta i32 (i32.const 10)) + (global $qback (mut i32) (i32.const 0)) + (global $qfront (mut i32) (i32.const 0)) + + (func $queue-empty (export "queue-empty") (result i32) + (i32.eq (global.get $qfront) (global.get $qback)) + ) + + (func $dequeue (export "dequeue") (result (ref null $cont)) + (local $i i32) + (if (call $queue-empty) + (then (return (ref.null $cont))) + ) + (local.set $i (global.get $qfront)) + (global.set $qfront (i32.add (local.get $i) (i32.const 1))) + (table.get $queue (local.get $i)) + ) + + (func $enqueue (export "enqueue") (param $k (ref $cont)) + ;; Check if queue is full + (if (i32.eq (global.get $qback) (table.size $queue)) + (then + ;; Check if there is enough space in the front to compact + (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) + (then + ;; Space is below threshold, grow table instead + (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) + ) + (else + ;; Enough space, move entries up to head of table + (global.set $qback (i32.sub (global.get $qback) (global.get $qfront))) + (table.copy $queue $queue + (i32.const 0) ;; dest = new front = 0 + (global.get $qfront) ;; src = old front + (global.get $qback) ;; len = new back = old back - old front + ) + (table.fill $queue ;; null out old entries to avoid leaks + (global.get $qback) ;; start = new back + (ref.null $cont) ;; init value + (global.get $qfront) ;; len = old front = old front - new front + ) + (global.set $qfront (i32.const 0)) + ) + ) + ) + ) + (table.set $queue (global.get $qback) (local.get $k)) + (global.set $qback (i32.add (global.get $qback) (i32.const 1))) + ) +) +(register "queue") + +;; simple scheduler for lightweight threads +(module $scheduler + (type $func (func)) + (type $cont (cont $func)) + + (event $yield (import "lwt" "yield")) + (event $fork (import "lwt" "fork") (param (ref $cont))) + + (func $queue-empty (import "queue" "queue-empty") (result i32)) + (func $dequeue (import "queue" "dequeue") (result (ref null $cont))) + (func $enqueue (import "queue" "enqueue") (param $k (ref $cont))) + + (func $run (export "run") (param $main (ref $cont)) + (call $enqueue (local.get $main)) + (loop $l + (if (call $queue-empty) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fork (result (ref $cont) (ref $cont)) + (resume (event $yield $on_yield) (event $fork $on_fork) + (call $dequeue) + ) + (br $l) ;; thread terminated + ) ;; $on_fork (result (ref $cont) (ref $cont)) + (call $enqueue) ;; current thread + (call $enqueue) ;; new thread + (br $l) + ) + ;; $on_yield (result (ref $cont)) + (call $enqueue) ;; current thread + (br $l) + ) + ) +) +(register "scheduler") + +(module $mailboxes + ;; Stupid implementation of mailboxes that raises an exception if + ;; there are too many mailboxes or if more than one message is sent + ;; to any given mailbox. + ;; + ;; Sufficient for the simple chain example. + + ;; -1 means empty + + (exception $too-many-mailboxes) + (exception $too-many-messages) + + (memory 1) + + (global $msize (mut i32) (i32.const 0)) + (global $mmax i32 (i32.const 1024)) ;; maximum number of mailboxes + + (func $init (export "init") + (memory.fill (i32.const 0) (i32.const -1) (i32.mul (global.get $mmax) (i32.const 4))) + ) + + (func $empty-mb (export "empty-mb") (param $mb i32) (result i32) + (local $offset i32) + (local.set $offset (i32.mul (local.get $mb) (i32.const 4))) + (i32.eq (i32.load (local.get $offset)) (i32.const -1)) + ) + + (func $new-mb (export "new-mb") (result i32) + (local $mb i32) + + (if (i32.ge_u (global.get $msize) (global.get $mmax)) + (then (throw $too-many-mailboxes)) + ) + + (local.set $mb (global.get $msize)) + (global.set $msize (i32.add (global.get $msize) (i32.const 1))) + (return (local.get $mb)) + ) + + (func $send-to-mb (export "send-to-mb") (param $v i32) (param $mb i32) + (local $offset i32) + (local.set $offset (i32.mul (local.get $mb) (i32.const 4))) + (if (call $empty-mb (local.get $mb)) + (then (i32.store (local.get $offset) (local.get $v))) + (else (throw $too-many-messages)) + ) + ) + + (func $recv-from-mb (export "recv-from-mb") (param $mb i32) (result i32) + (local $v i32) + (local $offset i32) + (local.set $offset (i32.mul (local.get $mb) (i32.const 4))) + (local.set $v (i32.load (local.get $offset))) + (i32.store (local.get $offset) (i32.const -1)) + (local.get $v) + ) +) +(register "mailboxes") + +;; actors implemented via lightweight threads +(module $actor-as-lwt + (type $func (func)) + (type $cont (cont $func)) + + (type $i-func (func (param i32))) + (type $i-cont (cont $i-func)) + + (type $ic-func (func (param i32 (ref $cont)))) + (type $ic-cont (cont $ic-func)) + + (func $log (import "spectest" "print_i32") (param i32)) + + ;; lwt interface + (event $yield (import "lwt" "yield")) + (event $fork (import "lwt" "fork") (param (ref $cont))) + + ;; mailbox interface + (func $init (import "mailboxes" "init")) + (func $empty-mb (import "mailboxes" "empty-mb") (param $mb i32) (result i32)) + (func $new-mb (import "mailboxes" "new-mb") (result i32)) + (func $send-to-mb (import "mailboxes" "send-to-mb") (param $v i32) (param $mb i32)) + (func $recv-from-mb (import "mailboxes" "recv-from-mb") (param $mb i32) (result i32)) + + ;; queue interface + (func $queue-empty (import "queue" "queue-empty") (result i32)) + (func $dequeue (import "queue" "dequeue") (result (ref null $cont))) + (func $enqueue (import "queue" "enqueue") (param $k (ref $cont))) + + ;; actor interface + (event $self (import "actor" "self") (result i32)) + (event $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) + (event $send (import "actor" "send") (param i32 i32)) + (event $recv (import "actor" "recv") (result i32)) + + (elem declare func $actk) + + (func $actk (param $mine i32) (param $nextk (ref $cont)) + (loop $l + (block $on_self (result (ref $i-cont)) + (block $on_spawn (result (ref $cont) (ref $i-cont)) + (block $on_send (result i32 i32 (ref $cont)) + (block $on_recv (result (ref $i-cont)) + (resume (event $self $on_self) + (event $spawn $on_spawn) + (event $send $on_send) + (event $recv $on_recv) + (local.get $nextk) + ) + (return) + ) ;; $on_recv (result (ref $i-cont)) + (let (local $ik (ref $i-cont)) + ;; block this thread until the mailbox is non-empty + (loop $blocked + (if (call $empty-mb (local.get $mine)) + (then (suspend $yield) + (br $blocked)) + ) + ) + (local.set $nextk (cont.bind (type $cont) (call $recv-from-mb (local.get $mine)) (local.get $ik))) + ) + (br $l) + ) ;; $on_send (result i32 i32 (ref $cont)) + (let (param i32 i32) (local $k (ref $cont)) + (call $send-to-mb) + (local.set $nextk (local.get $k)) + ) + (br $l) + ) ;; $on_spawn (result (ref $cont) (ref $i-cont)) + (let (local $you (ref $cont)) (local $ik (ref $i-cont)) + (call $new-mb) + (let (local $yours i32) + (suspend $fork (cont.bind (type $cont) + (local.get $yours) + (local.get $you) + (cont.new (type $ic-cont) (ref.func $actk)))) + (local.set $nextk (cont.bind (type $cont) (local.get $yours) (local.get $ik))) + ) + ) + (br $l) + ) ;; $on_self (result (ref $i-cont)) + (let (local $ik (ref $i-cont)) + (local.set $nextk (cont.bind (type $cont) (local.get $mine) (local.get $ik))) + ) + (br $l) + ) + ) + + (func $act (export "act") (param $k (ref $cont)) + (call $init) + (call $actk (call $new-mb) (local.get $k)) + ) +) +(register "actor-as-lwt") + +;; composing the actor and scheduler handlers together +(module $actor-scheduler + (type $func (func)) + (type $cont (cont $func)) + + (type $cont-func (func (param (ref $cont)))) + (type $cont-cont (cont $cont-func)) + + (elem declare func $act $scheduler) + + (func $act (import "actor-as-lwt" "act") (param $k (ref $cont))) + (func $scheduler (import "scheduler" "run") (param $k (ref $cont))) + + (func $run-actor (export "run-actor") (param $k (ref $cont)) + (call $scheduler (cont.bind (type $cont) (local.get $k) (cont.new (type $cont-cont) (ref.func $act)))) + ) +) +(register "actor-scheduler") + +(module + (type $func (func)) + (type $cont (cont $func)) + + (type $i-func (func (param i32))) + (type $i-cont (cont $i-func)) + + (elem declare func $chain) + + (func $run-actor (import "actor-scheduler" "run-actor") (param $k (ref $cont))) + (func $chain (import "chain" "chain") (param $n i32)) + + (func $run-chain (export "run-chain") (param $n i32) + (call $run-actor (cont.bind (type $cont) (local.get $n) (cont.new (type $i-cont) (ref.func $chain)))) + ) +) + +(invoke "run-chain" (i32.const 64)) diff --git a/proposals/continuations/examples/actor.wast b/proposals/continuations/examples/actor.wast new file mode 100644 index 000000000..48988a0dd --- /dev/null +++ b/proposals/continuations/examples/actor.wast @@ -0,0 +1,384 @@ +;; Actors + +;; actor interface +(module $actor + (type $func (func)) + (type $cont (cont $func)) + + (event $self (export "self") (result i32)) + (event $spawn (export "spawn") (param (ref $cont)) (result i32)) + (event $send (export "send") (param i32 i32)) + (event $recv (export "recv") (result i32)) +) +(register "actor") + +;; a simple example - pass a message through a chain of actors +(module $chain + (type $func (func)) + (type $cont (cont $func)) + + (type $i-func (func (param i32))) + (type $i-cont (cont $i-func)) + + (event $self (import "actor" "self") (result i32)) + (event $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) + (event $send (import "actor" "send") (param i32 i32)) + (event $recv (import "actor" "recv") (result i32)) + + (elem declare func $next) + + (func $log (import "spectest" "print_i32") (param i32)) + + (func $next (param $p i32) + (local $s i32) + (local.set $s (suspend $recv)) + (call $log (i32.const -1)) + (suspend $send (local.get $s) (local.get $p)) + ) + + ;; send the message 42 through a chain of n actors + (func $chain (export "chain") (param $n i32) + (local $p i32) + (local.set $p (suspend $self)) + + (loop $l + (if (i32.eqz (local.get $n)) + (then (suspend $send (i32.const 42) (local.get $p))) + (else (local.set $p (suspend $spawn (cont.bind (type $cont) (local.get $p) (cont.new (type $i-cont) (ref.func $next))))) + (local.set $n (i32.sub (local.get $n) (i32.const 1))) + (br $l)) + ) + ) + (call $log (suspend $recv)) + ) +) +(register "chain") + +;; queues of threads and mailboxes +(module $queue + (type $func (func)) + (type $cont (cont $func)) + + (func $log (import "spectest" "print_i32") (param i32)) + + ;; table (threads) and memory (mailboxes) as simple queues + (table $queue 0 (ref null $cont)) + (memory 1) + + (exception $too-many-mailboxes) + + (global $qdelta i32 (i32.const 10)) + + (global $qback-k (mut i32) (i32.const 0)) + (global $qfront-k (mut i32) (i32.const 0)) + + (func $queue-empty-k (export "queue-empty") (result i32) + (i32.eq (global.get $qfront-k) (global.get $qback-k)) + ) + + (func $dequeue-k (export "dequeue-k") (result (ref null $cont)) + (local $i i32) + (if (call $queue-empty-k) + (then (return (ref.null $cont))) + ) + (local.set $i (global.get $qfront-k)) + (global.set $qfront-k (i32.add (local.get $i) (i32.const 1))) + (table.get $queue (local.get $i)) + ) + + (func $enqueue-k (export "enqueue-k") (param $k (ref $cont)) + ;; Check if queue is full + (if (i32.eq (global.get $qback-k) (table.size $queue)) + (then + ;; Check if there is enough space in the front to compact + (if (i32.lt_u (global.get $qfront-k) (global.get $qdelta)) + (then + ;; Space is below threshold, grow table instead + (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) + ) + (else + ;; Enough space, move entries up to head of table + (global.set $qback-k (i32.sub (global.get $qback-k) (global.get $qfront-k))) + (table.copy $queue $queue + (i32.const 0) ;; dest = new front = 0 + (global.get $qfront-k) ;; src = old front + (global.get $qback-k) ;; len = new back = old back - old front + ) + (table.fill $queue ;; null out old entries to avoid leaks + (global.get $qback-k) ;; start = new back + (ref.null $cont) ;; init value + (global.get $qfront-k) ;; len = old front = old front - new front + ) + (global.set $qfront-k (i32.const 0)) + ) + ) + ) + ) + (table.set $queue (global.get $qback-k) (local.get $k)) + (global.set $qback-k (i32.add (global.get $qback-k) (i32.const 1))) + ) + + (global $qback-mb (mut i32) (i32.const 0)) + (global $qfront-mb (mut i32) (i32.const 0)) + + (func $queue-empty-mb (export "queue-empty-mb") (result i32) + (i32.eq (global.get $qfront-mb) (global.get $qback-mb)) + ) + + (func $dequeue-mb (export "dequeue-mb") (result i32) + (local $i i32) + (local $mb i32) + (if (call $queue-empty-mb) + (then (return (i32.const -1))) + ) + (local.set $i (global.get $qfront-mb)) + (global.set $qfront-mb (i32.add (local.get $i) (i32.const 1))) + (local.set $mb (i32.load (i32.mul (local.get $i) (i32.const 4)))) + (return (local.get $mb)) + ) + + (func $enqueue-mb (export "enqueue-mb") (param $mb i32) + ;; Check if queue is full + (if (i32.eq (global.get $qback-mb) (i32.const 16383)) + (then + ;; Check if there is enough space in the front to compact + (if (i32.lt_u (global.get $qfront-mb) (global.get $qdelta)) + (then + ;; Space is below threshold, throw exception + (throw $too-many-mailboxes) + ) + (else + ;; Enough space, move entries up to head of table + (global.set $qback-mb (i32.sub (global.get $qback-mb) (global.get $qfront-mb))) + (memory.copy + (i32.const 0) ;; dest = new front = 0 + (i32.mul (global.get $qfront-mb) (i32.const 4)) ;; src = old front + (i32.mul (global.get $qback-mb) (i32.const 4)) ;; len = new back = old back - old front + ) + (memory.fill ;; null out old entries to avoid leaks + (i32.mul (global.get $qback-mb) (i32.const 4)) ;; start = new back + (i32.const -1) ;; init value + (i32.mul (global.get $qfront-mb) (i32.const 4)) ;; len = old front = old front - new front + ) + (global.set $qfront-mb (i32.const 0)) + ) + ) + ) + ) + (i32.store (i32.mul (global.get $qback-mb) (i32.const 4)) (local.get $mb)) + (global.set $qback-mb (i32.add (global.get $qback-mb) (i32.const 1))) + ) +) +(register "queue") + +(module $mailboxes + ;; Stupid implementation of mailboxes that raises an exception if + ;; there are too many mailboxes or if more than one message is sent + ;; to any given mailbox. + ;; + ;; Sufficient for the simple chain example. + + ;; -1 means empty + + (func $log (import "spectest" "print_i32") (param i32)) + + (exception $too-many-mailboxes) + (exception $too-many-messages) + + (memory 1) + + (global $msize (mut i32) (i32.const 0)) ;; current number of mailboxes + (global $mmax i32 (i32.const 1024)) ;; maximum number of mailboxes + + (func $init (export "init") + (global.set $msize (i32.const 0)) + (memory.fill (i32.const 0) (i32.const -1) (i32.mul (global.get $mmax) (i32.const 4))) + ) + + (func $empty-mb (export "empty-mb") (param $mb i32) (result i32) + (local $offset i32) + (local.set $offset (i32.mul (local.get $mb) (i32.const 4))) + (i32.eq (i32.load (local.get $offset)) (i32.const -1)) + ) + + (func $new-mb (export "new-mb") (result i32) + (local $mb i32) + + (if (i32.ge_u (global.get $msize) (global.get $mmax)) + (then (throw $too-many-mailboxes)) + ) + + (local.set $mb (global.get $msize)) + (global.set $msize (i32.add (global.get $msize) (i32.const 1))) + (return (local.get $mb)) + ) + + (func $send-to-mb (export "send-to-mb") (param $v i32) (param $mb i32) + (local $offset i32) + (local.set $offset (i32.mul (local.get $mb) (i32.const 4))) + (if (call $empty-mb (local.get $mb)) + (then (i32.store (local.get $offset) (local.get $v))) + (else (throw $too-many-messages)) + ) + ) + + (func $recv-from-mb (export "recv-from-mb") (param $mb i32) (result i32) + (local $v i32) + (local $offset i32) + (local.set $offset (i32.mul (local.get $mb) (i32.const 4))) + (local.set $v (i32.load (local.get $offset))) + (i32.store (local.get $offset) (i32.const -1)) + (local.get $v) + ) +) +(register "mailboxes") + +;; actors implemented directly +(module $scheduler + (type $func (func)) + (type $cont (cont $func)) + + (func $log (import "spectest" "print_i32") (param i32)) + + (type $iproc (func (param i32))) + (type $icont (cont $iproc)) + + (type $icontfun (func (param (ref $icont)))) + (type $icontcont (cont (param (ref $icont)))) + + + ;; mailbox interface + (func $init (import "mailboxes" "init")) + (func $empty-mb (import "mailboxes" "empty-mb") (param $mb i32) (result i32)) + (func $new-mb (import "mailboxes" "new-mb") (result i32)) + (func $send-to-mb (import "mailboxes" "send-to-mb") (param $v i32) (param $mb i32)) + (func $recv-from-mb (import "mailboxes" "recv-from-mb") (param $mb i32) (result i32)) + + ;; queue interface + (func $dequeue-mb (import "queue" "dequeue-mb") (result i32)) + (func $enqueue-mb (import "queue" "enqueue-mb") (param i32)) + (func $dequeue-k (import "queue" "dequeue-k") (result (ref null $cont))) + (func $enqueue-k (import "queue" "enqueue-k") (param (ref $cont))) + + ;; actor interface + (event $self (import "actor" "self") (result i32)) + (event $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) + (event $send (import "actor" "send") (param i32 i32)) + (event $recv (import "actor" "recv") (result i32)) + + (elem declare func $recv-againf) + + ;; We implement blocking by reinvoking recv with the original + ;; handler. This is a common pattern nicely supported by shallow but + ;; not deep handlers. However, it does require composing the new + ;; reinvoked recv with the continuation. We simulate this behaviour + ;; (inefficiently, perhaps) by resuming the continuation with an + ;; identity handler and then building a new continuation. Might an + ;; instruction for composing or extending continuations be palatable + ;; / desirable? + ;; + ;; The resume_throw operation can be implemented with continuation + ;; composition. + + ;; compose recv with an existing continuation + (func $recv-againf (param $ik (ref $icont)) + (local $res i32) + (suspend $recv) + (local.set $res) + (resume (local.get $res) (local.get $ik)) + ) + (func $recv-again (param $ik (ref $icont)) (result (ref $cont)) + (cont.bind (type $cont) (local.get $ik) (cont.new (type $icontcont) (ref.func $recv-againf))) + ) + + ;; There are multiple ways of avoiding the need for + ;; $recv-again. Here are a couple. + ;; + ;; 1) Build handlers on top of lightweight threads (with fork and + ;; yield). Then we can just keep on yielding until the mailbox is + ;; non-empty, and delegate the actual scheduling to a separate + ;; handler. + ;; + ;; 2) Distinguish between unblocked and blocked threads in the + ;; thread queue. Typing makes this a bit of a pain to hack up + ;; directly in Wasm, but in practice this is not difficult, and + ;; similar to what existing actor implementations do. + + (func $run (export "run") (param $nextk (ref null $cont)) + (local $mine i32) ;; current mailbox + (call $init) + (local.set $mine (call $new-mb)) + (loop $l + (if (ref.is_null (local.get $nextk)) (then (return))) + (block $on_self (result (ref $icont)) + (block $on_spawn (result (ref $cont) (ref $icont)) + (block $on_send (result i32 i32 (ref $cont)) + (block $on_recv (result (ref $icont)) + (resume (event $self $on_self) + (event $spawn $on_spawn) + (event $send $on_send) + (event $recv $on_recv) + (local.get $nextk) + ) + (local.set $mine (call $dequeue-mb)) + (local.set $nextk (call $dequeue-k)) + (br $l) + ) ;; $on_recv (result (ref $icont)) + (let (local $ik (ref $icont)) + ;; block this thread until the mailbox is non-empty + (if (call $empty-mb (local.get $mine)) + (then (call $enqueue-mb (local.get $mine)) + (call $enqueue-k (call $recv-again (local.get $ik))) + (local.set $mine (call $dequeue-mb)) + (local.set $nextk (call $dequeue-k)) + (br $l)) + ) + (local.set $nextk (cont.bind (type $cont) (call $recv-from-mb (local.get $mine)) (local.get $ik))) + ) + (br $l) + ) ;; $on_send (result i32 i32 (ref $cont)) + (let (param i32 i32) (local $k (ref $cont)) + (call $send-to-mb) + (local.set $nextk (local.get $k)) + ) + (br $l) + ) ;; $on_spawn (result (ref $cont) (ref $icont)) + (let (local $you (ref $cont)) (local $ik (ref $icont)) + (call $new-mb) + (let (local $yours i32) + (call $enqueue-mb (local.get $yours)) + (call $enqueue-k (local.get $you)) + (local.set $nextk (cont.bind (type $cont) (local.get $yours) (local.get $ik))) + ) + ) + (br $l) + ) ;; $on_self (result (ref $icont)) + (let (local $ik (ref $icont)) + (local.set $nextk (cont.bind (type $cont) (local.get $mine) (local.get $ik))) + ) + (br $l) + ) + ) +) +(register "scheduler") + +(module + (type $func (func)) + (type $cont (cont $func)) + + (type $iproc (func (param i32))) + (type $icont (cont $iproc)) + + (func $log (import "spectest" "print_i32") (param i32)) + + (elem declare func $chain) + + (func $act (import "scheduler" "run") (param $k (ref null $cont))) + (func $chain (import "chain" "chain") (param $n i32)) + + (func $run-chain (export "run-chain") (param $n i32) + (call $act (cont.bind (type $cont) (local.get $n) (cont.new (type $icont) (ref.func $chain)))) + ) +) + +(assert_return (invoke "run-chain" (i32.const 64))) diff --git a/proposals/continuations/examples/async-await.wast b/proposals/continuations/examples/async-await.wast new file mode 100644 index 000000000..8a53fc7b9 --- /dev/null +++ b/proposals/continuations/examples/async-await.wast @@ -0,0 +1,318 @@ +;; async-await interface +(module $async-await + (type $i-func (func (param i32))) + (type $i-cont (cont $i-func)) + + ;; We use yield and fulfill to simulate asynchronous operations. + ;; + ;; Given a suitable asynchronous I/O API, they needn't be exposed to + ;; user code. + (event $yield (export "yield")) + (event $fulfill (export "fulfill") (param i32) (param i32)) + + (event $async (export "async") (param (ref $i-cont)) (result i32)) + (event $await (export "await") (param i32) (result i32)) +) +(register "async-await") + +(module $example + (type $i-func (func (param i32))) + (type $i-cont (cont $i-func)) + + (type $iii-fun (func (param i32 i32 i32))) + (type $iii-cont (cont $iii-fun)) + + (event $yield (import "async-await" "yield")) + (event $fulfill (import "async-await" "fulfill") (param i32) (param i32)) + (event $async (import "async-await" "async") (param (ref $i-cont)) (result i32)) + (event $await (import "async-await" "await") (param i32) (result i32)) + + (func $log (import "spectest" "print_i32") (param i32)) + + (elem declare func $sum) + + ;; an asynchronous function that computes i + i+1 + ... + j + ;; + ;; (instead of computing synchronously, it allows other computations + ;; to execute each time round the loop) + ;; + ;; the final result is written to the promise $p + (func $sum (param $i i32) (param $j i32) (param $p i32) + (local $a i32) + (loop $l + (call $log (local.get $i)) + (local.set $a (i32.add (local.get $a) (local.get $i))) + (local.set $i (i32.add (local.get $i) (i32.const 1))) + (if (i32.le_u (local.get $i) (local.get $j)) + (then (suspend $yield) + (br $l)) + ) + ) + (suspend $fulfill (local.get $p) (local.get $a)) + ) + + ;; compute p = 1+..+3; q = 5+..+7; r = 10+...+15 asynchronously + ;; once p and q have finished computing, compute x = p*q + ;; once r has finished computing, return x+r + (func $run (export "run") + (local $p i32) + (local $q i32) + (local $r i32) + + (local $x i32) + (local $y i32) + + (call $log (i32.const -1)) + (local.set $p (suspend $async (cont.bind (type $i-cont) (i32.const 1) (i32.const 3) (cont.new (type $iii-cont) (ref.func $sum))))) + (call $log (i32.const -2)) + (local.set $q (suspend $async (cont.bind (type $i-cont) (i32.const 5) (i32.const 7) (cont.new (type $iii-cont) (ref.func $sum))))) + (call $log (i32.const -3)) + (local.set $r (suspend $async (cont.bind (type $i-cont) (i32.const 10) (i32.const 15) (cont.new (type $iii-cont) (ref.func $sum))))) + (call $log (i32.const -4)) + + (local.set $x (i32.mul (suspend $await (local.get $p)) + (suspend $await (local.get $q)))) + + (call $log (i32.const -5)) + + (local.set $y (i32.add (suspend $await (local.get $r)) (local.get $x))) + + (call $log (i32.const -6)) + (call $log (local.get $y)) + (call $log (i32.const -7)) + ) +) +(register "example") + +;; queue of threads +(module $queue + (type $func (func)) + (type $cont (cont $func)) + + ;; Table as simple queue (keeping it simple, no ring buffer) + (table $queue 0 (ref null $cont)) + (global $qdelta i32 (i32.const 10)) + (global $qback (mut i32) (i32.const 0)) + (global $qfront (mut i32) (i32.const 0)) + + (func $queue-empty (export "queue-empty") (result i32) + (i32.eq (global.get $qfront) (global.get $qback)) + ) + + (func $dequeue (export "dequeue") (result (ref null $cont)) + (local $i i32) + (if (call $queue-empty) + (then (return (ref.null $cont))) + ) + (local.set $i (global.get $qfront)) + (global.set $qfront (i32.add (local.get $i) (i32.const 1))) + (table.get $queue (local.get $i)) + ) + + (func $enqueue (export "enqueue") (param $k (ref null $cont)) + ;; Check if queue is full + (if (i32.eq (global.get $qback) (table.size $queue)) + (then + ;; Check if there is enough space in the front to compact + (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) + (then + ;; Space is below threshold, grow table instead + (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) + ) + (else + ;; Enough space, move entries up to head of table + (global.set $qback (i32.sub (global.get $qback) (global.get $qfront))) + (table.copy $queue $queue + (i32.const 0) ;; dest = new front = 0 + (global.get $qfront) ;; src = old front + (global.get $qback) ;; len = new back = old back - old front + ) + (table.fill $queue ;; null out old entries to avoid leaks + (global.get $qback) ;; start = new back + (ref.null $cont) ;; init value + (global.get $qfront) ;; len = old front = old front - new front + ) + (global.set $qfront (i32.const 0)) + ) + ) + ) + ) + (table.set $queue (global.get $qback) (local.get $k)) + (global.set $qback (i32.add (global.get $qback) (i32.const 1))) + ) +) +(register "queue") + +;; promises +(module $promise + (type $func (func)) + (type $cont (cont $func)) + + (type $i-func (func (param i32))) + (type $i-cont (cont $i-func)) + + ;; a simplistic implementation of promises that assumes a maximum of + ;; 1000 promises and a maximum of one observer per promise + + (exception $too-many-promises) + (exception $too-many-observers) + + (global $num-promises (mut i32) (i32.const 0)) + (global $max-promises i32 (i32.const 1000)) + (table $observers 1000 (ref null $i-cont)) ;; observers waiting for promises to be fulfilled + (memory 1) ;; promise values + + ;; create and return a new promise + (func $new (export "new") (result i32) + (local $offset i32) + (local $p i32) + (if (i32.eq (global.get $num-promises) (global.get $max-promises)) + (then (throw $too-many-promises))) + (local.set $p (global.get $num-promises)) + (local.set $offset (i32.mul (local.get $p) (i32.const 4))) + (table.set $observers (local.get $p) (ref.null $i-cont)) + (i32.store (local.get $offset) (i32.const -1)) + (global.set $num-promises (i32.add (local.get $p) (i32.const 1))) + (return (local.get $p)) + ) + + ;; check whether promise $p is fulfilled + (func $fulfilled (export "fulfilled") (param $p i32) (result i32) + (local $offset i32) + (local.set $offset (i32.mul (local.get $p) (i32.const 4))) + (i32.ne (i32.load (local.get $offset)) (i32.const -1)) + ) + + ;; current value of promise $p + (func $read (export "read") (param $p i32) (result i32) + (local $offset i32) + (local.set $offset (i32.mul (local.get $p) (i32.const 4))) + (i32.load (local.get $offset)) + ) + + ;; register an observer for when promise $p is fulfilled + (func $await (export "await") (param $p i32) (param $k (ref $i-cont)) + (if (ref.is_null (table.get $observers (local.get $p))) + (then (table.set $observers (local.get $p) (local.get $k))) + (else (throw $too-many-observers)) + ) + ) + + ;; fulfill promise $p with value $v + (func $fulfill (export "fulfill") (param $p i32) (param $v i32) (result (ref null $cont)) + (local $offset i32) + (local $k (ref null $i-cont)) + (local.set $offset (i32.mul (local.get $p) (i32.const 4))) + (i32.store (local.get $offset) (local.get $v)) + (local.set $k (table.get $observers (local.get $p))) + (if (ref.is_null (local.get $k)) + (then (return (ref.null $cont))) + ) + (return (cont.bind (type $cont) (local.get $v) (local.get $k))) + ) +) +(register "promise") + +;; async-await scheduler +(module $scheduler + (type $func (func)) + (type $cont (cont $func)) + + (type $i-func (func (param i32))) + (type $i-cont (cont $i-func)) + + ;; async-await interface + (event $yield (import "async-await" "yield")) + (event $fulfill (import "async-await" "fulfill") (param i32) (param i32)) + (event $async (import "async-await" "async") (param (ref $i-cont)) (result i32)) + (event $await (import "async-await" "await") (param i32) (result i32)) + + ;; queue interface + (func $queue-empty (import "queue" "queue-empty") (result i32)) + (func $dequeue (import "queue" "dequeue") (result (ref null $cont))) + (func $enqueue (import "queue" "enqueue") (param $k (ref null $cont))) + + ;; promise interface + (func $new-promise (import "promise" "new") (result i32)) + (func $promise-fulfilled (import "promise" "fulfilled") (param $p i32) (result i32)) + (func $promise-value (import "promise" "read") (param $p i32) (result i32)) + (func $await-promise (import "promise" "await") (param $p i32) (param $k (ref $i-cont))) + (func $fulfill-promise (import "promise" "fulfill") (param $p i32) (param $v i32) (result (ref null $cont))) + + (func $run (export "run") (param $nextk (ref null $cont)) + (loop $l + (if (ref.is_null (local.get $nextk)) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fulfill (result i32 i32 (ref $cont)) + (block $on_async (result (ref $i-cont) (ref $i-cont)) + (block $on_await (result i32 (ref $i-cont)) + (resume (event $yield $on_yield) + (event $fulfill $on_fulfill) + (event $async $on_async) + (event $await $on_await) + (local.get $nextk) + ) + (local.set $nextk (call $dequeue)) + (br $l) ;; thread terminated + ) ;; $on_await (result i32 (ref $i-cont)) + (let (local $p i32) (local $ik (ref $i-cont)) + (if (call $promise-fulfilled (local.get $p)) + ;; if promise fulfilled then run continuation partially applied to value + (then (local.set $nextk (cont.bind (type $cont) (call $promise-value (local.get $p)) (local.get $ik)))) + ;; else add continuation to promise and run next continuation from the queue + (else (call $await-promise (local.get $p) (local.get $ik)) + (local.set $nextk (call $dequeue))) + ) + ) + (br $l) + ) ;; $on_async (result (ref $i-func) (ref $i-cont)) + (let (local $ak (ref $i-cont)) (local $ik (ref $i-cont)) + ;; create new promise + (call $new-promise) + (let (local $p i32) + ;; enqueue continuation partially applied to promise + (call $enqueue (cont.bind (type $cont) (local.get $p) (local.get $ik))) + ;; run computation partially applied to promise + (local.set $nextk (cont.bind (type $cont) (local.get $p) (local.get $ak))) + ) + ) + (br $l) + ) ;; $on_fulfill (result i32 i32 (ref $cont)) + (local.set $nextk) + (let (local $p i32) (local $v i32) + (call $fulfill-promise (local.get $p) (local.get $v)) + (let (local $k (ref null $cont)) + (if (ref.is_null (local.get $k)) + (then) + (else (call $enqueue (local.get $k))) + ) + ) + ) + (br $l) + ) ;; $on_yield (result (ref $cont)) + (call $enqueue) ;; current thread + (local.set $nextk (call $dequeue)) ;; next thread + (br $l) + ) + ) +) +(register "scheduler") + +(module + (type $func (func)) + (type $cont (cont $func)) + + (func $scheduler (import "scheduler" "run") (param $nextk (ref null $cont))) + + (func $log (import "spectest" "print_i32") (param i32)) + + (func $run-example (import "example" "run")) + + (elem declare func $run-example) + + (func (export "run") + (call $scheduler (cont.new (type $cont) (ref.func $run-example))) + ) +) + +(invoke "run") diff --git a/proposals/continuations/examples/fun-actor-lwt.wast b/proposals/continuations/examples/fun-actor-lwt.wast new file mode 100644 index 000000000..7269ef706 --- /dev/null +++ b/proposals/continuations/examples/fun-actor-lwt.wast @@ -0,0 +1,404 @@ +;; Actors via lightweight threads - functional version + +;; actor interface +(module $actor + (type $func (func)) + (type $cont (cont $func)) + + (event $self (export "self") (result i32)) + (event $spawn (export "spawn") (param (ref $cont)) (result i32)) + (event $send (export "send") (param i32 i32)) + (event $recv (export "recv") (result i32)) +) +(register "actor") + +;; a simple example - pass a message through a chain of actors +(module $chain + (type $func (func)) + (type $cont (cont $func)) + + (type $i-func (func (param i32))) + (type $i-cont (cont $i-func)) + + (event $self (import "actor" "self") (result i32)) + (event $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) + (event $send (import "actor" "send") (param i32 i32)) + (event $recv (import "actor" "recv") (result i32)) + + (elem declare func $next) + + (func $log (import "spectest" "print_i32") (param i32)) + + (func $next (param $p i32) + (local $s i32) + (local.set $s (suspend $recv)) + (call $log (i32.const -1)) + (suspend $send (local.get $s) (local.get $p)) + ) + + ;; send the message 42 through a chain of n actors + (func $chain (export "chain") (param $n i32) + (local $s i32) + (local $p i32) + (local.set $p (suspend $self)) + + (loop $l + (if (i32.eqz (local.get $n)) + (then (suspend $send (i32.const 42) (local.get $p))) + (else (local.set $p (suspend $spawn (cont.bind (type $cont) (local.get $p) (cont.new (type $i-cont) (ref.func $next))))) + (local.set $n (i32.sub (local.get $n) (i32.const 1))) + (br $l)) + ) + ) + (local.set $s (suspend $recv)) + (call $log (local.get $s)) + ) +) +(register "chain") + +;; interface to lightweight threads +(module $lwt + (type $func (func)) + (type $cont (cont $func)) + + (event $yield (export "yield")) + (event $fork (export "fork") (param (ref $cont))) +) +(register "lwt") + +;; queue of threads +(module $queue + (type $func (func)) + (type $cont (cont $func)) + + ;; Table as simple queue (keeping it simple, no ring buffer) + (table $queue 0 (ref null $cont)) + (global $qdelta i32 (i32.const 10)) + (global $qback (mut i32) (i32.const 0)) + (global $qfront (mut i32) (i32.const 0)) + + (func $queue-empty (export "queue-empty") (result i32) + (i32.eq (global.get $qfront) (global.get $qback)) + ) + + (func $dequeue (export "dequeue") (result (ref null $cont)) + (local $i i32) + (if (call $queue-empty) + (then (return (ref.null $cont))) + ) + (local.set $i (global.get $qfront)) + (global.set $qfront (i32.add (local.get $i) (i32.const 1))) + (table.get $queue (local.get $i)) + ) + + (func $enqueue (export "enqueue") (param $k (ref $cont)) + ;; Check if queue is full + (if (i32.eq (global.get $qback) (table.size $queue)) + (then + ;; Check if there is enough space in the front to compact + (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) + (then + ;; Space is below threshold, grow table instead + (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) + ) + (else + ;; Enough space, move entries up to head of table + (global.set $qback (i32.sub (global.get $qback) (global.get $qfront))) + (table.copy $queue $queue + (i32.const 0) ;; dest = new front = 0 + (global.get $qfront) ;; src = old front + (global.get $qback) ;; len = new back = old back - old front + ) + (table.fill $queue ;; null out old entries to avoid leaks + (global.get $qback) ;; start = new back + (ref.null $cont) ;; init value + (global.get $qfront) ;; len = old front = old front - new front + ) + (global.set $qfront (i32.const 0)) + ) + ) + ) + ) + (table.set $queue (global.get $qback) (local.get $k)) + (global.set $qback (i32.add (global.get $qback) (i32.const 1))) + ) +) +(register "queue") + +;; simple scheduler +(module $scheduler + (type $func (func)) + (type $cont (cont $func)) + + (event $yield (import "lwt" "yield")) + (event $fork (import "lwt" "fork") (param (ref $cont))) + + (func $queue-empty (import "queue" "queue-empty") (result i32)) + (func $dequeue (import "queue" "dequeue") (result (ref null $cont))) + (func $enqueue (import "queue" "enqueue") (param $k (ref $cont))) + + (func $run (export "run") (param $main (ref $cont)) + (call $enqueue (local.get $main)) + (loop $l + (if (call $queue-empty) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fork (result (ref $cont) (ref $cont)) + (resume (event $yield $on_yield) (event $fork $on_fork) + (call $dequeue) + ) + (br $l) ;; thread terminated + ) ;; $on_fork (result (ref $cont) (ref $cont)) + (call $enqueue) ;; current thread + (call $enqueue) ;; new thread + (br $l) + ) + ;; $on_yield (result (ref $cont)) + (call $enqueue) ;; current thread + (br $l) + ) + ) +) +(register "scheduler") + +(module $mailboxes + ;; Stupid implementation of mailboxes that raises an exception if + ;; there are too many mailboxes or if more than one message is sent + ;; to any given mailbox. + ;; + ;; Sufficient for the simple chain example. + + ;; -1 means empty + + (exception $too-many-mailboxes) + (exception $too-many-messages) + + (memory 1) + + (global $msize (mut i32) (i32.const 0)) + (global $mmax i32 (i32.const 1024)) ;; maximum number of mailboxes + + (func $init (export "init") + (memory.fill (i32.const 0) (i32.const -1) (i32.mul (global.get $mmax) (i32.const 4))) + ) + + (func $empty-mb (export "empty-mb") (param $mb i32) (result i32) + (local $offset i32) + (local.set $offset (i32.mul (local.get $mb) (i32.const 4))) + (i32.eq (i32.load (local.get $offset)) (i32.const -1)) + ) + + (func $new-mb (export "new-mb") (result i32) + (local $mb i32) + + (if (i32.ge_u (global.get $msize) (global.get $mmax)) + (then (throw $too-many-mailboxes)) + ) + + (local.set $mb (global.get $msize)) + (global.set $msize (i32.add (global.get $msize) (i32.const 1))) + (return (local.get $mb)) + ) + + (func $send-to-mb (export "send-to-mb") (param $v i32) (param $mb i32) + (local $offset i32) + (local.set $offset (i32.mul (local.get $mb) (i32.const 4))) + (if (call $empty-mb (local.get $mb)) + (then (i32.store (local.get $offset) (local.get $v))) + (else (throw $too-many-messages)) + ) + ) + + (func $recv-from-mb (export "recv-from-mb") (param $mb i32) (result i32) + (local $v i32) + (local $offset i32) + (local.set $offset (i32.mul (local.get $mb) (i32.const 4))) + (local.set $v (i32.load (local.get $offset))) + (i32.store (local.get $offset) (i32.const -1)) + (local.get $v) + ) +) +(register "mailboxes") + +;; actors via lightweight threads +(module $actor-as-lwt + (type $func (func)) + (type $cont (cont $func)) + + (type $i-func (func (param i32))) + (type $i-cont (cont $i-func)) + + (type $icont-func (func (param i32 (ref $cont)))) + (type $icont-cont (cont $icont-func)) + + (func $log (import "spectest" "print_i32") (param i32)) + + ;; lwt interface + (event $yield (import "lwt" "yield")) + (event $fork (import "lwt" "fork") (param (ref $cont))) + + ;; mailbox interface + (func $init (import "mailboxes" "init")) + (func $empty-mb (import "mailboxes" "empty-mb") (param $mb i32) (result i32)) + (func $new-mb (import "mailboxes" "new-mb") (result i32)) + (func $send-to-mb (import "mailboxes" "send-to-mb") (param $v i32) (param $mb i32)) + (func $recv-from-mb (import "mailboxes" "recv-from-mb") (param $mb i32) (result i32)) + + ;; actor interface + (event $self (import "actor" "self") (result i32)) + (event $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) + (event $send (import "actor" "send") (param i32 i32)) + (event $recv (import "actor" "recv") (result i32)) + + (elem declare func $act-nullary $act-res) + + ;; resume with $ik applied to $res + (func $act-res (param $mine i32) (param $res i32) (param $ik (ref $i-cont)) + (block $on_self (result (ref $i-cont)) + (block $on_spawn (result (ref $cont) (ref $i-cont)) + (block $on_send (result i32 i32 (ref $cont)) + (block $on_recv (result (ref $i-cont)) + ;; this should really be a tail call to the continuation + ;; do we need a 'return_resume' operator? + (resume (event $self $on_self) + (event $spawn $on_spawn) + (event $send $on_send) + (event $recv $on_recv) + (local.get $res) (local.get $ik) + ) + (return) + ) ;; $on_recv (result (ref $i-cont)) + (let (local $ik (ref $i-cont)) + ;; block this thread until the mailbox is non-empty + (loop $l + (if (call $empty-mb (local.get $mine)) + (then (suspend $yield) + (br $l)) + ) + ) + (call $recv-from-mb (local.get $mine)) + (local.set $res) + (return_call $act-res (local.get $mine) (local.get $res) (local.get $ik))) + (unreachable) + ) ;; $on_send (result i32 i32 (ref $cont)) + (let (param i32 i32) (local $k (ref $cont)) + (call $send-to-mb) + (return_call $act-nullary (local.get $mine) (local.get $k))) + (unreachable) + ) ;; $on_spawn (result (ref $cont) (ref $i-cont)) + (let (local $you (ref $cont)) (local $ik (ref $i-cont)) + (call $new-mb) + (let (local $yours i32) + (suspend $fork (cont.bind (type $cont) + (local.get $yours) + (local.get $you) + (cont.new (type $icont-cont) (ref.func $act-nullary)))) + (return_call $act-res (local.get $mine) (local.get $yours) (local.get $ik)) + ) + ) + (unreachable) + ) ;; $on_self (result (ref $i-cont)) + (let (local $ik (ref $i-cont)) + (return_call $act-res (local.get $mine) (local.get $mine) (local.get $ik)) + ) + (unreachable) + ) + + ;; resume with nullary continuation + (func $act-nullary (param $mine i32) (param $k (ref $cont)) + (local $res i32) + (block $on_self (result (ref $i-cont)) + (block $on_spawn (result (ref $cont) (ref $i-cont)) + (block $on_send (result i32 i32 (ref $cont)) + (block $on_recv (result (ref $i-cont)) + ;; this should really be a tail call to the continuation + ;; do we need a 'return_resume' operator? + (resume (event $self $on_self) + (event $spawn $on_spawn) + (event $send $on_send) + (event $recv $on_recv) + (local.get $k) + ) + (return) + ) ;; $on_recv (result (ref $i-cont)) + (let (local $ik (ref $i-cont)) + ;; block this thread until the mailbox is non-empty + (loop $l + (if (call $empty-mb (local.get $mine)) + (then (suspend $yield) + (br $l)) + ) + ) + (call $recv-from-mb (local.get $mine)) + (local.set $res) + (return_call $act-res (local.get $mine) (local.get $res) (local.get $ik))) + (unreachable) + ) ;; $on_send (result i32 i32 (ref $cont)) + (let (param i32 i32) (local $k (ref $cont)) + (call $send-to-mb) + (return_call $act-nullary (local.get $mine) (local.get $k))) + (unreachable) + ) ;; $on_spawn (result (ref $cont) (ref $i-cont)) + (let (local $you (ref $cont)) (local $ik (ref $i-cont)) + (call $new-mb) + (let (local $yours i32) + (suspend $fork (cont.bind (type $cont) + (local.get $yours) + (local.get $you) + (cont.new (type $icont-cont) (ref.func $act-nullary)))) + (return_call $act-res (local.get $mine) (local.get $yours) (local.get $ik)) + ) + ) + (unreachable) + ) ;; $on_self (result (ref $i-cont)) + (let (local $ik (ref $i-cont)) + (return_call $act-res (local.get $mine) (local.get $mine) (local.get $ik)) + ) + (unreachable) + ) + + (func $act (export "act") (param $k (ref $cont)) + (call $init) + (call $act-nullary (call $new-mb) (local.get $k)) + ) +) +(register "actor-as-lwt") + +;; composing the actor and scheduler handlers together +(module $actor-scheduler + (type $func (func)) + (type $cont (cont $func)) + + (type $cont-func (func (param (ref $cont)))) + (type $cont-cont (cont $cont-func)) + + (type $f-func (func (param (ref $func)))) + + (elem declare func $act $scheduler) + + (func $act (import "actor-as-lwt" "act") (param $k (ref $cont))) + (func $scheduler (import "scheduler" "run") (param $k (ref $cont))) + + (func $run-actor (export "run-actor") (param $k (ref $cont)) + (call $scheduler (cont.bind (type $cont) (local.get $k) (cont.new (type $cont-cont) (ref.func $act)))) + ) +) +(register "actor-scheduler") + +(module + (type $func (func)) + (type $cont (cont $func)) + + (type $i-func (func (param i32))) + (type $i-cont (cont $i-func)) + + (elem declare func $chain) + + (func $run-actor (import "actor-scheduler" "run-actor") (param $k (ref $cont))) + (func $chain (import "chain" "chain") (param $n i32)) + + (func $run-chain (export "run-chain") (param $n i32) + (call $run-actor (cont.bind (type $cont) (local.get $n) (cont.new (type $i-cont) (ref.func $chain)))) + ) +) + +(invoke "run-chain" (i32.const 64)) diff --git a/proposals/continuations/examples/fun-lwt.wast b/proposals/continuations/examples/fun-lwt.wast new file mode 100644 index 000000000..ea599f27e --- /dev/null +++ b/proposals/continuations/examples/fun-lwt.wast @@ -0,0 +1,255 @@ +;; functional lightweight threads + +;; interface to lightweight threads +(module $lwt + (type $func (func)) + (event $yield (export "yield")) + (event $fork (export "fork") (param (ref $func))) +) +(register "lwt") + +(module $example + (type $func (func)) + (type $cont (cont $func)) + (event $yield (import "lwt" "yield")) + (event $fork (import "lwt" "fork") (param (ref $func))) + + (func $log (import "spectest" "print_i32") (param i32)) + + (elem declare func $thread1 $thread2 $thread3) + + (func $main (export "main") + (call $log (i32.const 0)) + (suspend $fork (ref.func $thread1)) + (call $log (i32.const 1)) + (suspend $fork (ref.func $thread2)) + (call $log (i32.const 2)) + (suspend $fork (ref.func $thread3)) + (call $log (i32.const 3)) + ) + + (func $thread1 + (call $log (i32.const 10)) + (suspend $yield) + (call $log (i32.const 11)) + (suspend $yield) + (call $log (i32.const 12)) + ) + + (func $thread2 + (call $log (i32.const 20)) + (suspend $yield) + (call $log (i32.const 21)) + (suspend $yield) + (call $log (i32.const 22)) + ) + + (func $thread3 + (call $log (i32.const 30)) + (suspend $yield) + (call $log (i32.const 31)) + (suspend $yield) + (call $log (i32.const 32)) + ) +) +(register "example") + +(module $queue + (type $func (func)) + (type $cont (cont $func)) + + ;; Table as simple queue (keeping it simple, no ring buffer) + (table $queue 0 (ref null $cont)) + (global $qdelta i32 (i32.const 10)) + (global $qback (mut i32) (i32.const 0)) + (global $qfront (mut i32) (i32.const 0)) + + (func $queue-empty (export "queue-empty") (result i32) + (i32.eq (global.get $qfront) (global.get $qback)) + ) + + (func $dequeue (export "dequeue") (result (ref null $cont)) + (local $i i32) + (if (call $queue-empty) + (then (return (ref.null $cont))) + ) + (local.set $i (global.get $qfront)) + (global.set $qfront (i32.add (local.get $i) (i32.const 1))) + (table.get $queue (local.get $i)) + ) + + (func $enqueue (export "enqueue") (param $k (ref $cont)) + ;; Check if queue is full + (if (i32.eq (global.get $qback) (table.size $queue)) + (then + ;; Check if there is enough space in the front to compact + (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) + (then + ;; Space is below threshold, grow table instead + (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) + ) + (else + ;; Enough space, move entries up to head of table + (global.set $qback (i32.sub (global.get $qback) (global.get $qfront))) + (table.copy $queue $queue + (i32.const 0) ;; dest = new front = 0 + (global.get $qfront) ;; src = old front + (global.get $qback) ;; len = new back = old back - old front + ) + (table.fill $queue ;; null out old entries to avoid leaks + (global.get $qback) ;; start = new back + (ref.null $cont) ;; init value + (global.get $qfront) ;; len = old front = old front - new front + ) + (global.set $qfront (i32.const 0)) + ) + ) + ) + ) + (table.set $queue (global.get $qback) (local.get $k)) + (global.set $qback (i32.add (global.get $qback) (i32.const 1))) + ) +) +(register "queue") + +(module $schedulers + (type $func (func)) + (type $cont (cont $func)) + + (event $yield (import "lwt" "yield")) + (event $fork (import "lwt" "fork") (param (ref $func))) + + (func $queue-empty (import "queue" "queue-empty") (result i32)) + (func $dequeue (import "queue" "dequeue") (result (ref null $cont))) + (func $enqueue (import "queue" "enqueue") (param $k (ref $cont))) + + ;; four different schedulers: + ;; * lwt-kt and lwt-tk don't yield on encountering a fork + ;; 1) lwt-kt runs the continuation, queuing up the new thread for later + ;; 2) lwt-tk runs the new thread first, queuing up the continuation for later + ;; * lwt-ykt and lwt-ytk do yield on encountering a fork + ;; 3) lwt-ykt runs the continuation, queuing up the new thread for later + ;; 4) lwt-ytk runs the new thread first, queuing up the continuation for later + + ;; no yield on fork, continuation first + (func $lwt-kt (param $r (ref null $cont)) + (if (ref.is_null (local.get $r)) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fork (result (ref $func) (ref $cont)) + (resume (event $yield $on_yield) (event $fork $on_fork) (local.get $r)) + (call $dequeue) + (return_call $lwt-tk) + ) ;; $on_fork (result (ref $func) (ref $cont)) + (let (param (ref $func)) (result (ref $cont)) (local $r (ref $cont)) + (cont.new (type $cont)) + (call $enqueue) + (return_call $lwt-tk (local.get $r))) + ) ;; $on_yield (result (ref $cont)) + (call $enqueue) + (call $dequeue) + (return_call $lwt-tk) + ) + + ;; no yield on fork, new thread first + (func $lwt-tk (param $r (ref null $cont)) + (if (ref.is_null (local.get $r)) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fork (result (ref $func) (ref $cont)) + (resume (event $yield $on_yield) (event $fork $on_fork) (local.get $r)) + (call $dequeue) + (return_call $lwt-kt) + ) ;; $on_fork (result (ref $func) (ref $cont)) + (call $enqueue) + (return_call $lwt-kt (cont.new (type $cont))) + ) ;; $on_yield (result (ref $cont)) + (call $enqueue) + (call $dequeue) + (return_call $lwt-kt) + ) + + ;; yield on fork, continuation first + (func $lwt-ykt (param $r (ref null $cont)) + (if (ref.is_null (local.get $r)) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fork (result (ref $func) (ref $cont)) + (resume (event $yield $on_yield) (event $fork $on_fork) (local.get $r)) + (call $dequeue) + (return_call $lwt-ykt) + ) ;; $on_fork (result (ref $func) (ref $cont)) + (call $enqueue) + (cont.new (type $cont)) + (call $enqueue) + (return_call $lwt-ykt (call $dequeue)) + ) ;; $on_yield (result (ref $cont)) + (call $enqueue) + (call $dequeue) + (return_call $lwt-ykt) + ) + + ;; yield on fork, new thread first + (func $lwt-ytk (param $r (ref null $cont)) + (if (ref.is_null (local.get $r)) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fork (result (ref $func) (ref $cont)) + (resume (event $yield $on_yield) (event $fork $on_fork) (local.get $r)) + (call $dequeue) + (return_call $lwt-ytk) + ) ;; $on_fork (result (ref $func) (ref $cont)) + (let (param (ref $func)) (local $k (ref $cont)) + (cont.new (type $cont)) + (call $enqueue) + (call $enqueue (local.get $k)) + ) + (return_call $lwt-ytk (call $dequeue)) + ) ;; $on_yield (result (ref $cont)) + (call $enqueue) + (call $dequeue) + (return_call $lwt-ytk) + ) + + (func $scheduler1 (export "scheduler1") (param $main (ref $func)) + (call $lwt-kt (cont.new (type $cont) (local.get $main))) + ) + (func $scheduler2 (export "scheduler2") (param $main (ref $func)) + (call $lwt-tk (cont.new (type $cont) (local.get $main))) + ) + (func $scheduler3 (export "scheduler3") (param $main (ref $func)) + (call $lwt-ykt (cont.new (type $cont) (local.get $main))) + ) + (func $scheduler4 (export "scheduler4") (param $main (ref $func)) + (call $lwt-ytk (cont.new (type $cont) (local.get $main))) + ) +) + +(register "schedulers") + +(module + (type $func (func)) + (type $cont (cont $func)) + + (func $scheduler1 (import "schedulers" "scheduler1") (param $main (ref $func))) + (func $scheduler2 (import "schedulers" "scheduler2") (param $main (ref $func))) + (func $scheduler3 (import "schedulers" "scheduler3") (param $main (ref $func))) + (func $scheduler4 (import "schedulers" "scheduler4") (param $main (ref $func))) + + (func $log (import "spectest" "print_i32") (param i32)) + + (func $main (import "example" "main")) + + (elem declare func $main) + + (func (export "run") + (call $log (i32.const -1)) + (call $scheduler1 (ref.func $main)) + (call $log (i32.const -2)) + (call $scheduler2 (ref.func $main)) + (call $log (i32.const -3)) + (call $scheduler3 (ref.func $main)) + (call $log (i32.const -4)) + (call $scheduler4 (ref.func $main)) + (call $log (i32.const -5)) + ) +) + +(invoke "run") + diff --git a/proposals/continuations/examples/fun-pipes.wast b/proposals/continuations/examples/fun-pipes.wast new file mode 100644 index 000000000..abbef7b1e --- /dev/null +++ b/proposals/continuations/examples/fun-pipes.wast @@ -0,0 +1,88 @@ +;; Simple pipes example (functional version) +(module $pipes + (type $pfun (func (result i32))) + (type $cfun (func (param i32) (result i32))) + (type $producer (cont $pfun)) + (type $consumer (cont $cfun)) + + (event $send (export "send") (param i32)) + (event $receive (export "receive") (result i32)) + + (func $piper (param $n i32) (param $p (ref $producer)) (param $c (ref $consumer)) + (block $on-receive (result (ref $consumer)) + (resume (event $receive $on-receive) (local.get $n) (local.get $c)) + (return) + ) ;; receive + (local.set $c) + (return_call $copiper (local.get $c) (local.get $p)) + ) + + (func $copiper (param $c (ref $consumer)) (param $p (ref $producer)) + (local $n i32) + (block $on-send (result i32 (ref $producer)) + (resume (event $send $on-send) (local.get $p)) + (return) + ) ;; send + (local.set $p) + (local.set $n) + (return_call $piper (local.get $n) (local.get $p) (local.get $c)) + ) + + (func $pipe (export "pipe") (param $p (ref $producer)) (param $c (ref $consumer)) + (call $piper (i32.const -1) (local.get $p) (local.get $c)) + ) +) +(register "pipes") + +(module + (type $pfun (func (result i32))) + (type $cfun (func (param i32) (result i32))) + + (type $producer (cont $pfun)) + (type $consumer (cont $cfun)) + + (event $send (import "pipes" "send") (param i32)) + (event $receive (import "pipes" "receive") (result i32)) + + (func $pipe (import "pipes" "pipe") (param $p (ref $producer)) (param $c (ref $consumer))) + + (func $log (import "spectest" "print_i32") (param i32)) + + (elem declare func $nats $sum) + + ;; send n, n+1, ... + (func $nats (param $n i32) (result i32) + (loop $l + (call $log (i32.const -1)) + (call $log (local.get $n)) + (suspend $send (local.get $n)) + (local.set $n (i32.add (local.get $n) (i32.const 1))) + (br $l) + ) + (unreachable) + ) + + ;; receive 10 nats and return their sum + (func $sum (param $dummy i32) (result i32) + (local $i i32) + (local $a i32) + (local.set $i (i32.const 10)) + (local.set $a (i32.const 0)) + (loop $l + (local.set $a (i32.add (local.get $a) (suspend $receive))) + (call $log (i32.const -2)) + (call $log (local.get $a)) + (local.set $i (i32.sub (local.get $i) (i32.const 1))) + (br_if $l (i32.ne (local.get $i) (i32.const 0))) + ) + (return (local.get $a)) + ) + + (func (export "run") (param $n i32) + (call $pipe (cont.bind (type $producer) (local.get $n) (cont.new (type $consumer) (ref.func $nats))) + (cont.new (type $consumer) (ref.func $sum)) + ) + ) +) + +(invoke "run" (i32.const 0)) diff --git a/proposals/continuations/examples/fun-state.wast b/proposals/continuations/examples/fun-state.wast new file mode 100644 index 000000000..0a5a094c0 --- /dev/null +++ b/proposals/continuations/examples/fun-state.wast @@ -0,0 +1,61 @@ +;; Simple state example - functional with heterogeneous continuations +(module $state + (event $get (result i32)) + (event $set (param i32)) + + (type $gf (func (param i32) (result i32))) + (type $sf (func (result i32))) + + (type $gk (cont $gf)) + (type $sk (cont $sf)) + + (func $getting (param $k (ref $gk)) (param $s i32) (result i32) + (block $on_get (result (ref $gk)) + (block $on_set (result i32 (ref $sk)) + (resume (event $get $on_get) (event $set $on_set) + (local.get $s) (local.get $k) + ) + (return) + ) ;; $on_set (result i32 (ref $sk)) + (return_call $setting) + ) ;; $on_get (result (ref $gk)) + (local.get $s) + (return_call $getting) + ) + + (func $setting (param $s i32) (param $k (ref $sk)) (result i32) + (block $on_get (result (ref $gk)) + (block $on_set (result i32 (ref $sk)) + (resume (event $get $on_get) (event $set $on_set) + (local.get $k) + ) + (return) + ) ;; $on_set (result i32 (ref $sk)) + (return_call $setting) + ) ;; $on_get (result (ref $gk)) + (local.get $s) + (return_call $getting) + ) + + (func $f (result i32) + (suspend $set (i32.const 7)) + (i32.add + (suspend $get) + (i32.mul + (i32.const 2) + (suspend $set (i32.const 3)) + (i32.add + (i32.const 3) + (suspend $get) + ) + ) + ) + ) + + (elem declare func $f) + (func (export "run") (result i32) + (call $setting (i32.const 0) (cont.new (type $sk) (ref.func $f))) + ) +) + +(assert_return (invoke "run") (i32.const 19)) diff --git a/proposals/continuations/examples/lwt.wast b/proposals/continuations/examples/lwt.wast new file mode 100644 index 000000000..4c35de08f --- /dev/null +++ b/proposals/continuations/examples/lwt.wast @@ -0,0 +1,293 @@ +;; dynamic lightweight threads + +;; interface to lightweight threads +(module $lwt + (type $func (func)) + (type $cont (cont $func)) + + (event $yield (export "yield")) + (event $fork (export "fork") (param (ref $cont))) +) +(register "lwt") + +(module $example + (type $func (func)) + (type $cont (cont $func)) + + (event $yield (import "lwt" "yield")) + (event $fork (import "lwt" "fork") (param (ref $cont))) + + (func $log (import "spectest" "print_i32") (param i32)) + + (elem declare func $thread1 $thread2 $thread3) + + (func $main (export "main") + (call $log (i32.const 0)) + (suspend $fork (cont.new (type $cont) (ref.func $thread1))) + (call $log (i32.const 1)) + (suspend $fork (cont.new (type $cont) (ref.func $thread2))) + (call $log (i32.const 2)) + (suspend $fork (cont.new (type $cont) (ref.func $thread3))) + (call $log (i32.const 3)) + ) + + (func $thread1 + (call $log (i32.const 10)) + (suspend $yield) + (call $log (i32.const 11)) + (suspend $yield) + (call $log (i32.const 12)) + ) + + (func $thread2 + (call $log (i32.const 20)) + (suspend $yield) + (call $log (i32.const 21)) + (suspend $yield) + (call $log (i32.const 22)) + ) + + (func $thread3 + (call $log (i32.const 30)) + (suspend $yield) + (call $log (i32.const 31)) + (suspend $yield) + (call $log (i32.const 32)) + ) +) +(register "example") + +(module $queue + (type $func (func)) + (type $cont (cont $func)) + + ;; Table as simple queue (keeping it simple, no ring buffer) + (table $queue 0 (ref null $cont)) + (global $qdelta i32 (i32.const 10)) + (global $qback (mut i32) (i32.const 0)) + (global $qfront (mut i32) (i32.const 0)) + + (func $queue-empty (export "queue-empty") (result i32) + (i32.eq (global.get $qfront) (global.get $qback)) + ) + + (func $dequeue (export "dequeue") (result (ref null $cont)) + (local $i i32) + (if (call $queue-empty) + (then (return (ref.null $cont))) + ) + (local.set $i (global.get $qfront)) + (global.set $qfront (i32.add (local.get $i) (i32.const 1))) + (table.get $queue (local.get $i)) + ) + + (func $enqueue (export "enqueue") (param $k (ref null $cont)) + ;; Check if queue is full + (if (i32.eq (global.get $qback) (table.size $queue)) + (then + ;; Check if there is enough space in the front to compact + (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) + (then + ;; Space is below threshold, grow table instead + (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) + ) + (else + ;; Enough space, move entries up to head of table + (global.set $qback (i32.sub (global.get $qback) (global.get $qfront))) + (table.copy $queue $queue + (i32.const 0) ;; dest = new front = 0 + (global.get $qfront) ;; src = old front + (global.get $qback) ;; len = new back = old back - old front + ) + (table.fill $queue ;; null out old entries to avoid leaks + (global.get $qback) ;; start = new back + (ref.null $cont) ;; init value + (global.get $qfront) ;; len = old front = old front - new front + ) + (global.set $qfront (i32.const 0)) + ) + ) + ) + ) + (table.set $queue (global.get $qback) (local.get $k)) + (global.set $qback (i32.add (global.get $qback) (i32.const 1))) + ) +) +(register "queue") + +(module $scheduler + (type $func (func)) + (type $cont (cont $func)) + + (event $yield (import "lwt" "yield")) + (event $fork (import "lwt" "fork") (param (ref $cont))) + + (func $queue-empty (import "queue" "queue-empty") (result i32)) + (func $dequeue (import "queue" "dequeue") (result (ref null $cont))) + (func $enqueue (import "queue" "enqueue") (param $k (ref null $cont))) + + ;; synchronous scheduler (run current thread to completion without + ;; yielding) + (func $sync (export "sync") (param $nextk (ref null $cont)) + (loop $l + (if (ref.is_null (local.get $nextk)) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fork (result (ref $cont) (ref $cont)) + (resume (event $yield $on_yield) + (event $fork $on_fork) + (local.get $nextk) + ) + (local.set $nextk (call $dequeue)) + (br $l) ;; thread terminated + ) ;; $on_fork (result (ref $cont) (ref $cont)) + (local.set $nextk) ;; current thread + (call $enqueue) ;; new thread + (br $l) + ) + ;; $on_yield (result (ref $cont)) + (local.set $nextk) ;; carry on with current thread + (br $l) + ) + ) + + ;; four asynchronous schedulers: + ;; * kt and tk don't yield on encountering a fork + ;; 1) kt runs the continuation, queuing up the new thread for later + ;; 2) tk runs the new thread first, queuing up the continuation for later + ;; * ykt and ytk do yield on encountering a fork + ;; 3) ykt runs the continuation, queuing up the new thread for later + ;; 4) ytk runs the new thread first, queuing up the continuation for later + + ;; no yield on fork, continuation first + (func $kt (export "kt") (param $nextk (ref null $cont)) + (loop $l + (if (ref.is_null (local.get $nextk)) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fork (result (ref $cont) (ref $cont)) + (resume (event $yield $on_yield) + (event $fork $on_fork) + (local.get $nextk) + ) + (local.set $nextk (call $dequeue)) + (br $l) ;; thread terminated + ) ;; $on_fork (result (ref $cont) (ref $cont)) + (local.set $nextk) ;; current thread + (call $enqueue) ;; new thread + (br $l) + ) + ;; $on_yield (result (ref $cont)) + (call $enqueue) ;; current thread + (local.set $nextk (call $dequeue)) ;; next thread + (br $l) + ) + ) + + ;; no yield on fork, new thread first + (func $tk (export "tk") (param $nextk (ref null $cont)) + (loop $l + (if (ref.is_null (local.get $nextk)) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fork (result (ref $cont) (ref $cont)) + (resume (event $yield $on_yield) + (event $fork $on_fork) + (local.get $nextk) + ) + (local.set $nextk (call $dequeue)) + (br $l) ;; thread terminated + ) ;; $on_fork (result (ref $cont) (ref $cont)) + (call $enqueue) ;; current thread + (local.set $nextk) ;; new thread + (br $l) + ) + ;; $on_yield (result (ref $cont)) + (call $enqueue) ;; current thread + (local.set $nextk (call $dequeue)) ;; next thread + (br $l) + ) + ) + + ;; yield on fork, continuation first + (func $ykt (export "ykt") (param $nextk (ref null $cont)) + (loop $l + (if (ref.is_null (local.get $nextk)) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fork (result (ref $cont) (ref $cont)) + (resume (event $yield $on_yield) + (event $fork $on_fork) + (local.get $nextk) + ) + (local.set $nextk (call $dequeue)) + (br $l) ;; thread terminated + ) ;; $on_fork (result (ref $cont) (ref $cont)) + (call $enqueue) ;; current thread + (call $enqueue) ;; new thread + (local.set $nextk (call $dequeue)) ;; next thread + (br $l) + ) + ;; $on_yield (result (ref $cont)) + (call $enqueue) ;; current thread + (local.set $nextk (call $dequeue)) ;; next thread + (br $l) + ) + ) + + ;; yield on fork, new thread first + (func $ytk (export "ytk") (param $nextk (ref null $cont)) + (loop $l + (if (ref.is_null (local.get $nextk)) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fork (result (ref $cont) (ref $cont)) + (resume (event $yield $on_yield) + (event $fork $on_fork) + (local.get $nextk) + ) + (local.set $nextk (call $dequeue)) + (br $l) ;; thread terminated + ) ;; $on_fork (result (ref $cont) (ref $cont)) + (local.set $nextk) + (call $enqueue) ;; new thread + (call $enqueue (local.get $nextk)) ;; current thread + (local.set $nextk (call $dequeue)) ;; next thread + (br $l) + ) + ;; $on_yield (result (ref $cont)) + (call $enqueue) ;; current thread + (local.set $nextk (call $dequeue)) ;; next thread + (br $l) + ) + ) +) +(register "scheduler") + +(module + (type $func (func)) + (type $cont (cont $func)) + + (func $scheduler1 (import "scheduler" "sync") (param $nextk (ref null $cont))) + (func $scheduler2 (import "scheduler" "kt") (param $nextk (ref null $cont))) + (func $scheduler3 (import "scheduler" "tk") (param $nextk (ref null $cont))) + (func $scheduler4 (import "scheduler" "ykt") (param $nextk (ref null $cont))) + (func $scheduler5 (import "scheduler" "ytk") (param $nextk (ref null $cont))) + + (func $log (import "spectest" "print_i32") (param i32)) + + (func $main (import "example" "main")) + + (elem declare func $main) + + (func (export "run") + (call $log (i32.const -1)) + (call $scheduler1 (cont.new (type $cont) (ref.func $main))) + (call $log (i32.const -2)) + (call $scheduler2 (cont.new (type $cont) (ref.func $main))) + (call $log (i32.const -3)) + (call $scheduler3 (cont.new (type $cont) (ref.func $main))) + (call $log (i32.const -4)) + (call $scheduler4 (cont.new (type $cont) (ref.func $main))) + (call $log (i32.const -5)) + (call $scheduler5 (cont.new (type $cont) (ref.func $main))) + (call $log (i32.const -6)) + ) +) + +(invoke "run") diff --git a/proposals/continuations/examples/pipes.wast b/proposals/continuations/examples/pipes.wast new file mode 100644 index 000000000..e5a91b3a2 --- /dev/null +++ b/proposals/continuations/examples/pipes.wast @@ -0,0 +1,95 @@ +;; Simple pipes example +(module $pipes + (type $pfun (func (result i32))) + (type $cfun (func (param i32) (result i32))) + (type $producer (cont $pfun)) + (type $consumer (cont $cfun)) + + (event $send (export "send") (param i32)) + (event $receive (export "receive") (result i32)) + + (func $piper (export "pipe") (param $p (ref $producer)) (param $c (ref $consumer)) + (local $n i32) + (local $consuming i32) + + (local.set $n (i32.const -1)) + (local.set $consuming (i32.const 1)) + + (loop $l + (if (local.get $consuming) + (then + (block $on-receive (result (ref $consumer)) + (resume (event $receive $on-receive) (local.get $n) (local.get $c)) + (return) + ) ;; receive + (local.set $c) + (local.set $consuming (i32.const 0)) + (br $l) + ) + ) ;; else producing + (block $on-send (result i32 (ref $producer)) + (resume (event $send $on-send) (local.get $p)) + (return) + ) ;; send + (local.set $p) + (local.set $n) + (local.set $consuming (i32.const 1)) + (br $l) + ) + ) +) + +(register "pipes") + +(module + (type $pfun (func (result i32))) + (type $cfun (func (param i32) (result i32))) + + (type $producer (cont $pfun)) + (type $consumer (cont $cfun)) + + (event $send (import "pipes" "send") (param i32)) + (event $receive (import "pipes" "receive") (result i32)) + + (func $pipe (import "pipes" "pipe") (param $p (ref $producer)) (param $c (ref $consumer))) + + (func $log (import "spectest" "print_i32") (param i32)) + + (elem declare func $nats $sum) + + ;; send n, n+1, ... + (func $nats (param $n i32) (result i32) + (loop $l + (call $log (i32.const -1)) + (call $log (local.get $n)) + (suspend $send (local.get $n)) + (local.set $n (i32.add (local.get $n) (i32.const 1))) + (br $l) + ) + (unreachable) + ) + + ;; receive 10 nats and return their sum + (func $sum (param $dummy i32) (result i32) + (local $i i32) + (local $a i32) + (local.set $i (i32.const 10)) + (local.set $a (i32.const 0)) + (loop $l + (local.set $a (i32.add (local.get $a) (suspend $receive))) + (call $log (i32.const -2)) + (call $log (local.get $a)) + (local.set $i (i32.sub (local.get $i) (i32.const 1))) + (br_if $l (i32.ne (local.get $i) (i32.const 0))) + ) + (return (local.get $a)) + ) + + (func (export "run") (param $n i32) + (call $pipe (cont.bind (type $producer) (local.get $n) (cont.new (type $consumer) (ref.func $nats))) + (cont.new (type $consumer) (ref.func $sum)) + ) + ) +) + +(invoke "run" (i32.const 0)) diff --git a/proposals/continuations/examples/static-lwt.wast b/proposals/continuations/examples/static-lwt.wast new file mode 100644 index 000000000..a5538638d --- /dev/null +++ b/proposals/continuations/examples/static-lwt.wast @@ -0,0 +1,151 @@ +;; static lightweight threads + +;; interface to a fixed collection of lightweight threads +(module $lwt + (event $yield (export "yield")) +) +(register "lwt") + +(module $example + (event $yield (import "lwt" "yield")) + (func $log (import "spectest" "print_i32") (param i32)) + + (func $thread1 (export "thread1") + (call $log (i32.const 10)) + (suspend $yield) + (call $log (i32.const 11)) + (suspend $yield) + (call $log (i32.const 12)) + ) + + (func $thread2 (export "thread2") + (call $log (i32.const 20)) + (suspend $yield) + (call $log (i32.const 21)) + (suspend $yield) + (call $log (i32.const 22)) + ) + + (func $thread3 (export "thread3") + (call $log (i32.const 30)) + (suspend $yield) + (call $log (i32.const 31)) + (suspend $yield) + (call $log (i32.const 32)) + ) +) +(register "example") + +;; queue of threads +(module $queue + (type $func (func)) + (type $cont (cont $func)) + + ;; Table as simple queue (keeping it simple, no ring buffer) + (table $queue 0 (ref null $cont)) + (global $qdelta i32 (i32.const 10)) + (global $qback (mut i32) (i32.const 0)) + (global $qfront (mut i32) (i32.const 0)) + + (func $queue-empty (export "queue-empty") (result i32) + (i32.eq (global.get $qfront) (global.get $qback)) + ) + + (func $dequeue (export "dequeue") (result (ref null $cont)) + (local $i i32) + (if (call $queue-empty) + (then (return (ref.null $cont))) + ) + (local.set $i (global.get $qfront)) + (global.set $qfront (i32.add (local.get $i) (i32.const 1))) + (table.get $queue (local.get $i)) + ) + + (func $enqueue (export "enqueue") (param $k (ref $cont)) + ;; Check if queue is full + (if (i32.eq (global.get $qback) (table.size $queue)) + (then + ;; Check if there is enough space in the front to compact + (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) + (then + ;; Space is below threshold, grow table instead + (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) + ) + (else + ;; Enough space, move entries up to head of table + (global.set $qback (i32.sub (global.get $qback) (global.get $qfront))) + (table.copy $queue $queue + (i32.const 0) ;; dest = new front = 0 + (global.get $qfront) ;; src = old front + (global.get $qback) ;; len = new back = old back - old front + ) + (table.fill $queue ;; null out old entries to avoid leaks + (global.get $qback) ;; start = new back + (ref.null $cont) ;; init value + (global.get $qfront) ;; len = old front = old front - new front + ) + (global.set $qfront (i32.const 0)) + ) + ) + ) + ) + (table.set $queue (global.get $qback) (local.get $k)) + (global.set $qback (i32.add (global.get $qback) (i32.const 1))) + ) +) +(register "queue") + +(module $scheduler + (type $func (func)) + (type $cont (cont $func)) + + (event $yield (import "lwt" "yield")) + + ;; queue interface + (func $queue-empty (import "queue" "queue-empty") (result i32)) + (func $dequeue (import "queue" "dequeue") (result (ref null $cont))) + (func $enqueue (import "queue" "enqueue") (param $k (ref $cont))) + + (func $run (export "run") + (loop $l + (if (call $queue-empty) (then (return))) + (block $on_yield (result (ref $cont)) + (resume (event $yield $on_yield) + (call $dequeue) + ) + (br $l) ;; thread terminated + ) ;; $on_yield (result (ref $cont)) + (call $enqueue) ;; continuation of current thread + (br $l) + ) + ) +) +(register "scheduler") + +(module + (type $func (func)) + (type $cont (cont $func)) + + (func $scheduler (import "scheduler" "run")) + (func $enqueue (import "queue" "enqueue") (param (ref $cont))) + + (func $log (import "spectest" "print_i32") (param i32)) + + (func $thread1 (import "example" "thread1")) + (func $thread2 (import "example" "thread2")) + (func $thread3 (import "example" "thread3")) + + (elem declare func $thread1 $thread2 $thread3) + + (func (export "run") + (call $enqueue (cont.new (type $cont) (ref.func $thread1))) + (call $enqueue (cont.new (type $cont) (ref.func $thread2))) + (call $enqueue (cont.new (type $cont) (ref.func $thread3))) + + (call $log (i32.const -1)) + (call $scheduler) + (call $log (i32.const -2)) + ) +) + +(invoke "run") From ce9860d53b7902c2b2054483f2c3be309bba2ea5 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Thu, 15 Apr 2021 13:13:00 +0200 Subject: [PATCH 45/82] Add overview of formal rules (#11) --- interpreter/valid/valid.ml | 10 +- proposals/continuations/Overview.md | 158 ++++++++++++++++++++++++++++ 2 files changed, 163 insertions(+), 5 deletions(-) create mode 100644 proposals/continuations/Overview.md diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index a934daf74..934db4d0d 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -516,12 +516,12 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : op_type let EventType (FuncType (ts3, ts4), res) = event c x1 in require (res = Resumable) x1.at "handling a non-resumable event"; match Lib.List.last_opt (label c x2) with - | Some (RefType (NonNullable, DefHeapType (SynVar y'))) -> + | Some (RefType (nul', DefHeapType (SynVar y'))) -> let ContType z' = cont_type c (y' @@ x2.at) in - let FuncType (ts1', ts2') = func_type c (as_syn_var z' @@ x2.at) in - check_stack c ts4 ts1' x2.at; - check_stack c ts2 ts2' x2.at; - check_stack c (ts3 @ [RefType (NonNullable, DefHeapType (SynVar y'))]) (label c x2) x2.at + let ft' = func_type c (as_syn_var z' @@ x2.at) in + require (match_func_type c.types [] (FuncType (ts4, ts2)) ft') x2.at + "type mismatch in continuation type"; + check_stack c (ts3 @ [RefType (nul', DefHeapType (SynVar y'))]) (label c x2) x2.at | _ -> error e.at ("type mismatch: instruction requires continuation reference type" ^ diff --git a/proposals/continuations/Overview.md b/proposals/continuations/Overview.md new file mode 100644 index 000000000..70b1312f8 --- /dev/null +++ b/proposals/continuations/Overview.md @@ -0,0 +1,158 @@ +# Typed Continuations for WebAssembly + +## Language Extensions + +Based on [typed reference proposal](https://github.com/WebAssembly/function-references/blob/master/proposals/function-references/Overview.md) and [exception handling proposal](https://github.com/WebAssembly/exception-handling/blob/master/proposals/exception-handling/Exceptions.md). + + +### Types + +#### Defined Types + +* `cont ` is a new form of defined type + - `(cont $ft) ok` iff `$ft ok` and `$ft = [t1*] -> [t2*]` + + +### Instructions + +* `cont.new ` creates a new continuation + - `cont.new $ct : [(ref null? $ft)] -> [(ref $ct)]` + - iff `$ct = cont $ft` + +* `cont.bind ` binds a continuation to (partial) arguments + - `cont.bind $ct : [t3* (ref null? $ct')] -> [(ref $ct)]` + - iff `$ct = cont $ft` + - and `$ft = [t1*] -> [t2*]` + - and `$ct' = cont $ft'` + - and `$ft' = [t3* t1'*] -> [t2'*]` + - and `[t1'*] -> [t2'*] <: [t1*] -> [t2*]` + +* `suspend ` suspends the current continuation + - `suspend $e : [t1*] -> [t2*]` + - iff `event $e : [t1*] -> [t2*]` + +* `resume (event )*` resumes a continuation + - `resume (event $e $l)* : [t1* (ref null? $ct)] -> [t2*]` + - iff `$ct = cont $ft` + - and `$ft = [t1*] -> [t2*]` + - and `(event $e : [te1*] -> [te2*])*` + - and `(label $l : [te1'* (ref null? $ct')])*` + - and `([te1*] <: [te1'*])*` + - and `($ct' = cont $ft')*` + - and `([te2*] -> [t2*] <: $ft')*` + +* `resume_throw ` aborts a continuation + - `resume_throw $e : [te* (ref null? $ct)] -> [t2*]` + - iff `exception $e : [te*]` + - and `$ct = cont $ft` + - and `$ft = [t1*] -> [t2*]` + +* `barrier * end` blocks suspension + - `barrier $l bt instr* end : [t1*] -> [t2*]` + - iff `bt = [t1*] -> [t2*]` + - and `instr* : [t1*] -> [t2*]` with labels extended with `[t2*]` + + +## Reduction Semantics + +### Store extensions + +* New store component `evts` for allocated events + - `S ::= {..., evts *}` + +* An *event instance* represents an event tag + - `evtinst ::= {type }` + +* New store component `conts` for allocated continuations + - `S ::= {..., conts ?*}` + +* A continuation is a context annotated with its hole's arity + - `cont ::= (E : n)` + + +### Administrative instructions + +* `(ref.cont a)` represents a continuation value, where `a` is a *continuation address* indexing into the store's `conts` component + - `ref.cont a : [] -> [(ref $ct)]` + - iff `S.conts[a] = epsilon \/ S.conts[a] = (E : n)` + - and `$ct = cont $ft` + - and `$ft = [t1^n] -> [t2*]` + +* `(handle{( )*}? * end)` represents an active handler (or a barrier when no handler list is present) + - `(handle{(a $l)*}? instr* end) : [t1*] -> [t2*]` + - iff `instr* : [t1*] -> [t2*]` + - and `(S.evts[a].type = [te1*] -> [te2*])*` + - and `(label $l : [te1'* (ref null? $ct')])*` + - and `([te1*] <: [te1'*])*` + - and `($ct' = cont $ft')*` + - and `([te2*] -> [t2*] <: $ft')*` + + +### Handler contexts + +``` +H^ea ::= + _ + val* H^ea instr* + label_n{instr*} H^ea end + frame_n{F} H^ea end + catch{...} H^ea end + handle{(ea' $l)*} H^ea end (iff ea notin ea'*) +``` + + +### Reduction + +* `S; F; (ref.null t) (cont.new $ct) --> S; F; trap` + +* `S; F; (ref.func fa) (cont.new $ct) --> S'; F; (ref.cont |S.conts|)` + - iff `S' = S with conts += (E : n)` + - and `E = _ (invoke fa)` + - and `$ct = cont $ft` + - and `$ft = [t1^n] -> [t2*]` + +* `S; F; (ref.null t) (cont.bind $ct) --> S; F; trap` + +* `S; F; (ref.cont ca) (cont.bind $ct) --> S'; F; trap` + - iff `S.conts[ca] = epsilon` + +* `S; F; v^n (ref.cont ca) (cont.bind $ct) --> S'; F; (ref.const |S.conts|)` + - iff `S.conts[ca] = (E' : n')` + - and `$ct = cont $ft` + - and `$ft = [t1'*] -> [t2'*]` + - and `n = n' - |t1'*|` + - and `S' = S with conts[ca] = epsilon with conts += (E : |t1'*|)` + - and `E = E'[v^n _]` + +* `S; F; (ref.null t) (resume (event $e $l)*) --> S; F; trap` + +* `S; F; (ref.cont ca) (resume (event $e $l)*) --> S; F; trap` + - iff `S.conts[ca] = epsilon` + +* `S; F; v^n (ref.cont ca) (resume (event $e $l)*) --> S'; F; handle{(ea $l)*} E[v^n] end` + - iff `S.conts[ca] = (E : n)` + - and `(ea = F.evts[$e])*` + - and `S' = S with conts[ca] = epsilon` + +* `S; F; (ref.null t) (resume_throw $e) --> S; F; trap` + +* `S; F; (ref.cont ca) (resume_throw $e) --> S; F; trap` + - iff `S.conts[ca] = epsilon` + +* `S; F; v^m (ref.cont ca) (resume_throw $e) --> S'; F; E[v^m (throw $e)]` + - iff `S.conts[ca] = (E : n)` + - and `S.evts[F.evts[$e]].type = [t1^m] -> [t2*]` + - and `S' = S with conts[ca] = epsilon` + +* `S; F; (barrier bt instr* end) --> S; F; handle instr* end` + +* `S; F; (handle{(e $l)*}? v* end) --> S; F; v*` + +* `S; F; (handle H^ea[(suspend $e)] end) --> S; F; trap` + - iff `ea = F.evts[$e]` + +* `S; F; (handle{(ea1 $l1)* (ea $l) (ea2 $l2)*} H^ea[v^n (suspend $e)] end) --> S'; F; v^n (ref.cont |S.conts|) (br $l)` + - iff `ea notin ea1*` + - and `ea = F.evts[$e]` + - and `S.evts[ea].type = [t1^n] -> [t2^m]` + - and `S' = S with conts += (H^ea : m)` From a6c90c8b86150410d962d7f8a232b1a8dcf46e67 Mon Sep 17 00:00:00 2001 From: Anirudh S Date: Thu, 23 Sep 2021 17:43:22 +0530 Subject: [PATCH 46/82] Added mvar implementation --- test/core/cont.wast | 473 ++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 473 insertions(+) diff --git a/test/core/cont.wast b/test/core/cont.wast index 55a5923aa..df9da29e0 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -538,3 +538,476 @@ (i32.const 0) (i32.const 1) (i32.const 2) (i32.const 3) (i32.const 4) (i32.const 5) (i32.const 6) ) + +;; MVar implementation +;; Scheduler + +(module $scheduler2 + (type $proc (func)) + (type $cont (cont $proc)) + (type $susp_fn (func (param (ref null $cont)))) + + (event $yield (export "yield")) + (event $spawn (export "spawn") (param (ref $proc))) + (event $suspend (export "suspend") (param (ref $susp_fn))) + (event $resume (export "resume") (param (ref null $cont))) + + ;; Table as simple queue (keeping it simple, no ring buffer) + (table $curr_proc 0 (ref null $cont)) + (table $queue 0 (ref null $cont)) + + (global $qdelta i32 (i32.const 10)) + (global $qback (mut i32) (i32.const 0)) + (global $qfront (mut i32) (i32.const 0)) + (global $curr_status (mut i32) (i32.const 0)) + + (func $queue-empty (result i32) + (i32.eq (global.get $qfront) (global.get $qback)) + ) + + (func $dequeue (result (ref null $cont)) + (local $i i32) + (if (call $queue-empty) + (then (return (ref.null $cont))) + ) + (local.set $i (global.get $qfront)) + (global.set $qfront (i32.add (local.get $i) (i32.const 1))) + (table.get $queue (local.get $i)) + ) + + (func $enqueue (param $k (ref null $cont)) + ;; Check if queue is full + (if (i32.eq (global.get $qback) (table.size $queue)) + (then + ;; Check if there is enough space in the front to compact + (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) + (then + ;; Space is below threshold, grow table instead + (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) + ) + (else + ;; Enough space, move entries up to head of table + (global.set $qback (i32.sub (global.get $qback) (global.get $qfront))) + (table.copy $queue $queue + (i32.const 0) ;; dest = new front = 0 + (global.get $qfront) ;; src = old front + (global.get $qback) ;; len = new back = old back - old front + ) + (table.fill $queue ;; null out old entries to avoid leaks + (global.get $qback) ;; start = new back + (ref.null $cont) ;; init value + (global.get $qfront) ;; len = old front = old front - new front + ) + (global.set $qfront (i32.const 0)) + ) + ) + ) + ) + (table.set $queue (global.get $qback) (local.get $k)) + (global.set $qback (i32.add (global.get $qback) (i32.const 1))) + ) + + (func $curr-empty (result i32) + (i32.eqz (global.get $curr_status)) + ) + + (func $curr_set (param $k (ref null $cont)) + (global.set $curr_status (i32.const 1)) + (table.set $curr_proc (i32.const 0) (local.get $k)) + ) + + (func $curr_get (result (ref null $cont)) + (global.set $curr_status (i32.const 0)) + (table.get $curr_proc (i32.const 0)) + ) + + (func $exec_susp_fn (param $f (ref $susp_fn)) (param $k (ref $cont)) + ;; Bind k to f and make it the next thread to be executed + (cont.new (type $cont) (func.bind (type $proc) (local.get $k) (local.get $f))) + (call $curr_set) + ) + + (func $scheduler (export "scheduler") (param $main (ref $proc)) + (drop (table.grow $curr_proc (ref.null $cont) (i32.const 1))) + (call $curr_set (cont.new (type $cont) (local.get $main))) + (loop $l + (if (call $curr-empty) + (then + (if (call $queue-empty) + (then (return)) + (else + (call $curr_set (call $dequeue)) + ) + ) + ) + ) + (block $on_yield (result (ref $cont)) + (block $on_spawn (result (ref $proc) (ref $cont)) + (block $on_suspend (result (ref $susp_fn) (ref $cont)) + (block $on_resume (result (ref null $cont) (ref $cont)) + (resume (event $yield $on_yield) (event $spawn $on_spawn) + (event $suspend $on_suspend) (event $resume $on_resume) + (call $curr_get) + ) + (br $l) ;; thread terminated + ) + ;; on resume, cont (resumption) and cont (curr) on stack + (call $curr_set) ;; continuation of old thread + (call $enqueue) ;; thread to be resumed + (br $l) + ) + ;; on suspend, susp_fn and cont on stack + (call $exec_susp_fn) + (br $l) + ) + ;; on $spawn, proc and cont on stack + (call $enqueue) ;; continuation of old thread + (cont.new (type $cont)) + (call $enqueue) ;; new thread + (br $l) + ) + ;; on $yield, cont on stack + (call $enqueue) + (br $l) + ) + ) +) + +(register "scheduler2") + +;; Producer queue + +(module $producer_queue + (type $proc (func)) + (type $cont (cont $proc)) + + ;; Table as simple queue (keeping it simple, no ring buffer) + (table $queue 0 (ref null $cont)) + (global $qdelta i32 (i32.const 10)) + (global $qback (mut i32) (i32.const 0)) + (global $qfront (mut i32) (i32.const 0)) + + (func $queue-empty (export "queue-empty") (result i32) + (i32.eq (global.get $qfront) (global.get $qback)) + ) + + (func $dequeue (export "dequeue") (result (ref null $cont)) + (local $i i32) + (if (call $queue-empty) + (then (return (ref.null $cont))) + ) + (local.set $i (global.get $qfront)) + (global.set $qfront (i32.add (local.get $i) (i32.const 1))) + (table.get $queue (local.get $i)) + ) + + (func $enqueue (export "enqueue") (param $k (ref null $cont)) + ;; Check if queue is full + (if (i32.eq (global.get $qback) (table.size $queue)) + (then + ;; Check if there is enough space in the front to compact + (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) + (then + ;; Space is below threshold, grow table instead + (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) + ) + (else + ;; Enough space, move entries up to head of table + (global.set $qback (i32.sub (global.get $qback) (global.get $qfront))) + (table.copy $queue $queue + (i32.const 0) ;; dest = new front = 0 + (global.get $qfront) ;; src = old front + (global.get $qback) ;; len = new back = old back - old front + ) + (table.fill $queue ;; null out old entries to avoid leaks + (global.get $qback) ;; start = new back + (ref.null $cont) ;; init value + (global.get $qfront) ;; len = old front = old front - new front + ) + (global.set $qfront (i32.const 0)) + ) + ) + ) + ) + (table.set $queue (global.get $qback) (local.get $k)) + (global.set $qback (i32.add (global.get $qback) (i32.const 1))) + ) +) + +(register "producer_queue") + +;; Consumer queue + +(module $consumer_queue + (type $proc (func)) + (type $cont (cont $proc)) + + ;; Table as simple queue (keeping it simple, no ring buffer) + (table $queue 0 (ref null $cont)) + (global $qdelta i32 (i32.const 10)) + (global $qback (mut i32) (i32.const 0)) + (global $qfront (mut i32) (i32.const 0)) + + (func $queue-empty (export "queue-empty") (result i32) + (i32.eq (global.get $qfront) (global.get $qback)) + ) + + (func $dequeue (export "dequeue") (result (ref null $cont)) + (local $i i32) + (if (call $queue-empty) + (then (return (ref.null $cont))) + ) + (local.set $i (global.get $qfront)) + (global.set $qfront (i32.add (local.get $i) (i32.const 1))) + (table.get $queue (local.get $i)) + ) + + (func $enqueue (export "enqueue") (param $k (ref null $cont)) + ;; Check if queue is full + (if (i32.eq (global.get $qback) (table.size $queue)) + (then + ;; Check if there is enough space in the front to compact + (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) + (then + ;; Space is below threshold, grow table instead + (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) + ) + (else + ;; Enough space, move entries up to head of table + (global.set $qback (i32.sub (global.get $qback) (global.get $qfront))) + (table.copy $queue $queue + (i32.const 0) ;; dest = new front = 0 + (global.get $qfront) ;; src = old front + (global.get $qback) ;; len = new back = old back - old front + ) + (table.fill $queue ;; null out old entries to avoid leaks + (global.get $qback) ;; start = new back + (ref.null $cont) ;; init value + (global.get $qfront) ;; len = old front = old front - new front + ) + (global.set $qfront (i32.const 0)) + ) + ) + ) + ) + (table.set $queue (global.get $qback) (local.get $k)) + (global.set $qback (i32.add (global.get $qback) (i32.const 1))) + ) +) + +(register "consumer_queue") + +;; MVar + +(module $mvar + (type $proc (func)) + (type $cont (cont $proc)) + (type $susp_fn (func (param (ref null $cont)))) + + (event $yield (import "scheduler2" "yield")) + (event $spawn (import "scheduler2" "spawn") (param (ref $proc))) + (event $suspend (import "scheduler2" "suspend") (param (ref $susp_fn))) + (event $resume (import "scheduler2" "resume") (param (ref null $cont))) + + (func $scheduler (import "scheduler2" "scheduler") (param $main (ref $proc))) + + (func $pq-empty (import "producer_queue" "queue-empty") (result i32)) + (func $pq-dequeue (import "producer_queue" "dequeue") (result (ref null $cont))) + (func $pq-enqueue (import "producer_queue" "enqueue") (param (ref null $cont))) + + (func $cq-empty (import "consumer_queue" "queue-empty") (result i32)) + (func $cq-dequeue (import "consumer_queue" "dequeue") (result (ref null $cont))) + (func $cq-enqueue (import "consumer_queue" "enqueue") (param (ref null $cont))) + + (func $log (import "spectest" "print_i32") (param i32)) + + (global $data (mut i32) (i32.const 0)) + (global $state (mut i32) (i32.const 0)) + ;; States + ;; 0 - Empty (can write) + ;; 1 - Blocked (some other write/read operation is pending) + ;; 2 - Full (can read) + + (elem declare func $prod_susp_fn $cons_susp_fn) + + (func $prod_susp_fn (param $k (ref null $cont)) + (call $pq-enqueue (local.get $k)) + ) + + (func $cons_susp_fn (param $k (ref null $cont)) + (call $cq-enqueue (local.get $k)) + ) + + (func (export "fork") (param $f (ref $proc)) + (suspend $spawn (local.get $f)) + ) + + (func (export "put") (param $value i32) + (if (i32.gt_s (global.get $state) (i32.const 0)) + (then + (suspend $suspend (ref.func $prod_susp_fn)) + ;; Added to queue; Resumed only when it is its turn + ) + ) + + ;; Set the value + (global.set $data (local.get $value)) + (global.set $state (i32.const 2)) + + (if (i32.ne (call $cq-empty) (i32.const 1)) + (then + ;; Block all operations for new threads and resume the next consumer + (global.set $state (i32.const 1)) + (suspend $resume (call $cq-dequeue)) + ) + ) + ) + + (func (export "take") (result i32) + (local $read i32) + + (if (i32.lt_s (global.get $state) (i32.const 2)) + (then + (suspend $suspend (ref.func $cons_susp_fn)) + ;; Added to queue; Resumed only when it is its turn + ) + ) + + ;; Read the value + (global.set $state (i32.const 0)) + (local.set $read (global.get $data)) + + (if (i32.ne (call $pq-empty) (i32.const 1)) + (then + ;; Block all operations for new threads and resume the next producer + (global.set $state (i32.const 1)) + (suspend $resume (call $pq-dequeue)) + ) + ) + + (local.get $read) + ) + + (func (export "run") (param $f (ref $proc)) + (call $scheduler (local.get $f)) + ) +) + +(register "mvar") + + +(module + (type $proc (func)) + (func $fork (import "mvar" "fork") (param (ref $proc))) + (func $put (import "mvar" "put") (param i32)) + (func $take (import "mvar" "take") (result i32)) + (func $run (import "mvar" "run") (param (ref $proc))) + + (func $log (import "spectest" "print_i32") (param i32)) + + (exception $error) + + (elem declare func $producer $consumer $prod3 $cons3 $test1 $test2 $test3 $test4 $test5 $test6) + + (func $producer (param $v i32) + (call $put (local.get $v)) + ) + + (func $consumer (param $v i32) + (if (i32.ne (call $take) (local.get $v)) + (then (throw $error)) + ) + ) + + (func $prod3 + (call $producer (i32.const 1)) + (call $producer (i32.const 2)) + (call $producer (i32.const 3)) + ) + + (func $cons3 + (call $consumer (i32.const 1)) + (call $consumer (i32.const 2)) + (call $consumer (i32.const 3)) + ) + + (func $test1 + (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $producer))) + (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $consumer))) + ) + + (func $test2 + (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $consumer))) + (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $producer))) + ) + + (func $test3 + (call $fork (ref.func $prod3)) + (call $fork (ref.func $cons3)) + ) + + (func $test4 + (call $fork (ref.func $cons3)) + (call $fork (ref.func $prod3)) + ) + + (func $test5 + (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $producer))) + (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $consumer))) + (call $fork (func.bind (type $proc) (i32.const 2) (ref.func $producer))) + (call $fork (func.bind (type $proc) (i32.const 2) (ref.func $consumer))) + (call $fork (func.bind (type $proc) (i32.const 3) (ref.func $producer))) + (call $fork (func.bind (type $proc) (i32.const 3) (ref.func $consumer))) + ) + + (func $test6 + (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $consumer))) + (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $producer))) + (call $fork (func.bind (type $proc) (i32.const 2) (ref.func $consumer))) + (call $fork (func.bind (type $proc) (i32.const 2) (ref.func $producer))) + (call $fork (func.bind (type $proc) (i32.const 3) (ref.func $consumer))) + (call $fork (func.bind (type $proc) (i32.const 3) (ref.func $producer))) + ) + + (func $runtest (export "run") (param $f (ref $proc)) + (call $run (local.get $f)) + ) + + (func (export "test1") + (call $log (i32.const 1)) + (call $runtest (ref.func $test1)) + ) + + (func (export "test2") + (call $log (i32.const 2)) + (call $runtest (ref.func $test2)) + ) + + (func (export "test3") + (call $log (i32.const 3)) + (call $runtest (ref.func $test3)) + ) + + (func (export "test4") + (call $log (i32.const 4)) + (call $runtest (ref.func $test4)) + ) + + (func (export "test5") + (call $log (i32.const 5)) + (call $runtest (ref.func $test5)) + ) + + (func (export "test6") + (call $log (i32.const 6)) + (call $runtest (ref.func $test6)) + ) +) + +(assert_return (invoke "test1")) +(assert_return (invoke "test2")) +(assert_return (invoke "test3")) +(assert_return (invoke "test4")) +(assert_return (invoke "test5")) +(assert_return (invoke "test6")) + From e991efeb79e8646fcccbe23d7e652f6a505d5d47 Mon Sep 17 00:00:00 2001 From: Anirudh S Date: Tue, 28 Sep 2021 19:09:16 +0530 Subject: [PATCH 47/82] Added comments --- test/core/cont.wast | 44 +++++++++++++++++++++++++++++++++----------- 1 file changed, 33 insertions(+), 11 deletions(-) diff --git a/test/core/cont.wast b/test/core/cont.wast index df9da29e0..d31b51dd4 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -553,12 +553,18 @@ (event $resume (export "resume") (param (ref null $cont))) ;; Table as simple queue (keeping it simple, no ring buffer) - (table $curr_proc 0 (ref null $cont)) (table $queue 0 (ref null $cont)) - (global $qdelta i32 (i32.const 10)) - (global $qback (mut i32) (i32.const 0)) - (global $qfront (mut i32) (i32.const 0)) + ;; Holds the continuation which will be resumed next + (table $curr_proc 0 (ref null $cont)) + + ;; Queue variables + (global $qdelta i32 (i32.const 10)) ;; Threshold for allocating more space in the queue table + ;; If front > threshold, entries are moved instead + (global $qback (mut i32) (i32.const 0)) ;; Index of front of queue + (global $qfront (mut i32) (i32.const 0)) ;; Index of back of queue + + ;; Holds the status of curr_proc (1 -> Set, 0 -> Not set) (global $curr_status (mut i32) (i32.const 0)) (func $queue-empty (result i32) @@ -607,6 +613,7 @@ (global.set $qback (i32.add (global.get $qback) (i32.const 1))) ) + ;; Check if curr_proc is set or not. Return 1 if not set. (func $curr-empty (result i32) (i32.eqz (global.get $curr_status)) ) @@ -628,11 +635,18 @@ ) (func $scheduler (export "scheduler") (param $main (ref $proc)) + ;; Allocate space for curr_proc (drop (table.grow $curr_proc (ref.null $cont) (i32.const 1))) + + ;; Add the function to process queue (call $curr_set (cont.new (type $cont) (local.get $main))) + (loop $l (if (call $curr-empty) - (then + (then + ;; curr_proc not set + ;; If process queue is empty, no more processes to execute + ;; Else set curr_proc to the front of the queue (if (call $queue-empty) (then (return)) (else @@ -683,9 +697,12 @@ ;; Table as simple queue (keeping it simple, no ring buffer) (table $queue 0 (ref null $cont)) - (global $qdelta i32 (i32.const 10)) - (global $qback (mut i32) (i32.const 0)) - (global $qfront (mut i32) (i32.const 0)) + + ;; Queue variables + (global $qdelta i32 (i32.const 10)) ;; Threshold for allocating more space in the queue table + ;; If front > threshold, entries are moved instead + (global $qback (mut i32) (i32.const 0)) ;; Index of front of queue + (global $qfront (mut i32) (i32.const 0)) ;; Index of back of queue (func $queue-empty (export "queue-empty") (result i32) (i32.eq (global.get $qfront) (global.get $qback)) @@ -744,9 +761,12 @@ ;; Table as simple queue (keeping it simple, no ring buffer) (table $queue 0 (ref null $cont)) - (global $qdelta i32 (i32.const 10)) - (global $qback (mut i32) (i32.const 0)) - (global $qfront (mut i32) (i32.const 0)) + + ;; Queue variables + (global $qdelta i32 (i32.const 10)) ;; Threshold for allocating more space in the queue table + ;; If front > threshold, entries are moved instead + (global $qback (mut i32) (i32.const 0)) ;; Index of front of queue + (global $qfront (mut i32) (i32.const 0)) ;; Index of back of queue (func $queue-empty (export "queue-empty") (result i32) (i32.eq (global.get $qfront) (global.get $qback)) @@ -830,10 +850,12 @@ (elem declare func $prod_susp_fn $cons_susp_fn) + ;; Producer suspension function (func $prod_susp_fn (param $k (ref null $cont)) (call $pq-enqueue (local.get $k)) ) + ;; Consumer suspension function (func $cons_susp_fn (param $k (ref null $cont)) (call $cq-enqueue (local.get $k)) ) From 6b6f0e3d7c528daab1967e4b95562dda87630d27 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= <1827113+dhil@users.noreply.github.com> Date: Tue, 14 Dec 2021 15:57:05 +0000 Subject: [PATCH 48/82] Explainer document (#14) Add explainer document for Typed Continuations proposal. Co-authored-by: Sam Lindley Co-authored-by: Andreas Rossberg --- interpreter/binary/decode.ml | 26 +- interpreter/binary/encode.ml | 22 +- interpreter/exec/eval.ml | 74 +- interpreter/host/spectest.ml | 8 +- interpreter/runtime/event.ml | 10 - interpreter/runtime/event.mli | 7 - interpreter/runtime/instance.ml | 10 +- interpreter/runtime/tag.ml | 10 + interpreter/runtime/tag.mli | 7 + interpreter/syntax/ast.ml | 24 +- interpreter/syntax/free.ml | 24 +- interpreter/syntax/free.mli | 4 +- interpreter/syntax/types.ml | 22 +- interpreter/text/arrange.ml | 16 +- interpreter/text/lexer.mll | 2 +- interpreter/text/parser.mly | 90 +- interpreter/valid/match.ml | 8 +- interpreter/valid/valid.ml | 52 +- proposals/continuations/Explainer.md | 1679 +++++++++++++++++ proposals/continuations/Overview.md | 42 +- .../continuations/examples/actor-lwt.wast | 314 ++- proposals/continuations/examples/actor.wast | 113 +- .../continuations/examples/async-await.wast | 48 +- .../continuations/examples/control-lwt.wast | 341 ++++ .../continuations/examples/fun-actor-lwt.wast | 54 +- proposals/continuations/examples/fun-lwt.wast | 196 +- .../continuations/examples/fun-pipes.wast | 12 +- .../continuations/examples/fun-state.wast | 8 +- proposals/continuations/examples/lwt.wast | 123 +- proposals/continuations/examples/pipes.wast | 12 +- .../continuations/examples/static-lwt.wast | 8 +- test/core/cont.wast | 52 +- 32 files changed, 2855 insertions(+), 563 deletions(-) delete mode 100644 interpreter/runtime/event.ml delete mode 100644 interpreter/runtime/event.mli create mode 100644 interpreter/runtime/tag.ml create mode 100644 interpreter/runtime/tag.mli create mode 100644 proposals/continuations/Explainer.md create mode 100644 proposals/continuations/examples/control-lwt.wast diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index 2ed751c1d..0ad7118b4 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -210,10 +210,10 @@ let resumability s = | 1 -> Resumable | _ -> error s (pos s - 1) "malformed resumability" -let event_type s = +let tag_type s = let res = resumability s in let ft = func_type s in (* TODO *) - EventType (ft, res) + TagType (ft, res) let mutability s = match u8 s with @@ -633,7 +633,7 @@ let id s = | 10 -> `CodeSection | 11 -> `DataSection | 12 -> `DataCountSection - | 13 -> `EventSection + | 13 -> `TagSection | _ -> error s (pos s) "malformed section id" ) bo @@ -662,7 +662,7 @@ let import_desc s = | 0x01 -> TableImport (table_type s) | 0x02 -> MemoryImport (memory_type s) | 0x03 -> GlobalImport (global_type s) - | 0x04 -> EventImport (event_type s) + | 0x04 -> TagImport (tag_type s) | _ -> error s (pos s - 1) "malformed import kind" let import s = @@ -701,14 +701,14 @@ let memory_section s = section `MemorySection (vec (at memory)) [] s -(* Event section *) +(* Tag section *) -let event s = - let evtype = event_type s in - {evtype} +let tag s = + let tagtype = tag_type s in + {tagtype} -let event_section s = - section `EventSection (vec (at event)) [] s +let tag_section s = + section `TagSection (vec (at tag)) [] s (* Global section *) @@ -730,7 +730,7 @@ let export_desc s = | 0x01 -> TableExport (at var s) | 0x02 -> MemoryExport (at var s) | 0x03 -> GlobalExport (at var s) - | 0x04 -> EventExport (at var s) + | 0x04 -> TagExport (at var s) | _ -> error s (pos s - 1) "malformed export kind" let export s = @@ -903,7 +903,7 @@ let module_ s = iterate custom_section s; let memories = memory_section s in iterate custom_section s; - let events = event_section s in + let tags = tag_section s in iterate custom_section s; let globals = global_section s in iterate custom_section s; @@ -930,7 +930,7 @@ let module_ s = let funcs = List.map2 Source.(fun t f -> {f.it with ftype = t} @@ f.at) func_types func_bodies - in {types; tables; memories; events; globals; funcs; imports; exports; elems; datas; start} + in {types; tables; memories; tags; globals; funcs; imports; exports; elems; datas; start} let decode name bs = at module_ (stream name bs) diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index f2df56e43..6139945ab 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -148,8 +148,8 @@ struct let global_type = function | GlobalType (t, mut) -> value_type t; mutability mut - let event_type = function - | EventType (ft, res) -> resumability res; func_type ft (* TODO *) + let tag_type = function + | TagType (ft, res) -> resumability res; func_type ft (* TODO *) (* Expressions *) @@ -486,7 +486,7 @@ struct | TableImport t -> u8 0x01; table_type t | MemoryImport t -> u8 0x02; memory_type t | GlobalImport t -> u8 0x03; global_type t - | EventImport t -> u8 0x04; event_type t + | TagImport t -> u8 0x04; tag_type t let import im = let {module_name; item_name; idesc} = im.it in @@ -525,13 +525,13 @@ struct let global_section gs = section 6 (vec global) gs (gs <> []) - (* Event section *) - let event evt = - let {evtype} = evt.it in - event_type evtype + (* Tag section *) + let tag tag = + let {tagtype} = tag.it in + tag_type tagtype - let event_section es = - section 13 (vec event) es (es <> []) + let tag_section ts = + section 13 (vec tag) ts (ts <> []) (* Export section *) let export_desc d = @@ -540,7 +540,7 @@ struct | TableExport x -> u8 1; var x | MemoryExport x -> u8 2; var x | GlobalExport x -> u8 3; var x - | EventExport x -> u8 4; var x + | TagExport x -> u8 4; var x let export ex = let {name = n; edesc} = ex.it in @@ -649,7 +649,7 @@ struct func_section m.it.funcs; table_section m.it.tables; memory_section m.it.memories; - event_section m.it.events; + tag_section m.it.tags; global_section m.it.globals; export_section m.it.exports; start_section m.it.start; diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index aa9a7d15e..1c88c5eb4 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -66,11 +66,11 @@ and admin_instr' = | Label of int * instr list * code | Local of int * value list * code | Frame of int * frame * code - | Catch of int * event_inst option * instr list * code - | Handle of (event_inst * idx) list option * code + | Catch of int * tag_inst option * instr list * code + | Handle of (tag_inst * idx) list option * code | Trapping of string - | Throwing of event_inst * value stack - | Suspending of event_inst * value stack * ctxt + | Throwing of tag_inst * value stack + | Suspending of tag_inst * value stack * ctxt | Returning of value stack | ReturningInvoke of value stack * func_inst | Breaking of int32 * value stack @@ -125,7 +125,7 @@ let func (inst : module_inst) x = lookup "function" inst.funcs x let table (inst : module_inst) x = lookup "table" inst.tables x let memory (inst : module_inst) x = lookup "memory" inst.memories x let global (inst : module_inst) x = lookup "global" inst.globals x -let event (inst : module_inst) x = lookup "event" inst.events x +let tag (inst : module_inst) x = lookup "tag" inst.tags x let elem (inst : module_inst) x = lookup "element segment" inst.elems x let data (inst : module_inst) x = lookup "data segment" inst.datas x let local (frame : frame) x = lookup "local" frame.locals x @@ -233,14 +233,14 @@ let rec step (c : config) : config = let n1 = List.length ts1 in let n2 = List.length ts2 in let args, vs' = split n1 vs e.at in - let exno = Option.map (event c.frame.inst) xo in + let exno = Option.map (tag c.frame.inst) xo in vs', [Catch (n2, exno, es2, ([], [Label (n2, [], (args, List.map plain es1)) @@ e.at])) @@ e.at] | Throw x, vs -> - let evt = event c.frame.inst x in - let EventType (FuncType (ts, _), _) = Event.type_of evt in + let tagt = tag c.frame.inst x in + let TagType (FuncType (ts, _), _) = Tag.type_of tagt in let vs0, vs' = split (List.length ts) vs e.at in - vs', [Throwing (evt, vs0) @@ e.at] + vs', [Throwing (tagt, vs0) @@ e.at] | Br x, vs -> [], [Breaking (x.it, vs) @@ e.at] @@ -335,10 +335,10 @@ let rec step (c : config) : config = Ref (ContRef (ref (Some (n - List.length args, ctxt')))) :: vs', [] | Suspend x, vs -> - let evt = event c.frame.inst x in - let EventType (FuncType (ts, _), _) = Event.type_of evt in + let tagt = tag c.frame.inst x in + let TagType (FuncType (ts, _), _) = Tag.type_of tagt in let args, vs' = split (List.length ts) vs e.at in - vs', [Suspending (evt, args, fun code -> code) @@ e.at] + vs', [Suspending (tagt, args, fun code -> code) @@ e.at] | Resume xls, Ref (NullRef _) :: vs -> vs, [Trapping "null continuation reference" @@ e.at] @@ -347,7 +347,7 @@ let rec step (c : config) : config = vs, [Trapping "continuation already consumed" @@ e.at] | Resume xls, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> - let hs = List.map (fun (x, l) -> event c.frame.inst x, l) xls in + let hs = List.map (fun (x, l) -> tag c.frame.inst x, l) xls in let args, vs' = split n vs e.at in cont := None; vs', [Handle (Some hs, ctxt (args, [])) @@ e.at] @@ -359,8 +359,8 @@ let rec step (c : config) : config = vs, [Trapping "continuation already consumed" @@ e.at] | ResumeThrow x, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> - let evt = event c.frame.inst x in - let EventType (FuncType (ts, _), _) = Event.type_of evt in + let tagt = tag c.frame.inst x in + let TagType (FuncType (ts, _), _) = Tag.type_of tagt in let args, vs' = split (List.length ts) vs e.at in let vs1', es1' = ctxt (args, [Plain (Throw x) @@ e.at]) in cont := None; @@ -669,9 +669,9 @@ let rec step (c : config) : config = | Label (n, es0, (vs', [])), vs -> vs' @ vs, [] - | Label (n, es0, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs -> + | Label (n, es0, (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs -> let ctxt' code = [], [Label (n, es0, compose (ctxt code) (vs', es')) @@ e.at] in - vs, [Suspending (evt, vs1, ctxt') @@ at] + vs, [Suspending (tagt, vs1, ctxt') @@ at] | Label (n, es0, (vs', {it = ReturningInvoke (vs0, f); at} :: es')), vs -> vs, [ReturningInvoke (vs0, f) @@ at] @@ -692,9 +692,9 @@ let rec step (c : config) : config = | Local (n, vs0, (vs', [])), vs -> vs' @ vs, [] - | Local (n, vs0, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs -> + | Local (n, vs0, (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs -> let ctxt' code = [], [Local (n, vs0, compose (ctxt code) (vs', es')) @@ e.at] in - vs, [Suspending (evt, vs1, ctxt') @@ at] + vs, [Suspending (tagt, vs1, ctxt') @@ at] | Local (n, vs0, (vs', e' :: es')), vs when is_jumping e' -> vs, [e'] @@ -708,9 +708,9 @@ let rec step (c : config) : config = | Frame (n, frame', (vs', [])), vs -> vs' @ vs, [] - | Frame (n, frame', (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs -> + | Frame (n, frame', (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs -> let ctxt' code = [], [Frame (n, frame', compose (ctxt code) (vs', es')) @@ e.at] in - vs, [Suspending (evt, vs1, ctxt') @@ at] + vs, [Suspending (tagt, vs1, ctxt') @@ at] | Frame (n, frame', (vs', {it = Returning vs0; at} :: es')), vs -> take n vs0 e.at @ vs, [] @@ -757,9 +757,9 @@ let rec step (c : config) : config = | Catch (n, exno, es0, (vs', [])), vs -> vs' @ vs, [] - | Catch (n, exno, es0, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs -> + | Catch (n, exno, es0, (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs -> let ctxt' code = [], [Catch (n, exno, es0, compose (ctxt code) (vs', es')) @@ e.at] in - vs, [Suspending (evt, vs1, ctxt') @@ at] + vs, [Suspending (tagt, vs1, ctxt') @@ at] | Catch (n, None, es0, (vs', {it = Throwing (exn, vs0); at} :: _)), vs -> vs, [Label (n, [], ([], List.map plain es0)) @@ e.at] @@ -781,16 +781,16 @@ let rec step (c : config) : config = | Handle (None, (vs', {it = Suspending _; at} :: es')), vs -> vs, [Trapping "barrier hit by suspension" @@ at] - | Handle (Some hs, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs - when List.mem_assq evt hs -> - let EventType (FuncType (_, ts), _) = Event.type_of evt in + | Handle (Some hs, (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs + when List.mem_assq tagt hs -> + let TagType (FuncType (_, ts), _) = Tag.type_of tagt in let ctxt' code = compose (ctxt code) (vs', es') in [Ref (ContRef (ref (Some (List.length ts, ctxt'))))] @ vs1 @ vs, - [Plain (Br (List.assq evt hs)) @@ e.at] + [Plain (Br (List.assq tagt hs)) @@ e.at] - | Handle (hso, (vs', {it = Suspending (evt, vs1, ctxt); at} :: es')), vs -> + | Handle (hso, (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs -> let ctxt' code = [], [Handle (hso, compose (ctxt code) (vs', es')) @@ e.at] in - vs, [Suspending (evt, vs1, ctxt') @@ at] + vs, [Suspending (tagt, vs1, ctxt') @@ at] | Handle (hso, (vs', e' :: es')), vs when is_jumping e' -> vs, [e'] @@ -819,7 +819,7 @@ let rec eval (c : config) : value stack = (match e.it with | Trapping msg -> Trap.error e.at msg | Throwing _ -> Exception.error e.at "unhandled exception" - | Suspending _ -> Suspension.error e.at "unhandled event" + | Suspending _ -> Suspension.error e.at "unhandled tag" | Returning _ | ReturningInvoke _ -> Crash.error e.at "undefined frame" | Breaking _ -> Crash.error e.at "undefined label" | _ -> assert false @@ -876,9 +876,9 @@ let create_global (inst : module_inst) (glob : global) : global_inst = let v = eval_const inst ginit in Global.alloc (Types.sem_global_type inst.types gtype) v -let create_event (inst : module_inst) (evt : event) : event_inst = - let {evtype} = evt.it in - Event.alloc (Types.sem_event_type inst.types evtype) +let create_tag (inst : module_inst) (tag : tag) : tag_inst = + let {tagtype} = tag.it in + Tag.alloc (Types.sem_tag_type inst.types tagtype) let create_export (inst : module_inst) (ex : export) : export_inst = let {name; edesc} = ex.it in @@ -888,7 +888,7 @@ let create_export (inst : module_inst) (ex : export) : export_inst = | TableExport x -> ExternTable (table inst x) | MemoryExport x -> ExternMemory (memory inst x) | GlobalExport x -> ExternGlobal (global inst x) - | EventExport x -> ExternEvent (event inst x) + | TagExport x -> ExternTag (tag inst x) in (name, ext) let create_elem (inst : module_inst) (seg : elem_segment) : elem_inst = @@ -916,7 +916,7 @@ let add_import (m : module_) (ext : extern) (im : import) (inst : module_inst) | ExternTable tab -> {inst with tables = tab :: inst.tables} | ExternMemory mem -> {inst with memories = mem :: inst.memories} | ExternGlobal glob -> {inst with globals = glob :: inst.globals} - | ExternEvent evt -> {inst with events = evt :: inst.events} + | ExternTag tag -> {inst with tags = tag :: inst.tags} let init_type (inst : module_inst) (type_ : type_) (x : type_inst) = @@ -962,7 +962,7 @@ let run_start start = let init (m : module_) (exts : extern list) : module_inst = let - { types; imports; tables; memories; globals; funcs; events; + { types; imports; tables; memories; globals; funcs; tags; exports; elems; datas; start } = m.it in @@ -978,7 +978,7 @@ let init (m : module_) (exts : extern list) : module_inst = tables = inst2.tables @ List.map (create_table inst2) tables; memories = inst2.memories @ List.map (create_memory inst2) memories; globals = inst2.globals @ List.map (create_global inst2) globals; - events = inst2.events @ List.map (create_event inst2) events; + tags = inst2.tags @ List.map (create_tag inst2) tags; } in let inst = diff --git a/interpreter/host/spectest.ml b/interpreter/host/spectest.ml index 162734d4b..ff7d9de2e 100644 --- a/interpreter/host/spectest.ml +++ b/interpreter/host/spectest.ml @@ -25,8 +25,8 @@ let table = let memory = Memory.alloc (MemoryType {min = 1l; max = Some 2l}) let func f ft = Func.alloc_host (Types.alloc (FuncDefType ft)) (f ft) -let event = Event.alloc (EventType (FuncType ([NumType I32Type], [NumType I32Type]), Resumable)) -let except = Event.alloc (EventType (FuncType ([NumType I32Type], []), Terminal)) +let tag = Tag.alloc (TagType (FuncType ([NumType I32Type], [NumType I32Type]), Resumable)) +let except = Tag.alloc (TagType (FuncType ([NumType I32Type], []), Terminal)) let print_value v = Printf.printf "%s : %s\n" @@ -55,6 +55,6 @@ let lookup name t = | "global_f64", _ -> ExternGlobal (global (GlobalType (NumType F64Type, Immutable))) | "table", _ -> ExternTable table | "memory", _ -> ExternMemory memory - | "event", _ -> ExternEvent event - | "exception", _ -> ExternEvent except + | "tag", _ -> ExternTag tag + | "exception", _ -> ExternTag except | _ -> raise Not_found diff --git a/interpreter/runtime/event.ml b/interpreter/runtime/event.ml deleted file mode 100644 index 852261579..000000000 --- a/interpreter/runtime/event.ml +++ /dev/null @@ -1,10 +0,0 @@ -open Types - -type event = {ty : event_type} -type t = event - -let alloc ty = - {ty} - -let type_of evt = - evt.ty diff --git a/interpreter/runtime/event.mli b/interpreter/runtime/event.mli deleted file mode 100644 index a1aa74541..000000000 --- a/interpreter/runtime/event.mli +++ /dev/null @@ -1,7 +0,0 @@ -open Types - -type event -type t = event - -val alloc : event_type -> event -val type_of : event -> event_type diff --git a/interpreter/runtime/instance.ml b/interpreter/runtime/instance.ml index 8899aa45d..f5668480f 100644 --- a/interpreter/runtime/instance.ml +++ b/interpreter/runtime/instance.ml @@ -7,7 +7,7 @@ type module_inst = tables : table_inst list; memories : memory_inst list; globals : global_inst list; - events : event_inst list; + tags : tag_inst list; exports : export_inst list; elems : elem_inst list; datas : data_inst list; @@ -18,7 +18,7 @@ and func_inst = module_inst Lib.Promise.t Func.t and table_inst = Table.t and memory_inst = Memory.t and global_inst = Global.t -and event_inst = Event.t +and tag_inst = Tag.t and export_inst = Ast.name * extern and elem_inst = Value.ref_ list ref and data_inst = string ref @@ -28,7 +28,7 @@ and extern = | ExternTable of table_inst | ExternMemory of memory_inst | ExternGlobal of global_inst - | ExternEvent of event_inst + | ExternTag of tag_inst (* Reference types *) @@ -51,7 +51,7 @@ let () = (* Auxiliary functions *) let empty_module_inst = - { types = []; funcs = []; tables = []; memories = []; globals = []; events = []; + { types = []; funcs = []; tables = []; memories = []; globals = []; tags = []; exports = []; elems = []; datas = [] } let extern_type_of c = function @@ -59,7 +59,7 @@ let extern_type_of c = function | ExternTable tab -> ExternTableType (Table.type_of tab) | ExternMemory mem -> ExternMemoryType (Memory.type_of mem) | ExternGlobal glob -> ExternGlobalType (Global.type_of glob) - | ExternEvent evt -> ExternEventType (Event.type_of evt) + | ExternTag tag -> ExternTagType (Tag.type_of tag) let export inst name = try Some (List.assoc name inst.exports) with Not_found -> None diff --git a/interpreter/runtime/tag.ml b/interpreter/runtime/tag.ml new file mode 100644 index 000000000..cd6c93079 --- /dev/null +++ b/interpreter/runtime/tag.ml @@ -0,0 +1,10 @@ +open Types + +type tag = {ty : tag_type} +type t = tag + +let alloc ty = + {ty} + +let type_of tag = + tag.ty diff --git a/interpreter/runtime/tag.mli b/interpreter/runtime/tag.mli new file mode 100644 index 000000000..c4730e299 --- /dev/null +++ b/interpreter/runtime/tag.mli @@ -0,0 +1,7 @@ +open Types + +type tag +type t = tag + +val alloc : tag_type -> tag +val type_of : tag -> tag_type diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml index cd7b805a9..53a5bb81b 100644 --- a/interpreter/syntax/ast.ml +++ b/interpreter/syntax/ast.ml @@ -157,12 +157,12 @@ and func' = } -(* Events *) +(* Tags *) -type event = event' Source.phrase -and event' = +type tag = tag' Source.phrase +and tag' = { - evtype : event_type; + tagtype : tag_type; } @@ -212,7 +212,7 @@ and export_desc' = | TableExport of idx | MemoryExport of idx | GlobalExport of idx - | EventExport of idx + | TagExport of idx type export = export' Source.phrase and export' = @@ -227,7 +227,7 @@ and import_desc' = | TableImport of table_type | MemoryImport of memory_type | GlobalImport of global_type - | EventImport of event_type + | TagImport of tag_type type import = import' Source.phrase and import' = @@ -244,7 +244,7 @@ and module_' = globals : global list; tables : table list; memories : memory list; - events : event list; + tags : tag list; funcs : func list; start : idx option; elems : elem_segment list; @@ -262,7 +262,7 @@ let empty_module = globals = []; tables = []; memories = []; - events = []; + tags = []; funcs = []; start = None; elems = []; @@ -284,7 +284,7 @@ let import_type_of (m : module_) (im : import) : import_type = | TableImport t -> ExternTableType t | MemoryImport t -> ExternMemoryType t | GlobalImport t -> ExternGlobalType t - | EventImport t -> ExternEventType t + | TagImport t -> ExternTagType t in ImportType (et, module_name, item_name) let export_type_of (m : module_) (ex : export) : export_type = @@ -307,9 +307,9 @@ let export_type_of (m : module_) (ex : export) : export_type = | GlobalExport x -> let gts = globals ets @ List.map (fun g -> g.it.gtype) m.it.globals in ExternGlobalType (nth gts x.it) - | EventExport x -> - let evts = events ets @ List.map (fun e -> e.it.evtype) m.it.events in - ExternEventType (nth evts x.it) + | TagExport x -> + let tagts = tags ets @ List.map (fun t -> t.it.tagtype) m.it.tags in + ExternTagType (nth tagts x.it) in ExportType (et, name) let module_type_of (m : module_) : module_type = diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml index 467902d57..990ac3216 100644 --- a/interpreter/syntax/free.ml +++ b/interpreter/syntax/free.ml @@ -10,7 +10,7 @@ type t = globals : Set.t; tables : Set.t; memories : Set.t; - events : Set.t; + tags : Set.t; funcs : Set.t; elems : Set.t; datas : Set.t; @@ -24,7 +24,7 @@ let empty : t = globals = Set.empty; tables = Set.empty; memories = Set.empty; - events = Set.empty; + tags = Set.empty; funcs = Set.empty; elems = Set.empty; datas = Set.empty; @@ -38,7 +38,7 @@ let union (s1 : t) (s2 : t) : t = globals = Set.union s1.globals s2.globals; tables = Set.union s1.tables s2.tables; memories = Set.union s1.memories s2.memories; - events = Set.union s1.events s2.events; + tags = Set.union s1.tags s2.tags; funcs = Set.union s1.funcs s2.funcs; elems = Set.union s1.elems s2.elems; datas = Set.union s1.datas s2.datas; @@ -50,7 +50,7 @@ let types s = {empty with types = s} let globals s = {empty with globals = s} let tables s = {empty with tables = s} let memories s = {empty with memories = s} -let events s = {empty with events = s} +let tags s = {empty with tags = s} let funcs s = {empty with funcs = s} let elems s = {empty with elems = s} let datas s = {empty with datas = s} @@ -91,7 +91,7 @@ let cont_type (ContType x) = var_type x let global_type (GlobalType (t, _mut)) = value_type t let table_type (TableType (_lim, t)) = ref_type t let memory_type (MemoryType (_lim)) = empty -let event_type (EventType (ft, _res)) = func_type ft +let tag_type (TagType (ft, _res)) = func_type ft let def_type = function | FuncDefType ft -> func_type ft @@ -115,8 +115,8 @@ let rec instr (e : instr) = let free = block_type bt ++ block es in {free with locals = Lib.Fun.repeat (List.length ts) shift free.locals} | Try (bt, es1, xo, es2) -> - block_type bt ++ block es1 ++ opt (fun x -> events (idx x)) xo ++ block es2 - | Throw x | ResumeThrow x | Suspend x -> events (idx x) + block_type bt ++ block es1 ++ opt (fun x -> tags (idx x)) xo ++ block es2 + | Throw x | ResumeThrow x | Suspend x -> tags (idx x) | Br x | BrIf x | BrOnNull x -> labels (idx x) | BrTable (xs, x) -> list (fun x -> labels (idx x)) (x::xs) | Return | CallRef | ReturnCallRef -> empty @@ -124,7 +124,7 @@ let rec instr (e : instr) = | CallIndirect (x, y) | ReturnCallIndirect (x, y) -> tables (idx x) ++ types (idx y) | FuncBind x | ContNew x | ContBind x -> types (idx x) - | Resume xys -> list (fun (x, y) -> events (idx x) ++ labels (idx y)) xys + | Resume xys -> list (fun (x, y) -> tags (idx x) ++ labels (idx y)) xys | LocalGet x | LocalSet x | LocalTee x -> locals (idx x) | GlobalGet x | GlobalSet x -> globals (idx x) | TableGet x | TableSet x | TableSize x | TableGrow x | TableFill x -> @@ -147,7 +147,7 @@ let func (f : func) = {(types (idx f.it.ftype) ++ block f.it.body) with locals = Set.empty} let table (t : table) = table_type t.it.ttype let memory (m : memory) = memory_type m.it.mtype -let event (e : event) = event_type e.it.evtype +let tag (e : tag) = tag_type e.it.tagtype let segment_mode f (m : segment_mode) = match m.it with @@ -168,7 +168,7 @@ let export_desc (d : export_desc) = | TableExport x -> tables (idx x) | MemoryExport x -> memories (idx x) | GlobalExport x -> globals (idx x) - | EventExport x -> events (idx x) + | TagExport x -> tags (idx x) let import_desc (d : import_desc) = match d.it with @@ -176,7 +176,7 @@ let import_desc (d : import_desc) = | TableImport tt -> table_type tt | MemoryImport mt -> memory_type mt | GlobalImport gt -> global_type gt - | EventImport et -> event_type et + | TagImport et -> tag_type et let export (e : export) = export_desc e.it.edesc let import (i : import) = import_desc i.it.idesc @@ -189,7 +189,7 @@ let module_ (m : module_) = list global m.it.globals ++ list table m.it.tables ++ list memory m.it.memories ++ - list event m.it.events ++ + list tag m.it.tags ++ list func m.it.funcs ++ start m.it.start ++ list elem m.it.elems ++ diff --git a/interpreter/syntax/free.mli b/interpreter/syntax/free.mli index 870056731..066a6fab5 100644 --- a/interpreter/syntax/free.mli +++ b/interpreter/syntax/free.mli @@ -6,7 +6,7 @@ type t = globals : Set.t; tables : Set.t; memories : Set.t; - events : Set.t; + tags : Set.t; funcs : Set.t; elems : Set.t; datas : Set.t; @@ -26,7 +26,7 @@ val global : Ast.global -> t val func : Ast.func -> t val table : Ast.table -> t val memory : Ast.memory -> t -val event : Ast.event -> t +val tag : Ast.tag -> t val elem : Ast.elem_segment -> t val data : Ast.data_segment -> t val export : Ast.export -> t diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml index 40b1837f2..800d24c6b 100644 --- a/interpreter/syntax/types.ml +++ b/interpreter/syntax/types.ml @@ -24,13 +24,13 @@ type resumability = Terminal | Resumable type table_type = TableType of Int32.t limits * ref_type type memory_type = MemoryType of Int32.t limits type global_type = GlobalType of value_type * mutability -type event_type = EventType of func_type * resumability (* TODO: use index *) +type tag_type = TagType of func_type * resumability (* TODO: use index *) type extern_type = | ExternFuncType of func_type | ExternTableType of table_type | ExternMemoryType of memory_type | ExternGlobalType of global_type - | ExternEventType of event_type + | ExternTagType of tag_type type export_type = ExportType of extern_type * name type import_type = ImportType of extern_type * name * name @@ -109,8 +109,8 @@ let memories = Lib.List.map_filter (function ExternMemoryType t -> Some t | _ -> None) let globals = Lib.List.map_filter (function ExternGlobalType t -> Some t | _ -> None) -let events = - Lib.List.map_filter (function ExternEventType t -> Some t | _ -> None) +let tags = + Lib.List.map_filter (function ExternTagType t -> Some t | _ -> None) (* Allocation *) @@ -163,15 +163,15 @@ let sem_func_type c (FuncType (ins, out)) = let sem_cont_type c (ContType x) = ContType (sem_var_type c x) -let sem_event_type c (EventType (ft, res)) = - EventType (sem_func_type c ft, res) +let sem_tag_type c (TagType (ft, res)) = + TagType (sem_func_type c ft, res) let sem_extern_type c = function | ExternFuncType ft -> ExternFuncType (sem_func_type c ft) | ExternTableType tt -> ExternTableType (sem_table_type c tt) | ExternMemoryType mt -> ExternMemoryType (sem_memory_type c mt) | ExternGlobalType gt -> ExternGlobalType (sem_global_type c gt) - | ExternEventType et -> ExternEventType (sem_event_type c et) + | ExternTagType et -> ExternTagType (sem_tag_type c et) let sem_def_type c = function @@ -276,16 +276,16 @@ let string_of_global_type = function | GlobalType (t, Immutable) -> string_of_value_type t | GlobalType (t, Mutable) -> "(mut " ^ string_of_value_type t ^ ")" -let string_of_event_type = function - | EventType (ft, Terminal) -> "exception " ^ string_of_func_type ft - | EventType (ft, Resumable) -> string_of_func_type ft +let string_of_tag_type = function + | TagType (ft, Terminal) -> "exception " ^ string_of_func_type ft + | TagType (ft, Resumable) -> string_of_func_type ft let string_of_extern_type = function | ExternFuncType ft -> "func " ^ string_of_func_type ft | ExternTableType tt -> "table " ^ string_of_table_type tt | ExternMemoryType mt -> "memory " ^ string_of_memory_type mt | ExternGlobalType gt -> "global " ^ string_of_global_type gt - | ExternEventType et -> "event " ^ string_of_event_type et + | ExternTagType et -> "tag " ^ string_of_tag_type et let string_of_export_type (ExportType (et, name)) = "\"" ^ string_of_name name ^ "\" : " ^ string_of_extern_type et diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index 1268f0b1c..f641c0949 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -283,7 +283,7 @@ let rec instr e = | Suspend x -> "suspend " ^ var x, [] | Resume xys -> "resume", - List.map (fun (x, y) -> Node ("event " ^ var x ^ " " ^ var y, [])) xys + List.map (fun (x, y) -> Node ("tag " ^ var x ^ " " ^ var y, [])) xys | ResumeThrow x -> "resume_throw " ^ var x, [] | Barrier (bt, es) -> "barrier", block_type bt @ list instr es | LocalGet x -> "local.get " ^ var x, [] @@ -356,9 +356,9 @@ let memory off i mem = let {mtype = MemoryType lim} = mem.it in Node ("memory $" ^ nat (off + i) ^ " " ^ limits nat32 lim, []) -let event off i evt = - let {evtype = EventType (FuncType (ins, out), res)} = evt.it in - Node ("event $" ^ nat (off + i) ^ resumability res, +let tag off i tag = + let {tagtype = TagType (FuncType (ins, out), res)} = tag.it in + Node ("tag $" ^ nat (off + i) ^ resumability res, decls "param" ins @ decls "result" out ) @@ -416,8 +416,8 @@ let import_desc fx tx mx ex gx d = incr tx; table 0 (!tx - 1) ({ttype = t} @@ d.at) | MemoryImport t -> incr mx; memory 0 (!mx - 1) ({mtype = t} @@ d.at) - | EventImport t -> - incr ex; event 0 (!ex - 1) ({evtype = t} @@ d.at) + | TagImport t -> + incr ex; tag 0 (!ex - 1) ({tagtype = t} @@ d.at) | GlobalImport t -> incr gx; Node ("global $" ^ nat (!gx - 1), [global_type t]) @@ -433,7 +433,7 @@ let export_desc d = | TableExport x -> Node ("table", [atom var x]) | MemoryExport x -> Node ("memory", [atom var x]) | GlobalExport x -> Node ("global", [atom var x]) - | EventExport x -> Node ("event", [atom var x]) + | TagExport x -> Node ("tag", [atom var x]) let export ex = let {name = n; edesc} = ex.it in @@ -462,7 +462,7 @@ let module_with_var_opt x_opt m = imports @ listi (table !tx) m.it.tables @ listi (memory !mx) m.it.memories @ - listi (event !ex) m.it.events @ + listi (tag !ex) m.it.tags @ listi (global !gx) m.it.globals @ listi (func_with_index !fx) m.it.funcs @ list export m.it.exports @ diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index dd508a8f2..16b90d24e 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -381,7 +381,7 @@ rule token = parse | "global" { GLOBAL } | "table" { TABLE } | "memory" { MEMORY } - | "event" { EVENT } + | "tag" { TAG } | "exception" { EXCEPTION } | "elem" { ELEM } | "data" { DATA } diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index 938dbd0da..140e5045c 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -87,7 +87,7 @@ let empty_types () = {space = empty (); list = []} type context = { types : types; - tables : space; memories : space; events : space; + tables : space; memories : space; tags : space; funcs : space; locals : space; globals : space; datas : space; elems : space; labels : space; deferred_locals : (unit -> unit) list ref @@ -95,7 +95,7 @@ type context = let empty_context () = { types = empty_types (); - tables = empty (); memories = empty (); events = empty (); + tables = empty (); memories = empty (); tags = empty (); funcs = empty (); locals = empty (); globals = empty (); datas = empty (); elems = empty (); labels = empty (); deferred_locals = ref [] @@ -136,7 +136,7 @@ let local (c : context) x = lookup "local" c.locals x let global (c : context) x = lookup "global" c.globals x let table (c : context) x = lookup "table" c.tables x let memory (c : context) x = lookup "memory" c.memories x -let event (c : context) x = lookup "event" c.events x +let tag (c : context) x = lookup "tag" c.tags x let elem (c : context) x = lookup "elem segment" c.elems x let data (c : context) x = lookup "data segment" c.datas x let label (c : context) x = lookup "label " c.labels x @@ -166,7 +166,7 @@ let bind_local (c : context) x = force_locals c; bind_abs "local" c.locals x let bind_global (c : context) x = bind_abs "global" c.globals x let bind_table (c : context) x = bind_abs "table" c.tables x let bind_memory (c : context) x = bind_abs "memory" c.memories x -let bind_event (c : context) x = bind_abs "event" c.events x +let bind_tag (c : context) x = bind_abs "tag" c.tags x let bind_elem (c : context) x = bind_abs "elem segment" c.elems x let bind_data (c : context) x = bind_abs "data segment" c.datas x let bind_label (c : context) x = bind_rel "label" c.labels x @@ -183,7 +183,7 @@ let anon_locals (c : context) n at = let anon_global (c : context) at = bind "global" c.globals 1l at let anon_table (c : context) at = bind "table" c.tables 1l at let anon_memory (c : context) at = bind "memory" c.memories 1l at -let anon_event (c : context) at = bind "event" c.events 1l at +let anon_tag (c : context) at = bind "tag" c.tags 1l at let anon_elem (c : context) at = bind "elem segment" c.elems 1l at let anon_data (c : context) at = bind "data segment" c.datas 1l at let anon_label (c : context) at = bind "label" c.labels 1l at @@ -229,7 +229,7 @@ let inline_func_type_explicit (c : context) x ft at = %token LOAD STORE OFFSET_EQ_NAT ALIGN_EQ_NAT %token CONST UNARY BINARY TEST COMPARE CONVERT %token REF_NULL REF_FUNC REF_EXTERN REF_IS_NULL REF_AS_NON_NULL -%token FUNC START TYPE PARAM RESULT LOCAL GLOBAL EVENT EXCEPTION +%token FUNC START TYPE PARAM RESULT LOCAL GLOBAL TAG EXCEPTION %token TABLE ELEM MEMORY DATA DECLARE OFFSET ITEM IMPORT EXPORT %token MODULE BIN QUOTE %token SCRIPT REGISTER INVOKE GET @@ -351,11 +351,11 @@ func_type : { fun c -> let FuncType (ins, out) = $6 c in FuncType ($4 c :: ins, out) } -event_type : +tag_type : | func_type - { fun c -> EventType ($1 c, Resumable) } + { fun c -> TagType ($1 c, Resumable) } | EXCEPTION func_type - { fun c -> EventType ($2 c, Terminal) } + { fun c -> TagType ($2 c, Terminal) } table_type : | limits ref_type { fun c -> TableType ($1, $2 c) } @@ -437,7 +437,7 @@ plain_instr : | UNREACHABLE { fun c -> unreachable } | NOP { fun c -> nop } | DROP { fun c -> drop } - | THROW var { fun c -> throw ($2 c event) } + | THROW var { fun c -> throw ($2 c tag) } | BR var { fun c -> br ($2 c label) } | BR_IF var { fun c -> br_if ($2 c label) } | BR_TABLE var var_list @@ -451,8 +451,8 @@ plain_instr : | RETURN_CALL_REF { fun c -> return_call_ref } | CONT_NEW LPAR TYPE var RPAR { fun c -> cont_new ($4 c type_) } | CONT_BIND LPAR TYPE var RPAR { fun c -> cont_bind ($4 c type_) } - | SUSPEND var { fun c -> suspend ($2 c event) } - | RESUME_THROW var { fun c -> resume_throw ($2 c event) } + | SUSPEND var { fun c -> suspend ($2 c tag) } + | RESUME_THROW var { fun c -> resume_throw ($2 c tag) } | LOCAL_GET var { fun c -> local_get ($2 c local) } | LOCAL_SET var { fun c -> local_set ($2 c local) } | LOCAL_TEE var { fun c -> local_tee ($2 c local) } @@ -602,8 +602,8 @@ resume_instr : { let at = at () in fun c -> resume ($2 c) @@ at } resume_instr_handler : - | LPAR EVENT var var RPAR resume_instr_handler - { fun c -> ($3 c event, $4 c label) :: $6 c } + | LPAR TAG var var RPAR resume_instr_handler + { fun c -> ($3 c tag, $4 c label) :: $6 c } | /* empty */ { fun c -> [] } @@ -614,8 +614,8 @@ resume_instr_instr : fun c -> let hs, es = $2 c in resume hs @@ at1, es } resume_instr_handler_instr : - | LPAR EVENT var var RPAR resume_instr_handler_instr - { fun c -> let hs, es = $6 c in ($3 c event, $4 c label) :: hs, es } + | LPAR TAG var var RPAR resume_instr_handler_instr + { fun c -> let hs, es = $6 c in ($3 c tag, $4 c label) :: hs, es } | instr { fun c -> [], $1 c } @@ -639,7 +639,7 @@ block_instr : let ts, es1 = $3 c' in try_ ts es1 None ($6 c') } | TRY labeling_opt block CATCH labeling_end_opt LPAR EXCEPTION var RPAR instr_list END labeling_end_opt { fun c -> let c' = $2 c ($5 @ $12) in - let ts, es1 = $3 c' in try_ ts es1 (Some ($8 c' event)) ($10 c') } + let ts, es1 = $3 c' in try_ ts es1 (Some ($8 c' tag)) ($10 c') } | BARRIER labeling_opt block END labeling_end_opt { fun c -> let c' = $2 c $5 in let bt, es = $3 c' in barrier bt es } @@ -797,8 +797,8 @@ call_expr_results : { fun c -> [], $1 c } resume_expr_handler : - | LPAR EVENT var var RPAR resume_expr_handler - { fun c -> let hs, es = $6 c in ($3 c event, $4 c label) :: hs, es } + | LPAR TAG var var RPAR resume_expr_handler + { fun c -> let hs, es = $6 c in ($3 c tag, $4 c label) :: hs, es } | expr_list { fun c -> [], $1 c } @@ -837,7 +837,7 @@ try_block_result_body : FuncType (ins, out' @ out), es } try_ : | LPAR DO instr_list RPAR LPAR CATCH LPAR EXCEPTION var RPAR instr_list RPAR - { fun c -> $3 c, Some ($9 c event), $11 c } + { fun c -> $3 c, Some ($9 c tag), $11 c } | LPAR DO instr_list RPAR LPAR CATCH_ALL instr_list RPAR { fun c -> $3 c, None, $7 c } @@ -974,7 +974,7 @@ func_body : {f with locals = $4 c :: f.locals} } -/* Tables, Memories, Globals, Events */ +/* Tables, Memories, Globals, Tags */ table_use : | LPAR TABLE var RPAR { fun c -> $3 c } @@ -1136,39 +1136,39 @@ global_fields : { fun c x at -> let globs, ims, exs = $2 c x at in globs, ims, $1 (GlobalExport x) c :: exs } -event : - | LPAR EVENT bind_var_opt event_fields RPAR +tag : + | LPAR TAG bind_var_opt tag_fields RPAR { let at = at () in - fun c -> let x = $3 c anon_event bind_event @@ at in + fun c -> let x = $3 c anon_tag bind_tag @@ at in fun () -> $4 c x at } | LPAR EXCEPTION bind_var_opt exception_fields RPAR /* Sugar */ { let at = at () in - fun c -> let x = $3 c anon_event bind_event @@ at in + fun c -> let x = $3 c anon_tag bind_tag @@ at in fun () -> $4 c x at } -event_fields : - | event_type - { fun c x at -> [{evtype = $1 c} @@ at], [], [] } - | inline_import event_type /* Sugar */ +tag_fields : + | tag_type + { fun c x at -> [{tagtype = $1 c} @@ at], [], [] } + | inline_import tag_type /* Sugar */ { fun c x at -> [], [{ module_name = fst $1; item_name = snd $1; - idesc = EventImport ($2 c) @@ at } @@ at], [] } - | inline_export event_fields /* Sugar */ + idesc = TagImport ($2 c) @@ at } @@ at], [] } + | inline_export tag_fields /* Sugar */ { fun c x at -> let evts, ims, exs = $2 c x at in - evts, ims, $1 (EventExport x) c :: exs } + evts, ims, $1 (TagExport x) c :: exs } exception_fields : /* Sugar */ | func_type - { fun c x at -> [{evtype = EventType ($1 c, Terminal)} @@ at], [], [] } + { fun c x at -> [{tagtype = TagType ($1 c, Terminal)} @@ at], [], [] } | inline_import func_type { fun c x at -> [], [{ module_name = fst $1; item_name = snd $1; - idesc = EventImport (EventType ($2 c, Terminal)) @@ at } @@ at], [] } + idesc = TagImport (TagType ($2 c, Terminal)) @@ at } @@ at], [] } | inline_export exception_fields { fun c x at -> let evts, ims, exs = $2 c x at in - evts, ims, $1 (EventExport x) c :: exs } + evts, ims, $1 (TagExport x) c :: exs } /* Imports & Exports */ @@ -1190,12 +1190,12 @@ import_desc : | LPAR GLOBAL bind_var_opt global_type RPAR { fun c -> ignore ($3 c anon_global bind_global); fun () -> GlobalImport ($4 c) } - | LPAR EVENT bind_var_opt event_type RPAR - { fun c -> ignore ($3 c anon_event bind_event); - fun () -> EventImport ($4 c) } + | LPAR TAG bind_var_opt tag_type RPAR + { fun c -> ignore ($3 c anon_tag bind_tag); + fun () -> TagImport ($4 c) } | LPAR EXCEPTION bind_var_opt func_type RPAR /* Sugar */ - { fun c -> ignore ($3 c anon_event bind_event); - fun () -> EventImport (EventType ($4 c, Terminal)) } + { fun c -> ignore ($3 c anon_tag bind_tag); + fun () -> TagImport (TagType ($4 c, Terminal)) } import : | LPAR IMPORT name name import_desc RPAR @@ -1211,8 +1211,8 @@ export_desc : | LPAR TABLE var RPAR { fun c -> TableExport ($3 c table) } | LPAR MEMORY var RPAR { fun c -> MemoryExport ($3 c memory) } | LPAR GLOBAL var RPAR { fun c -> GlobalExport ($3 c global) } - | LPAR EVENT var RPAR { fun c -> EventExport ($3 c event) } - | LPAR EXCEPTION var RPAR { fun c -> EventExport ($3 c event) } /* Sugar */ + | LPAR TAG var RPAR { fun c -> TagExport ($3 c tag) } + | LPAR EXCEPTION var RPAR { fun c -> TagExport ($3 c tag) } /* Sugar */ export : | LPAR EXPORT name export_desc RPAR @@ -1273,13 +1273,13 @@ module_fields1 : error (List.hd m.imports).at "import after memory definition"; { m with memories = mems @ m.memories; datas = data @ m.datas; imports = ims @ m.imports; exports = exs @ m.exports } } - | event module_fields + | tag module_fields { fun c -> let ef = $1 c in let mff = $2 c in fun () -> let mf = mff () in fun () -> let evts, ims, exs = ef () in let m = mf () in if evts <> [] && m.imports <> [] then - error (List.hd m.imports).at "import after event definition"; - { m with events = evts @ m.events; + error (List.hd m.imports).at "import after tag definition"; + { m with tags = evts @ m.tags; imports = ims @ m.imports; exports = exs @ m.exports } } | func module_fields { fun c -> let ff = $1 c in let mff = $2 c in diff --git a/interpreter/valid/match.ml b/interpreter/valid/match.ml index d0b2c1075..17f6a7b21 100644 --- a/interpreter/valid/match.ml +++ b/interpreter/valid/match.ml @@ -81,7 +81,7 @@ and eq_memory_type c a (MemoryType lim1) (MemoryType lim2) = and eq_global_type c a (GlobalType (t1, mut1)) (GlobalType (t2, mut2)) = eq_mutability c a mut1 mut2 && eq_value_type c a t1 t2 -and eq_event_type c a (EventType (ft1, res1)) (EventType (ft2, res2)) = +and eq_tag_type c a (TagType (ft1, res1)) (TagType (ft2, res2)) = eq_resumability c a res1 res2 && eq_func_type c [] ft1 ft2 and eq_extern_type c a et1 et2 = @@ -90,7 +90,7 @@ and eq_extern_type c a et1 et2 = | ExternTableType tt1, ExternTableType tt2 -> eq_table_type c a tt1 tt2 | ExternMemoryType mt1, ExternMemoryType mt2 -> eq_memory_type c a mt1 mt2 | ExternGlobalType gt1, ExternGlobalType gt2 -> eq_global_type c a gt1 gt2 - | ExternEventType et1, ExternEventType et2 -> eq_event_type c a et1 et2 + | ExternTagType et1, ExternTagType et2 -> eq_tag_type c a et1 et2 | _, _ -> false @@ -156,7 +156,7 @@ and match_global_type c a (GlobalType (t1, mut1)) (GlobalType (t2, mut2)) = | Immutable -> match_value_type c a t1 t2 | Mutable -> eq_value_type c [] t1 t2 -and match_event_type c a (EventType (ft1, res1)) (EventType (ft2, res2)) = +and match_tag_type c a (TagType (ft1, res1)) (TagType (ft2, res2)) = eq_resumability c [] res1 res2 && match_func_type c a ft1 ft2 and match_extern_type c a et1 et2 = @@ -165,7 +165,7 @@ and match_extern_type c a et1 et2 = | ExternTableType tt1, ExternTableType tt2 -> match_table_type c a tt1 tt2 | ExternMemoryType mt1, ExternMemoryType mt2 -> match_memory_type c a mt1 mt2 | ExternGlobalType gt1, ExternGlobalType gt2 -> match_global_type c a gt1 gt2 - | ExternEventType et1, ExternEventType et2 -> match_event_type c a et1 et2 + | ExternTagType et1, ExternTagType et2 -> match_tag_type c a et1 et2 | _, _ -> false and match_def_type c a dt1 dt2 = diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 934db4d0d..473241c03 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -22,7 +22,7 @@ type context = tables : table_type list; memories : memory_type list; globals : global_type list; - events : event_type list; + tags : tag_type list; elems : ref_type list; datas : unit list; locals : value_type list; @@ -33,7 +33,7 @@ type context = let empty_context = { types = []; funcs = []; tables = []; memories = []; - globals = []; events = []; elems = []; datas = []; + globals = []; tags = []; elems = []; datas = []; locals = []; results = []; labels = []; refs = Free.empty } @@ -47,7 +47,7 @@ let func_var (c : context) x = lookup "function" c.funcs x let table (c : context) x = lookup "table" c.tables x let memory (c : context) x = lookup "memory" c.memories x let global (c : context) x = lookup "global" c.globals x -let event (c : context) x = lookup "event" c.events x +let tag (c : context) x = lookup "tag" c.tags x let elem (c : context) x = lookup "elem segment" c.elems x let data (c : context) x = lookup "data segment" c.datas x let local (c : context) x = lookup "local" c.locals x @@ -127,8 +127,8 @@ let check_memory_type (c : context) (mt : memory_type) at = check_limits lim 0x1_0000l at "memory size must be at most 65536 pages (4GiB)" -let check_event_type (c : context) (et : event_type) at = - let EventType (ft, res) = et in +let check_tag_type (c : context) (et : tag_type) at = + let TagType (ft, res) = et in let FuncType (_, ts2) = ft in check_func_type c ft at; require (res = Resumable || ts2 = []) at "exception type must not have results" @@ -362,8 +362,8 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : op_type match xo with | None -> [] | Some x -> - let EventType (FuncType (ts1', _), res) = event c x in - require (res = Terminal) e.at "catching a non-exception event"; + let TagType (FuncType (ts1', _), res) = tag c x in + require (res = Terminal) e.at "catching a non-exception tag"; ts1' in let ft2 = FuncType (ts1', ts2) in @@ -371,8 +371,8 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : op_type ts1 --> ts2 | Throw x -> - let EventType (FuncType (ts1, ts2), res) = event c x in - require (res = Terminal) e.at "throwing a non-exception event"; + let TagType (FuncType (ts1, ts2), res) = tag c x in + require (res = Terminal) e.at "throwing a non-exception tag"; ts1 -->... ts2 | Br x -> @@ -503,8 +503,8 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : op_type ) | Suspend x -> - let EventType (FuncType (ts1, ts2), res) = event c x in - require (res = Resumable) e.at "suspending with a non-resumable event"; + let TagType (FuncType (ts1, ts2), res) = tag c x in + require (res = Resumable) e.at "suspending with a non-resumable tag"; ts1 --> ts2 | Resume xys -> @@ -513,8 +513,8 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : op_type let ContType z = cont_type c (y @@ e.at) in let FuncType (ts1, ts2) = func_type c (as_syn_var z @@ e.at) in List.iter (fun (x1, x2) -> - let EventType (FuncType (ts3, ts4), res) = event c x1 in - require (res = Resumable) x1.at "handling a non-resumable event"; + let TagType (FuncType (ts3, ts4), res) = tag c x1 in + require (res = Resumable) x1.at "handling a non-resumable tag"; match Lib.List.last_opt (label c x2) with | Some (RefType (nul', DefHeapType (SynVar y'))) -> let ContType z' = cont_type c (y' @@ x2.at) in @@ -537,8 +537,8 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : op_type ) | ResumeThrow x -> - let EventType (FuncType (ts0, _), res) = event c x in - require (res = Terminal) e.at "throwing a non-exception event"; + let TagType (FuncType (ts0, _), res) = tag c x in + require (res = Terminal) e.at "throwing a non-exception tag"; (match peek_ref 0 s e.at with | nul, DefHeapType (SynVar y) -> let ContType z = cont_type c (y @@ e.at) in @@ -752,7 +752,7 @@ let check_const (c : context) (const : const) (t : value_type) = check_block c const.it (FuncType ([], [t])) const.at -(* Tables, Memories, Globals, Events *) +(* Tables, Memories, Globals, Tags *) let check_table (c : context) (tab : table) = let {ttype} = tab.it in @@ -797,9 +797,9 @@ let check_global (c : context) (glob : global) = let GlobalType (t, mut) = gtype in check_const c ginit t -let check_event (c : context) (evt : event) = - let {evtype} = evt.it in - check_event_type c evtype evt.at +let check_tag (c : context) (tag : tag) = + let {tagtype} = tag.it in + check_tag_type c tagtype tag.at (* Modules *) @@ -825,9 +825,9 @@ let check_import (im : import) (c : context) : context = | GlobalImport gt -> check_global_type c gt idesc.at; {c with globals = gt :: c.globals} - | EventImport et -> - check_event_type c et idesc.at; - {c with events = et :: c.events} + | TagImport et -> + check_tag_type c et idesc.at; + {c with tags = et :: c.tags} module NameSet = Set.Make(struct type t = Ast.name let compare = compare end) @@ -838,7 +838,7 @@ let check_export (c : context) (set : NameSet.t) (ex : export) : NameSet.t = | TableExport x -> ignore (table c x) | MemoryExport x -> ignore (memory c x) | GlobalExport x -> ignore (global c x) - | EventExport x -> ignore (event c x) + | TagExport x -> ignore (tag c x) ); require (not (NameSet.mem name set)) ex.at "duplicate export name"; NameSet.add name set @@ -846,7 +846,7 @@ let check_export (c : context) (set : NameSet.t) (ex : export) : NameSet.t = let check_module (m : module_) = let - { types; imports; tables; memories; globals; events; funcs; + { types; imports; tables; memories; globals; tags; funcs; start; elems; datas; exports } = m.it in let c0 = @@ -861,7 +861,7 @@ let check_module (m : module_) = funcs = c0.funcs @ List.map (fun f -> ignore (func_type c0 f.it.ftype); f.it.ftype.it) funcs; tables = c0.tables @ List.map (fun tab -> tab.it.ttype) tables; memories = c0.memories @ List.map (fun mem -> mem.it.mtype) memories; - events = c0.events @ List.map (fun evt -> evt.it.evtype) events; + tags = c0.tags @ List.map (fun tag -> tag.it.tagtype) tags; elems = List.map (fun elem -> elem.it.etype) elems; datas = List.map (fun _data -> ()) datas; } @@ -873,7 +873,7 @@ let check_module (m : module_) = List.iter (check_global c1) globals; List.iter (check_table c1) tables; List.iter (check_memory c1) memories; - List.iter (check_event c1) events; + List.iter (check_tag c1) tags; List.iter (check_elem c1) elems; List.iter (check_data c1) datas; List.iter (check_func c) funcs; diff --git a/proposals/continuations/Explainer.md b/proposals/continuations/Explainer.md new file mode 100644 index 000000000..43fe12453 --- /dev/null +++ b/proposals/continuations/Explainer.md @@ -0,0 +1,1679 @@ +# Typed continuations + +This document provides an informal presentation of the *typed +continuations* proposal, a minimal and compatible extension to Wasm +for structured non-local control flow. The proposal is minimal in the +sense that it leverages Wasm's existing instruction set and type +system. It extends the instruction set with instructions to suspend, +resume, and abort computations, and extends the type system with a +single new reference type for *continuations*. + +## Table of contents + +1. [Motivation](#motivation) +2. [Additional requirements](#additional-requirements) +3. [Instruction set](#instruction-set) + 1. [Declaring control tags](#declaring-control-tags) + 2. [Creating continuations](#creating-continuations) + 3. [Resuming continuations](#resuming-continuations) + 4. [Suspending continuations](#suspending-continuations) + 5. [Binding continuations](#binding-continuations) + 6. [Trapping continuations](#trapping-continuations) +4. [Examples](#examples) + 1. [Lightweight threads (static)](#lightweight-threads-static) + 2. [Lightweight threads (dynamic)](#lightweight-threads-dynamic) + 3. [Actors](#actors) + 4. [Async/await](#asyncawait) + 5. [Delimited continuations](#delimited-continuations) +5. [Implementation strategies](#implementation-strategies) +6. [Design considerations and extensions](#design-considerations-and-extensions) + 1. [Memory management](#memory-management) + 2. [Linear versus constant time dispatch](#linear-versus-constant-time-dispatch) + 3. [Named handlers](#named-handlers) + 4. [Direct switching](#direct-switching) + 5. [Control/prompt as an alternative basis](#controlprompt-as-an-alternative-basis) + 6. [Coupling of continuation capture and dispatch](#coupling-of-continuation-capture-and-dispatch) + 7. [Tail-resumptive handlers](#tail-resumptive-handlers) + 8. [Multi-shot continuations](#multi-shot-continuations) + 9. [Interoperability, legacy code, and the barrier instruction](#interoperability-legacy-code-and-the-barrier-instruction) + 10. [First-class tags](#first-class-tags) + 11. [Shallow versus deep handlers](#shallow-versus-deep-handlers) + +## Motivation + +Non-local control flow features provide the ability to suspend the +current execution context and later resume it. Many +industrial-strength programming languages feature a wealth of +non-local control flow features such as async/await, coroutines, +generators/iterators, effect handlers, call/cc, and so forth. For some +programming languages non-local control flow is central to their +identity, meaning that they rely on non-local control flow for +efficiency, e.g. to support massively scalable concurrency. + +Currently, Wasm lacks support for implementing such features directly +and efficiently without a circuitous global transformation of source +programs on the producer side. One possible strategy is to add special +support for each individual non-local control flow feature to Wasm, +but strategy does not scale to the next 700 non-local control flow +features. Instead, the goal of this proposal is to introduce a unifed +structured mechanism that is sufficiently general to cover present +use-cases as well as being forwards compatible with future use-cases, +while admitting efficient implementations. + +The proposed mechanism is based on proven technology: *delimited +continuations*. An undelimited continuation represents the rest of a +computation from a certain point in its execution. A delimited +continuation is a more modular form of continuation, representing the +rest of a computation from a particular point in its execution up to a +*delimiter* or *prompt*. Operationally, one may think of undelimited +continuations as stacks and delimited continuations as segmented +stacks. + +In their raw form delimited continuations do not readily fit into the +Wasm ecosystem, as the Wasm type system is not powerful enough to type +them. The gist of the problem is that the classic treatment of +delimited continuations provides only one universal control tag +(i.e. the mechanism which transforms a runtime stack into a +programmatic data object). In order to use Wasm's simple type system +to type delimited continuations, we use the idea of multiple *named* +control tags from Plotkin and Pretnar's effect handlers. Each control +tag is declared module-wide along its payload type and return +type. This declaration can be used to readily type points of non-local +transfer of control. From an operational perspective we may view +control tags as a means for writing an interface for the possible +kinds of non-local transfers (or stack switches) that a computation +may perform. + +### Typed continuation primer + +A *continuation* is a first-class program object that represents the +remainder of computation from a certain point in the execution of a +program --- intuitively, its current stack. The typed continuations +proposal is based on a structured notion of delimited continuations. A +*delimited continuation* is a continuation whose extent is delimited +by some *control delimiter*, meaning it represents the remainder of +computation from a certain point up to (and possibly including) its +control delimiter -- intuitively, a segment of the stack. An +alternative to delimited continuations is undelimited continuations +which represent the remainder of the *entire* program. Delimited +continuations are preferable as they are more modular and more +fine-grained in the sense that they provide a means for suspending +local execution contexts rather than the entire global execution +context. In particular, delimited continuations are more expressive, +as an undelimited continuation is merely a delimited continuation +whose control delimiter is placed at the start of the program. + +The crucial feature of the typed continuations proposal that makes it +more structured than conventional delimited continuations is *control +tags*. A control tag is a typed symbolic entity that suspends the +current execution context and reifies it as a *continuation object* +(henceforth, just *continuation*) up to its control delimiter. The +type of a control tag communicates the type of its payload as well as +its expected return type, i.e. the type of data that must be supplied +to its associated continuation upon resumption. In other words, +control tags define an *interface* for constructing continuations. + +A second aspect of the design that aids modularity by separating +concerns is that the construction of continuations is distinct from +*handling* of continuations. A continuation is handled at the +delimiter of a control tag rather than at the invocation site of the +control tag. Control tags are a mild extension of exception tags as in +the exception handling proposal. The key difference is that in +addition to a payload type, a control tag also declares a return +type. Roughly, control tags can be thought of as resumable exceptions. + +Typed continuations may be efficiently implemented using segmented +stacks, but other implementations are also possible. + +## Additional requirements + + * **No GC dependency**: We intend every language to be able to use + typed continuations to implement non-local flow abstractions + irrespective of whether its memory is managed by a GC. Thus this + proposal must not depend on the presence of a full-blown GC as in + the GC proposal, rather, reference counting or a similar technique + must be sufficient in cases where some form of memory management is + necessary. + + * **Debugging friendliness**: The addition of continuations must + preserve compatibility with standard debugging formats such as + DWARF, meaning it must be possible to obtain a sequential + unobstructed stack trace in the presence of continuations. + + * **Exception handling compatibility**: [The exception handling + proposal](https://github.com/WebAssembly/exception-handling) adds + special support for one kind of non-local control flow abstraction, + namely, exception handlers. Exceptions must continue to work in the + presence of typed continuations and vice versa. + + * **Preserve Wasm invariants of legacy code**: The proposal must + provide a means to protect the invariants of existing Wasm + code. For instance, this means that in the presence of code that + uses typed continuations it should be possible to ensure that other + legacy code cannot suspend. The mechanism for protecting invariants + need not be automatic (in the same vein as explicit synchronisation + might be needed when adding threads and shared memory). + +## Instruction set + +The proposal adds a new reference type for continuations. + +```wasm + (cont $t) +``` + +A continuation type is given in terms of a function type `$t`, whose parameters `tp*` +describes the expected stack shape prior to resuming/starting the +continuation, and whose return types `tr*` describes the stack +shape after the continuation has run to completion. + +As a shorthand, we will often write the function type inline and write a continuation type as +```wasm + (cont [tp*] -> [tr*]) +``` + +### Declaring control tags + +A control tag is similar to an exception extended with a result type +(or list thereof). Operationally, a control tag may be thought of as a +*resumable* exception. A tag declaration provides the type signature +of a control tag. + +```wasm + (tag $e (param tp*) (result tr*)) +``` + +The `$e` is the symbolic index of the control tag in the index space +of tags. The parameter types `tp*` describe the expected stack layout +prior to invoking the tag, and the result types `tr*` describe the +stack layout following an invocation of the operation. In this +document we will sometimes write `$e : [tp*] -> [tr*]` as shorthand +for indicating that such a declaration is in scope. + +### Creating continuations + +The following instruction creates a continuation in *suspended state* +from a function. + +```wasm + cont.new $ct : [(ref $ft)] -> [(ref $ct)] + where: + - $ft = func [t1*] -> [t2*] + - $ct = cont $ft +``` + +The instruction takes as operand a reference to +a function of type `[t1*] -> [t2*]`. The body of this function is a +computation that may perform non-local control flow. + + +### Invoking continuations + +There are two ways to invoke (or run) a continuation. + +The first way to invoke a continuation resumes the continuation under +a *handler*, which handles subsequent control suspensions within the +continuation. + +```wasm + resume (tag $e $l)* : [tp* (ref $ct)] -> [tr*] + where: + - $ct = cont [tp*] -> [tr*] +``` + +The `resume` instruction is parameterised by a handler defined by a +collection of pairs of control tags and labels. Each pair maps a +control tag to a label pointing to its corresponding handler code. The +`resume` instruction consumes its continuation argument, meaning a +continuation may be resumed only once. + +The second way to invoke a continuation is to raise an exception at +the control tag invocation site. This amounts to performing "an +abortive action" which causes the stack to be unwound. + + +```wasm + resume_throw $exn : [tp* (ref $ct)])] -> [tr*] + where: + - $ct = cont [ta*] -> [tr*] + - $exn : [tp*] -> [] +``` + +The instruction `resume_throw` is parameterised by the exception to be +raised at the control tag invocation site. As with `resume`, this +instruction also fully consumes its continuation +argument. Operationally, this instruction raises the exception `$exn` +with parameters of type `tp*` at the control tag invocation point in +the context of the supplied continuation. As an exception is being +raised (the continuation is not actually being supplied a value) the +parameter types for the continuation `ta*` are unconstrained. + +### Suspending continuations + +A computation running inside a continuation can suspend itself by +invoking one of the declared control tags. + + +```wasm + suspend $e : [tp*] -> [tr*] + where: + - $e : [tp*] -> [tr*] +``` + +The instruction `suspend` invokes the control tag named `$e` with +arguments of types `tp*`. Operationally, the instruction transfers +control out of the continuation to the nearest enclosing handler for +`$e`. This behaviour is similar to how raising an exception transfers +control to the nearest exception handler that handles the +exception. The key difference is that the continuation at the +suspension point expects to be resumed later with arguments of types +`tr*`. + +### Binding continuations + +The parameter list of a continuation may be shrunk via `cont.bind`. This +instruction provides a way to partially apply a given +continuation. This facility turns out to be important in practice due +to the block and type structure of Wasm as in order to return a +continuation from a block, all branches within the block must agree on +the type of continuation. By using `cont.bind`, one can +programmatically ensure that the branches within a block each return a +continuation with compatible type (the [Examples](#examples) section +provides several example usages of `cont.bind`). + + +```wasm + cont.bind $ct2 : [tp1* (ref $ct1)] -> [(ref $ct2)] + where: + $ct1 = cont [tp1* tp2*] -> [tr*] + $ct2 = cont [tp2*] -> [tr*] +``` + +The instruction `cont.bind` binds the arguments of type `tp1*` to a +continuation of type `$ct1`, yielding a modified continuation of type +`$ct2` which expects fewer arguments. This instruction also consumes +its continuation argument, and yields a new continuation that can be +supplied to either `resume`,`resume_throw`, or `cont.bind`. + +### Trapping continuations + +In order to allow ensuring that control cannot be captured across +certain abstraction or language boundaries, we provide an instruction +for explicitly trapping attempts at reifying stacks across a certain +point. + +```wasm + barrier $l bt instr* end : [t1*] -> [t2*] + where: + - bt = [t1*] -> [t2*] + - instr* : [t1*] -> [t2*] +``` + +The `barrier` instruction is a block with label `$l`, block type +`bt = [t1*] -> [t2*]`, whose body is the instruction sequence given +by `instr*`. Operationally, `barrier` may be viewed as a "catch-all" +handler, that handles any control tag by invoking a trap. + +## Continuation lifetime + +### Producing continuations + +There are three different ways in which continuations are produced +(`cont.new,suspend,cont.bind`). A fresh continuation object is +allocated with `cont.new` and the current continuation is reused with +`suspend` and `cont.bind`. + +The `cont.bind` instruction is directly analogous to the mildly +controversial `func.bind` instruction from the function references +proposal. However, whereas the latter necessitates the allocation of a +new closure, as continuations are single-shot no allocation is +necessary: all allocation happens when the original continuation is +created by preallocating one slot for each continuation argument. + +### Consuming continuations + +There are three different ways in which continuations are consumed +(`resume,resume_throw,cont.bind`). A continuation is resumed with a +particular handler with `resume`. A continuation is aborted with +`resume_throw`. A continuation is partially applied with `cont.bind`. + +In order to ensure that continuations are one-shot, `resume`, +`resume_throw`, and `cont.bind` destructively modify the continuation +object such that any subsequent use of the same continuation object +will result in a trap. + +## Examples + +### Lightweight threads (static) + +(The full code for this example is [here](examples/static-lwt.wast).) + +Lightweight threads are one of the primary use-cases for typed +continuations. In their most basic *static* form we assume a fixed +collection of cooperative threads with a single tag that allows a +thread to signal that it is willing to yield. + +```wasm +(module $lwt + (tag $yield (export "yield")) +) +(register "lwt") +``` + +The `$yield` tag takes no parameter and has no result. Having +declared it, we can now write some cooperative threads as functions. + +```wasm +(module $example + (tag $yield (import "lwt" "yield")) + (func $log (import "spectest" "print_i32") (param i32)) + + (func $thread1 (export "thread1") + (call $log (i32.const 10)) + (suspend $yield) + (call $log (i32.const 11)) + (suspend $yield) + (call $log (i32.const 12)) + ) + + (func $thread2 (export "thread2") + (call $log (i32.const 20)) + (suspend $yield) + (call $log (i32.const 21)) + (suspend $yield) + (call $log (i32.const 22)) + ) + + (func $thread3 (export "thread3") + (call $log (i32.const 30)) + (suspend $yield) + (call $log (i32.const 31)) + (suspend $yield) + (call $log (i32.const 32)) + ) +) +(register "example") +``` + +Our intention is to interleave the execution of `$thread1`, +`$thread2`, and `$thread3`, using `(suspend $yield)` to suspend +execution to a scheduler which will perform a context switch. + +If we were to try to run any of these functions at the top-level then +they would trap as soon as they try to suspend with the `$yield$` +tag, because we have not yet specified how to handle it. + +We now define a scheduler. + +```wasm +(module $scheduler + (type $func (func)) + (type $cont (cont $func)) + + (tag $yield (import "lwt" "yield")) + + ;; queue interface + (func $queue-empty (import "queue" "queue-empty") (result i32)) + (func $dequeue (import "queue" "dequeue") (result (ref null $cont))) + (func $enqueue (import "queue" "enqueue") (param $k (ref $cont))) + + (func $run (export "run") + (loop $l + (if (call $queue-empty) (then (return))) + (block $on_yield (result (ref $cont)) + (resume (tag $yield $on_yield) + (call $dequeue) + ) + (br $l) ;; thread terminated + ) ;; $on_yield (result (ref $cont)) + (call $enqueue) ;; continuation of current thread + (br $l) + ) + ) +) +(register "scheduler") +``` + +We assume a suitable interface to a queue of active threads +represented as continuations. The scheduler is a loop which repeatedly +runs the continuation (thread) at the head of the queue. It does so by +resuming the continuation with a handler for the `$yield` tag. The +handler `(tag $yield $on_yield)` specifies that the `$yield` tag +is handled by running the code immediately following the block +labelled with `$on_yield`, the `$on_yield` clause. The result of the +block `(result (ref $cont))` declares that there will be a +continuation on the stack when suspending with the `$yield` tag, +which is the continuation of the currently executing thread. The +`$on_yield` clause enqueues this continuation and proceeds to the next +iteration of the loop. + +In order to interleave our three test threads together, we create a +new continuation for each, enqueue the continuations, and invoke the +scheduler. The `cont.new` operation turns a function reference into a +corresponding continuation reference. + +```wasm +(module + (type $func (func)) + (type $cont (cont $func)) + + (func $scheduler (import "scheduler" "run")) + (func $enqueue (import "queue" "enqueue") (param (ref $cont))) + + (func $log (import "spectest" "print_i32") (param i32)) + + (func $thread1 (import "example" "thread1")) + (func $thread2 (import "example" "thread2")) + (func $thread3 (import "example" "thread3")) + + (elem declare func $thread1 $thread2 $thread3) + + (func (export "run") + (call $enqueue (cont.new (type $cont) (ref.func $thread1))) + (call $enqueue (cont.new (type $cont) (ref.func $thread2))) + (call $enqueue (cont.new (type $cont) (ref.func $thread3))) + + (call $log (i32.const -1)) + (call $scheduler) + (call $log (i32.const -2)) + ) +) + +(invoke "run") +``` + +The output is as follows. +``` +-1 : i32 +10 : i32 +20 : i32 +30 : i32 +11 : i32 +21 : i32 +31 : i32 +12 : i32 +22 : i32 +32 : i32 +-2 : i32 +``` +The threads are interleaved as expected. + +### Lightweight threads (dynamic) + +(The full code for this example is [here](examples/lwt.wast).) + +We can make our lightweight threads functionality considerably more +expressive by allowing new threads to be forked dynamically. + +```wasm +(module $lwt + (type $func (func)) + (type $cont (cont $func)) + + (tag $yield (export "yield")) + (tag $fork (export "fork") (param (ref $cont))) +) +(register "lwt") +``` + +We declare a new `$fork` tag that takes a continuation as a +parameter and (like `$yield`) returns no result. Now we modify our +example to fork each of the three threads from a single main thread. + +```wasm +(module $example + (type $func (func)) + (type $cont (cont $func)) + + (tag $yield (import "lwt" "yield")) + (tag $fork (import "lwt" "fork") (param (ref $cont))) + + (func $log (import "spectest" "print_i32") (param i32)) + + (elem declare func $thread1 $thread2 $thread3) + + (func $main (export "main") + (call $log (i32.const 0)) + (suspend $fork (cont.new (type $cont) (ref.func $thread1))) + (call $log (i32.const 1)) + (suspend $fork (cont.new (type $cont) (ref.func $thread2))) + (call $log (i32.const 2)) + (suspend $fork (cont.new (type $cont) (ref.func $thread3))) + (call $log (i32.const 3)) + ) + + (func $thread1 + (call $log (i32.const 10)) + (suspend $yield) + (call $log (i32.const 11)) + (suspend $yield) + (call $log (i32.const 12)) + ) + + (func $thread2 + (call $log (i32.const 20)) + (suspend $yield) + (call $log (i32.const 21)) + (suspend $yield) + (call $log (i32.const 22)) + ) + + (func $thread3 + (call $log (i32.const 30)) + (suspend $yield) + (call $log (i32.const 31)) + (suspend $yield) + (call $log (i32.const 32)) + ) +) +(register "example") +``` + +As with the static example we define a scheduler module. +```wasm +(module $scheduler + (type $func (func)) + (type $cont (cont $func)) + + (tag $yield (import "lwt" "yield")) + (tag $fork (import "lwt" "fork") (param (ref $cont))) + + (func $queue-empty (import "queue" "queue-empty") (result i32)) + (func $dequeue (import "queue" "dequeue") (result (ref null $cont))) + (func $enqueue (import "queue" "enqueue") (param $k (ref null $cont))) + ... +) +(register "scheduler") +``` + +In this example we illustrate five different schedulers. First, we +write a baseline synchronous scheduler which simply runs the current +thread to completion without actually yielding. + +```wasm + (func $sync (export "sync") (param $nextk (ref null $cont)) + (loop $l + (if (ref.is_null (local.get $nextk)) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fork (result (ref $cont) (ref $cont)) + (resume (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) + ) + (local.set $nextk (call $dequeue)) + (br $l) ;; thread terminated + ) ;; $on_fork (result (ref $cont) (ref $cont)) + (local.set $nextk) ;; current thread + (call $enqueue) ;; new thread + (br $l) + ) + ;; $on_yield (result (ref $cont)) + (local.set $nextk) ;; carry on with current thread + (br $l) + ) + ) +``` + +The `$nextk` parameter represents the continuation of the next +thread. The loop is repeatedly executed until `$nextk` is null +(meaning that all threads have finished). The body of the loop is the +code inside the two nested blocks. It resumes the next continuation, +dequeues the next continuation, and then continues to the next +iteration of the loop. The handler passed to `resume` specifies how to +handle both `$yield` and `$fork` tags. Yielding carries on executing +the current thread (this scheduler is synchronous). Forking enqueues +the new thread and continues executing the current thread. + +As with the static example, the result of the `$on_yield` block +`(result (ref $cont))` declares that there will be a continuation on +the stack when suspending with the `$yield` tag, which is the +continuation of the currently executing thread. The result of the +`$on_fork` block `(result (ref $cont) (ref $cont))` declares that +there will be two continuations on the stack when suspending with the +`$fork` tag: the first is the parameter passed to fork (the new +thread) and the second is the continuation of the currently executing +thread. + +Running the synchronous scheduler on the example produces the following output. +``` +0 : i32 +1 : i32 +2 : i32 +3 : i32 +10 : i32 +11 : i32 +12 : i32 +20 : i32 +21 : i32 +22 : i32 +30 : i32 +31 : i32 +32 : i32 +``` +First the main thread runs to completion, then each of the forked +threads in sequence. + +Following a similar pattern, we define four different asynchronous +schedulers. + +```wasm + ;; four asynchronous schedulers: + ;; * kt and tk don't yield on encountering a fork + ;; 1) kt runs the continuation, queuing up the new thread for later + ;; 2) tk runs the new thread first, queuing up the continuation for later + ;; * ykt and ytk do yield on encountering a fork + ;; 3) ykt runs the continuation, queuing up the new thread for later + ;; 4) ytk runs the new thread first, queuing up the continuation for later + + ;; no yield on fork, continuation first + (func $kt (export "kt") (param $nextk (ref null $cont)) + (loop $l + (if (ref.is_null (local.get $nextk)) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fork (result (ref $cont) (ref $cont)) + (resume (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) + ) + (local.set $nextk (call $dequeue)) + (br $l) ;; thread terminated + ) ;; $on_fork (result (ref $cont) (ref $cont)) + (local.set $nextk) ;; current thread + (call $enqueue) ;; new thread + (br $l) + ) + ;; $on_yield (result (ref $cont)) + (call $enqueue) ;; current thread + (local.set $nextk (call $dequeue)) ;; next thread + (br $l) + ) + ) + + ;; no yield on fork, new thread first + (func $tk (export "tk") (param $nextk (ref null $cont)) + (loop $l + (if (ref.is_null (local.get $nextk)) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fork (result (ref $cont) (ref $cont)) + (resume (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) + ) + (local.set $nextk (call $dequeue)) + (br $l) ;; thread terminated + ) ;; $on_fork (result (ref $cont) (ref $cont)) + (call $enqueue) ;; current thread + (local.set $nextk) ;; new thread + (br $l) + ) + ;; $on_yield (result (ref $cont)) + (call $enqueue) ;; current thread + (local.set $nextk (call $dequeue)) ;; next thread + (br $l) + ) + ) + + ;; yield on fork, continuation first + (func $ykt (export "ykt") (param $nextk (ref null $cont)) + (loop $l + (if (ref.is_null (local.get $nextk)) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fork (result (ref $cont) (ref $cont)) + (resume (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) + ) + (local.set $nextk (call $dequeue)) + (br $l) ;; thread terminated + ) ;; $on_fork (result (ref $cont) (ref $cont)) + (call $enqueue) ;; current thread + (call $enqueue) ;; new thread + (local.set $nextk (call $dequeue)) ;; next thread + (br $l) + ) + ;; $on_yield (result (ref $cont)) + (call $enqueue) ;; current thread + (local.set $nextk (call $dequeue)) ;; next thread + (br $l) + ) + ) + + ;; yield on fork, new thread first + (func $ytk (export "ytk") (param $nextk (ref null $cont)) + (loop $l + (if (ref.is_null (local.get $nextk)) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fork (result (ref $cont) (ref $cont)) + (resume (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) + ) + (local.set $nextk (call $dequeue)) + (br $l) ;; thread terminated + ) ;; $on_fork (result (ref $cont) (ref $cont)) + (local.set $nextk) + (call $enqueue) ;; new thread + (call $enqueue (local.get $nextk)) ;; current thread + (local.set $nextk (call $dequeue)) ;; next thread + (br $l) + ) + ;; $on_yield (result (ref $cont)) + (call $enqueue) ;; current thread + (local.set $nextk (call $dequeue)) ;; next thread + (br $l) + ) + ) +``` + +Each `$on_yield` clause is identical, enqueing the continuation of the +current thread and dequeing the next continuation for the thread. The +`$on_fork` clauses implement different behaviours for scheduling the +current and newly forked threads. + +We run our example using each of the five schedulers. + +```wasm +(module + (type $func (func)) + (type $cont (cont $func)) + + (func $scheduler1 (import "scheduler" "sync") (param $nextk (ref null $cont))) + (func $scheduler2 (import "scheduler" "kt") (param $nextk (ref null $cont))) + (func $scheduler3 (import "scheduler" "tk") (param $nextk (ref null $cont))) + (func $scheduler4 (import "scheduler" "ykt") (param $nextk (ref null $cont))) + (func $scheduler5 (import "scheduler" "ytk") (param $nextk (ref null $cont))) + + (func $log (import "spectest" "print_i32") (param i32)) + + (func $main (import "example" "main")) + + (elem declare func $main) + + (func (export "run") + (call $log (i32.const -1)) + (call $scheduler1 (cont.new (type $cont) (ref.func $main))) + (call $log (i32.const -2)) + (call $scheduler2 (cont.new (type $cont) (ref.func $main))) + (call $log (i32.const -3)) + (call $scheduler3 (cont.new (type $cont) (ref.func $main))) + (call $log (i32.const -4)) + (call $scheduler4 (cont.new (type $cont) (ref.func $main))) + (call $log (i32.const -5)) + (call $scheduler5 (cont.new (type $cont) (ref.func $main))) + (call $log (i32.const -6)) + ) +) + +(invoke "run") +``` + +The output is as follows, demonstrating the various different scheduling behaviours. +``` +-1 : i32 +0 : i32 +1 : i32 +2 : i32 +3 : i32 +10 : i32 +11 : i32 +12 : i32 +20 : i32 +21 : i32 +22 : i32 +30 : i32 +31 : i32 +32 : i32 +-2 : i32 +0 : i32 +1 : i32 +2 : i32 +3 : i32 +10 : i32 +20 : i32 +30 : i32 +11 : i32 +21 : i32 +31 : i32 +12 : i32 +22 : i32 +32 : i32 +-3 : i32 +0 : i32 +10 : i32 +1 : i32 +20 : i32 +11 : i32 +2 : i32 +30 : i32 +21 : i32 +12 : i32 +3 : i32 +31 : i32 +22 : i32 +32 : i32 +-4 : i32 +0 : i32 +1 : i32 +10 : i32 +2 : i32 +20 : i32 +11 : i32 +3 : i32 +30 : i32 +21 : i32 +12 : i32 +31 : i32 +22 : i32 +32 : i32 +-5 : i32 +0 : i32 +10 : i32 +1 : i32 +11 : i32 +20 : i32 +2 : i32 +12 : i32 +21 : i32 +30 : i32 +3 : i32 +22 : i32 +31 : i32 +32 : i32 +-6 : i32 +``` + +### Actors + +TODO + +### Async/await + +TODO + +### Delimited continuations + +(The full code for this example is [here](examples/control-lwt.wast).) + +Conventional unstructured delimited continuations can be directly +implemented using our typed continuations design. Here we illustrate +how to implement lightweight threads on top of the control/prompt +delimited control operators. + +First we implement control/prompt. + +```wasm +;; interface to control/prompt +(module $control + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) + + ;; we sometimes write contref as shorthand for a reference to a continuation + + (type $cont-func (func (param (ref $cont)))) ;; [contref ([] -> [])] -> [] + (type $cont-cont (cont $cont-func)) ;; cont ([contref ([] -> [])] -> []) + + ;; Implementation of a generic delimited control operator using + ;; effect handlers. + ;; + ;; For lightweight threads we have no payload. More general types + ;; for control and prompt are: + ;; + ;; control : [([contref ([ta*] -> [tr*])] -> [tr*])] -> [ta*] + ;; prompt : [contref ([] -> [tr*])] -> [tr*] + ;; + ;; (We can also give more refined types if we want to support + ;; answer-type modification and various flavours of answer-type + ;; polymorphism - but these are well outside the scope of a Wasm + ;; proposal!) + ;; + ;; (Technically this is control0/prompt0 rather than + ;; control/prompt.) + (tag $control (export "control") (param (ref $cont-func))) ;; control : [([contref ([] -> [])] -> [])] -> [] + (func $prompt (export "prompt") (param $nextk (ref null $cont)) ;; prompt : [(contref ([] -> []))] -> [] + (block $on_control (result (ref $cont-func) (ref $cont)) + (resume (tag $control $on_control) + (local.get $nextk)) + (return) + ) ;; $on_control (param (ref $cont-func) (ref $cont)) + (let (local $h (ref $cont-func)) (local $k (ref $cont)) + (call_ref (local.get $k) (local.get $h)) + ) + ) +) +(register "control") +``` + +The `$control` tag amounts to a universal control tag, which takes a +second-order function `$h` as an argument (it's second-order in that +it's a function that itself takes a function, wrapped in a +continuation, as an argument). The implementation of prompt is the +universal handler for `$control`, which simply applies the second +order function `$h` to the captured continuation. + +In the above code we have specialised `$control` and `$prompt` to the +case where the continuation has no parameters and no results, as this +suffices for implementing lightweight threads. A continuation +parameter corresponds to the result of a control tag, so in the +absence of parametric polymorphism, in order to simulate standard +control tags in general we would need one copy of `$control` for each +type of result we wanted to support. + +The following example is just like the one we implemented for dynamic +lightweight threads using `$yield` and `$fork` tags decoupled from +handlers for defining different schedulers. Here instead we +parameterise the whole example by the behaviour of yielding and +forking as `$yield` and `$fork` functions. + +```wasm +(module $example + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) + + (type $cont-func (func (param (ref $cont)))) ;; [cont ([] -> [])] -> [] + (type $cont-cont (cont $cont-func)) ;; cont ([cont ([] -> [])] -> []) + + (type $func-cont-func-func (func (param (ref $func)) (param (ref $cont-func)))) ;; ([] -> []) -> ([contref ([] -> [])] -> []) -> [] + (type $func-cont-func-cont (cont $func-cont-func-func)) ;; cont (([] -> []) -> ([contref ([] -> [])] -> []) -> []) + + (func $log (import "spectest" "print_i32") (param i32)) + + (elem declare func $main $thread1 $thread2 $thread3) + + (func $main (export "main") (param $yield (ref $func)) (param $fork (ref $cont-func)) + (call $log (i32.const 0)) + (call_ref + (cont.bind (type $cont) (local.get $yield) (local.get $fork) + (cont.new (type $func-cont-func-cont) (ref.func $thread1))) + (local.get $fork)) + (call $log (i32.const 1)) + (call_ref + (cont.bind (type $cont) (local.get $yield) (local.get $fork) + (cont.new (type $func-cont-func-cont) (ref.func $thread2))) + (local.get $fork)) + (call $log (i32.const 2)) + (call_ref + (cont.bind (type $cont) (local.get $yield) (local.get $fork) + (cont.new (type $func-cont-func-cont) (ref.func $thread3))) + (local.get $fork)) + (call $log (i32.const 3)) + ) + + (func $thread1 (param $yield (ref $func)) (param $fork (ref $cont-func)) + (call $log (i32.const 10)) + (call_ref (local.get $yield)) + (call $log (i32.const 11)) + (call_ref (local.get $yield)) + (call $log (i32.const 12)) + ) + + (func $thread2 (param $yield (ref $func)) (param $fork (ref $cont-func)) + (call $log (i32.const 20)) + (call_ref (local.get $yield)) + (call $log (i32.const 21)) + (call_ref (local.get $yield)) + (call $log (i32.const 22)) + ) + + (func $thread3 (param $yield (ref $func)) (param $fork (ref $cont-func)) + (call $log (i32.const 30)) + (call_ref (local.get $yield)) + (call $log (i32.const 31)) + (call_ref (local.get $yield)) + (call $log (i32.const 32)) + ) +) +(register "example") +``` + +The function type `$func-cont-func-fun` is the type of a function that +takes an implementation of a `$yield` function and the implementation +as a `$fork` function as pararameters; the continuation type +`$func-cont-func-cont` is the same thing as a continuation. + +We now define a scheduler module analogous to that of the previous +dynamic lightweight thread example. As before, we will implement five +different schedulers. + +```wasm +(module + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) + + (type $cont-func (func (param (ref $cont)))) ;; [contref ([] -> [])] -> [] + (type $cont-cont (cont $cont-func)) ;; [(contref ([contref ([] -> [])]))] -> [] + + (type $func-cont-func-func (func (param (ref $func)) (param (ref $cont-func)))) ;; ([] -> []) -> ([cont ([] -> [])] -> []) -> [] + (type $func-cont-func-cont (cont $func-cont-func-func)) ;; cont (([] -> []) -> ([cont ([] -> [])] -> []) -> []) + + (elem declare func + $handle-yield-sync $handle-yield + $handle-fork-sync $handle-fork-kt $handle-fork-tk $handle-fork-ykt $handle-fork-ytk + $yield + $fork-sync $fork-kt $fork-tk $fork-ykt $fork-ytk) + + ;; control/prompt interface + (tag $control (import "control" "control") (param (ref $cont-func))) ;; control : ([cont ([] -> [])] -> []) -> [] + (func $prompt (import "control" "prompt") (param $nextk (ref null $cont))) ;; prompt : cont ([] -> []) -> [] + + ;; queue interface + (func $queue-empty (import "queue" "queue-empty") (result i32)) + (func $dequeue (import "queue" "dequeue") (result (ref null $cont))) + (func $enqueue (import "queue" "enqueue") (param $k (ref $cont))) + ... +(register "scheduler") +``` + +Unlike before, with control/prompt a generic scheduler loop must be +decoupled from the implementations of each operation (yield / fork) as +the latter are passed in as arguments to user code + +```wasm + ;; generic boilerplate scheduler + (func $scheduler (param $nextk (ref null $cont)) + (loop $loop + (if (ref.is_null (local.get $nextk)) (then (return))) + (call $prompt (local.get $nextk)) + (local.set $nextk (call $dequeue)) + (br $loop) + ) + ) +``` + +The scheduler loop simply keeps on calling prompt with the next thread +in the queue until the queue of threads is exhausted. + +For each scheduler, we invoke the generic scheduler using a +continuation parameterised by suitable implementations of yield and +fork. + +First, we do the baseline synchronous scheduler. + +```wasm + ;; synchronous scheduler + (func $handle-yield-sync (param $k (ref $cont)) + (call $scheduler (local.get $k)) + ) + (func $yield-sync + (suspend $control (ref.func $handle-yield)) + ) + (func $handle-fork-sync (param $t (ref $cont)) (param $k (ref $cont)) + (call $enqueue (local.get $t)) + (call $scheduler (local.get $k)) + ) + (func $fork-sync (param $t (ref $cont)) + (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-sync))) + ) + (func $sync (export "sync") (param $k (ref $func-cont-func-cont)) + (call $scheduler + (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-sync) (local.get $k))) + ) +``` + +The `func.bind` instruction is needed in the implementations of fork +More generally `func.bind` is needed for any operation that takes +arguments. One could use another continuation here instead, but +constructing a new continuation every time an operation is invoked +seems unnecessarily wasteful. + +All of the asynchronous schedulers make use of the same implementation +of yield, which enqueues the continuation of the current thread and +dequeues the next available thread. + +```wasm + ;; asynchronous yield (used by all asynchronous schedulers) + (func $handle-yield (param $k (ref $cont)) + (call $enqueue (local.get $k)) + (call $scheduler (call $dequeue)) + ) + (func $yield + (suspend $control (ref.func $handle-yield)) + ) +``` + +Each asynchronous scheduler uses its own implementation of fork. + +```wasm + ;; four asynchronous implementations of fork: + ;; * kt and tk don't yield on encountering a fork + ;; 1) kt runs the continuation, queuing up the new thread for later + ;; 2) tk runs the new thread first, queuing up the continuation for later + ;; * ykt and ytk do yield on encountering a fork + ;; 3) ykt runs the continuation, queuing up the new thread for later + ;; 4) ytk runs the new thread first, queuing up the continuation for later + + ;; no yield on fork, continuation first + (func $handle-fork-kt (param $t (ref $cont)) (param $k (ref $cont)) + (call $enqueue (local.get $t)) + (call $scheduler (local.get $k)) + ) + (func $fork-kt (param $t (ref $cont)) + (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-kt))) + ) + (func $kt (export "kt") (param $k (ref $func-cont-func-cont)) + (call $scheduler + (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-kt) (local.get $k))) + ) + + ;; no yield on fork, new thread first + (func $handle-fork-tk (param $t (ref $cont)) (param $k (ref $cont)) + (call $enqueue (local.get $k)) + (call $scheduler (local.get $t)) + ) + (func $fork-tk (param $t (ref $cont)) + (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-tk))) + ) + (func $tk (export "tk") (param $k (ref $func-cont-func-cont)) + (call $scheduler + (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-tk) (local.get $k))) + ) + + ;; yield on fork, continuation first + (func $handle-fork-ykt (param $t (ref $cont)) (param $k (ref $cont)) + (call $enqueue (local.get $k)) + (call $enqueue (local.get $t)) + (call $scheduler (call $dequeue)) + ) + (func $fork-ykt (param $t (ref $cont)) + (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-ykt))) + ) + (func $ykt (export "ykt") (param $k (ref $func-cont-func-cont)) + (call $scheduler + (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-ykt) (local.get $k))) + ) + + ;; yield on fork, new thread first + (func $handle-fork-ytk (param $t (ref $cont)) (param $k (ref $cont)) + (call $enqueue (local.get $t)) + (call $enqueue (local.get $k)) + (call $scheduler (call $dequeue)) + ) + (func $fork-ytk (param $t (ref $cont)) + (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-ytk))) + ) + (func $ytk (export "ytk") (param $k (ref $func-cont-func-cont)) + (call $scheduler + (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-ytk) (local.get $k))) + ) +) +(register "scheduler") +``` + +Invoking the schedulers is much like in our original dynamic +lightweight threads example, but the types are more complex due to the +need to index the handled computation (`$main` in this case) by the +implementations of forking and yielding. + +```wasm +(module + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) + + (type $cont-func (func (param (ref $cont)))) ;; [contref ([] -> [])] -> [] + (type $cont-cont (cont $cont-func)) ;; cont ([contref ([] -> [])] -> []) + + (type $func-cont-func-func (func (param (ref $func)) (param (ref $cont-func)))) ;; ([] -> []) -> ([contref ([] -> [])] -> []) -> [] + (type $func-cont-func-cont (cont $func-cont-func-func)) ;; contref (([] -> []) -> ([contref ([] -> [])] -> []) -> []) + + (func $scheduler-sync (import "scheduler" "sync") (param $nextk (ref $func-cont-func-cont))) + (func $scheduler-kt (import "scheduler" "kt") (param $nextk (ref $func-cont-func-cont))) + (func $scheduler-tk (import "scheduler" "tk") (param $nextk (ref $func-cont-func-cont))) + (func $scheduler-ykt (import "scheduler" "ykt") (param $nextk (ref $func-cont-func-cont))) + (func $scheduler-ytk (import "scheduler" "ytk") (param $nextk (ref $func-cont-func-cont))) + + (func $log (import "spectest" "print_i32") (param i32)) + + (func $main (import "example" "main") (param $yield (ref $func)) (param $fork (ref $cont-func))) + + (elem declare func $main) + + (func $run (export "run") + (call $log (i32.const -1)) + (call $scheduler-sync (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $log (i32.const -2)) + (call $scheduler-kt (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $log (i32.const -3)) + (call $scheduler-tk (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $log (i32.const -4)) + (call $scheduler-ykt (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $log (i32.const -5)) + (call $scheduler-ytk (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $log (i32.const -6)) + ) +) +``` + +The output of running this code is just as in the direct +implementation of dynamic lightweight threads. + +## Implementation strategies + +### Segmented stacks + +TODO + + + + +### Continuation-passing style + +TODO + +### Virtual memory + +TODO + +### Stack cut'n'paste + +TODO + +### OS threads + +TODO + +## Design considerations and extensions + +### Memory management + +The current proposal does not require a general garbage collector as +the linearity of continuations guarantees that there are no cycles in +continuation objects. In theory, we could dispense with automated +memory management altogether if we took seriously the idea that +failure to use a continuation constitutes a bug in the producer. In +practice, for most producers enforcing such a discipline is +unrealistic and not something an engine can rely on anyway. To prevent +space leaks, most engines will need some form of automated memory +meanagement for unconsumed continuations. Due to the acyclicity of +continuations, a reference counting scheme is sufficient. + +### Linear versus constant time dispatch + +The `suspend` instruction relies on traversing a stack of +handlers in order to find the appropriate handler, similarly to +exception handling. A potential problem is that this can incur a +linear runtime cost, especially if we think in terms of segmented +stacks, where `suspend` must search the active stack chain for a +suitable handler for its argument. Practical experience from Multicore +OCaml suggests that for critical use cases (async/await, lightweight +threads, actors, etc.) the depth of the handler stack tends to be +small so the cost of this linear traversal is negligible. Nonetheless, +future applications may benefit from constant-time dispatch. To enable +constant-time dispatch we would need to know the target stack a +priori, which might be acheived either by maintaining a shadow stack +or by extending `suspend` to explicitly target a named handler. + +### Named handlers + +We can accommodate named handlers by introducing a new reference type +`handler t*`, which essentially is a unique prompt created by +executing a variant of the `resume` instruction and is passed to the +continuation: + +```wasm + resume_with (tag $e $l)* : [ t1* (ref $ht) ] -> [ t2* ] + where: + - $ht = handler t2* + - $ct = cont ([ (ref $ht) t1* ] -> [ t2* ]) +``` + +The handler reference is similar to a prompt in a system of +multi-prompt continuations. However, since it is created fresh for +each handler, multiple activations of the same prompt cannot exist by +construction. + +This instruction is complemented by an instruction for suspending to a +specific handler: + +```wasm + suspend_to $e : [ s* (ref $ht) ] -> [ t* ] + where: + - $ht = handler tr* + - $e : [ s* ] -> [ t* ] +``` + +If the handler is not currently active, e.g., because an outer handler +has been suspended, then this instruction would trap. + +### Direct switching + +The current proposal uses the asymmetric suspend/resume pair of +primitives that is characteristic of effect handlers. It does not +include a symmetric way of switching to another continuation directly, +without going through a handler, and it is conceivable that the double +hop through a handler might involve unnecessary overhead for use cases +like lightweight threading. + +Though there is currently no evidence that the double hop overhead is +significant in practice, if it does turn out to be important for some +applications then the current proposal can be extended with a more +symmetric `switch_to` primitive. + +Given named handlers, it is possible to introduce a somewhat magic +instruction for switching directly to another continuation: + +```wasm + switch_to : [ t1* (ref $ct1) (ref $ht) ] -> [ t2* ] + where: + - $ht = handler t3* + - $ct1 = cont ([ (ref $ht) (ref $ct2$) t1* ] -> [ t3* ]) + - $ct2 = cont ([ t2* ] -> [ t3* ]) +``` + +This behaves as if there was a built-in tag + +```wasm + (tag $Switch (param t1* (ref $ct1)) (result t3*)) +``` + +with which the computation suspends to the handler, and the handler +implicitly handles this by resuming to the continuation argument, +thereby effectively switching to it in one step. Like `suspend_to`, +this would trap if the handler was not currently active. + +The fact that the handler implicitly resumes, passing itself as a +handler to the target continuation, makes this construct behave like a +deep handler, which is slightly at odds with the rest of the proposal. + +In addition to the handler, `switch_to` also passes the new +continuation to the target, which allows the target to switch back to +it in a symmetric fashion. Notably, in such a use case, `$ct1` and +`$ct2` would be the same type (and hence recursive). + +In fact, symmetric switching need not necessarily be tied to named +handlers, since there could also be an indirect version with dynamic +handler lookup: + +```wasm + switch : [ t1* (ref $ct1) ] -> [ t2* ] + where: + - $ct1 = cont ([ (ref $ct2) t1* ] -> [ t3* ]) + - $ct2 = cont ([ t2* ] -> [ t3* ]) +``` + +It seems undesirable that every handler implicitly handles the +built-in `$Switch` tag, so this should be opt-in by a mode flag on the +resume instruction(s). + +### Control/prompt as an alternative basis + +An alternative to our typed continuations proposal is to use more +established delimited control operators such as control/prompt and +shift/reset. As illustrated in the examples section, control/prompt +can be viewed as a special instance of the current proposal with a +single universal control tag `control` and a handler for each +`prompt`. + +As `control` amounts to a universal control tag it correspondingly has +a higher-order type. As illustrated by the example, this requires more +complicated types than with the current proposal and depends on +greater use of function closures. + +When considered as a source language feature effect handlers are +preferable to control/prompt because they are more modular and easier +to reason about. Effect handlers naturally provide a separation of +concerns. Users program to an effect interface, whereas `control` +allows (and indeed requires) them to essentially rewrite the +implementation inline (in practice this is unmanageable, so one +abstracts over a few key behaviours using functions as illustrated in +the example). Of course, intermediate languages have different +requirements to source languages, so modularity and ease of reasoning +may be less critical. Nonetheless, they should not be discounted +entirely. + +### Coupling of continuation capture and dispatch + +A possible concern with the current design is that it relies on a +specific form of dispatch based on tags. Suspending not only captures +the current continuation up to the nearest prompt, but also dispatches +to the handler clause associated with the given tag. It might be +tempting to try to decouple continuation capture from dispatch, but it +is unclear what other form of dispatch would be useful or whether +there is a clean way to enable such decoupling. + +With control/prompt there is no coupling of continuation capture with +dispatch, because there is no dispatch. But this is precisely because +`control` behaves as a universal tag, which requires behaviour to be +given inline via a closure, breaking modularity and necessitating a +higher-order type even for simple uses of continuations like +lightweight threads. + +This is not to say that control/prompt or a generalisation to +multiprompt delimited continuations is necessarily a bad low-level +implementation technique. For instance, the +[libmprompt](https://github.com/koka-lang/libmprompt) C library +implements effect handlers on top of multiprompt delimited +continuations. However, a key difference there is that the C +implementation does not require static stack typing, something that is +fundamental to the design of Wasm. Thus, the implementation does not +need to contend directly with the higher-order type of `control`. + +### Tail-resumptive handlers + +A handler is said to be *tail-resumptive* if the handler invokes the +continuation in tail-position in every control tag clause. The +canonical example of a tail-resumptive handler is dynamic binding +(which can be useful to implement implicit parameters to +computations). The control tag clauses of a tail-resumptive handler +can be inlined at the control tag invocation sites, because they do +not perform any non-trivial control flow manipulation, they simply +retrieve a value. Inlining clause definitions means that no time is +spent constructing continuation objects. + +The present iteration of this proposal does not include facilities for +identifying and inlining tail-resumptive handlers. None of the +critical use-cases requires such a facility. Nevertheless, it is +natural to envisage a future iteration of this proposal that includes +an extension for distinguishing tail-resumptive handlers. + +### Multi-shot continuations + +Continuations in this proposal are *single-shot* (aka *linear*), +meaning that they must be invoked exactly once (though this is not +statically enforced). A continuation can be invoked either by resuming +it (with `resume`) or by aborting it (with `resume_throw`). Some +applications such as backtracking, probabilistic programming, and +process duplication exploit *multi-shot* continuations, but none of +the critical use cases require multi-shot continuations. Nevertheless, +it is natural to envisage a future iteration of this proposal that +includes support for multi-shot continuations by way of a continuation +clone instruction. + +### Interoperability, legacy code, and the barrier instruction + +The barrier instruction provides a direct way of preventing control +tags from being suspended outside a particular computation. + +Consider a module A written using an existing C/C++ compiler that +targets a Wasm backend. Let us assume that module A depends on a +second Wasm module B. Now suppose that the producer for module B is +updated to take advantage of typed continuations. In order to ensure +that suspensions arising in calls to B do not pass through A, +potentially causing unexpected changes to the semantics of A, the +producer for module A can ensure that all external calls are wrapped +in the barrier instruction. + +It might seem preferable to somehow guarantee that support for typed +continuations is not enabled by default, meaning that no changes to +the producer for module A would be necessary. But it is unclear what +such an approach would look like in practice and whether it would +actually be feasible. In any case, using the barrier instruction the +producer for B could make module B safe for linking with an unchanged +module A by wrapping the barrier instruction around all of the +functions exported by module B. + +Questions of Wasm interoperability and support for legacy code are +largely orthogonal to the typed continuations proposal and similar +issues already arise with extensions such as exceptions. + +### First-class tags + +In the current proposal tags are statically defined in a module +header. This should suffice for supporting the critical +use-cases. However, for some purposes, such as implementing richer +forms of control operators such as effect handlers, it might be useful +to add support for dynamically generated tags. These could be used, +for instance, for more efficiently compiling effect handlers that take +advantage of features such as Multicore OCaml's functors, where the +type of an effect (tag) may not be fully known at compile time. + +### Shallow versus deep handlers + +The effect handlers feature which underlies the design of the typed +continuations proposal classically comes in too forms: shallow and +deep handlers. With shallow handlers, the installation of handlers is +completely decoupled from resuming a continuation. With deep handlers, +the handler that produced the continuation is automatically +reinstalled when a continuation is resumed. The typed continuations +proposal adopts a hybrid of shallow and deep handlers, which we call +*sheep handlers*. Like a shallow handler, there is no automatic +reinstallation of an existing handler. But like deep handlers a new +handler is installed when a continuation is resumed: the new handler +is written explicitly as part of the `resume` instruction. + + +TODO: resuspend (aka OCaml's reperform, and analogous to exception proposal's rethrow) + +TODO: return clauses + +TODO: preemption / asynchrony / interrupts + +TODO: how do we interact with parametric polymorphism? + +TODO: lexically-scoped handlers + +TODO: parametric tags / existential types? + +TODO: tag subtyping? + +TODO: compare to asyncify? + +TODO: compare to Wasm/k? + +TOOD: compare to the Koka Wasm backend? diff --git a/proposals/continuations/Overview.md b/proposals/continuations/Overview.md index 70b1312f8..568c6783b 100644 --- a/proposals/continuations/Overview.md +++ b/proposals/continuations/Overview.md @@ -27,21 +27,21 @@ Based on [typed reference proposal](https://github.com/WebAssembly/function-refe - and `$ft' = [t3* t1'*] -> [t2'*]` - and `[t1'*] -> [t2'*] <: [t1*] -> [t2*]` -* `suspend ` suspends the current continuation - - `suspend $e : [t1*] -> [t2*]` - - iff `event $e : [t1*] -> [t2*]` +* `suspend ` suspends the current continuation + - `suspend $t : [t1*] -> [t2*]` + - iff `tag $t : [t1*] -> [t2*]` -* `resume (event )*` resumes a continuation - - `resume (event $e $l)* : [t1* (ref null? $ct)] -> [t2*]` +* `resume (tag )*` resumes a continuation + - `resume (tag $e $l)* : [t1* (ref null? $ct)] -> [t2*]` - iff `$ct = cont $ft` - and `$ft = [t1*] -> [t2*]` - - and `(event $e : [te1*] -> [te2*])*` + - and `(tag $t : [te1*] -> [te2*])*` - and `(label $l : [te1'* (ref null? $ct')])*` - and `([te1*] <: [te1'*])*` - and `($ct' = cont $ft')*` - and `([te2*] -> [t2*] <: $ft')*` -* `resume_throw ` aborts a continuation +* `resume_throw ` aborts a continuation - `resume_throw $e : [te* (ref null? $ct)] -> [t2*]` - iff `exception $e : [te*]` - and `$ct = cont $ft` @@ -57,11 +57,11 @@ Based on [typed reference proposal](https://github.com/WebAssembly/function-refe ### Store extensions -* New store component `evts` for allocated events - - `S ::= {..., evts *}` +* New store component `tags` for allocated tags + - `S ::= {..., tags *}` -* An *event instance* represents an event tag - - `evtinst ::= {type }` +* A *tag instance* represents a control tag + - `taginst ::= {type }` * New store component `conts` for allocated continuations - `S ::= {..., conts ?*}` @@ -78,10 +78,10 @@ Based on [typed reference proposal](https://github.com/WebAssembly/function-refe - and `$ct = cont $ft` - and `$ft = [t1^n] -> [t2*]` -* `(handle{( )*}? * end)` represents an active handler (or a barrier when no handler list is present) +* `(handle{( )*}? * end)` represents an active handler (or a barrier when no handler list is present) - `(handle{(a $l)*}? instr* end) : [t1*] -> [t2*]` - iff `instr* : [t1*] -> [t2*]` - - and `(S.evts[a].type = [te1*] -> [te2*])*` + - and `(S.tags[a].type = [te1*] -> [te2*])*` - and `(label $l : [te1'* (ref null? $ct')])*` - and `([te1*] <: [te1'*])*` - and `($ct' = cont $ft')*` @@ -124,14 +124,14 @@ H^ea ::= - and `S' = S with conts[ca] = epsilon with conts += (E : |t1'*|)` - and `E = E'[v^n _]` -* `S; F; (ref.null t) (resume (event $e $l)*) --> S; F; trap` +* `S; F; (ref.null t) (resume (tag $e $l)*) --> S; F; trap` -* `S; F; (ref.cont ca) (resume (event $e $l)*) --> S; F; trap` +* `S; F; (ref.cont ca) (resume (tag $e $l)*) --> S; F; trap` - iff `S.conts[ca] = epsilon` -* `S; F; v^n (ref.cont ca) (resume (event $e $l)*) --> S'; F; handle{(ea $l)*} E[v^n] end` +* `S; F; v^n (ref.cont ca) (resume (tag $e $l)*) --> S'; F; handle{(ea $l)*} E[v^n] end` - iff `S.conts[ca] = (E : n)` - - and `(ea = F.evts[$e])*` + - and `(ea = F.tags[$e])*` - and `S' = S with conts[ca] = epsilon` * `S; F; (ref.null t) (resume_throw $e) --> S; F; trap` @@ -141,7 +141,7 @@ H^ea ::= * `S; F; v^m (ref.cont ca) (resume_throw $e) --> S'; F; E[v^m (throw $e)]` - iff `S.conts[ca] = (E : n)` - - and `S.evts[F.evts[$e]].type = [t1^m] -> [t2*]` + - and `S.tags[F.tags[$e]].type = [t1^m] -> [t2*]` - and `S' = S with conts[ca] = epsilon` * `S; F; (barrier bt instr* end) --> S; F; handle instr* end` @@ -149,10 +149,10 @@ H^ea ::= * `S; F; (handle{(e $l)*}? v* end) --> S; F; v*` * `S; F; (handle H^ea[(suspend $e)] end) --> S; F; trap` - - iff `ea = F.evts[$e]` + - iff `ea = F.tags[$e]` * `S; F; (handle{(ea1 $l1)* (ea $l) (ea2 $l2)*} H^ea[v^n (suspend $e)] end) --> S'; F; v^n (ref.cont |S.conts|) (br $l)` - iff `ea notin ea1*` - - and `ea = F.evts[$e]` - - and `S.evts[ea].type = [t1^n] -> [t2^m]` + - and `ea = F.tags[$e]` + - and `S.tags[ea].type = [t1^n] -> [t2^m]` - and `S' = S with conts += (H^ea : m)` diff --git a/proposals/continuations/examples/actor-lwt.wast b/proposals/continuations/examples/actor-lwt.wast index 2526a3d7f..ead651eea 100644 --- a/proposals/continuations/examples/actor-lwt.wast +++ b/proposals/continuations/examples/actor-lwt.wast @@ -2,16 +2,246 @@ ;; actor interface (module $actor - (type $func (func)) - (type $cont (cont $func)) - - (event $self (export "self") (result i32)) - (event $spawn (export "spawn") (param (ref $cont)) (result i32)) - (event $send (export "send") (param i32 i32)) - (event $recv (export "recv") (result i32)) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) + + ;; self : [i32] -> [] + ;; spawn : [cont ([] -> [])] -> [i32] + ;; send : [i32 i32] -> [] + ;; recv : [] -> [i32] + (tag $self (export "self") (result i32)) + (tag $spawn (export "spawn") (param (ref $cont)) (result i32)) + (tag $send (export "send") (param i32 i32)) + (tag $recv (export "recv") (result i32)) ) (register "actor") +;; a simple example - pass a message through a chain of actors +(module $chain + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) + + (type $i-func (func (param i32))) ;; [i32] -> [] + (type $i-cont (cont $i-func)) ;; cont ([i32] -> []) + + ;; self : [i32] -> [] + ;; spawn : [cont ([] -> [])] -> [i32] + ;; send : [i32 i32] -> [] + ;; recv : [] -> [i32] + (tag $self (import "actor" "self") (result i32)) + (tag $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) + (tag $send (import "actor" "send") (param i32 i32)) + (tag $recv (import "actor" "recv") (result i32)) + + (elem declare func $next) + + (func $log (import "spectest" "print_i32") (param i32)) + + (func $next (param $p i32) + (local $s i32) + (local.set $s (suspend $recv)) + (call $log (i32.const -1)) + (suspend $send (local.get $s) (local.get $p)) + ) + + ;; send the message 42 through a chain of n actors + (func $chain (export "chain") (param $n i32) + (local $p i32) + (local.set $p (suspend $self)) + + (loop $l + (if (i32.eqz (local.get $n)) + (then (suspend $send (i32.const 42) (local.get $p))) + (else (local.set $p (suspend $spawn (cont.bind (type $cont) (local.get $p) (cont.new (type $i-cont) (ref.func $next))))) + (local.set $n (i32.sub (local.get $n) (i32.const 1))) + (br $l)) + ) + ) + (call $log (suspend $recv)) + ) +) +(register "chain") + +;; queues of threads and mailboxes +(module $queue + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) + + (func $log (import "spectest" "print_i32") (param i32)) + + ;; table (threads) and memory (mailboxes) as simple queues + (table $queue 0 (ref null $cont)) + (memory 1) + + (exception $too-many-mailboxes) + + (global $qdelta i32 (i32.const 10)) + + (global $qback-k (mut i32) (i32.const 0)) + (global $qfront-k (mut i32) (i32.const 0)) + + (func $queue-empty-k (export "queue-empty") (result i32) + (i32.eq (global.get $qfront-k) (global.get $qback-k)) + ) + + (func $dequeue-k (export "dequeue-k") (result (ref null $cont)) + (local $i i32) + (if (call $queue-empty-k) + (then (return (ref.null $cont))) + ) + (local.set $i (global.get $qfront-k)) + (global.set $qfront-k (i32.add (local.get $i) (i32.const 1))) + (table.get $queue (local.get $i)) + ) + + (func $enqueue-k (export "enqueue-k") (param $k (ref $cont)) + ;; Check if queue is full + (if (i32.eq (global.get $qback-k) (table.size $queue)) + (then + ;; Check if there is enough space in the front to compact + (if (i32.lt_u (global.get $qfront-k) (global.get $qdelta)) + (then + ;; Space is below threshold, grow table instead + (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) + ) + (else + ;; Enough space, move entries up to head of table + (global.set $qback-k (i32.sub (global.get $qback-k) (global.get $qfront-k))) + (table.copy $queue $queue + (i32.const 0) ;; dest = new front = 0 + (global.get $qfront-k) ;; src = old front + (global.get $qback-k) ;; len = new back = old back - old front + ) + (table.fill $queue ;; null out old entries to avoid leaks + (global.get $qback-k) ;; start = new back + (ref.null $cont) ;; init value + (global.get $qfront-k) ;; len = old front = old front - new front + ) + (global.set $qfront-k (i32.const 0)) + ) + ) + ) + ) + (table.set $queue (global.get $qback-k) (local.get $k)) + (global.set $qback-k (i32.add (global.get $qback-k) (i32.const 1))) + ) + + (global $qback-mb (mut i32) (i32.const 0)) + (global $qfront-mb (mut i32) (i32.const 0)) + + (func $queue-empty-mb (export "queue-empty-mb") (result i32) + (i32.eq (global.get $qfront-mb) (global.get $qback-mb)) + ) + + (func $dequeue-mb (export "dequeue-mb") (result i32) + (local $i i32) + (local $mb i32) + (if (call $queue-empty-mb) + (then (return (i32.const -1))) + ) + (local.set $i (global.get $qfront-mb)) + (global.set $qfront-mb (i32.add (local.get $i) (i32.const 1))) + (local.set $mb (i32.load (i32.mul (local.get $i) (i32.const 4)))) + (return (local.get $mb)) + ) + + (func $enqueue-mb (export "enqueue-mb") (param $mb i32) + ;; Check if queue is full + (if (i32.eq (global.get $qback-mb) (i32.const 16383)) + (then + ;; Check if there is enough space in the front to compact + (if (i32.lt_u (global.get $qfront-mb) (global.get $qdelta)) + (then + ;; Space is below threshold, throw exception + (throw $too-many-mailboxes) + ) + (else + ;; Enough space, move entries up to head of table + (global.set $qback-mb (i32.sub (global.get $qback-mb) (global.get $qfront-mb))) + (memory.copy + (i32.const 0) ;; dest = new front = 0 + (i32.mul (global.get $qfront-mb) (i32.const 4)) ;; src = old front + (i32.mul (global.get $qback-mb) (i32.const 4)) ;; len = new back = old back - old front + ) + (memory.fill ;; null out old entries to avoid leaks + (i32.mul (global.get $qback-mb) (i32.const 4)) ;; start = new back + (i32.const -1) ;; init value + (i32.mul (global.get $qfront-mb) (i32.const 4)) ;; len = old front = old front - new front + ) + (global.set $qfront-mb (i32.const 0)) + ) + ) + ) + ) + (i32.store (i32.mul (global.get $qback-mb) (i32.const 4)) (local.get $mb)) + (global.set $qback-mb (i32.add (global.get $qback-mb) (i32.const 1))) + ) +) +(register "queue") + +(module $mailboxes + ;; Stupid implementation of mailboxes that raises an exception if + ;; there are too many mailboxes or if more than one message is sent + ;; to any given mailbox. + ;; + ;; Sufficient for the simple chain example. + + ;; -1 means empty + + (func $log (import "spectest" "print_i32") (param i32)) + + (exception $too-many-mailboxes) + (exception $too-many-messages) + + (memory 1) + + (global $msize (mut i32) (i32.const 0)) ;; current number of mailboxes + (global $mmax i32 (i32.const 1024)) ;; maximum number of mailboxes + + (func $init (export "init") + (global.set $msize (i32.const 0)) + (memory.fill (i32.const 0) (i32.const -1) (i32.mul (global.get $mmax) (i32.const 4))) + ) + + (func $empty-mb (export "empty-mb") (param $mb i32) (result i32) + (local $offset i32) + (local.set $offset (i32.mul (local.get $mb) (i32.const 4))) + (i32.eq (i32.load (local.get $offset)) (i32.const -1)) + ) + + (func $new-mb (export "new-mb") (result i32) + (local $mb i32) + + (if (i32.ge_u (global.get $msize) (global.get $mmax)) + (then (throw $too-many-mailboxes)) + ) + + (local.set $mb (global.get $msize)) + (global.set $msize (i32.add (global.get $msize) (i32.const 1))) + (return (local.get $mb)) + ) + + (func $send-to-mb (export "send-to-mb") (param $v i32) (param $mb i32) + (local $offset i32) + (local.set $offset (i32.mul (local.get $mb) (i32.const 4))) + (if (call $empty-mb (local.get $mb)) + (then (i32.store (local.get $offset) (local.get $v))) + (else (throw $too-many-messages)) + ) + ) + + (func $recv-from-mb (export "recv-from-mb") (param $mb i32) (result i32) + (local $v i32) + (local $offset i32) + (local.set $offset (i32.mul (local.get $mb) (i32.const 4))) + (local.set $v (i32.load (local.get $offset))) + (i32.store (local.get $offset) (i32.const -1)) + (local.get $v) + ) +) +(register "mailboxes") + + ;; a simple example - pass a message through a chain of actors (module $chain (type $func (func)) @@ -20,10 +250,10 @@ (type $i-func (func (param i32))) (type $i-cont (cont $i-func)) - (event $self (import "actor" "self") (result i32)) - (event $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) - (event $send (import "actor" "send") (param i32 i32)) - (event $recv (import "actor" "recv") (result i32)) + (tag $self (import "actor" "self") (result i32)) + (tag $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) + (tag $send (import "actor" "send") (param i32 i32)) + (tag $recv (import "actor" "recv") (result i32)) (elem declare func $next) @@ -59,8 +289,8 @@ (type $func (func)) (type $cont (cont $func)) - (event $yield (export "yield")) - (event $fork (export "fork") (param (ref $cont))) + (tag $yield (export "yield")) + (tag $fork (export "fork") (param (ref $cont))) ) (register "lwt") @@ -128,8 +358,8 @@ (type $func (func)) (type $cont (cont $func)) - (event $yield (import "lwt" "yield")) - (event $fork (import "lwt" "fork") (param (ref $cont))) + (tag $yield (import "lwt" "yield")) + (tag $fork (import "lwt" "fork") (param (ref $cont))) (func $queue-empty (import "queue" "queue-empty") (result i32)) (func $dequeue (import "queue" "dequeue") (result (ref null $cont))) @@ -141,7 +371,7 @@ (if (call $queue-empty) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (event $yield $on_yield) (event $fork $on_fork) + (resume (tag $yield $on_yield) (tag $fork $on_fork) (call $dequeue) ) (br $l) ;; thread terminated @@ -219,20 +449,20 @@ ;; actors implemented via lightweight threads (module $actor-as-lwt - (type $func (func)) - (type $cont (cont $func)) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) - (type $i-func (func (param i32))) - (type $i-cont (cont $i-func)) + (type $i-func (func (param i32))) ;; [i32] -> [] + (type $i-cont (cont $i-func)) ;; cont ([i32] -> []) - (type $ic-func (func (param i32 (ref $cont)))) - (type $ic-cont (cont $ic-func)) + (type $ic-func (func (param i32 (ref $cont)))) ;; [i32 (cont ([] -> []))] -> [] + (type $ic-cont (cont $ic-func)) ;; cont ([i32 (cont ([] -> []))] -> []) (func $log (import "spectest" "print_i32") (param i32)) ;; lwt interface - (event $yield (import "lwt" "yield")) - (event $fork (import "lwt" "fork") (param (ref $cont))) + (tag $yield (import "lwt" "yield")) + (tag $fork (import "lwt" "fork") (param (ref $cont))) ;; mailbox interface (func $init (import "mailboxes" "init")) @@ -247,10 +477,14 @@ (func $enqueue (import "queue" "enqueue") (param $k (ref $cont))) ;; actor interface - (event $self (import "actor" "self") (result i32)) - (event $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) - (event $send (import "actor" "send") (param i32 i32)) - (event $recv (import "actor" "recv") (result i32)) + ;; self : [i32] -> [] + ;; spawn : [cont ([] -> [])] -> [i32] + ;; send : [i32 i32] -> [] + ;; recv : [] -> [i32] + (tag $self (import "actor" "self") (result i32)) + (tag $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) + (tag $send (import "actor" "send") (param i32 i32)) + (tag $recv (import "actor" "recv") (result i32)) (elem declare func $actk) @@ -260,10 +494,10 @@ (block $on_spawn (result (ref $cont) (ref $i-cont)) (block $on_send (result i32 i32 (ref $cont)) (block $on_recv (result (ref $i-cont)) - (resume (event $self $on_self) - (event $spawn $on_spawn) - (event $send $on_send) - (event $recv $on_recv) + (resume (tag $self $on_self) + (tag $spawn $on_spawn) + (tag $send $on_send) + (tag $recv $on_recv) (local.get $nextk) ) (return) @@ -314,11 +548,11 @@ ;; composing the actor and scheduler handlers together (module $actor-scheduler - (type $func (func)) - (type $cont (cont $func)) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) - (type $cont-func (func (param (ref $cont)))) - (type $cont-cont (cont $cont-func)) + (type $cont-func (func (param (ref $cont)))) ;; [cont ([] -> []) -> []] + (type $cont-cont (cont $cont-func)) ;; cont ([cont ([] -> []) -> []]) (elem declare func $act $scheduler) @@ -332,11 +566,11 @@ (register "actor-scheduler") (module - (type $func (func)) - (type $cont (cont $func)) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) - (type $i-func (func (param i32))) - (type $i-cont (cont $i-func)) + (type $i-func (func (param i32))) ;; [i32] -> [] + (type $i-cont (cont $i-func)) ;; cont ([i32] -> []) (elem declare func $chain) diff --git a/proposals/continuations/examples/actor.wast b/proposals/continuations/examples/actor.wast index 48988a0dd..3a8d36f48 100644 --- a/proposals/continuations/examples/actor.wast +++ b/proposals/continuations/examples/actor.wast @@ -2,28 +2,36 @@ ;; actor interface (module $actor - (type $func (func)) - (type $cont (cont $func)) - - (event $self (export "self") (result i32)) - (event $spawn (export "spawn") (param (ref $cont)) (result i32)) - (event $send (export "send") (param i32 i32)) - (event $recv (export "recv") (result i32)) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) + + ;; self : [i32] -> [] + ;; spawn : [cont ([] -> [])] -> [i32] + ;; send : [i32 i32] -> [] + ;; recv : [] -> [i32] + (tag $self (export "self") (result i32)) + (tag $spawn (export "spawn") (param (ref $cont)) (result i32)) + (tag $send (export "send") (param i32 i32)) + (tag $recv (export "recv") (result i32)) ) (register "actor") ;; a simple example - pass a message through a chain of actors (module $chain - (type $func (func)) - (type $cont (cont $func)) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) - (type $i-func (func (param i32))) - (type $i-cont (cont $i-func)) + (type $i-func (func (param i32))) ;; [i32] -> [] + (type $i-cont (cont $i-func)) ;; cont ([i32] -> []) - (event $self (import "actor" "self") (result i32)) - (event $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) - (event $send (import "actor" "send") (param i32 i32)) - (event $recv (import "actor" "recv") (result i32)) + ;; self : [i32] -> [] + ;; spawn : [cont ([] -> [])] -> [i32] + ;; send : [i32 i32] -> [] + ;; recv : [] -> [i32] + (tag $self (import "actor" "self") (result i32)) + (tag $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) + (tag $send (import "actor" "send") (param i32 i32)) + (tag $recv (import "actor" "recv") (result i32)) (elem declare func $next) @@ -56,8 +64,8 @@ ;; queues of threads and mailboxes (module $queue - (type $func (func)) - (type $cont (cont $func)) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) (func $log (import "spectest" "print_i32") (param i32)) @@ -235,17 +243,16 @@ ;; actors implemented directly (module $scheduler - (type $func (func)) - (type $cont (cont $func)) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) (func $log (import "spectest" "print_i32") (param i32)) - (type $iproc (func (param i32))) - (type $icont (cont $iproc)) - - (type $icontfun (func (param (ref $icont)))) - (type $icontcont (cont (param (ref $icont)))) + (type $i-func (func (param i32))) ;; [i32] -> [] + (type $i-cont (cont $i-func)) ;; cont ([i32] -> []) + (type $i-cont-func (func (param (ref $i-cont)))) ;; [(cont ([i32] -> []))] -> [] + (type $i-cont-cont (cont $i-cont-func)) ;; cont ([(cont ([i32] -> []))] -> []) ;; mailbox interface (func $init (import "mailboxes" "init")) @@ -261,10 +268,14 @@ (func $enqueue-k (import "queue" "enqueue-k") (param (ref $cont))) ;; actor interface - (event $self (import "actor" "self") (result i32)) - (event $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) - (event $send (import "actor" "send") (param i32 i32)) - (event $recv (import "actor" "recv") (result i32)) + ;; self : [i32] -> [] + ;; spawn : [cont ([] -> [])] -> [i32] + ;; send : [i32 i32] -> [] + ;; recv : [] -> [i32] + (tag $self (import "actor" "self") (result i32)) + (tag $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) + (tag $send (import "actor" "send") (param i32 i32)) + (tag $recv (import "actor" "recv") (result i32)) (elem declare func $recv-againf) @@ -277,18 +288,18 @@ ;; instruction for composing or extending continuations be palatable ;; / desirable? ;; - ;; The resume_throw operation can be implemented with continuation - ;; composition. + ;; The resume_throw operation can be implemented (inefficiently) + ;; with continuation composition. ;; compose recv with an existing continuation - (func $recv-againf (param $ik (ref $icont)) + (func $recv-againf (param $ik (ref $i-cont)) (local $res i32) (suspend $recv) (local.set $res) (resume (local.get $res) (local.get $ik)) ) - (func $recv-again (param $ik (ref $icont)) (result (ref $cont)) - (cont.bind (type $cont) (local.get $ik) (cont.new (type $icontcont) (ref.func $recv-againf))) + (func $recv-again (param $ik (ref $i-cont)) (result (ref $cont)) + (cont.bind (type $cont) (local.get $ik) (cont.new (type $i-cont-cont) (ref.func $recv-againf))) ) ;; There are multiple ways of avoiding the need for @@ -310,21 +321,21 @@ (local.set $mine (call $new-mb)) (loop $l (if (ref.is_null (local.get $nextk)) (then (return))) - (block $on_self (result (ref $icont)) - (block $on_spawn (result (ref $cont) (ref $icont)) + (block $on_self (result (ref $i-cont)) + (block $on_spawn (result (ref $cont) (ref $i-cont)) (block $on_send (result i32 i32 (ref $cont)) - (block $on_recv (result (ref $icont)) - (resume (event $self $on_self) - (event $spawn $on_spawn) - (event $send $on_send) - (event $recv $on_recv) + (block $on_recv (result (ref $i-cont)) + (resume (tag $self $on_self) + (tag $spawn $on_spawn) + (tag $send $on_send) + (tag $recv $on_recv) (local.get $nextk) ) (local.set $mine (call $dequeue-mb)) (local.set $nextk (call $dequeue-k)) (br $l) - ) ;; $on_recv (result (ref $icont)) - (let (local $ik (ref $icont)) + ) ;; $on_recv (result (ref $i-cont)) + (let (local $ik (ref $i-cont)) ;; block this thread until the mailbox is non-empty (if (call $empty-mb (local.get $mine)) (then (call $enqueue-mb (local.get $mine)) @@ -342,8 +353,8 @@ (local.set $nextk (local.get $k)) ) (br $l) - ) ;; $on_spawn (result (ref $cont) (ref $icont)) - (let (local $you (ref $cont)) (local $ik (ref $icont)) + ) ;; $on_spawn (result (ref $cont) (ref $i-cont)) + (let (local $you (ref $cont)) (local $ik (ref $i-cont)) (call $new-mb) (let (local $yours i32) (call $enqueue-mb (local.get $yours)) @@ -352,8 +363,8 @@ ) ) (br $l) - ) ;; $on_self (result (ref $icont)) - (let (local $ik (ref $icont)) + ) ;; $on_self (result (ref $i-cont)) + (let (local $ik (ref $i-cont)) (local.set $nextk (cont.bind (type $cont) (local.get $mine) (local.get $ik))) ) (br $l) @@ -363,11 +374,11 @@ (register "scheduler") (module - (type $func (func)) - (type $cont (cont $func)) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) - (type $iproc (func (param i32))) - (type $icont (cont $iproc)) + (type $i-func (func (param i32))) ;; [i32] -> [] + (type $i-cont (cont $i-func)) ;; cont ([i32] -> []) (func $log (import "spectest" "print_i32") (param i32)) @@ -377,7 +388,7 @@ (func $chain (import "chain" "chain") (param $n i32)) (func $run-chain (export "run-chain") (param $n i32) - (call $act (cont.bind (type $cont) (local.get $n) (cont.new (type $icont) (ref.func $chain)))) + (call $act (cont.bind (type $cont) (local.get $n) (cont.new (type $i-cont) (ref.func $chain)))) ) ) diff --git a/proposals/continuations/examples/async-await.wast b/proposals/continuations/examples/async-await.wast index 8a53fc7b9..514ed4170 100644 --- a/proposals/continuations/examples/async-await.wast +++ b/proposals/continuations/examples/async-await.wast @@ -7,11 +7,16 @@ ;; ;; Given a suitable asynchronous I/O API, they needn't be exposed to ;; user code. - (event $yield (export "yield")) - (event $fulfill (export "fulfill") (param i32) (param i32)) - - (event $async (export "async") (param (ref $i-cont)) (result i32)) - (event $await (export "await") (param i32) (result i32)) + ;; + ;; yield : [] -> [] + ;; fulfill : [i32] -> [i32] + (tag $yield (export "yield")) + (tag $fulfill (export "fulfill") (param i32) (param i32)) + + ;; async : [cont ([i32] -> [])] -> [i32] + ;; await : [i32] -> [i32] + (tag $async (export "async") (param (ref $i-cont)) (result i32)) + (tag $await (export "await") (param i32) (result i32)) ) (register "async-await") @@ -22,10 +27,14 @@ (type $iii-fun (func (param i32 i32 i32))) (type $iii-cont (cont $iii-fun)) - (event $yield (import "async-await" "yield")) - (event $fulfill (import "async-await" "fulfill") (param i32) (param i32)) - (event $async (import "async-await" "async") (param (ref $i-cont)) (result i32)) - (event $await (import "async-await" "await") (param i32) (result i32)) + ;; yield : [] -> [] + ;; fulfill : [i32] -> [i32] + ;; async : [cont ([i32] -> [])] -> [i32] + ;; await : [i32] -> [i32] + (tag $yield (import "async-await" "yield")) + (tag $fulfill (import "async-await" "fulfill") (param i32) (param i32)) + (tag $async (import "async-await" "async") (param (ref $i-cont)) (result i32)) + (tag $await (import "async-await" "await") (param i32) (result i32)) (func $log (import "spectest" "print_i32") (param i32)) @@ -222,10 +231,15 @@ (type $i-cont (cont $i-func)) ;; async-await interface - (event $yield (import "async-await" "yield")) - (event $fulfill (import "async-await" "fulfill") (param i32) (param i32)) - (event $async (import "async-await" "async") (param (ref $i-cont)) (result i32)) - (event $await (import "async-await" "await") (param i32) (result i32)) + ;; + ;; yield : [] -> [] + ;; fulfill : [i32] -> [i32] + ;; async : [cont ([i32] -> [])] -> [i32] + ;; await : [i32] -> [i32] + (tag $yield (import "async-await" "yield")) + (tag $fulfill (import "async-await" "fulfill") (param i32) (param i32)) + (tag $async (import "async-await" "async") (param (ref $i-cont)) (result i32)) + (tag $await (import "async-await" "await") (param i32) (result i32)) ;; queue interface (func $queue-empty (import "queue" "queue-empty") (result i32)) @@ -246,10 +260,10 @@ (block $on_fulfill (result i32 i32 (ref $cont)) (block $on_async (result (ref $i-cont) (ref $i-cont)) (block $on_await (result i32 (ref $i-cont)) - (resume (event $yield $on_yield) - (event $fulfill $on_fulfill) - (event $async $on_async) - (event $await $on_await) + (resume (tag $yield $on_yield) + (tag $fulfill $on_fulfill) + (tag $async $on_async) + (tag $await $on_await) (local.get $nextk) ) (local.set $nextk (call $dequeue)) diff --git a/proposals/continuations/examples/control-lwt.wast b/proposals/continuations/examples/control-lwt.wast new file mode 100644 index 000000000..1c1e6496b --- /dev/null +++ b/proposals/continuations/examples/control-lwt.wast @@ -0,0 +1,341 @@ +;; dynamic lightweight threads via control/prompt + +;; interface to control/prompt +(module $control + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) + + (type $cont-func (func (param (ref $cont)))) ;; [cont ([] -> [])] -> [] + (type $cont-cont (cont $cont-func)) ;; cont ([cont ([] -> [])] -> []) + + ;; Implementation of a generic delimited control operator using + ;; effect handlers. + ;; + ;; For lightweight threads we have no payload. More general types + ;; for control and prompt are: + ;; + ;; control : ([cont ([ta*] -> [tr*])] -> [tr*]) -> [ta*] + ;; prompt : cont ([] -> [tr*]) -> [tr*] + ;; + ;; (We can also give more refined types if we want to support + ;; answer-type modification and various flavours of answer-type + ;; polymorphism - but these are well outside the scope of a Wasm + ;; proposal!) + ;; + ;; (Technically this is control0/prompt0 rather than + ;; control/prompt.) + (tag $control (export "control") (param (ref $cont-func))) ;; control : ([cont ([] -> [])] -> []) -> [] + (func $prompt (export "prompt") (param $nextk (ref null $cont)) ;; prompt : cont ([] -> []) -> [] + (block $on_control (result (ref $cont-func) (ref $cont)) + (resume (tag $control $on_control) + (local.get $nextk)) + (return) + ) ;; $on_control (param (ref $cont-func) (ref $cont)) + (let (local $h (ref $cont-func)) (local $k (ref $cont)) + (call_ref (local.get $k) (local.get $h)) + ) + ) +) +(register "control") + +;; With control/prompt we use functions for abstracting over yield and +;; fork operations rather than tags. + +(module $example + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) + + (type $cont-func (func (param (ref $cont)))) ;; [cont ([] -> [])] -> [] + (type $cont-cont (cont $cont-func)) ;; cont ([cont ([] -> [])] -> []) + + (type $func-cont-func-func (func (param (ref $func)) (param (ref $cont-func)))) ;; ([] -> []) -> ([cont ([] -> [])] -> []) -> [] + (type $func-cont-func-cont (cont $func-cont-func-func)) ;; cont (([] -> []) -> ([cont ([] -> [])] -> []) -> []) + + (func $log (import "spectest" "print_i32") (param i32)) + + (elem declare func $main $thread1 $thread2 $thread3) + + (func $main (export "main") (param $yield (ref $func)) (param $fork (ref $cont-func)) + (call $log (i32.const 0)) + (call_ref + (cont.bind (type $cont) (local.get $yield) (local.get $fork) + (cont.new (type $func-cont-func-cont) (ref.func $thread1))) + (local.get $fork)) + (call $log (i32.const 1)) + (call_ref + (cont.bind (type $cont) (local.get $yield) (local.get $fork) + (cont.new (type $func-cont-func-cont) (ref.func $thread2))) + (local.get $fork)) + (call $log (i32.const 2)) + (call_ref + (cont.bind (type $cont) (local.get $yield) (local.get $fork) + (cont.new (type $func-cont-func-cont) (ref.func $thread3))) + (local.get $fork)) + (call $log (i32.const 3)) + ) + + (func $thread1 (param $yield (ref $func)) (param $fork (ref $cont-func)) + (call $log (i32.const 10)) + (call_ref (local.get $yield)) + (call $log (i32.const 11)) + (call_ref (local.get $yield)) + (call $log (i32.const 12)) + ) + + (func $thread2 (param $yield (ref $func)) (param $fork (ref $cont-func)) + (call $log (i32.const 20)) + (call_ref (local.get $yield)) + (call $log (i32.const 21)) + (call_ref (local.get $yield)) + (call $log (i32.const 22)) + ) + + (func $thread3 (param $yield (ref $func)) (param $fork (ref $cont-func)) + (call $log (i32.const 30)) + (call_ref (local.get $yield)) + (call $log (i32.const 31)) + (call_ref (local.get $yield)) + (call $log (i32.const 32)) + ) +) +(register "example") + +(module $queue + (type $func (func)) + (type $cont (cont $func)) + + (func $log (import "spectest" "print_i32") (param i32)) + + ;; Table as simple queue (keeping it simple, no ring buffer) + (table $queue 0 (ref null $cont)) + (global $qdelta i32 (i32.const 10)) + (global $qback (mut i32) (i32.const 0)) + (global $qfront (mut i32) (i32.const 0)) + + (func $queue-empty (export "queue-empty") (result i32) + (i32.eq (global.get $qfront) (global.get $qback)) + ) + + (func $dequeue (export "dequeue") (result (ref null $cont)) + (local $i i32) + (if (call $queue-empty) + (then (return (ref.null $cont))) + ) + (local.set $i (global.get $qfront)) + (global.set $qfront (i32.add (local.get $i) (i32.const 1))) + (table.get $queue (local.get $i)) + ) + + (func $enqueue (export "enqueue") (param $k (ref $cont)) + ;; Check if queue is full + (if (i32.eq (global.get $qback) (table.size $queue)) + (then + ;; Check if there is enough space in the front to compact + (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) + (then + ;; Space is below threshold, grow table instead + (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) + ) + (else + ;; Enough space, move entries up to head of table + (global.set $qback (i32.sub (global.get $qback) (global.get $qfront))) + (table.copy $queue $queue + (i32.const 0) ;; dest = new front = 0 + (global.get $qfront) ;; src = old front + (global.get $qback) ;; len = new back = old back - old front + ) + (table.fill $queue ;; null out old entries to avoid leaks + (global.get $qback) ;; start = new back + (ref.null $cont) ;; init value + (global.get $qfront) ;; len = old front = old front - new front + ) + (global.set $qfront (i32.const 0)) + ) + ) + ) + ) + (table.set $queue (global.get $qback) (local.get $k)) + (global.set $qback (i32.add (global.get $qback) (i32.const 1))) + ) +) +(register "queue") + +(module $scheduler + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) + + (type $cont-func (func (param (ref $cont)))) ;; [cont ([] -> [])] -> [] + (type $cont-cont (cont $cont-func)) ;; cont ([cont ([] -> [])] -> []) + + (type $func-cont-func-func (func (param (ref $func)) (param (ref $cont-func)))) ;; ([] -> []) -> ([cont ([] -> [])] -> []) -> [] + (type $func-cont-func-cont (cont $func-cont-func-func)) ;; cont (([] -> []) -> ([cont ([] -> [])] -> []) -> []) + + (func $log (import "spectest" "print_i32") (param i32)) + + ;; queue interface + (func $queue-empty (import "queue" "queue-empty") (result i32)) + (func $dequeue (import "queue" "dequeue") (result (ref null $cont))) + (func $enqueue (import "queue" "enqueue") (param $k (ref $cont))) + + (elem declare func + $handle-yield-sync $handle-yield + $handle-fork-sync $handle-fork-kt $handle-fork-tk $handle-fork-ykt $handle-fork-ytk + $yield + $fork-sync $fork-kt $fork-tk $fork-ykt $fork-ytk) + + ;; control/prompt interface + (tag $control (import "control" "control") (param (ref $cont-func))) ;; control : ([cont ([] -> [])] -> []) -> [] + (func $prompt (import "control" "prompt") (param $nextk (ref null $cont))) ;; prompt : cont ([] -> []) -> [] + + ;; generic boilerplate scheduler + ;; + ;; with control/prompt the core scheduler loop must be decoupled + ;; from the implementations of each operation (yield / fork) as the + ;; latter are passed in as arguments to user code + (func $scheduler (param $nextk (ref null $cont)) + (loop $loop + (if (ref.is_null (local.get $nextk)) (then (return))) + (call $prompt (local.get $nextk)) + (local.set $nextk (call $dequeue)) + (br $loop) + ) + ) + + ;; func.bind is needed in the implementations of fork + ;; + ;; More generally func.bind is needed for any operation that + ;; takes arguments. + ;; + ;; One could use another continuation here instead, but constructing + ;; a new continuation every time an operation is invoked seems + ;; unnecessarily wasteful. + + ;; synchronous scheduler + (func $handle-yield-sync (param $k (ref $cont)) + (call $scheduler (local.get $k)) + ) + (func $yield-sync + (suspend $control (ref.func $handle-yield)) + ) + (func $handle-fork-sync (param $t (ref $cont)) (param $k (ref $cont)) + (call $enqueue (local.get $t)) + (call $scheduler (local.get $k)) + ) + (func $fork-sync (param $t (ref $cont)) + (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-sync))) + ) + (func $sync (export "sync") (param $k (ref $func-cont-func-cont)) + (call $scheduler + (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-sync) (local.get $k))) + ) + + ;; asynchronous yield (used by all asynchronous schedulers) + (func $handle-yield (param $k (ref $cont)) + (call $enqueue (local.get $k)) + (call $scheduler (call $dequeue)) + ) + (func $yield + (suspend $control (ref.func $handle-yield)) + ) + ;; four asynchronous implementations of fork: + ;; * kt and tk don't yield on encountering a fork + ;; 1) kt runs the continuation, queuing up the new thread for later + ;; 2) tk runs the new thread first, queuing up the continuation for later + ;; * ykt and ytk do yield on encountering a fork + ;; 3) ykt runs the continuation, queuing up the new thread for later + ;; 4) ytk runs the new thread first, queuing up the continuation for later + + ;; no yield on fork, continuation first + (func $handle-fork-kt (param $t (ref $cont)) (param $k (ref $cont)) + (call $enqueue (local.get $t)) + (call $scheduler (local.get $k)) + ) + (func $fork-kt (param $t (ref $cont)) + (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-kt))) + ) + (func $kt (export "kt") (param $k (ref $func-cont-func-cont)) + (call $scheduler + (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-kt) (local.get $k))) + ) + + ;; no yield on fork, new thread first + (func $handle-fork-tk (param $t (ref $cont)) (param $k (ref $cont)) + (call $enqueue (local.get $k)) + (call $scheduler (local.get $t)) + ) + (func $fork-tk (param $t (ref $cont)) + (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-tk))) + ) + (func $tk (export "tk") (param $k (ref $func-cont-func-cont)) + (call $scheduler + (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-tk) (local.get $k))) + ) + + ;; yield on fork, continuation first + (func $handle-fork-ykt (param $t (ref $cont)) (param $k (ref $cont)) + (call $enqueue (local.get $k)) + (call $enqueue (local.get $t)) + (call $scheduler (call $dequeue)) + ) + (func $fork-ykt (param $t (ref $cont)) + (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-ykt))) + ) + (func $ykt (export "ykt") (param $k (ref $func-cont-func-cont)) + (call $scheduler + (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-ykt) (local.get $k))) + ) + + ;; yield on fork, new thread first + (func $handle-fork-ytk (param $t (ref $cont)) (param $k (ref $cont)) + (call $enqueue (local.get $t)) + (call $enqueue (local.get $k)) + (call $scheduler (call $dequeue)) + ) + (func $fork-ytk (param $t (ref $cont)) + (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-ytk))) + ) + (func $ytk (export "ytk") (param $k (ref $func-cont-func-cont)) + (call $scheduler + (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-ytk) (local.get $k))) + ) +) +(register "scheduler") + +(module + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) + + (type $cont-func (func (param (ref $cont)))) ;; [cont ([] -> [])] -> [] + (type $cont-cont (cont $cont-func)) ;; cont ([cont ([] -> [])] -> []) + + (type $func-cont-func-func (func (param (ref $func)) (param (ref $cont-func)))) ;; ([] -> []) -> ([cont ([] -> [])] -> []) -> [] + (type $func-cont-func-cont (cont $func-cont-func-func)) ;; cont (([] -> []) -> ([cont ([] -> [])] -> []) -> []) + + (func $scheduler-sync (import "scheduler" "sync") (param $nextk (ref $func-cont-func-cont))) + (func $scheduler-kt (import "scheduler" "kt") (param $nextk (ref $func-cont-func-cont))) + (func $scheduler-tk (import "scheduler" "tk") (param $nextk (ref $func-cont-func-cont))) + (func $scheduler-ykt (import "scheduler" "ykt") (param $nextk (ref $func-cont-func-cont))) + (func $scheduler-ytk (import "scheduler" "ytk") (param $nextk (ref $func-cont-func-cont))) + + (func $log (import "spectest" "print_i32") (param i32)) + + (func $main (import "example" "main") (param $yield (ref $func)) (param $fork (ref $cont-func))) + + (elem declare func $main) + + (func $run (export "run") + (call $log (i32.const -1)) + (call $scheduler-sync (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $log (i32.const -2)) + (call $scheduler-kt (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $log (i32.const -3)) + (call $scheduler-tk (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $log (i32.const -4)) + (call $scheduler-ykt (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $log (i32.const -5)) + (call $scheduler-ytk (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $log (i32.const -6)) + ) +) + +(invoke "run") diff --git a/proposals/continuations/examples/fun-actor-lwt.wast b/proposals/continuations/examples/fun-actor-lwt.wast index 7269ef706..2b1f95fd8 100644 --- a/proposals/continuations/examples/fun-actor-lwt.wast +++ b/proposals/continuations/examples/fun-actor-lwt.wast @@ -5,10 +5,10 @@ (type $func (func)) (type $cont (cont $func)) - (event $self (export "self") (result i32)) - (event $spawn (export "spawn") (param (ref $cont)) (result i32)) - (event $send (export "send") (param i32 i32)) - (event $recv (export "recv") (result i32)) + (tag $self (export "self") (result i32)) + (tag $spawn (export "spawn") (param (ref $cont)) (result i32)) + (tag $send (export "send") (param i32 i32)) + (tag $recv (export "recv") (result i32)) ) (register "actor") @@ -20,10 +20,10 @@ (type $i-func (func (param i32))) (type $i-cont (cont $i-func)) - (event $self (import "actor" "self") (result i32)) - (event $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) - (event $send (import "actor" "send") (param i32 i32)) - (event $recv (import "actor" "recv") (result i32)) + (tag $self (import "actor" "self") (result i32)) + (tag $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) + (tag $send (import "actor" "send") (param i32 i32)) + (tag $recv (import "actor" "recv") (result i32)) (elem declare func $next) @@ -61,8 +61,8 @@ (type $func (func)) (type $cont (cont $func)) - (event $yield (export "yield")) - (event $fork (export "fork") (param (ref $cont))) + (tag $yield (export "yield")) + (tag $fork (export "fork") (param (ref $cont))) ) (register "lwt") @@ -130,8 +130,8 @@ (type $func (func)) (type $cont (cont $func)) - (event $yield (import "lwt" "yield")) - (event $fork (import "lwt" "fork") (param (ref $cont))) + (tag $yield (import "lwt" "yield")) + (tag $fork (import "lwt" "fork") (param (ref $cont))) (func $queue-empty (import "queue" "queue-empty") (result i32)) (func $dequeue (import "queue" "dequeue") (result (ref null $cont))) @@ -143,7 +143,7 @@ (if (call $queue-empty) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (event $yield $on_yield) (event $fork $on_fork) + (resume (tag $yield $on_yield) (tag $fork $on_fork) (call $dequeue) ) (br $l) ;; thread terminated @@ -233,8 +233,8 @@ (func $log (import "spectest" "print_i32") (param i32)) ;; lwt interface - (event $yield (import "lwt" "yield")) - (event $fork (import "lwt" "fork") (param (ref $cont))) + (tag $yield (import "lwt" "yield")) + (tag $fork (import "lwt" "fork") (param (ref $cont))) ;; mailbox interface (func $init (import "mailboxes" "init")) @@ -244,10 +244,10 @@ (func $recv-from-mb (import "mailboxes" "recv-from-mb") (param $mb i32) (result i32)) ;; actor interface - (event $self (import "actor" "self") (result i32)) - (event $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) - (event $send (import "actor" "send") (param i32 i32)) - (event $recv (import "actor" "recv") (result i32)) + (tag $self (import "actor" "self") (result i32)) + (tag $spawn (import "actor" "spawn") (param (ref $cont)) (result i32)) + (tag $send (import "actor" "send") (param i32 i32)) + (tag $recv (import "actor" "recv") (result i32)) (elem declare func $act-nullary $act-res) @@ -259,10 +259,10 @@ (block $on_recv (result (ref $i-cont)) ;; this should really be a tail call to the continuation ;; do we need a 'return_resume' operator? - (resume (event $self $on_self) - (event $spawn $on_spawn) - (event $send $on_send) - (event $recv $on_recv) + (resume (tag $self $on_self) + (tag $spawn $on_spawn) + (tag $send $on_send) + (tag $recv $on_recv) (local.get $res) (local.get $ik) ) (return) @@ -312,10 +312,10 @@ (block $on_recv (result (ref $i-cont)) ;; this should really be a tail call to the continuation ;; do we need a 'return_resume' operator? - (resume (event $self $on_self) - (event $spawn $on_spawn) - (event $send $on_send) - (event $recv $on_recv) + (resume (tag $self $on_self) + (tag $spawn $on_spawn) + (tag $send $on_send) + (tag $recv $on_recv) (local.get $k) ) (return) diff --git a/proposals/continuations/examples/fun-lwt.wast b/proposals/continuations/examples/fun-lwt.wast index ea599f27e..0da82ee55 100644 --- a/proposals/continuations/examples/fun-lwt.wast +++ b/proposals/continuations/examples/fun-lwt.wast @@ -2,17 +2,20 @@ ;; interface to lightweight threads (module $lwt - (type $func (func)) - (event $yield (export "yield")) - (event $fork (export "fork") (param (ref $func))) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) + + (tag $yield (export "yield")) ;; [] -> [] + (tag $fork (export "fork") (param (ref $cont))) ;; [cont ([] -> [])] -> [] ) (register "lwt") (module $example - (type $func (func)) - (type $cont (cont $func)) - (event $yield (import "lwt" "yield")) - (event $fork (import "lwt" "fork") (param (ref $func))) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) + + (tag $yield (import "lwt" "yield")) ;; [] -> [] + (tag $fork (import "lwt" "fork") (param (ref $cont))) ;; [cont ([] -> [])] -> [] (func $log (import "spectest" "print_i32") (param i32)) @@ -20,11 +23,11 @@ (func $main (export "main") (call $log (i32.const 0)) - (suspend $fork (ref.func $thread1)) + (suspend $fork (cont.new (type $cont) (ref.func $thread1))) (call $log (i32.const 1)) - (suspend $fork (ref.func $thread2)) + (suspend $fork (cont.new (type $cont) (ref.func $thread2))) (call $log (i32.const 2)) - (suspend $fork (ref.func $thread3)) + (suspend $fork (cont.new (type $cont) (ref.func $thread3))) (call $log (i32.const 3)) ) @@ -55,8 +58,8 @@ (register "example") (module $queue - (type $func (func)) - (type $cont (cont $func)) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) ;; Table as simple queue (keeping it simple, no ring buffer) (table $queue 0 (ref null $cont)) @@ -112,125 +115,132 @@ ) (register "queue") -(module $schedulers - (type $func (func)) - (type $cont (cont $func)) +(module $scheduler + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) - (event $yield (import "lwt" "yield")) - (event $fork (import "lwt" "fork") (param (ref $func))) + (tag $yield (import "lwt" "yield")) ;; [] -> [] + (tag $fork (import "lwt" "fork") (param (ref $cont))) ;; [cont ([] -> [])] -> [] (func $queue-empty (import "queue" "queue-empty") (result i32)) (func $dequeue (import "queue" "dequeue") (result (ref null $cont))) (func $enqueue (import "queue" "enqueue") (param $k (ref $cont))) + ;; synchronous scheduler (run current thread to completion without + ;; yielding) + (func $sync (export "sync") (param $nextk (ref null $cont)) + (if (ref.is_null (local.get $nextk)) (then (return))) + (block $on_yield (result (ref $cont)) + (block $on_fork (result (ref $cont) (ref $cont)) + (resume + (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) + ) + (return_call $sync (call $dequeue)) + ) ;; $on_fork (result (ref $func) (ref $cont)) + (let (param (ref $cont)) (result (ref $cont)) (local $nextk (ref $cont)) + (call $enqueue) + (return_call $sync (local.get $nextk))) + ) ;; $on_yield (result (ref $cont)) + (return_call $sync) + ) + ;; four different schedulers: - ;; * lwt-kt and lwt-tk don't yield on encountering a fork - ;; 1) lwt-kt runs the continuation, queuing up the new thread for later - ;; 2) lwt-tk runs the new thread first, queuing up the continuation for later - ;; * lwt-ykt and lwt-ytk do yield on encountering a fork - ;; 3) lwt-ykt runs the continuation, queuing up the new thread for later - ;; 4) lwt-ytk runs the new thread first, queuing up the continuation for later + ;; * kt and tk don't yield on encountering a fork + ;; 1) kt runs the continuation, queuing up the new thread for later + ;; 2) tk runs the new thread first, queuing up the continuation for later + ;; * ykt and ytk do yield on encountering a fork + ;; 3) ykt runs the continuation, queuing up the new thread for later + ;; 4) ytk runs the new thread first, queuing up the continuation for later ;; no yield on fork, continuation first - (func $lwt-kt (param $r (ref null $cont)) - (if (ref.is_null (local.get $r)) (then (return))) + (func $kt (export "kt") (param $nextk (ref null $cont)) + (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) - (block $on_fork (result (ref $func) (ref $cont)) - (resume (event $yield $on_yield) (event $fork $on_fork) (local.get $r)) - (call $dequeue) - (return_call $lwt-tk) + (block $on_fork (result (ref $cont) (ref $cont)) + (resume + (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) + ) + (return_call $tk (call $dequeue)) ) ;; $on_fork (result (ref $func) (ref $cont)) - (let (param (ref $func)) (result (ref $cont)) (local $r (ref $cont)) - (cont.new (type $cont)) + (let (param (ref $cont)) (result (ref $cont)) (local $nextk (ref $cont)) (call $enqueue) - (return_call $lwt-tk (local.get $r))) + (return_call $tk (local.get $nextk))) ) ;; $on_yield (result (ref $cont)) (call $enqueue) - (call $dequeue) - (return_call $lwt-tk) + (return_call $tk (call $dequeue)) ) ;; no yield on fork, new thread first - (func $lwt-tk (param $r (ref null $cont)) - (if (ref.is_null (local.get $r)) (then (return))) + (func $tk (export "tk") (param $nextk (ref null $cont)) + (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) - (block $on_fork (result (ref $func) (ref $cont)) - (resume (event $yield $on_yield) (event $fork $on_fork) (local.get $r)) - (call $dequeue) - (return_call $lwt-kt) - ) ;; $on_fork (result (ref $func) (ref $cont)) - (call $enqueue) - (return_call $lwt-kt (cont.new (type $cont))) + (block $on_fork (result (ref $cont) (ref $cont)) + (resume + (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk)) + (return_call $kt (call $dequeue)) + ) ;; $on_fork (result (ref $cont) (ref $cont)) + (return_call $kt (call $enqueue)) ) ;; $on_yield (result (ref $cont)) (call $enqueue) - (call $dequeue) - (return_call $lwt-kt) + (return_call $kt (call $dequeue)) ) ;; yield on fork, continuation first - (func $lwt-ykt (param $r (ref null $cont)) - (if (ref.is_null (local.get $r)) (then (return))) + (func $ykt (export "ykt") (param $nextk (ref null $cont)) + (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) - (block $on_fork (result (ref $func) (ref $cont)) - (resume (event $yield $on_yield) (event $fork $on_fork) (local.get $r)) - (call $dequeue) - (return_call $lwt-ykt) - ) ;; $on_fork (result (ref $func) (ref $cont)) + (block $on_fork (result (ref $cont) (ref $cont)) + (resume + (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) + ) + (return_call $ykt (call $dequeue)) + ) ;; $on_fork (result (ref $cont) (ref $cont)) (call $enqueue) - (cont.new (type $cont)) (call $enqueue) - (return_call $lwt-ykt (call $dequeue)) + (return_call $ykt (call $dequeue)) ) ;; $on_yield (result (ref $cont)) (call $enqueue) - (call $dequeue) - (return_call $lwt-ykt) + (return_call $ykt (call $dequeue)) ) ;; yield on fork, new thread first - (func $lwt-ytk (param $r (ref null $cont)) - (if (ref.is_null (local.get $r)) (then (return))) + (func $ytk (export "ytk") (param $nextk (ref null $cont)) + (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) - (block $on_fork (result (ref $func) (ref $cont)) - (resume (event $yield $on_yield) (event $fork $on_fork) (local.get $r)) - (call $dequeue) - (return_call $lwt-ytk) - ) ;; $on_fork (result (ref $func) (ref $cont)) - (let (param (ref $func)) (local $k (ref $cont)) - (cont.new (type $cont)) + (block $on_fork (result (ref $cont) (ref $cont)) + (resume (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk)) + (return_call $ytk (call $dequeue)) + ) ;; $on_fork (result (ref $cont) (ref $cont)) + (let (param (ref $cont)) (local $k (ref $cont)) (call $enqueue) (call $enqueue (local.get $k)) ) - (return_call $lwt-ytk (call $dequeue)) + (return_call $ytk (call $dequeue)) ) ;; $on_yield (result (ref $cont)) (call $enqueue) - (call $dequeue) - (return_call $lwt-ytk) - ) - - (func $scheduler1 (export "scheduler1") (param $main (ref $func)) - (call $lwt-kt (cont.new (type $cont) (local.get $main))) - ) - (func $scheduler2 (export "scheduler2") (param $main (ref $func)) - (call $lwt-tk (cont.new (type $cont) (local.get $main))) - ) - (func $scheduler3 (export "scheduler3") (param $main (ref $func)) - (call $lwt-ykt (cont.new (type $cont) (local.get $main))) - ) - (func $scheduler4 (export "scheduler4") (param $main (ref $func)) - (call $lwt-ytk (cont.new (type $cont) (local.get $main))) + (return_call $ytk (call $dequeue)) ) ) -(register "schedulers") +(register "scheduler") (module - (type $func (func)) - (type $cont (cont $func)) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) - (func $scheduler1 (import "schedulers" "scheduler1") (param $main (ref $func))) - (func $scheduler2 (import "schedulers" "scheduler2") (param $main (ref $func))) - (func $scheduler3 (import "schedulers" "scheduler3") (param $main (ref $func))) - (func $scheduler4 (import "schedulers" "scheduler4") (param $main (ref $func))) + (func $scheduler-sync (import "scheduler" "sync") (param $nextk (ref null $cont))) + (func $scheduler-kt (import "scheduler" "kt") (param $nextk (ref null $cont))) + (func $schedule-tk (import "scheduler" "tk") (param $nextk (ref null $cont))) + (func $scheduler-ykt (import "scheduler" "ykt") (param $nextk (ref null $cont))) + (func $scheduler-ytk (import "scheduler" "ytk") (param $nextk (ref null $cont))) (func $log (import "spectest" "print_i32") (param i32)) @@ -240,14 +250,16 @@ (func (export "run") (call $log (i32.const -1)) - (call $scheduler1 (ref.func $main)) + (call $scheduler-sync (cont.new (type $cont) (ref.func $main))) (call $log (i32.const -2)) - (call $scheduler2 (ref.func $main)) + (call $scheduler-kt (cont.new (type $cont) (ref.func $main))) (call $log (i32.const -3)) - (call $scheduler3 (ref.func $main)) + (call $schedule-tk (cont.new (type $cont) (ref.func $main))) (call $log (i32.const -4)) - (call $scheduler4 (ref.func $main)) + (call $scheduler-ykt (cont.new (type $cont) (ref.func $main))) (call $log (i32.const -5)) + (call $scheduler-ytk (cont.new (type $cont) (ref.func $main))) + (call $log (i32.const -6)) ) ) diff --git a/proposals/continuations/examples/fun-pipes.wast b/proposals/continuations/examples/fun-pipes.wast index abbef7b1e..55697ad21 100644 --- a/proposals/continuations/examples/fun-pipes.wast +++ b/proposals/continuations/examples/fun-pipes.wast @@ -5,12 +5,12 @@ (type $producer (cont $pfun)) (type $consumer (cont $cfun)) - (event $send (export "send") (param i32)) - (event $receive (export "receive") (result i32)) + (tag $send (export "send") (param i32)) + (tag $receive (export "receive") (result i32)) (func $piper (param $n i32) (param $p (ref $producer)) (param $c (ref $consumer)) (block $on-receive (result (ref $consumer)) - (resume (event $receive $on-receive) (local.get $n) (local.get $c)) + (resume (tag $receive $on-receive) (local.get $n) (local.get $c)) (return) ) ;; receive (local.set $c) @@ -20,7 +20,7 @@ (func $copiper (param $c (ref $consumer)) (param $p (ref $producer)) (local $n i32) (block $on-send (result i32 (ref $producer)) - (resume (event $send $on-send) (local.get $p)) + (resume (tag $send $on-send) (local.get $p)) (return) ) ;; send (local.set $p) @@ -41,8 +41,8 @@ (type $producer (cont $pfun)) (type $consumer (cont $cfun)) - (event $send (import "pipes" "send") (param i32)) - (event $receive (import "pipes" "receive") (result i32)) + (tag $send (import "pipes" "send") (param i32)) + (tag $receive (import "pipes" "receive") (result i32)) (func $pipe (import "pipes" "pipe") (param $p (ref $producer)) (param $c (ref $consumer))) diff --git a/proposals/continuations/examples/fun-state.wast b/proposals/continuations/examples/fun-state.wast index 0a5a094c0..23d6c62a9 100644 --- a/proposals/continuations/examples/fun-state.wast +++ b/proposals/continuations/examples/fun-state.wast @@ -1,7 +1,7 @@ ;; Simple state example - functional with heterogeneous continuations (module $state - (event $get (result i32)) - (event $set (param i32)) + (tag $get (result i32)) + (tag $set (param i32)) (type $gf (func (param i32) (result i32))) (type $sf (func (result i32))) @@ -12,7 +12,7 @@ (func $getting (param $k (ref $gk)) (param $s i32) (result i32) (block $on_get (result (ref $gk)) (block $on_set (result i32 (ref $sk)) - (resume (event $get $on_get) (event $set $on_set) + (resume (tag $get $on_get) (tag $set $on_set) (local.get $s) (local.get $k) ) (return) @@ -26,7 +26,7 @@ (func $setting (param $s i32) (param $k (ref $sk)) (result i32) (block $on_get (result (ref $gk)) (block $on_set (result i32 (ref $sk)) - (resume (event $get $on_get) (event $set $on_set) + (resume (tag $get $on_get) (tag $set $on_set) (local.get $k) ) (return) diff --git a/proposals/continuations/examples/lwt.wast b/proposals/continuations/examples/lwt.wast index 4c35de08f..6a5955a58 100644 --- a/proposals/continuations/examples/lwt.wast +++ b/proposals/continuations/examples/lwt.wast @@ -2,20 +2,20 @@ ;; interface to lightweight threads (module $lwt - (type $func (func)) - (type $cont (cont $func)) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) - (event $yield (export "yield")) - (event $fork (export "fork") (param (ref $cont))) + (tag $yield (export "yield")) ;; [] -> [] + (tag $fork (export "fork") (param (ref $cont))) ;; [cont ([] -> [])] -> [] ) (register "lwt") (module $example - (type $func (func)) - (type $cont (cont $func)) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) - (event $yield (import "lwt" "yield")) - (event $fork (import "lwt" "fork") (param (ref $cont))) + (tag $yield (import "lwt" "yield")) ;; [] -> [] + (tag $fork (import "lwt" "fork") (param (ref $cont))) ;; [cont ([] -> [])] -> [] (func $log (import "spectest" "print_i32") (param i32)) @@ -57,9 +57,10 @@ ) (register "example") +;; queue of threads (module $queue - (type $func (func)) - (type $cont (cont $func)) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) ;; Table as simple queue (keeping it simple, no ring buffer) (table $queue 0 (ref null $cont)) @@ -116,11 +117,11 @@ (register "queue") (module $scheduler - (type $func (func)) - (type $cont (cont $func)) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) - (event $yield (import "lwt" "yield")) - (event $fork (import "lwt" "fork") (param (ref $cont))) + (tag $yield (import "lwt" "yield")) ;; [] -> [] + (tag $fork (import "lwt" "fork") (param (ref $cont))) ;; [cont ([] -> [])] -> [] (func $queue-empty (import "queue" "queue-empty") (result i32)) (func $dequeue (import "queue" "dequeue") (result (ref null $cont))) @@ -133,9 +134,10 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (event $yield $on_yield) - (event $fork $on_fork) - (local.get $nextk) + (resume + (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) ) (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated @@ -143,8 +145,7 @@ (local.set $nextk) ;; current thread (call $enqueue) ;; new thread (br $l) - ) - ;; $on_yield (result (ref $cont)) + ) ;; $on_yield (result (ref $cont)) (local.set $nextk) ;; carry on with current thread (br $l) ) @@ -164,19 +165,19 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (event $yield $on_yield) - (event $fork $on_fork) - (local.get $nextk) + (resume + (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) ) (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated ) ;; $on_fork (result (ref $cont) (ref $cont)) - (local.set $nextk) ;; current thread + (local.set $nextk) ;; current thread (call $enqueue) ;; new thread (br $l) - ) - ;; $on_yield (result (ref $cont)) - (call $enqueue) ;; current thread + ) ;; $on_yield (result (ref $cont)) + (call $enqueue) ;; current thread (local.set $nextk (call $dequeue)) ;; next thread (br $l) ) @@ -188,19 +189,19 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (event $yield $on_yield) - (event $fork $on_fork) - (local.get $nextk) + (resume + (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) ) (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated ) ;; $on_fork (result (ref $cont) (ref $cont)) - (call $enqueue) ;; current thread + (call $enqueue) ;; current thread (local.set $nextk) ;; new thread (br $l) - ) - ;; $on_yield (result (ref $cont)) - (call $enqueue) ;; current thread + ) ;; $on_yield (result (ref $cont)) + (call $enqueue) ;; current thread (local.set $nextk (call $dequeue)) ;; next thread (br $l) ) @@ -212,20 +213,20 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (event $yield $on_yield) - (event $fork $on_fork) - (local.get $nextk) + (resume + (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) ) (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated ) ;; $on_fork (result (ref $cont) (ref $cont)) - (call $enqueue) ;; current thread + (call $enqueue) ;; current thread (call $enqueue) ;; new thread - (local.set $nextk (call $dequeue)) ;; next thread + (local.set $nextk (call $dequeue)) ;; next thread (br $l) - ) - ;; $on_yield (result (ref $cont)) - (call $enqueue) ;; current thread + ) ;; $on_yield (result (ref $cont)) + (call $enqueue) ;; current thread (local.set $nextk (call $dequeue)) ;; next thread (br $l) ) @@ -237,21 +238,21 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (event $yield $on_yield) - (event $fork $on_fork) - (local.get $nextk) + (resume + (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) ) (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated ) ;; $on_fork (result (ref $cont) (ref $cont)) (local.set $nextk) (call $enqueue) ;; new thread - (call $enqueue (local.get $nextk)) ;; current thread - (local.set $nextk (call $dequeue)) ;; next thread + (call $enqueue (local.get $nextk)) ;; current thread + (local.set $nextk (call $dequeue)) ;; next thread (br $l) - ) - ;; $on_yield (result (ref $cont)) - (call $enqueue) ;; current thread + ) ;; $on_yield (result (ref $cont)) + (call $enqueue) ;; current thread (local.set $nextk (call $dequeue)) ;; next thread (br $l) ) @@ -260,14 +261,14 @@ (register "scheduler") (module - (type $func (func)) - (type $cont (cont $func)) + (type $func (func)) ;; [] -> [] + (type $cont (cont $func)) ;; cont ([] -> []) - (func $scheduler1 (import "scheduler" "sync") (param $nextk (ref null $cont))) - (func $scheduler2 (import "scheduler" "kt") (param $nextk (ref null $cont))) - (func $scheduler3 (import "scheduler" "tk") (param $nextk (ref null $cont))) - (func $scheduler4 (import "scheduler" "ykt") (param $nextk (ref null $cont))) - (func $scheduler5 (import "scheduler" "ytk") (param $nextk (ref null $cont))) + (func $scheduler-sync (import "scheduler" "sync") (param $nextk (ref null $cont))) + (func $scheduler-kt (import "scheduler" "kt") (param $nextk (ref null $cont))) + (func $schedule-tk (import "scheduler" "tk") (param $nextk (ref null $cont))) + (func $scheduler-ykt (import "scheduler" "ykt") (param $nextk (ref null $cont))) + (func $scheduler-ytk (import "scheduler" "ytk") (param $nextk (ref null $cont))) (func $log (import "spectest" "print_i32") (param i32)) @@ -277,15 +278,15 @@ (func (export "run") (call $log (i32.const -1)) - (call $scheduler1 (cont.new (type $cont) (ref.func $main))) + (call $scheduler-sync (cont.new (type $cont) (ref.func $main))) (call $log (i32.const -2)) - (call $scheduler2 (cont.new (type $cont) (ref.func $main))) + (call $scheduler-kt (cont.new (type $cont) (ref.func $main))) (call $log (i32.const -3)) - (call $scheduler3 (cont.new (type $cont) (ref.func $main))) + (call $schedule-tk (cont.new (type $cont) (ref.func $main))) (call $log (i32.const -4)) - (call $scheduler4 (cont.new (type $cont) (ref.func $main))) + (call $scheduler-ykt (cont.new (type $cont) (ref.func $main))) (call $log (i32.const -5)) - (call $scheduler5 (cont.new (type $cont) (ref.func $main))) + (call $scheduler-ytk (cont.new (type $cont) (ref.func $main))) (call $log (i32.const -6)) ) ) diff --git a/proposals/continuations/examples/pipes.wast b/proposals/continuations/examples/pipes.wast index e5a91b3a2..573b9491a 100644 --- a/proposals/continuations/examples/pipes.wast +++ b/proposals/continuations/examples/pipes.wast @@ -5,8 +5,8 @@ (type $producer (cont $pfun)) (type $consumer (cont $cfun)) - (event $send (export "send") (param i32)) - (event $receive (export "receive") (result i32)) + (tag $send (export "send") (param i32)) + (tag $receive (export "receive") (result i32)) (func $piper (export "pipe") (param $p (ref $producer)) (param $c (ref $consumer)) (local $n i32) @@ -19,7 +19,7 @@ (if (local.get $consuming) (then (block $on-receive (result (ref $consumer)) - (resume (event $receive $on-receive) (local.get $n) (local.get $c)) + (resume (tag $receive $on-receive) (local.get $n) (local.get $c)) (return) ) ;; receive (local.set $c) @@ -28,7 +28,7 @@ ) ) ;; else producing (block $on-send (result i32 (ref $producer)) - (resume (event $send $on-send) (local.get $p)) + (resume (tag $send $on-send) (local.get $p)) (return) ) ;; send (local.set $p) @@ -48,8 +48,8 @@ (type $producer (cont $pfun)) (type $consumer (cont $cfun)) - (event $send (import "pipes" "send") (param i32)) - (event $receive (import "pipes" "receive") (result i32)) + (tag $send (import "pipes" "send") (param i32)) + (tag $receive (import "pipes" "receive") (result i32)) (func $pipe (import "pipes" "pipe") (param $p (ref $producer)) (param $c (ref $consumer))) diff --git a/proposals/continuations/examples/static-lwt.wast b/proposals/continuations/examples/static-lwt.wast index a5538638d..0bd0b376b 100644 --- a/proposals/continuations/examples/static-lwt.wast +++ b/proposals/continuations/examples/static-lwt.wast @@ -2,12 +2,12 @@ ;; interface to a fixed collection of lightweight threads (module $lwt - (event $yield (export "yield")) + (tag $yield (export "yield")) ) (register "lwt") (module $example - (event $yield (import "lwt" "yield")) + (tag $yield (import "lwt" "yield")) (func $log (import "spectest" "print_i32") (param i32)) (func $thread1 (export "thread1") @@ -99,7 +99,7 @@ (type $func (func)) (type $cont (cont $func)) - (event $yield (import "lwt" "yield")) + (tag $yield (import "lwt" "yield")) ;; queue interface (func $queue-empty (import "queue" "queue-empty") (result i32)) @@ -110,7 +110,7 @@ (loop $l (if (call $queue-empty) (then (return))) (block $on_yield (result (ref $cont)) - (resume (event $yield $on_yield) + (resume (tag $yield $on_yield) (call $dequeue) ) (br $l) ;; thread terminated diff --git a/test/core/cont.wast b/test/core/cont.wast index d31b51dd4..c32b30add 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -1,9 +1,9 @@ -;; Unhandled events & guards +;; Unhandled tags & guards (module (exception $exn) - (event $e1) - (event $e2) + (tag $e1) + (tag $e2) (type $f1 (func)) (type $k1 (cont $f1)) @@ -18,7 +18,7 @@ (func (export "unhandled-3") (block $h (result (ref $k1)) - (resume (event $e2 $h) (cont.new (type $k1) (ref.func $f1))) + (resume (tag $e2 $h) (cont.new (type $k1) (ref.func $f1))) (unreachable) ) (drop) @@ -26,7 +26,7 @@ (func (export "handled") (block $h (result (ref $k1)) - (resume (event $e1 $h) (cont.new (type $k1) (ref.func $f1))) + (resume (tag $e1 $h) (cont.new (type $k1) (ref.func $f1))) (unreachable) ) (drop) @@ -39,7 +39,7 @@ (func (export "uncaught-1") (block $h (result (ref $k1)) - (resume (event $e1 $h) (cont.new (type $k1) (ref.func $f2))) + (resume (tag $e1 $h) (cont.new (type $k1) (ref.func $f2))) (unreachable) ) (drop) @@ -47,7 +47,7 @@ (func (export "uncaught-2") (block $h (result (ref $k1)) - (resume (event $e1 $h) (cont.new (type $k1) (ref.func $f1))) + (resume (tag $e1 $h) (cont.new (type $k1) (ref.func $f1))) (unreachable) ) (resume_throw $exn) @@ -63,7 +63,7 @@ (func (export "barrier") (block $h (result (ref $k1)) - (resume (event $e1 $h) (cont.new (type $k1) (ref.func $f3))) + (resume (tag $e1 $h) (cont.new (type $k1) (ref.func $f3))) (unreachable) ) (resume_throw $exn) @@ -79,7 +79,7 @@ ) (func $nl2 (param $k (ref $k1)) (block $h (result (ref $k1)) - (resume (event $e1 $h) (local.get $k)) + (resume (tag $e1 $h) (local.get $k)) (unreachable) ) (resume (local.get $k)) @@ -87,12 +87,12 @@ ) (func $nl3 (param $k (ref $k1)) (block $h1 (result (ref $k1)) - (resume (event $e1 $h1) (local.get $k)) + (resume (tag $e1 $h1) (local.get $k)) (unreachable) ) (let (local $k' (ref $k1)) (block $h2 (result (ref $k1)) - (resume (event $e1 $h2) (local.get $k')) + (resume (tag $e1 $h2) (local.get $k')) (unreachable) ) (resume (local.get $k')) @@ -137,8 +137,8 @@ ;; Simple state example (module $state - (event $get (result i32)) - (event $set (param i32) (result i32)) + (tag $get (result i32)) + (tag $set (param i32) (result i32)) (type $f (func (param i32) (result i32))) (type $k (cont $f)) @@ -147,7 +147,7 @@ (loop $loop (block $on_get (result (ref $k)) (block $on_set (result i32 (ref $k)) - (resume (event $get $on_get) (event $set $on_set) + (resume (tag $get $on_get) (tag $set $on_set) (local.get $s) (local.get $k) ) (return) @@ -195,7 +195,7 @@ (type $cont0 (cont $gen)) (type $cont (cont $geny)) - (event $yield (param i64) (result i32)) + (tag $yield (param i64) (result i32)) ;; Hook for logging purposes (global $hook (export "hook") (mut (ref $gen)) (ref.func $dummy)) @@ -217,7 +217,7 @@ (local.get $i) (cont.new (type $cont0) (ref.func $gen)) (block $on_first_yield (param i64 (ref $cont0)) (result i64 (ref $cont)) - (resume (event $yield $on_first_yield)) + (resume (tag $yield $on_first_yield)) (unreachable) ) (loop $on_yield (param i64) (param (ref $cont)) @@ -226,7 +226,7 @@ (local.set $sum (i64.add (local.get $sum) (local.get $n))) (i64.eq (local.get $n) (local.get $j)) (local.get $k) ) - (resume (event $yield $on_yield)) + (resume (tag $yield $on_yield)) ) (return (local.get $sum)) ) @@ -247,8 +247,8 @@ (type $proc (func)) (type $cont (cont $proc)) - (event $yield (export "yield")) - (event $spawn (export "spawn") (param (ref $proc))) + (tag $yield (export "yield")) + (tag $spawn (export "spawn") (param (ref $proc))) ;; Table as simple queue (keeping it simple, no ring buffer) (table $queue 0 (ref null $cont)) @@ -308,7 +308,7 @@ (if (call $queue-empty) (then (return))) (block $on_yield (result (ref $cont)) (block $on_spawn (result (ref $proc) (ref $cont)) - (resume (event $yield $on_yield) (event $spawn $on_spawn) + (resume (tag $yield $on_yield) (tag $spawn $on_spawn) (call $dequeue) ) (br $l) ;; thread terminated @@ -331,8 +331,8 @@ (module (type $proc (func)) (type $cont (cont $proc)) - (event $yield (import "scheduler" "yield")) - (event $spawn (import "scheduler" "spawn") (param (ref $proc))) + (tag $yield (import "scheduler" "yield")) + (tag $spawn (import "scheduler" "spawn") (param (ref $proc))) (func $scheduler (import "scheduler" "scheduler") (param $main (ref $proc))) (func $log (import "spectest" "print_i32") (param i32)) @@ -418,8 +418,8 @@ (module $concurrent-generator (func $log (import "spectest" "print_i64") (param i64)) - (event $syield (import "scheduler" "yield")) - (event $spawn (import "scheduler" "spawn") (param (ref $proc))) + (tag $syield (import "scheduler" "yield")) + (tag $spawn (import "scheduler" "spawn") (param (ref $proc))) (func $scheduler (import "scheduler" "scheduler") (param $main (ref $proc))) (type $ghook (func (param i64))) @@ -502,7 +502,7 @@ (module - (event $e (result i32 i32 i32 i32 i32 i32)) + (tag $e (result i32 i32 i32 i32 i32 i32)) (type $f0 (func (result i32 i32 i32 i32 i32 i32 i32))) (type $f2 (func (param i32 i32) (result i32 i32 i32 i32 i32 i32 i32))) @@ -524,7 +524,7 @@ (local $k4 (ref null $k4)) (local $k2 (ref null $k2)) (block $l (result (ref $k6)) - (resume (event $e $l) (cont.new (type $k0) (ref.func $f))) + (resume (tag $e $l) (cont.new (type $k0) (ref.func $f))) (unreachable) ) (local.set $k6) From 6a62ed1a6a50c46ad3997d382cfac157ce360a2d Mon Sep 17 00:00:00 2001 From: Sam Lindley Date: Thu, 3 Feb 2022 14:24:02 +0000 Subject: [PATCH 49/82] Revert "MVar implementation" (#17) --- test/core/cont.wast | 495 -------------------------------------------- 1 file changed, 495 deletions(-) diff --git a/test/core/cont.wast b/test/core/cont.wast index c32b30add..22c30dc59 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -538,498 +538,3 @@ (i32.const 0) (i32.const 1) (i32.const 2) (i32.const 3) (i32.const 4) (i32.const 5) (i32.const 6) ) - -;; MVar implementation -;; Scheduler - -(module $scheduler2 - (type $proc (func)) - (type $cont (cont $proc)) - (type $susp_fn (func (param (ref null $cont)))) - - (event $yield (export "yield")) - (event $spawn (export "spawn") (param (ref $proc))) - (event $suspend (export "suspend") (param (ref $susp_fn))) - (event $resume (export "resume") (param (ref null $cont))) - - ;; Table as simple queue (keeping it simple, no ring buffer) - (table $queue 0 (ref null $cont)) - - ;; Holds the continuation which will be resumed next - (table $curr_proc 0 (ref null $cont)) - - ;; Queue variables - (global $qdelta i32 (i32.const 10)) ;; Threshold for allocating more space in the queue table - ;; If front > threshold, entries are moved instead - (global $qback (mut i32) (i32.const 0)) ;; Index of front of queue - (global $qfront (mut i32) (i32.const 0)) ;; Index of back of queue - - ;; Holds the status of curr_proc (1 -> Set, 0 -> Not set) - (global $curr_status (mut i32) (i32.const 0)) - - (func $queue-empty (result i32) - (i32.eq (global.get $qfront) (global.get $qback)) - ) - - (func $dequeue (result (ref null $cont)) - (local $i i32) - (if (call $queue-empty) - (then (return (ref.null $cont))) - ) - (local.set $i (global.get $qfront)) - (global.set $qfront (i32.add (local.get $i) (i32.const 1))) - (table.get $queue (local.get $i)) - ) - - (func $enqueue (param $k (ref null $cont)) - ;; Check if queue is full - (if (i32.eq (global.get $qback) (table.size $queue)) - (then - ;; Check if there is enough space in the front to compact - (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) - (then - ;; Space is below threshold, grow table instead - (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) - ) - (else - ;; Enough space, move entries up to head of table - (global.set $qback (i32.sub (global.get $qback) (global.get $qfront))) - (table.copy $queue $queue - (i32.const 0) ;; dest = new front = 0 - (global.get $qfront) ;; src = old front - (global.get $qback) ;; len = new back = old back - old front - ) - (table.fill $queue ;; null out old entries to avoid leaks - (global.get $qback) ;; start = new back - (ref.null $cont) ;; init value - (global.get $qfront) ;; len = old front = old front - new front - ) - (global.set $qfront (i32.const 0)) - ) - ) - ) - ) - (table.set $queue (global.get $qback) (local.get $k)) - (global.set $qback (i32.add (global.get $qback) (i32.const 1))) - ) - - ;; Check if curr_proc is set or not. Return 1 if not set. - (func $curr-empty (result i32) - (i32.eqz (global.get $curr_status)) - ) - - (func $curr_set (param $k (ref null $cont)) - (global.set $curr_status (i32.const 1)) - (table.set $curr_proc (i32.const 0) (local.get $k)) - ) - - (func $curr_get (result (ref null $cont)) - (global.set $curr_status (i32.const 0)) - (table.get $curr_proc (i32.const 0)) - ) - - (func $exec_susp_fn (param $f (ref $susp_fn)) (param $k (ref $cont)) - ;; Bind k to f and make it the next thread to be executed - (cont.new (type $cont) (func.bind (type $proc) (local.get $k) (local.get $f))) - (call $curr_set) - ) - - (func $scheduler (export "scheduler") (param $main (ref $proc)) - ;; Allocate space for curr_proc - (drop (table.grow $curr_proc (ref.null $cont) (i32.const 1))) - - ;; Add the function to process queue - (call $curr_set (cont.new (type $cont) (local.get $main))) - - (loop $l - (if (call $curr-empty) - (then - ;; curr_proc not set - ;; If process queue is empty, no more processes to execute - ;; Else set curr_proc to the front of the queue - (if (call $queue-empty) - (then (return)) - (else - (call $curr_set (call $dequeue)) - ) - ) - ) - ) - (block $on_yield (result (ref $cont)) - (block $on_spawn (result (ref $proc) (ref $cont)) - (block $on_suspend (result (ref $susp_fn) (ref $cont)) - (block $on_resume (result (ref null $cont) (ref $cont)) - (resume (event $yield $on_yield) (event $spawn $on_spawn) - (event $suspend $on_suspend) (event $resume $on_resume) - (call $curr_get) - ) - (br $l) ;; thread terminated - ) - ;; on resume, cont (resumption) and cont (curr) on stack - (call $curr_set) ;; continuation of old thread - (call $enqueue) ;; thread to be resumed - (br $l) - ) - ;; on suspend, susp_fn and cont on stack - (call $exec_susp_fn) - (br $l) - ) - ;; on $spawn, proc and cont on stack - (call $enqueue) ;; continuation of old thread - (cont.new (type $cont)) - (call $enqueue) ;; new thread - (br $l) - ) - ;; on $yield, cont on stack - (call $enqueue) - (br $l) - ) - ) -) - -(register "scheduler2") - -;; Producer queue - -(module $producer_queue - (type $proc (func)) - (type $cont (cont $proc)) - - ;; Table as simple queue (keeping it simple, no ring buffer) - (table $queue 0 (ref null $cont)) - - ;; Queue variables - (global $qdelta i32 (i32.const 10)) ;; Threshold for allocating more space in the queue table - ;; If front > threshold, entries are moved instead - (global $qback (mut i32) (i32.const 0)) ;; Index of front of queue - (global $qfront (mut i32) (i32.const 0)) ;; Index of back of queue - - (func $queue-empty (export "queue-empty") (result i32) - (i32.eq (global.get $qfront) (global.get $qback)) - ) - - (func $dequeue (export "dequeue") (result (ref null $cont)) - (local $i i32) - (if (call $queue-empty) - (then (return (ref.null $cont))) - ) - (local.set $i (global.get $qfront)) - (global.set $qfront (i32.add (local.get $i) (i32.const 1))) - (table.get $queue (local.get $i)) - ) - - (func $enqueue (export "enqueue") (param $k (ref null $cont)) - ;; Check if queue is full - (if (i32.eq (global.get $qback) (table.size $queue)) - (then - ;; Check if there is enough space in the front to compact - (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) - (then - ;; Space is below threshold, grow table instead - (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) - ) - (else - ;; Enough space, move entries up to head of table - (global.set $qback (i32.sub (global.get $qback) (global.get $qfront))) - (table.copy $queue $queue - (i32.const 0) ;; dest = new front = 0 - (global.get $qfront) ;; src = old front - (global.get $qback) ;; len = new back = old back - old front - ) - (table.fill $queue ;; null out old entries to avoid leaks - (global.get $qback) ;; start = new back - (ref.null $cont) ;; init value - (global.get $qfront) ;; len = old front = old front - new front - ) - (global.set $qfront (i32.const 0)) - ) - ) - ) - ) - (table.set $queue (global.get $qback) (local.get $k)) - (global.set $qback (i32.add (global.get $qback) (i32.const 1))) - ) -) - -(register "producer_queue") - -;; Consumer queue - -(module $consumer_queue - (type $proc (func)) - (type $cont (cont $proc)) - - ;; Table as simple queue (keeping it simple, no ring buffer) - (table $queue 0 (ref null $cont)) - - ;; Queue variables - (global $qdelta i32 (i32.const 10)) ;; Threshold for allocating more space in the queue table - ;; If front > threshold, entries are moved instead - (global $qback (mut i32) (i32.const 0)) ;; Index of front of queue - (global $qfront (mut i32) (i32.const 0)) ;; Index of back of queue - - (func $queue-empty (export "queue-empty") (result i32) - (i32.eq (global.get $qfront) (global.get $qback)) - ) - - (func $dequeue (export "dequeue") (result (ref null $cont)) - (local $i i32) - (if (call $queue-empty) - (then (return (ref.null $cont))) - ) - (local.set $i (global.get $qfront)) - (global.set $qfront (i32.add (local.get $i) (i32.const 1))) - (table.get $queue (local.get $i)) - ) - - (func $enqueue (export "enqueue") (param $k (ref null $cont)) - ;; Check if queue is full - (if (i32.eq (global.get $qback) (table.size $queue)) - (then - ;; Check if there is enough space in the front to compact - (if (i32.lt_u (global.get $qfront) (global.get $qdelta)) - (then - ;; Space is below threshold, grow table instead - (drop (table.grow $queue (ref.null $cont) (global.get $qdelta))) - ) - (else - ;; Enough space, move entries up to head of table - (global.set $qback (i32.sub (global.get $qback) (global.get $qfront))) - (table.copy $queue $queue - (i32.const 0) ;; dest = new front = 0 - (global.get $qfront) ;; src = old front - (global.get $qback) ;; len = new back = old back - old front - ) - (table.fill $queue ;; null out old entries to avoid leaks - (global.get $qback) ;; start = new back - (ref.null $cont) ;; init value - (global.get $qfront) ;; len = old front = old front - new front - ) - (global.set $qfront (i32.const 0)) - ) - ) - ) - ) - (table.set $queue (global.get $qback) (local.get $k)) - (global.set $qback (i32.add (global.get $qback) (i32.const 1))) - ) -) - -(register "consumer_queue") - -;; MVar - -(module $mvar - (type $proc (func)) - (type $cont (cont $proc)) - (type $susp_fn (func (param (ref null $cont)))) - - (event $yield (import "scheduler2" "yield")) - (event $spawn (import "scheduler2" "spawn") (param (ref $proc))) - (event $suspend (import "scheduler2" "suspend") (param (ref $susp_fn))) - (event $resume (import "scheduler2" "resume") (param (ref null $cont))) - - (func $scheduler (import "scheduler2" "scheduler") (param $main (ref $proc))) - - (func $pq-empty (import "producer_queue" "queue-empty") (result i32)) - (func $pq-dequeue (import "producer_queue" "dequeue") (result (ref null $cont))) - (func $pq-enqueue (import "producer_queue" "enqueue") (param (ref null $cont))) - - (func $cq-empty (import "consumer_queue" "queue-empty") (result i32)) - (func $cq-dequeue (import "consumer_queue" "dequeue") (result (ref null $cont))) - (func $cq-enqueue (import "consumer_queue" "enqueue") (param (ref null $cont))) - - (func $log (import "spectest" "print_i32") (param i32)) - - (global $data (mut i32) (i32.const 0)) - (global $state (mut i32) (i32.const 0)) - ;; States - ;; 0 - Empty (can write) - ;; 1 - Blocked (some other write/read operation is pending) - ;; 2 - Full (can read) - - (elem declare func $prod_susp_fn $cons_susp_fn) - - ;; Producer suspension function - (func $prod_susp_fn (param $k (ref null $cont)) - (call $pq-enqueue (local.get $k)) - ) - - ;; Consumer suspension function - (func $cons_susp_fn (param $k (ref null $cont)) - (call $cq-enqueue (local.get $k)) - ) - - (func (export "fork") (param $f (ref $proc)) - (suspend $spawn (local.get $f)) - ) - - (func (export "put") (param $value i32) - (if (i32.gt_s (global.get $state) (i32.const 0)) - (then - (suspend $suspend (ref.func $prod_susp_fn)) - ;; Added to queue; Resumed only when it is its turn - ) - ) - - ;; Set the value - (global.set $data (local.get $value)) - (global.set $state (i32.const 2)) - - (if (i32.ne (call $cq-empty) (i32.const 1)) - (then - ;; Block all operations for new threads and resume the next consumer - (global.set $state (i32.const 1)) - (suspend $resume (call $cq-dequeue)) - ) - ) - ) - - (func (export "take") (result i32) - (local $read i32) - - (if (i32.lt_s (global.get $state) (i32.const 2)) - (then - (suspend $suspend (ref.func $cons_susp_fn)) - ;; Added to queue; Resumed only when it is its turn - ) - ) - - ;; Read the value - (global.set $state (i32.const 0)) - (local.set $read (global.get $data)) - - (if (i32.ne (call $pq-empty) (i32.const 1)) - (then - ;; Block all operations for new threads and resume the next producer - (global.set $state (i32.const 1)) - (suspend $resume (call $pq-dequeue)) - ) - ) - - (local.get $read) - ) - - (func (export "run") (param $f (ref $proc)) - (call $scheduler (local.get $f)) - ) -) - -(register "mvar") - - -(module - (type $proc (func)) - (func $fork (import "mvar" "fork") (param (ref $proc))) - (func $put (import "mvar" "put") (param i32)) - (func $take (import "mvar" "take") (result i32)) - (func $run (import "mvar" "run") (param (ref $proc))) - - (func $log (import "spectest" "print_i32") (param i32)) - - (exception $error) - - (elem declare func $producer $consumer $prod3 $cons3 $test1 $test2 $test3 $test4 $test5 $test6) - - (func $producer (param $v i32) - (call $put (local.get $v)) - ) - - (func $consumer (param $v i32) - (if (i32.ne (call $take) (local.get $v)) - (then (throw $error)) - ) - ) - - (func $prod3 - (call $producer (i32.const 1)) - (call $producer (i32.const 2)) - (call $producer (i32.const 3)) - ) - - (func $cons3 - (call $consumer (i32.const 1)) - (call $consumer (i32.const 2)) - (call $consumer (i32.const 3)) - ) - - (func $test1 - (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $producer))) - (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $consumer))) - ) - - (func $test2 - (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $consumer))) - (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $producer))) - ) - - (func $test3 - (call $fork (ref.func $prod3)) - (call $fork (ref.func $cons3)) - ) - - (func $test4 - (call $fork (ref.func $cons3)) - (call $fork (ref.func $prod3)) - ) - - (func $test5 - (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $producer))) - (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $consumer))) - (call $fork (func.bind (type $proc) (i32.const 2) (ref.func $producer))) - (call $fork (func.bind (type $proc) (i32.const 2) (ref.func $consumer))) - (call $fork (func.bind (type $proc) (i32.const 3) (ref.func $producer))) - (call $fork (func.bind (type $proc) (i32.const 3) (ref.func $consumer))) - ) - - (func $test6 - (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $consumer))) - (call $fork (func.bind (type $proc) (i32.const 1) (ref.func $producer))) - (call $fork (func.bind (type $proc) (i32.const 2) (ref.func $consumer))) - (call $fork (func.bind (type $proc) (i32.const 2) (ref.func $producer))) - (call $fork (func.bind (type $proc) (i32.const 3) (ref.func $consumer))) - (call $fork (func.bind (type $proc) (i32.const 3) (ref.func $producer))) - ) - - (func $runtest (export "run") (param $f (ref $proc)) - (call $run (local.get $f)) - ) - - (func (export "test1") - (call $log (i32.const 1)) - (call $runtest (ref.func $test1)) - ) - - (func (export "test2") - (call $log (i32.const 2)) - (call $runtest (ref.func $test2)) - ) - - (func (export "test3") - (call $log (i32.const 3)) - (call $runtest (ref.func $test3)) - ) - - (func (export "test4") - (call $log (i32.const 4)) - (call $runtest (ref.func $test4)) - ) - - (func (export "test5") - (call $log (i32.const 5)) - (call $runtest (ref.func $test5)) - ) - - (func (export "test6") - (call $log (i32.const 6)) - (call $runtest (ref.func $test6)) - ) -) - -(assert_return (invoke "test1")) -(assert_return (invoke "test2")) -(assert_return (invoke "test3")) -(assert_return (invoke "test4")) -(assert_return (invoke "test5")) -(assert_return (invoke "test6")) - From 069848a4b10d1cdd4ee97306408e45941540fa00 Mon Sep 17 00:00:00 2001 From: Sam Lindley Date: Thu, 3 Feb 2022 15:34:44 +0000 Subject: [PATCH 50/82] update README --- README.md | 19 +++++++++++-------- 1 file changed, 11 insertions(+), 8 deletions(-) diff --git a/README.md b/README.md index 695da1ab9..d9d4412dc 100644 --- a/README.md +++ b/README.md @@ -1,17 +1,20 @@ -[![Build Status](https://travis-ci.org/WebAssembly/function-references.svg?branch=master)](https://travis-ci.org/WebAssembly/function-references) +# Typed Continuations Proposal for WebAssembly -# Continuations Proposal for WebAssembly +This repository is a clone of +[github.com/WebAssembly/spec/](https://github.com/WebAssembly/spec/). +It is meant for discussion, prototype specification and implementation +of a proposal to add support for different patterns of non-local +control flow to WebAssembly. -This repository is a clone of [github.com/WebAssembly/spec/](https://github.com/WebAssembly/spec/). -It is meant for discussion, prototype specification and implementation of a proposal to add support for basic function reference types to WebAssembly. +The proposal is fully implemented as part of the reference interpreter. -* See the [overview](proposals/continuations/Overview.md) for a summary of the proposal. +* See the [explainer](proposals/continuations/Explainer.md) for a high-level summary of the proposal. -* See the [modified spec](https://webassembly.github.io/continuations/core) for details. (Note, link is 404.) +* See the [overview](proposals/continuations/Overview.md) for a more formal description of the proposal. -The repository is based on the [function references](proposals/function-references/Overview.md) and the [tail call]proposals/tail-call/Overview.md) proposal and includes all respective changes. +* See the [examples](proposals/continuations/examples) for Wasm code for implementing various different features including lightweight threads, actors, and async/await. -Original README from upstream repository follows... +Original `README` from upstream repository follows. # spec From 57c59550fe78f4e83b6f5c032bf1446220b41c13 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Mon, 10 Oct 2022 16:38:06 +0100 Subject: [PATCH 51/82] Type-indexed tags. (#18) This patch adapts the internal and external representation of tags such that they are parameterised by a type index rather than an immediate type. In addition, it also updates the implementation of exception handling to match that of WebAssembly/exception-handling. Co-authored-by: Andreas Rossberg --- interpreter/Makefile | 2 +- interpreter/binary/decode.ml | 60 ++++---- interpreter/binary/encode.ml | 33 ++-- interpreter/exec/eval.ml | 174 +++++++++++++-------- interpreter/host/spectest.ml | 8 +- interpreter/syntax/ast.ml | 7 +- interpreter/syntax/free.ml | 14 +- interpreter/syntax/operators.ml | 4 +- interpreter/syntax/types.ml | 11 +- interpreter/text/arrange.ml | 29 ++-- interpreter/text/lexer.mll | 5 +- interpreter/text/parser.conflicts | 0 interpreter/text/parser.mly | 171 +++++++++++---------- interpreter/valid/match.ml | 11 +- interpreter/valid/valid.ml | 108 +++++++------ test/core/catch.wast | 86 ----------- test/core/cont.wast | 2 +- test/core/try_catch.wast | 242 ++++++++++++++++++++++++++++++ 18 files changed, 617 insertions(+), 350 deletions(-) create mode 100644 interpreter/text/parser.conflicts delete mode 100644 test/core/catch.wast create mode 100644 test/core/try_catch.wast diff --git a/interpreter/Makefile b/interpreter/Makefile index c163b15aa..d4839d4b9 100644 --- a/interpreter/Makefile +++ b/interpreter/Makefile @@ -19,7 +19,7 @@ WINMAKE = winmake.bat DIRS = util syntax binary text valid runtime exec script host main LIBS = bigarray -FLAGS = -lexflags -ml -cflags '-w +a-4-27-42-44-45 -warn-error +a-3' +FLAGS = -lexflags -ml -cflags '-w +a-4-27-42-44-45-70 -warn-error +a-3' OCBA = ocamlbuild $(FLAGS) $(DIRS:%=-I %) OCB = $(OCBA) $(LIBS:%=-libs %) JS = # set to JS shell command to run JS tests diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index 0ad7118b4..bed2fd4f9 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -138,6 +138,9 @@ let sized f s = open Types +let var s = vu32 s +let zero s = expect 0x00 s "zero byte expected" + let var_type s = let pos = pos s in match vs33 s with @@ -204,16 +207,10 @@ let memory_type s = let lim = limits vu32 s in MemoryType lim -let resumability s = - match u8 s with - | 0 -> Terminal - | 1 -> Resumable - | _ -> error s (pos s - 1) "malformed resumability" - let tag_type s = - let res = resumability s in - let ft = func_type s in (* TODO *) - TagType (ft, res) + zero s; + let x = var_type s in + TagType x let mutability s = match u8 s with @@ -232,11 +229,8 @@ let global_type s = open Ast open Operators -let var s = vu32 s - let op s = u8 s let end_ s = expect 0x0b s "END opcode expected" -let zero s = expect 0x00 s "zero byte expected" let memop s = let align = vu32 s in @@ -301,24 +295,29 @@ let rec instr s = | 0x06 -> let bt = block_type s in - let es1 = instr_block s in - let xo = - if peek s = Some 0x07 then begin - expect 0x07 s "CATCH or CATCH_ALL opcode expected"; - Some (at var s) - end - else begin - expect 0x19 s "CATCH or CATCH_ALL opcode expected"; + let es = instr_block s in + let ct = catch_list s in + let ca = + if peek s = Some 0x19 then begin + ignore (u8 s); + Some (instr_block s) + end else None - end in - let es2 = instr_block s in - end_ s; - try_ bt es1 xo es2 + if ct <> [] || ca <> None then begin + end_ s; + try_catch bt es ct ca + end else begin + match op s with + | 0x0b -> try_catch bt es [] None + | 0x18 -> try_delegate bt es (at var s) + | b -> illegal s pos b + end | 0x07 -> error s pos "misplaced CATCH opcode" | 0x08 -> throw (at var s) + | 0x09 -> rethrow (at var s) - | 0x09 | 0x0a as b -> illegal s pos b + | 0x0a as b -> illegal s pos b | 0x0b -> error s pos "misplaced END opcode" | 0x0c -> br (at var s) @@ -351,8 +350,7 @@ let rec instr s = end_ s; let_ bt locs es - | 0x18 as b -> illegal s pos b - + | 0x18 -> error s pos "misplaced DELEGATE opcode" | 0x19 -> error s pos "misplaced CATCH_ALL opcode" | 0x1a -> drop @@ -607,6 +605,14 @@ and instr_block' s es = let pos = pos s in let e' = instr s in instr_block' s (Source.(e' @@ region s pos pos) :: es) +and catch_list s = + if peek s = Some 0x07 then begin + ignore (u8 s); + let tag = at var s in + let instrs = instr_block s in + (tag, instrs) :: catch_list s + end else + [] let const s = let c = at instr_block s in diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 6139945ab..661c0a798 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -141,15 +141,11 @@ struct | Immutable -> u8 0 | Mutable -> u8 1 - let resumability = function - | Terminal -> u8 0 - | Resumable -> u8 1 - let global_type = function | GlobalType (t, mut) -> value_type t; mutability mut - let tag_type = function - | TagType (ft, res) -> resumability res; func_type ft (* TODO *) + let tag_type (TagType x) = + vu32 0x00l; var_type x (* Expressions *) @@ -192,14 +188,22 @@ struct | Let (bt, locs, es) -> op 0x17; block_type bt; locals locs; list instr es; end_ () - | Try (bt, es1, xo, es2) -> - op 0x06; block_type bt; list instr es1; - (match xo with - | Some x -> op 0x07; var x - | None -> op 0x19 - ); - list instr es2; end_ () + | TryCatch (bt, es, ct, ca) -> + op 0x06; block_type bt; list instr es; + let catch (tag, es) = + op 0x07; var tag; list instr es + in + list catch ct; + begin match ca with + | None -> () + | Some es -> op 0x19; list instr es + end; + end_ () + | TryDelegate (bt, es, x) -> + op 0x06; block_type bt; list instr es; + op 0x18; var x | Throw x -> op 0x08; var x + | Rethrow x -> op 0x09; var x | Br x -> op 0x0c; var x | BrIf x -> op 0x0d; var x @@ -527,8 +531,7 @@ struct (* Tag section *) let tag tag = - let {tagtype} = tag.it in - tag_type tagtype + tag_type tag.it.tagtype let tag_section ts = section 13 (vec tag) ts (ts <> []) diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 1c88c5eb4..f95638566 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -63,21 +63,25 @@ and admin_instr' = | Plain of instr' | Refer of ref_ | Invoke of func_inst - | Label of int * instr list * code - | Local of int * value list * code - | Frame of int * frame * code - | Catch of int * tag_inst option * instr list * code + | Label of int32 * instr list * code + | Local of int32 * value list * code + | Frame of int32 * frame * code | Handle of (tag_inst * idx) list option * code | Trapping of string | Throwing of tag_inst * value stack + | Rethrowing of int32 * (admin_instr -> admin_instr) | Suspending of tag_inst * value stack * ctxt | Returning of value stack | ReturningInvoke of value stack * func_inst | Breaking of int32 * value stack + | Catch of int32 * (Tag.t * instr list) list * instr list option * code + | Caught of int32 * Tag.t * value stack * code + | Delegate of int32 * code + | Delegating of int32 * Tag.t * value stack and ctxt = code -> code -type cont = int * ctxt (* TODO: represent type properly *) +type cont = int32 * ctxt (* TODO: represent type properly *) type ref_ += ContRef of cont option ref let () = @@ -151,10 +155,10 @@ let block_type inst bt at = | VarBlockType (SemVar x) -> as_func_def_type (def_of x) let take n (vs : 'a stack) at = - try Lib.List.take n vs with Failure _ -> Crash.error at "stack underflow" + try Lib.List32.take n vs with Failure _ -> Crash.error at "stack underflow" let drop n (vs : 'a stack) at = - try Lib.List.drop n vs with Failure _ -> Crash.error at "stack underflow" + try Lib.List32.drop n vs with Failure _ -> Crash.error at "stack underflow" let split n (vs : 'a stack) at = take n vs at, drop n vs at @@ -201,14 +205,14 @@ let rec step (c : config) : config = | Block (bt, es'), vs -> let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in - let n1 = List.length ts1 in - let n2 = List.length ts2 in + let n1 = Lib.List32.length ts1 in + let n2 = Lib.List32.length ts2 in let args, vs' = take n1 vs e.at, drop n1 vs e.at in vs', [Label (n2, [], (args, List.map plain es')) @@ e.at] | Loop (bt, es'), vs -> let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in - let n1 = List.length ts1 in + let n1 = Lib.List32.length ts1 in let args, vs' = take n1 vs e.at, drop n1 vs e.at in vs', [Label (n1, [e' @@ e.at], (args, List.map plain es')) @@ e.at] @@ -219,29 +223,40 @@ let rec step (c : config) : config = vs', [Plain (Block (bt, es1)) @@ e.at] | Let (bt, locals, es'), vs -> - let locs, vs' = split (List.length locals) vs e.at in + let locs, vs' = split (Lib.List32.length locals) vs e.at in let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in - let args, vs'' = split (List.length ts1) vs' e.at in + let args, vs'' = split (Lib.List32.length ts1) vs' e.at in vs'', [ - Local (List.length ts2, List.rev locs, + Local (Lib.List32.length ts2, List.rev locs, (args, [Plain (Block (bt, es')) @@ e.at]) ) @@ e.at ] - | Try (bt, es1, xo, es2), vs -> - let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in - let n1 = List.length ts1 in - let n2 = List.length ts2 in - let args, vs' = split n1 vs e.at in - let exno = Option.map (tag c.frame.inst) xo in - vs', [Catch (n2, exno, es2, ([], [Label (n2, [], (args, List.map plain es1)) @@ e.at])) @@ e.at] - | Throw x, vs -> let tagt = tag c.frame.inst x in - let TagType (FuncType (ts, _), _) = Tag.type_of tagt in - let vs0, vs' = split (List.length ts) vs e.at in + let TagType x' = Tag.type_of tagt in + let FuncType (ts, _) = as_func_def_type (def_of (as_sem_var x')) in + let vs0, vs' = split (Lib.List32.length ts) vs e.at in vs', [Throwing (tagt, vs0) @@ e.at] + | Rethrow x, vs -> + vs, [Rethrowing (x.it, fun e -> e) @@ e.at] + + | TryCatch (bt, es', cts, ca), vs -> + let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in + let n1 = Lib.List32.length ts1 in + let n2 = Lib.List32.length ts2 in + let args, vs' = take n1 vs e.at, drop n1 vs e.at in + let cts' = List.map (fun (x, es'') -> ((tag c.frame.inst x), es'')) cts in + vs', [Label (n2, [], ([], [Catch (n2, cts', ca, (args, List.map plain es')) @@ e.at])) @@ e.at] + + | TryDelegate (bt, es', x), vs -> + let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in + let n1 = Lib.List32.length ts1 in + let n2 = Lib.List32.length ts2 in + let args, vs' = take n1 vs e.at, drop n1 vs e.at in + vs', [Label (n2, [], ([], [Delegate (x.it, (args, List.map plain es')) @@ e.at])) @@ e.at] + | Br x, vs -> [], [Breaking (x.it, vs) @@ e.at] @@ -303,7 +318,7 @@ let rec step (c : config) : config = let FuncType (ts, _) = Func.type_of f in let FuncType (ts', _) = func_type c.frame.inst x in let args, vs' = - try split (List.length ts - List.length ts') vs e.at + try split (Int32.sub (Lib.List32.length ts) (Lib.List32.length ts')) vs e.at with Failure _ -> Crash.error e.at "type mismatch at function bind" in let f' = Func.alloc_closure (type_ c.frame.inst x) f args in @@ -315,7 +330,7 @@ let rec step (c : config) : config = | ContNew x, Ref (FuncRef f) :: vs -> let FuncType (ts, _) = Func.type_of f in let ctxt code = compose code ([], [Invoke f @@ e.at]) in - Ref (ContRef (ref (Some (List.length ts, ctxt)))) :: vs, [] + Ref (ContRef (ref (Some (Lib.List32.length ts, ctxt)))) :: vs, [] | ContBind x, Ref (NullRef _) :: vs -> vs, [Trapping "null continuation reference" @@ e.at] @@ -327,17 +342,18 @@ let rec step (c : config) : config = let ContType z = cont_type c.frame.inst x in let FuncType (ts', _) = as_func_def_type (def_of (as_sem_var z)) in let args, vs' = - try split (n - List.length ts') vs e.at + try split (Int32.sub n (Lib.List32.length ts')) vs e.at with Failure _ -> Crash.error e.at "type mismatch at continuation bind" in cont := None; let ctxt' code = ctxt (compose code (args, [])) in - Ref (ContRef (ref (Some (n - List.length args, ctxt')))) :: vs', [] + Ref (ContRef (ref (Some (Int32.sub n (Lib.List32.length args), ctxt')))) :: vs', [] | Suspend x, vs -> let tagt = tag c.frame.inst x in - let TagType (FuncType (ts, _), _) = Tag.type_of tagt in - let args, vs' = split (List.length ts) vs e.at in + let TagType x' = Tag.type_of tagt in + let FuncType (ts, _) = as_func_def_type (def_of (as_sem_var x')) in + let args, vs' = split (Lib.List32.length ts) vs e.at in vs', [Suspending (tagt, args, fun code -> code) @@ e.at] | Resume xls, Ref (NullRef _) :: vs -> @@ -360,15 +376,16 @@ let rec step (c : config) : config = | ResumeThrow x, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> let tagt = tag c.frame.inst x in - let TagType (FuncType (ts, _), _) = Tag.type_of tagt in - let args, vs' = split (List.length ts) vs e.at in + let TagType x' = Tag.type_of tagt in + let FuncType (ts, _) = as_func_def_type (def_of (as_sem_var x')) in + let args, vs' = split (Lib.List32.length ts) vs e.at in let vs1', es1' = ctxt (args, [Plain (Throw x) @@ e.at]) in cont := None; vs1' @ vs', es1' | Barrier (bt, es'), vs -> let FuncType (ts1, _) = block_type c.frame.inst bt e.at in - let args, vs' = split (List.length ts1) vs e.at in + let args, vs' = split (Lib.List32.length ts1) vs e.at in vs', [ Handle (None, (args, [Plain (Block (bt, es')) @@ e.at]) @@ -702,7 +719,7 @@ let rec step (c : config) : config = | Local (n, vs0, code'), vs -> let frame' = {c.frame with locals = List.map ref vs0 @ c.frame.locals} in let c' = step {c with frame = frame'; code = code'} in - let vs0' = List.map (!) (take (List.length vs0) c'.frame.locals e.at) in + let vs0' = List.map (!) (take (Lib.List32.length vs0) c'.frame.locals e.at) in vs, [Local (n, vs0', c'.code) @@ e.at] | Frame (n, frame', (vs', [])), vs -> @@ -717,7 +734,7 @@ let rec step (c : config) : config = | Frame (n, frame', (vs', {it = ReturningInvoke (vs0, f); at} :: es')), vs -> let FuncType (ts1, _) = Func.type_of f in - take (List.length ts1) vs0 e.at @ vs, [Invoke f @@ at] + take (Lib.List32.length ts1) vs0 e.at @ vs, [Invoke f @@ at] | Frame (n, fame', (vs', {it = Breaking _; at} :: es')), vs -> Crash.error at "undefined label" @@ -729,12 +746,66 @@ let rec step (c : config) : config = let c' = step {frame = frame'; code = code'; budget = c.budget - 1} in vs, [Frame (n, frame', c'.code) @@ e.at] + | Catch (n, cts, ca, (vs', [])), vs -> + vs' @ vs, [] + + | Catch (n, cts, ca, (vs', ({it = Trapping _ | Breaking _ | Returning _ | Delegating _; at} as e) :: es')), vs -> + vs, [e] + + | Catch (n, cts, ca, (vs', {it = Rethrowing (k, cont); at} :: es')), vs -> + vs, [Rethrowing (k, (fun e -> Catch (n, cts, ca, (vs', (cont e) :: es')) @@ e.at)) @@ at] + + | Catch (n, (a', es'') :: cts, ca, (vs', {it = Throwing (a, vs0); at} :: es')), vs -> + if a == a' then + vs, [Caught (n, a, vs0, (vs0, List.map plain es'')) @@ at] + else + vs, [Catch (n, cts, ca, (vs', {it = Throwing (a, vs0); at} :: es')) @@ e.at] + + | Catch (n, [], Some es'', (vs', {it = Throwing (a, vs0); at} :: es')), vs -> + vs, [Caught (n, a, vs0, (vs0, List.map plain es'')) @@ at] + + | Catch (n, [], None, (vs', {it = Throwing (a, vs0); at} :: es')), vs -> + vs, [Throwing (a, vs0) @@ at] + + | Catch (n, cts, ca, code'), vs -> + let c' = step {c with code = code'} in + vs, [Catch (n, cts, ca, c'.code) @@ e.at] + + | Caught (n, a, vs0, (vs', [])), vs -> + vs' @ vs, [] + + | Caught (n, a, vs0, (vs', ({it = Trapping _ | Breaking _ | Returning _ | Throwing _ | Delegating _; at} as e) :: es')), vs -> + vs, [e] + + | Caught (n, a, vs0, (vs', {it = Rethrowing (0l, cont); at} :: es')), vs -> + vs, [Caught (n, a, vs0, (vs', (cont (Throwing (a, vs0) @@ at)) :: es')) @@ e.at] + + | Caught (n, a, vs0, (vs', {it = Rethrowing (k, cont); at} :: es')), vs -> + vs, [Rethrowing (k, (fun e -> Caught (n, a, vs0, (vs', (cont e) :: es')) @@ e.at)) @@ at] + + | Caught (n, a, vs0, code'), vs -> + let c' = step {c with code = code'} in + vs, [Caught (n, a, vs0, c'.code) @@ e.at] + + | Delegate (l, (vs', [])), vs -> + vs' @ vs, [] + + | Delegate (l, (vs', ({it = Trapping _ | Breaking _ | Returning _ | Rethrowing _ | Delegating _; at} as e) :: es')), vs -> + vs, [e] + + | Delegate (l, (vs', {it = Throwing (a, vs0); at} :: es')), vs -> + vs, [Delegating (l, a, vs0) @@ e.at] + + | Delegate (l, code'), vs -> + let c' = step {c with code = code'} in + vs, [Delegate (l, c'.code) @@ e.at] + | Invoke f, vs when c.budget = 0 -> Exhaustion.error e.at "call stack exhausted" | Invoke f, vs -> let FuncType (ts1, ts2) = Func.type_of f in - let args, vs' = split (List.length ts1) vs e.at in + let args, vs' = split (Lib.List32.length ts1) vs e.at in (match f with | Func.AstFunc (_, inst', func) -> let {locals; body; _} = func.it in @@ -744,7 +815,7 @@ let rec step (c : config) : config = let locals' = List.map (fun t -> t @@ func.at) ts1 @ locals in let bt = VarBlockType (SemVar (alloc (FuncDefType (FuncType ([], ts2))))) in let es0 = [Plain (Let (bt, locals', body)) @@ func.at] in - vs', [Frame (List.length ts2, frame m, (List.rev vs0, es0)) @@ e.at] + vs', [Frame (Lib.List32.length ts2, frame m, (List.rev vs0, es0)) @@ e.at] | Func.HostFunc (_, f) -> (try List.rev (f (List.rev args)) @ vs', [] @@ -754,27 +825,6 @@ let rec step (c : config) : config = args @ args' @ vs', [Invoke f' @@ e.at] ) - | Catch (n, exno, es0, (vs', [])), vs -> - vs' @ vs, [] - - | Catch (n, exno, es0, (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs -> - let ctxt' code = [], [Catch (n, exno, es0, compose (ctxt code) (vs', es')) @@ e.at] in - vs, [Suspending (tagt, vs1, ctxt') @@ at] - - | Catch (n, None, es0, (vs', {it = Throwing (exn, vs0); at} :: _)), vs -> - vs, [Label (n, [], ([], List.map plain es0)) @@ e.at] - - | Catch (n, Some exn, es0, (vs', {it = Throwing (exn0, vs0); at} :: _)), vs - when exn0 == exn -> - vs, [Label (n, [], (vs0, List.map plain es0)) @@ e.at] - - | Catch (n, exno, es0, (vs', e' :: es')), vs when is_jumping e' -> - vs, [e'] - - | Catch (n, exno, es0, code'), vs -> - let c' = step {c with code = code'} in - vs, [Catch (n, exno, es0, c'.code) @@ e.at] - | Handle (hso, (vs', [])), vs -> vs' @ vs, [] @@ -783,9 +833,10 @@ let rec step (c : config) : config = | Handle (Some hs, (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs when List.mem_assq tagt hs -> - let TagType (FuncType (_, ts), _) = Tag.type_of tagt in + let TagType x' = Tag.type_of tagt in + let FuncType (_, ts) = as_func_def_type (def_of (as_sem_var x')) in let ctxt' code = compose (ctxt code) (vs', es') in - [Ref (ContRef (ref (Some (List.length ts, ctxt'))))] @ vs1 @ vs, + [Ref (ContRef (ref (Some (Lib.List32.length ts, ctxt'))))] @ vs1 @ vs, [Plain (Br (List.assq tagt hs)) @@ e.at] | Handle (hso, (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs -> @@ -799,6 +850,11 @@ let rec step (c : config) : config = let c' = step {c with code = code'} in vs, [Handle (hso, c'.code) @@ e.at] + | Rethrowing _, _ -> + Crash.error e.at "undefined catch label" + | Delegating _, _ -> + Crash.error e.at "undefined delegate label" + | Trapping _, _ | Throwing _, _ | Suspending _, _ diff --git a/interpreter/host/spectest.ml b/interpreter/host/spectest.ml index ff7d9de2e..9fe6ba652 100644 --- a/interpreter/host/spectest.ml +++ b/interpreter/host/spectest.ml @@ -25,8 +25,12 @@ let table = let memory = Memory.alloc (MemoryType {min = 1l; max = Some 2l}) let func f ft = Func.alloc_host (Types.alloc (FuncDefType ft)) (f ft) -let tag = Tag.alloc (TagType (FuncType ([NumType I32Type], [NumType I32Type]), Resumable)) -let except = Tag.alloc (TagType (FuncType ([NumType I32Type], []), Terminal)) +let tag = + let p = Types.alloc (FuncDefType (FuncType ([NumType I32Type], [NumType I32Type]))) in + Tag.alloc (TagType (SemVar p)) +let except = + let p = Types.alloc (FuncDefType (FuncType ([NumType I32Type], []))) in + Tag.alloc (TagType (SemVar p)) let print_value v = Printf.printf "%s : %s\n" diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml index 53a5bb81b..e091b9b0a 100644 --- a/interpreter/syntax/ast.ml +++ b/interpreter/syntax/ast.ml @@ -84,8 +84,13 @@ and instr' = | Loop of block_type * instr list (* loop header *) | If of block_type * instr list * instr list (* conditional *) | Let of block_type * local list * instr list (* local bindings *) - | Try of block_type * instr list * idx option * instr list (* handle exception *) + | TryCatch of block_type * instr list * (* try *) + (idx * instr list) list * (* catch exception with tag *) + instr list option (* catch_all *) + | TryDelegate of block_type * instr list * (* try *) + idx (* delegate to outer handler *) | Throw of idx (* throw exception *) + | Rethrow of idx (* rethrow exception *) | Br of idx (* break to n-th surrounding label *) | BrIf of idx (* conditional break *) | BrTable of idx list * idx (* indexed break *) diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml index 990ac3216..329737eb3 100644 --- a/interpreter/syntax/free.ml +++ b/interpreter/syntax/free.ml @@ -63,7 +63,7 @@ let zero = Set.singleton 0l let shift s = Set.map (Int32.add (-1l)) (Set.remove 0l s) let (++) = union -let opt free xo = Lib.Option.get (Option.map free xo) empty +let _opt free xo = Lib.Option.get (Option.map free xo) empty let list free xs = List.fold_left union empty (List.map free xs) let var_type = function @@ -91,7 +91,7 @@ let cont_type (ContType x) = var_type x let global_type (GlobalType (t, _mut)) = value_type t let table_type (TableType (_lim, t)) = ref_type t let memory_type (MemoryType (_lim)) = empty -let tag_type (TagType (ft, _res)) = func_type ft +let tag_type (TagType x) = var_type x let def_type = function | FuncDefType ft -> func_type ft @@ -114,9 +114,15 @@ let rec instr (e : instr) = | Let (bt, ts, es) -> let free = block_type bt ++ block es in {free with locals = Lib.Fun.repeat (List.length ts) shift free.locals} - | Try (bt, es1, xo, es2) -> - block_type bt ++ block es1 ++ opt (fun x -> tags (idx x)) xo ++ block es2 + | TryCatch (bt, es, ct, ca) -> + let catch (tag, es) = tags (idx tag) ++ block es in + let catch_all = function + | None -> empty + | Some es -> block es in + block es ++ (list catch ct) ++ catch_all ca + | TryDelegate (bt, es, x) -> block es ++ tags (idx x) | Throw x | ResumeThrow x | Suspend x -> tags (idx x) + | Rethrow x -> labels (idx x) | Br x | BrIf x | BrOnNull x -> labels (idx x) | BrTable (xs, x) -> list (fun x -> labels (idx x)) (x::xs) | Return | CallRef | ReturnCallRef -> empty diff --git a/interpreter/syntax/operators.ml b/interpreter/syntax/operators.ml index d996c2b77..c49bfea98 100644 --- a/interpreter/syntax/operators.ml +++ b/interpreter/syntax/operators.ml @@ -21,8 +21,10 @@ let loop bt es = Loop (bt, es) let if_ bt es1 es2 = If (bt, es1, es2) let let_ bt ts es = Let (bt, ts, es) -let try_ bt es1 xo es2 = Try (bt, es1, xo, es2) +let try_catch bt es ct ca = TryCatch (bt, es, ct, ca) +let try_delegate bt es x = TryDelegate (bt, es, x) let throw x = Throw x +let rethrow x = Rethrow x let br x = Br x let br_if x = BrIf x diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml index 800d24c6b..657ad9f58 100644 --- a/interpreter/syntax/types.ml +++ b/interpreter/syntax/types.ml @@ -20,11 +20,10 @@ and def_type = FuncDefType of func_type | ContDefType of cont_type type 'a limits = {min : 'a; max : 'a option} type mutability = Immutable | Mutable -type resumability = Terminal | Resumable type table_type = TableType of Int32.t limits * ref_type type memory_type = MemoryType of Int32.t limits type global_type = GlobalType of value_type * mutability -type tag_type = TagType of func_type * resumability (* TODO: use index *) +type tag_type = TagType of var type extern_type = | ExternFuncType of func_type | ExternTableType of table_type @@ -163,8 +162,8 @@ let sem_func_type c (FuncType (ins, out)) = let sem_cont_type c (ContType x) = ContType (sem_var_type c x) -let sem_tag_type c (TagType (ft, res)) = - TagType (sem_func_type c ft, res) +let sem_tag_type c (TagType x) = + TagType (sem_var_type c x) let sem_extern_type c = function | ExternFuncType ft -> ExternFuncType (sem_func_type c ft) @@ -276,9 +275,7 @@ let string_of_global_type = function | GlobalType (t, Immutable) -> string_of_value_type t | GlobalType (t, Mutable) -> "(mut " ^ string_of_value_type t ^ ")" -let string_of_tag_type = function - | TagType (ft, Terminal) -> "exception " ^ string_of_func_type ft - | TagType (ft, Resumable) -> string_of_func_type ft +let string_of_tag_type (TagType x) = string_of_var x let string_of_extern_type = function | ExternFuncType ft -> "func " ^ string_of_func_type ft diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index f641c0949..7e3ed27db 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -74,10 +74,6 @@ let def_type dt = | FuncDefType ft -> func_type ft | ContDefType ct -> cont_type ct -let resumability = function - | Terminal -> " exception" - | Resumable -> "" - let limits nat {min; max} = String.concat " " (nat min :: opt nat max) @@ -254,15 +250,18 @@ let rec instr e = | Let (bt, locals, es) -> "let", block_type bt @ decls "local" (List.map Source.it locals) @ list instr es - | Try (bt, es1, xo, es2) -> - let catch, exn = - match xo with - | Some x -> "catch", [Node ("exception " ^ var x, [])] - | None -> "catch_all", [] - in - "try", block_type bt @ - [Node ("do", list instr es1); Node (catch, exn @ list instr es2)] + | TryCatch (bt, es, ct, ca) -> + let catch (tag, es) = Node ("catch " ^ var tag, list instr es) in + let catch_all = match ca with + | Some es -> [Node ("catch_all", list instr es)] + | None -> [] in + let handler = list catch ct @ catch_all in + "try", block_type bt @ [Node ("do", list instr es)] @ handler + | TryDelegate (bt, es, x) -> + let delegate = [Node ("delegate " ^ var x, [])] in + "try", block_type bt @ [Node ("do", list instr es)] @ delegate | Throw x -> "throw " ^ var x, [] + | Rethrow x -> "rethrow " ^ var x, [] | Br x -> "br " ^ var x, [] | BrIf x -> "br_if " ^ var x, [] | BrTable (xs, x) -> @@ -357,9 +356,9 @@ let memory off i mem = Node ("memory $" ^ nat (off + i) ^ " " ^ limits nat32 lim, []) let tag off i tag = - let {tagtype = TagType (FuncType (ins, out), res)} = tag.it in - Node ("tag $" ^ nat (off + i) ^ resumability res, - decls "param" ins @ decls "result" out + let {tagtype = TagType x} = tag.it in + Node ("tag $" ^ nat (off + i), + [Node ("type", [atom var_type x])] ) let is_elem_kind = function diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index 16b90d24e..eaecfd767 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -211,11 +211,13 @@ rule token = parse | "return_call_indirect" { RETURN_CALL_INDIRECT } | "func.bind" { FUNC_BIND } - | "throw" { THROW } | "try" { TRY } | "do" { DO } | "catch" { CATCH } | "catch_all" { CATCH_ALL } + | "delegate" { DELEGATE } + | "throw" { THROW } + | "rethrow" { RETHROW } | "cont.new" { CONT_NEW } | "cont.bind" { CONT_BIND } @@ -382,7 +384,6 @@ rule token = parse | "table" { TABLE } | "memory" { MEMORY } | "tag" { TAG } - | "exception" { EXCEPTION } | "elem" { ELEM } | "data" { DATA } | "declare" { DECLARE } diff --git a/interpreter/text/parser.conflicts b/interpreter/text/parser.conflicts new file mode 100644 index 000000000..e69de29bb diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index 140e5045c..0e502731f 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -147,6 +147,8 @@ let func_type (c : context) x = | _ -> error x.at ("non-function type " ^ Int32.to_string x.it) | exception Failure _ -> error x.at ("unknown type " ^ Int32.to_string x.it) +let handlers (c : context) h = + List.map (fun (l, i) -> (l c tag, i c)) h let bind_abs category space x = if VarMap.mem x.it space.map then @@ -209,14 +211,15 @@ let inline_func_type_explicit (c : context) x ft at = error at "inline function type does not match explicit type"; x + %} %token LPAR RPAR %token NAT INT FLOAT STRING VAR %token NUM_TYPE FUNCREF EXTERNREF REF EXTERN NULL MUT CONT %token UNREACHABLE NOP DROP SELECT -%token BLOCK END IF THEN ELSE LOOP LET -%token THROW TRY DO CATCH CATCH_ALL +%token BLOCK END IF THEN ELSE LOOP LET TRY DO CATCH CATCH_ALL +%token DELEGATE %token CONT_NEW CONT_BIND SUSPEND RESUME RESUME_THROW BARRIER %token BR BR_IF BR_TABLE BR_ON_NULL %token CALL CALL_REF CALL_INDIRECT @@ -229,7 +232,8 @@ let inline_func_type_explicit (c : context) x ft at = %token LOAD STORE OFFSET_EQ_NAT ALIGN_EQ_NAT %token CONST UNARY BINARY TEST COMPARE CONVERT %token REF_NULL REF_FUNC REF_EXTERN REF_IS_NULL REF_AS_NON_NULL -%token FUNC START TYPE PARAM RESULT LOCAL GLOBAL TAG EXCEPTION +%token THROW RETHROW +%token FUNC START TYPE PARAM RESULT LOCAL GLOBAL TAG %token TABLE ELEM MEMORY DATA DECLARE OFFSET ITEM IMPORT EXPORT %token MODULE BIN QUOTE %token SCRIPT REGISTER INVOKE GET @@ -352,10 +356,10 @@ func_type : FuncType ($4 c :: ins, out) } tag_type : + | type_use + { fun c -> TagType (SynVar ($1 c type_).it) } | func_type - { fun c -> TagType ($1 c, Resumable) } - | EXCEPTION func_type - { fun c -> TagType ($2 c, Terminal) } + { let at = at () in fun c -> TagType (SynVar (inline_func_type c ($1 c) at).it) } table_type : | limits ref_type { fun c -> TableType ($1, $2 c) } @@ -438,6 +442,7 @@ plain_instr : | NOP { fun c -> nop } | DROP { fun c -> drop } | THROW var { fun c -> throw ($2 c tag) } + | RETHROW var { fun c -> rethrow ($2 c label) } | BR var { fun c -> br ($2 c label) } | BR_IF var { fun c -> br_if ($2 c label) } | BR_TABLE var var_list @@ -596,6 +601,44 @@ call_instr_results_instr : | instr { fun c -> [], $1 c } +handler_instr : + | catch_list_instr END + { fun bt es c -> try_catch bt es (handlers c $1) None } + | catch_list_instr catch_all END + { fun bt es c -> try_catch bt es (handlers c $1) (Some ($2 c)) } + | catch_all END + { fun bt es c -> try_catch bt es [] (Some ($1 c)) } + | END { fun bt es c -> try_catch bt es [] None } + + +catch_list_instr : + | catch catch_list_instr { $1 :: $2 } + | catch { [$1] } + +handler : + | catch_list + { fun bt es _ c' -> + let cs = (List.map (fun (l, i) -> (l c' tag, i c')) $1) in + try_catch bt es cs None } + | catch_list LPAR catch_all RPAR + { fun bt es _ c' -> + let cs = (List.map (fun (l, i) -> (l c' tag, i c')) $1) in + try_catch bt es cs (Some ($3 c')) } + | LPAR catch_all RPAR + { fun bt es _ c' -> try_catch bt es [] (Some ($2 c')) } + | LPAR DELEGATE var RPAR + { fun bt es c _ -> try_delegate bt es ($3 c label) } + | /* empty */ { fun bt es c _ -> try_catch bt es [] None } + +catch_list : + | catch_list LPAR catch RPAR { $1 @ [$3] } + | LPAR catch RPAR { [$2] } + +catch : + | CATCH var instr_list { ($2, $3) } + +catch_all : + | CATCH_ALL instr_list { $2 } resume_instr : | RESUME resume_instr_handler @@ -634,12 +677,12 @@ block_instr : { let at = at () in fun c -> let c' = enter_let ($2 c $5) at in let ts, ls, es = $3 c c' in let_ ts ls es } - | TRY labeling_opt block CATCH_ALL labeling_end_opt instr_list END labeling_end_opt - { fun c -> let c' = $2 c ($5 @ $8) in - let ts, es1 = $3 c' in try_ ts es1 None ($6 c') } - | TRY labeling_opt block CATCH labeling_end_opt LPAR EXCEPTION var RPAR instr_list END labeling_end_opt - { fun c -> let c' = $2 c ($5 @ $12) in - let ts, es1 = $3 c' in try_ ts es1 (Some ($8 c' tag)) ($10 c') } + | TRY labeling_opt block handler_instr + { fun c -> let c' = $2 c [] in + let ts, es = $3 c' in $4 ts es c' } + | TRY labeling_opt block DELEGATE var + { fun c -> let c' = $2 c [] in + let ts, es = $3 c' in try_delegate ts es ($5 c label) } | BARRIER labeling_opt block END labeling_end_opt { fun c -> let c' = $2 c $5 in let bt, es = $3 c' in barrier bt es } @@ -759,10 +802,8 @@ expr1 : /* Sugar */ { let at = at () in fun c -> let c' = enter_let ($2 c []) at in let bt, ls, es = $3 c c' in [], let_ bt ls es } - | TRY try_block - { fun c -> - let bt, (es1, xo, es2) = $2 c in - [], try_ bt es1 xo es2 } + | TRY labeling_opt try_block + { fun c -> let c' = $2 c [] in [], $3 c c' } | BARRIER labeling_opt block { fun c -> let c' = $2 c [] in let bt, es = $3 c' in [], barrier bt es } @@ -802,45 +843,6 @@ resume_expr_handler : | expr_list { fun c -> [], $1 c } - - -try_block : - | type_use try_block_param_body - { let at = at () in - fun c -> - let t = $1 c type_ in - let ft, es = $2 c in - let x = SynVar (inline_func_type_explicit c t ft at).it in - VarBlockType x, es } - | try_block_param_body /* Sugar */ - { let at = at () in - fun c -> - let bt = - match fst ($1 c) with - | FuncType ([], []) -> ValBlockType None - | FuncType ([], [t]) -> ValBlockType (Some t) - | ft -> VarBlockType (SynVar (inline_func_type c ft at).it) - in bt, snd ($1 c) } -try_block_param_body : - | try_block_result_body { $1 } - | LPAR PARAM value_type_list RPAR try_block_param_body - { fun c -> - let FuncType (ins, out), es = $5 c in - let ins' = snd $3 c in - FuncType (ins' @ ins, out), es } -try_block_result_body : - | try_ { fun c -> FuncType ([], []), $1 c } - | LPAR RESULT value_type_list RPAR try_block_result_body - { fun c -> - let FuncType (ins, out), es = $5 c in - let out' = snd $3 c in - FuncType (ins, out' @ out), es } -try_ : - | LPAR DO instr_list RPAR LPAR CATCH LPAR EXCEPTION var RPAR instr_list RPAR - { fun c -> $3 c, Some ($9 c tag), $11 c } - | LPAR DO instr_list RPAR LPAR CATCH_ALL instr_list RPAR - { fun c -> $3 c, None, $7 c } - if_block : | type_use if_block_param_body { let at = at () in @@ -880,6 +882,44 @@ if_ : | LPAR THEN instr_list RPAR /* Sugar */ { fun c c' -> [], $3 c', [] } +try_block : + | type_use try_block_param_body + { let at = at () in + fun c c' -> + let body = $2 c in + let bt = VarBlockType (SynVar (inline_func_type_explicit c' ($1 c' type_) (fst body) at).it) in + snd body bt c c' } + | try_block_param_body /* Sugar */ + { let at = at () in + fun c c' -> + let body = $1 c in + let bt = + match fst body with + | FuncType ([], []) -> ValBlockType None + | FuncType ([], [t]) -> ValBlockType (Some t) + | ft -> VarBlockType (SynVar (inline_func_type c' ft at).it) + in snd body bt c c' } + +try_block_param_body : + | try_block_result_body { $1 } + | LPAR PARAM value_type_list RPAR try_block_param_body + { fun c -> + let FuncType (ins, out) = fst ($5 c) in + FuncType ((snd $3) c @ ins, out), snd ($5 c) } + +try_block_result_body : + | try_ { fun _c -> FuncType ([], []), $1 } + | LPAR RESULT value_type_list RPAR try_block_result_body + { fun c -> + let FuncType (ins, out) = fst ($5 c) in + let vs = (snd $3) c in + FuncType (ins, vs @ out), snd ($5 c) } + +try_ : + | LPAR DO instr_list RPAR handler + { fun bt c c' -> $5 bt ($3 c') c c' } + + instr_list : | /* empty */ { fun c -> [] } | select_instr { fun c -> [$1 c] } @@ -1141,10 +1181,6 @@ tag : { let at = at () in fun c -> let x = $3 c anon_tag bind_tag @@ at in fun () -> $4 c x at } - | LPAR EXCEPTION bind_var_opt exception_fields RPAR /* Sugar */ - { let at = at () in - fun c -> let x = $3 c anon_tag bind_tag @@ at in - fun () -> $4 c x at } tag_fields : | tag_type @@ -1158,19 +1194,6 @@ tag_fields : { fun c x at -> let evts, ims, exs = $2 c x at in evts, ims, $1 (TagExport x) c :: exs } -exception_fields : /* Sugar */ - | func_type - { fun c x at -> [{tagtype = TagType ($1 c, Terminal)} @@ at], [], [] } - | inline_import func_type - { fun c x at -> - [], - [{ module_name = fst $1; item_name = snd $1; - idesc = TagImport (TagType ($2 c, Terminal)) @@ at } @@ at], [] } - | inline_export exception_fields - { fun c x at -> let evts, ims, exs = $2 c x at in - evts, ims, $1 (TagExport x) c :: exs } - - /* Imports & Exports */ import_desc : @@ -1193,9 +1216,6 @@ import_desc : | LPAR TAG bind_var_opt tag_type RPAR { fun c -> ignore ($3 c anon_tag bind_tag); fun () -> TagImport ($4 c) } - | LPAR EXCEPTION bind_var_opt func_type RPAR /* Sugar */ - { fun c -> ignore ($3 c anon_tag bind_tag); - fun () -> TagImport (TagType ($4 c, Terminal)) } import : | LPAR IMPORT name name import_desc RPAR @@ -1212,7 +1232,6 @@ export_desc : | LPAR MEMORY var RPAR { fun c -> MemoryExport ($3 c memory) } | LPAR GLOBAL var RPAR { fun c -> GlobalExport ($3 c global) } | LPAR TAG var RPAR { fun c -> TagExport ($3 c tag) } - | LPAR EXCEPTION var RPAR { fun c -> TagExport ($3 c tag) } /* Sugar */ export : | LPAR EXPORT name export_desc RPAR diff --git a/interpreter/valid/match.ml b/interpreter/valid/match.ml index 17f6a7b21..0166d8638 100644 --- a/interpreter/valid/match.ml +++ b/interpreter/valid/match.ml @@ -26,9 +26,6 @@ let eq_nullability c a nul1 nul2 = let eq_mutability c a mut1 mut2 = mut1 = mut2 -let eq_resumability c a res1 res2 = - res1 = res2 - let eq_limits c a lim1 lim2 = lim1.min = lim2.min && lim1.max = lim2.max @@ -81,8 +78,8 @@ and eq_memory_type c a (MemoryType lim1) (MemoryType lim2) = and eq_global_type c a (GlobalType (t1, mut1)) (GlobalType (t2, mut2)) = eq_mutability c a mut1 mut2 && eq_value_type c a t1 t2 -and eq_tag_type c a (TagType (ft1, res1)) (TagType (ft2, res2)) = - eq_resumability c a res1 res2 && eq_func_type c [] ft1 ft2 +and eq_tag_type c a (TagType x1) (TagType x2) = + eq_var_type c a x1 x2 and eq_extern_type c a et1 et2 = match et1, et2 with @@ -156,8 +153,8 @@ and match_global_type c a (GlobalType (t1, mut1)) (GlobalType (t2, mut2)) = | Immutable -> match_value_type c a t1 t2 | Mutable -> eq_value_type c [] t1 t2 -and match_tag_type c a (TagType (ft1, res1)) (TagType (ft2, res2)) = - eq_resumability c [] res1 res2 && match_func_type c a ft1 ft2 +and match_tag_type c a (TagType x1) (TagType x2) = + match_var_type c a x1 x2 and match_extern_type c a et1 et2 = match et1, et2 with diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 473241c03..a51eb2b73 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -15,6 +15,8 @@ let require b at s = if not b then error at s (* Context *) +type label_kind = BlockLabel | CatchLabel + type context = { types : def_type list; @@ -27,7 +29,7 @@ type context = datas : unit list; locals : value_type list; results : value_type list; - labels : result_type list; + labels : (label_kind * result_type) list; refs : Free.t; } @@ -128,10 +130,8 @@ let check_memory_type (c : context) (mt : memory_type) at = "memory size must be at most 65536 pages (4GiB)" let check_tag_type (c : context) (et : tag_type) at = - let TagType (ft, res) = et in - let FuncType (_, ts2) = ft in - check_func_type c ft at; - require (res = Resumable || ts2 = []) at "exception type must not have results" + let TagType x = et in + ignore (func_type c (as_syn_var x @@ at)) let check_global_type (c : context) (gt : global_type) at = let GlobalType (t, mut) = gt in @@ -330,18 +330,18 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : op_type | Block (bt, es) -> let FuncType (ts1, ts2) as ft = check_block_type c bt e.at in - check_block {c with labels = ts2 :: c.labels} es ft e.at; + check_block {c with labels = (BlockLabel, ts2) :: c.labels} es ft e.at; ts1 --> ts2 | Loop (bt, es) -> let FuncType (ts1, ts2) as ft = check_block_type c bt e.at in - check_block {c with labels = ts1 :: c.labels} es ft e.at; + check_block {c with labels = (BlockLabel, ts1) :: c.labels} es ft e.at; ts1 --> ts2 | If (bt, es1, es2) -> let FuncType (ts1, ts2) as ft = check_block_type c bt e.at in - check_block {c with labels = ts2 :: c.labels} es1 ft e.at; - check_block {c with labels = ts2 :: c.labels} es2 ft e.at; + check_block {c with labels = (BlockLabel, ts2) :: c.labels} es1 ft e.at; + check_block {c with labels = (BlockLabel, ts2) :: c.labels} es2 ft e.at; (ts1 @ [NumType I32Type]) --> ts2 | Let (bt, locals, es) -> @@ -349,49 +349,58 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : op_type List.iter (check_local c false) locals; let c' = { c with - labels = ts2 :: c.labels; + labels = (BlockLabel, ts2) :: c.labels; locals = List.map Source.it locals @ c.locals; } in check_block c' es ft e.at; (ts1 @ List.map Source.it locals) --> ts2 - | Try (bt, es1, xo, es2) -> - let FuncType (ts1, ts2) as ft1 = check_block_type c bt e.at in - check_block {c with labels = ts2 :: c.labels} es1 ft1 e.at; - let ts1' = - match xo with - | None -> [] - | Some x -> - let TagType (FuncType (ts1', _), res) = tag c x in - require (res = Terminal) e.at "catching a non-exception tag"; - ts1' - in - let ft2 = FuncType (ts1', ts2) in - check_block {c with labels = ts2 :: c.labels} es2 ft2 e.at; + | Throw x -> + let TagType y = tag c x in + let FuncType (ts1, _) = func_type c (as_syn_var y @@ e.at) in + ts1 -->... [] + + | Rethrow x -> + let (kind, _) = label c x in + require (kind = CatchLabel) e.at "invalid rethrow label"; + [] -->... [] + + | TryCatch (bt, es, cts, ca) -> + let FuncType (ts1, ts2) as ft = check_block_type c bt e.at in + let c_try = {c with labels = (BlockLabel, ts2) :: c.labels} in + let c_catch = {c with labels = (CatchLabel, ts2) :: c.labels} in + check_block c_try es ft e.at; + List.iter (fun ct -> check_catch ct c_catch ft e.at) cts; + Lib.Option.app (fun es -> check_block c_catch es ft e.at) ca; ts1 --> ts2 - | Throw x -> - let TagType (FuncType (ts1, ts2), res) = tag c x in - require (res = Terminal) e.at "throwing a non-exception tag"; - ts1 -->... ts2 + | TryDelegate (bt, es, x) -> + let FuncType (ts1, ts2) as ft = check_block_type c bt e.at in + ignore (label c x); + check_block {c with labels = (BlockLabel, ts2) :: c.labels} es ft e.at; + ts1 --> ts2 | Br x -> - label c x -->... [] + let (_, ts) = label c x in + ts -->... [] | BrIf x -> - (label c x @ [NumType I32Type]) --> label c x + let (_, ts) = label c x in + (ts @ [NumType I32Type]) --> ts | BrTable (xs, x) -> - let n = List.length (label c x) in - let ts = Lib.List.table n (fun i -> peek (n - i) s) in - check_stack c ts (label c x) x.at; - List.iter (fun x' -> check_stack c ts (label c x') x'.at) xs; + let (_, ts) = label c x in + let n = List.length ts in + let ts' = Lib.List.table n (fun i -> peek (n - i) s) in + check_stack c ts' ts x.at; + List.iter (fun x' -> check_stack c ts' (snd (label c x')) x'.at) xs; (ts @ [NumType I32Type]) -->... [] | BrOnNull x -> let (_, t) = peek_ref 0 s e.at in - (label c x @ [RefType (Nullable, t)]) --> - (label c x @ [RefType (NonNullable, t)]) + let (_, ts) = label c x in + (ts @ [RefType (Nullable, t)]) --> + (ts @ [RefType (NonNullable, t)]) | Return -> c.results -->... [] @@ -503,8 +512,8 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : op_type ) | Suspend x -> - let TagType (FuncType (ts1, ts2), res) = tag c x in - require (res = Resumable) e.at "suspending with a non-resumable tag"; + let TagType x' = tag c x in + let FuncType (ts1, ts2) = func_type c (as_syn_var x' @@ x.at) in ts1 --> ts2 | Resume xys -> @@ -513,19 +522,20 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : op_type let ContType z = cont_type c (y @@ e.at) in let FuncType (ts1, ts2) = func_type c (as_syn_var z @@ e.at) in List.iter (fun (x1, x2) -> - let TagType (FuncType (ts3, ts4), res) = tag c x1 in - require (res = Resumable) x1.at "handling a non-resumable tag"; - match Lib.List.last_opt (label c x2) with + let TagType x1' = tag c x1 in + let FuncType (ts3, ts4) = func_type c (as_syn_var x1' @@ x1.at) in + let (_, ts') = label c x2 in + match Lib.List.last_opt ts' with | Some (RefType (nul', DefHeapType (SynVar y'))) -> let ContType z' = cont_type c (y' @@ x2.at) in let ft' = func_type c (as_syn_var z' @@ x2.at) in require (match_func_type c.types [] (FuncType (ts4, ts2)) ft') x2.at "type mismatch in continuation type"; - check_stack c (ts3 @ [RefType (nul', DefHeapType (SynVar y'))]) (label c x2) x2.at + check_stack c (ts3 @ [RefType (nul', DefHeapType (SynVar y'))]) ts' x2.at | _ -> error e.at ("type mismatch: instruction requires continuation reference type" ^ - " but label has " ^ string_of_result_type (label c x2)) + " but label has " ^ string_of_result_type ts') ) xys; (ts1 @ [RefType (nul, DefHeapType (SynVar y))]) --> ts2 | _, BotHeapType -> @@ -537,8 +547,8 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : op_type ) | ResumeThrow x -> - let TagType (FuncType (ts0, _), res) = tag c x in - require (res = Terminal) e.at "throwing a non-exception tag"; + let TagType x' = tag c x in + let FuncType (ts0, _) = func_type c (as_syn_var x' @@ x.at) in (match peek_ref 0 s e.at with | nul, DefHeapType (SynVar y) -> let ContType z = cont_type c (y @@ e.at) in @@ -554,7 +564,7 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : op_type | Barrier (bt, es) -> let FuncType (ts1, ts2) as ft = check_block_type c bt e.at in - check_block {c with labels = ts2 :: c.labels} es ft e.at; + check_block {c with labels = (BlockLabel, ts2) :: c.labels} es ft e.at; ts1 --> ts2 | LocalGet x -> @@ -710,6 +720,12 @@ and check_block (c : context) (es : instr list) (ft : func_type) at = ("type mismatch: block requires " ^ string_of_result_type ts2 ^ " but stack has " ^ string_of_result_type (snd s)) +and check_catch (ct : idx * instr list) (c : context) (ft : func_type) at = + let (x, es) = ct in + let TagType y = tag c x in + let FuncType (ts1, _) = func_type c (as_syn_var y @@ at) in + let FuncType (_, ts2) = ft in + check_block c es (FuncType (ts1, ts2)) at (* Functions & Constants *) @@ -733,7 +749,7 @@ let check_func (c : context) (f : func) = { c with locals = ts1 @ List.map Source.it locals; results = ts2; - labels = [ts2] + labels = [(BlockLabel, ts2)] } in check_block c' body (FuncType ([], ts2)) f.at diff --git a/test/core/catch.wast b/test/core/catch.wast deleted file mode 100644 index 34815415a..000000000 --- a/test/core/catch.wast +++ /dev/null @@ -1,86 +0,0 @@ -;; Test the minimal "exception handling" extension - -(module - (exception $e0) - (exception $e1 (param i32)) - - (func (export "catch-1") (result i32) - (try (result i32) - (do (i32.const -1) (throw $e0) (i32.const 0)) - (catch_all (i32.const 1)) - ) - ) - - (func (export "catch-2") (result i32) - (try (result i32) - (do - (try (result i32) - (do - (throw $e0) - (i32.const 0) - ) - (catch_all - (throw $e0) - (i32.const 1) - ) - ) - ) - (catch_all - (i32.const 2) - ) - ) - ) - - (func (export "catch-3") (result i32) - (try (result i32) - (do (throw $e1 (i32.const 66)) (i32.const 0)) - (catch_all (i32.const 1)) - ) - ) - - (func (export "catch-4") (result i32) - (try (result i32) - (do (throw $e1 (i32.const 66)) (i32.const 0)) - (catch (exception $e1)) - ) - ) - - (func (export "success-0") (result i32) - (try (result i32) - (do (i32.const 0)) - (catch_all (i32.const 1)) - ) - ) - - (func (export "success-1") (result i32) - (try (result i32) - (do - (try (result i32) - (do (throw $e0) (i32.const 0)) - (catch_all (i32.const 1)) - ) - ) - (catch_all (i32.const 2)) - ) - ) - - (func (export "uncaught-1") - (throw $e0) - ) - - (func (export "uncaught-2") (result i32) - (try (result i32) - (do (throw $e0) (i32.const 0)) - (catch (exception $e1)) - ) - ) -) - -(assert_return (invoke "catch-1") (i32.const 1)) -(assert_return (invoke "catch-2") (i32.const 2)) -(assert_return (invoke "catch-3") (i32.const 1)) -(assert_return (invoke "catch-4") (i32.const 66)) -(assert_return (invoke "success-0") (i32.const 0)) -(assert_return (invoke "success-1") (i32.const 1)) -(assert_exception (invoke "uncaught-1") "unhandled") -(assert_exception (invoke "uncaught-2") "unhandled") diff --git a/test/core/cont.wast b/test/core/cont.wast index 22c30dc59..981565621 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -1,7 +1,7 @@ ;; Unhandled tags & guards (module - (exception $exn) + (tag $exn) (tag $e1) (tag $e2) diff --git a/test/core/try_catch.wast b/test/core/try_catch.wast new file mode 100644 index 000000000..8ab9096bc --- /dev/null +++ b/test/core/try_catch.wast @@ -0,0 +1,242 @@ +;; Test try-catch blocks. + +(module + (tag $e0 (export "e0")) + (func (export "throw") (throw $e0)) +) + +(register "test") + +(module + (tag $imported-e0 (import "test" "e0")) + (func $imported-throw (import "test" "throw")) + (tag $e0) + (tag $e1) + (tag $e2) + (tag $e-i32 (param i32)) + (tag $e-f32 (param f32)) + (tag $e-i64 (param i64)) + (tag $e-f64 (param f64)) + + (func $throw-if (param i32) (result i32) + (local.get 0) + (i32.const 0) (if (i32.ne) (then (throw $e0))) + (i32.const 0) + ) + + (func (export "empty-catch") (try (do) (catch $e0))) + + (func (export "simple-throw-catch") (param i32) (result i32) + (try (result i32) + (do (local.get 0) (i32.eqz) (if (then (throw $e0)) (else)) (i32.const 42)) + (catch $e0 (i32.const 23)) + ) + ) + + (func (export "unreachable-not-caught") (try (do (unreachable)) (catch_all))) + + (func $div (param i32 i32) (result i32) + (local.get 0) (local.get 1) (i32.div_u) + ) + (func (export "trap-in-callee") (param i32 i32) (result i32) + (try (result i32) + (do (local.get 0) (local.get 1) (call $div)) + (catch_all (i32.const 11)) + ) + ) + + (func (export "catch-complex-1") (param i32) (result i32) + (try (result i32) + (do + (try (result i32) + (do + (local.get 0) + (i32.eqz) + (if + (then (throw $e0)) + (else + (local.get 0) + (i32.const 1) + (i32.eq) + (if (then (throw $e1)) (else (throw $e2))) + ) + ) + (i32.const 2) + ) + (catch $e0 (i32.const 3)) + ) + ) + (catch $e1 (i32.const 4)) + ) + ) + + (func (export "catch-complex-2") (param i32) (result i32) + (try (result i32) + (do + (local.get 0) + (i32.eqz) + (if + (then (throw $e0)) + (else + (local.get 0) + (i32.const 1) + (i32.eq) + (if (then (throw $e1)) (else (throw $e2))) + ) + ) + (i32.const 2) + ) + (catch $e0 (i32.const 3)) + (catch $e1 (i32.const 4)) + ) + ) + + (func (export "throw-catch-param-i32") (param i32) (result i32) + (try (result i32) + (do (local.get 0) (throw $e-i32) (i32.const 2)) + (catch $e-i32 (return)) + ) + ) + + (func (export "throw-catch-param-f32") (param f32) (result f32) + (try (result f32) + (do (local.get 0) (throw $e-f32) (f32.const 0)) + (catch $e-f32 (return)) + ) + ) + + (func (export "throw-catch-param-i64") (param i64) (result i64) + (try (result i64) + (do (local.get 0) (throw $e-i64) (i64.const 2)) + (catch $e-i64 (return)) + ) + ) + + (func (export "throw-catch-param-f64") (param f64) (result f64) + (try (result f64) + (do (local.get 0) (throw $e-f64) (f64.const 0)) + (catch $e-f64 (return)) + ) + ) + + (func $throw-param-i32 (param i32) (local.get 0) (throw $e-i32)) + (func (export "catch-param-i32") (param i32) (result i32) + (try (result i32) + (do (i32.const 0) (local.get 0) (call $throw-param-i32)) + (catch $e-i32) + ) + ) + + (func (export "catch-imported") (result i32) + (try (result i32) + (do + (i32.const 1) + (call $imported-throw) + ) + (catch $imported-e0 (i32.const 2)) + ) + ) + + (func (export "catchless-try") (param i32) (result i32) + (try (result i32) + (do + (try (result i32) + (do (local.get 0) (call $throw-if)) + ) + ) + (catch $e0 (i32.const 1)) + ) + ) +) + +(assert_return (invoke "empty-catch")) + +(assert_return (invoke "simple-throw-catch" (i32.const 0)) (i32.const 23)) +(assert_return (invoke "simple-throw-catch" (i32.const 1)) (i32.const 42)) + +(assert_trap (invoke "unreachable-not-caught") "unreachable") + +(assert_return (invoke "trap-in-callee" (i32.const 7) (i32.const 2)) (i32.const 3)) +(assert_trap (invoke "trap-in-callee" (i32.const 1) (i32.const 0)) "integer divide by zero") + +(assert_return (invoke "catch-complex-1" (i32.const 0)) (i32.const 3)) +(assert_return (invoke "catch-complex-1" (i32.const 1)) (i32.const 4)) +(assert_exception (invoke "catch-complex-1" (i32.const 2)) "unhandled exception") + +(assert_return (invoke "catch-complex-2" (i32.const 0)) (i32.const 3)) +(assert_return (invoke "catch-complex-2" (i32.const 1)) (i32.const 4)) +(assert_exception (invoke "catch-complex-2" (i32.const 2)) "unhandled exception") + +(assert_return (invoke "throw-catch-param-i32" (i32.const 0)) (i32.const 0)) +(assert_return (invoke "throw-catch-param-i32" (i32.const 1)) (i32.const 1)) +(assert_return (invoke "throw-catch-param-i32" (i32.const 10)) (i32.const 10)) + +(assert_return (invoke "throw-catch-param-f32" (f32.const 5.0)) (f32.const 5.0)) +(assert_return (invoke "throw-catch-param-f32" (f32.const 10.5)) (f32.const 10.5)) + +(assert_return (invoke "throw-catch-param-i64" (i64.const 5)) (i64.const 5)) +(assert_return (invoke "throw-catch-param-i64" (i64.const 0)) (i64.const 0)) +(assert_return (invoke "throw-catch-param-i64" (i64.const -1)) (i64.const -1)) + +(assert_return (invoke "throw-catch-param-f64" (f64.const 5.0)) (f64.const 5.0)) +(assert_return (invoke "throw-catch-param-f64" (f64.const 10.5)) (f64.const 10.5)) + +(assert_return (invoke "catch-param-i32" (i32.const 5)) (i32.const 5)) + +(assert_return (invoke "catch-imported") (i32.const 2)) + +(assert_return (invoke "catchless-try" (i32.const 0)) (i32.const 0)) +(assert_return (invoke "catchless-try" (i32.const 1)) (i32.const 1)) + +(module + (func $imported-throw (import "test" "throw")) + (tag $e0) + + (func (export "imported-mismatch") (result i32) + (try (result i32) + (do + (try (result i32) + (do + (i32.const 1) + (call $imported-throw) + ) + (catch $e0 (i32.const 2)) + ) + ) + (catch_all (i32.const 3)) + ) + ) +) + +(assert_return (invoke "imported-mismatch") (i32.const 3)) + +(assert_malformed + (module quote "(module (func (catch_all)))") + "unexpected token" +) + +(assert_malformed + (module quote "(module (tag $e) (func (catch $e)))") + "unexpected token" +) + +(assert_malformed + (module quote + "(module (func (try (do) (catch_all) (catch_all))))" + ) + "unexpected token" +) + +(assert_invalid (module (func (result i32) (try (result i32) (do)))) + "type mismatch: instruction requires [i32] but stack has []") +(assert_invalid (module (func (result i32) (try (result i32) (do (i64.const 42))))) + "type mismatch: instruction requires [i32] but stack has [i64]") +(assert_invalid (module (tag) (func (try (do) (catch 0 (i32.const 42))))) + "type mismatch: block requires [] but stack has [i32]") +(assert_invalid (module + (tag (param i64)) + (func (result i32) + (try (result i32) (do (i32.const 42)) (catch 0)))) + "type mismatch: instruction requires [i32] but stack has [i64]") +(assert_invalid (module (func (try (do) (catch_all (i32.const 42))))) + "type mismatch: block requires [] but stack has [i32]") \ No newline at end of file From f317d0b850792a9f3733d934fbd7a339c4c77ce1 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Fri, 3 Mar 2023 20:49:57 +0100 Subject: [PATCH 52/82] Refactor `cont.wast` to not use `let` & `func.bind` (#24) This commit refactors the file `cont.wast` such that it no longer uses `let` and `func.bind`. We change the type of `spawn` such that it is parameterised by a continuation type rather than a function type, and then we replace every use of `func.bind` by a corresponding `cont.bind`. --- test/core/cont.wast | 62 +++++++++++++++++++++++++-------------------- 1 file changed, 34 insertions(+), 28 deletions(-) diff --git a/test/core/cont.wast b/test/core/cont.wast index 981565621..6830c9e31 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -86,18 +86,18 @@ (unreachable) ) (func $nl3 (param $k (ref $k1)) + (local $k' (ref null $k1)) (block $h1 (result (ref $k1)) (resume (tag $e1 $h1) (local.get $k)) (unreachable) ) - (let (local $k' (ref $k1)) - (block $h2 (result (ref $k1)) - (resume (tag $e1 $h2) (local.get $k')) - (unreachable) - ) - (resume (local.get $k')) + (local.set $k') + (block $h2 (result (ref $k1)) + (resume (tag $e1 $h2) (local.get $k')) (unreachable) ) + (resume (local.get $k')) + (unreachable) ) (func $nl4 (param $k (ref $k1)) (drop (cont.bind (type $k1) (local.get $k))) @@ -214,6 +214,8 @@ (func (export "sum") (param $i i64) (param $j i64) (result i64) (local $sum i64) + (local $n i64) + (local $k (ref null $cont)) (local.get $i) (cont.new (type $cont0) (ref.func $gen)) (block $on_first_yield (param i64 (ref $cont0)) (result i64 (ref $cont)) @@ -221,11 +223,11 @@ (unreachable) ) (loop $on_yield (param i64) (param (ref $cont)) - (let (result i32 (ref $cont)) - (local $n i64) (local $k (ref $cont)) - (local.set $sum (i64.add (local.get $sum) (local.get $n))) - (i64.eq (local.get $n) (local.get $j)) (local.get $k) - ) + (local.set $k) + (local.set $n) + (local.set $sum (i64.add (local.get $sum) (local.get $n))) + (i64.eq (local.get $n) (local.get $j)) + (local.get $k) (resume (tag $yield $on_yield)) ) (return (local.get $sum)) @@ -248,7 +250,7 @@ (type $cont (cont $proc)) (tag $yield (export "yield")) - (tag $spawn (export "spawn") (param (ref $proc))) + (tag $spawn (export "spawn") (param (ref $cont))) ;; Table as simple queue (keeping it simple, no ring buffer) (table $queue 0 (ref null $cont)) @@ -302,12 +304,12 @@ (global.set $qback (i32.add (global.get $qback) (i32.const 1))) ) - (func $scheduler (export "scheduler") (param $main (ref $proc)) - (call $enqueue (cont.new (type $cont) (local.get $main))) + (func $scheduler (export "scheduler") (param $main (ref $cont)) + (call $enqueue (local.get $main)) (loop $l (if (call $queue-empty) (then (return))) (block $on_yield (result (ref $cont)) - (block $on_spawn (result (ref $proc) (ref $cont)) + (block $on_spawn (result (ref $cont) (ref $cont)) (resume (tag $yield $on_yield) (tag $spawn $on_spawn) (call $dequeue) ) @@ -315,7 +317,6 @@ ) ;; on $spawn, proc and cont on stack (call $enqueue) ;; continuation of old thread - (cont.new (type $cont)) (call $enqueue) ;; new thread (br $l) ) @@ -330,10 +331,12 @@ (module (type $proc (func)) + (type $pproc (func (param i32))) ;; parameterised proc (type $cont (cont $proc)) + (type $pcont (cont $pproc)) ;; parameterised continuation proc (tag $yield (import "scheduler" "yield")) - (tag $spawn (import "scheduler" "spawn") (param (ref $proc))) - (func $scheduler (import "scheduler" "scheduler") (param $main (ref $proc))) + (tag $spawn (import "scheduler" "spawn") (param (ref $cont))) + (func $scheduler (import "scheduler" "scheduler") (param $main (ref $cont))) (func $log (import "spectest" "print_i32") (param i32)) @@ -344,11 +347,11 @@ (func $main (call $log (i32.const 0)) - (suspend $spawn (ref.func $thread1)) + (suspend $spawn (cont.new (type $cont) (ref.func $thread1))) (call $log (i32.const 1)) - (suspend $spawn (func.bind (type $proc) (global.get $depth) (ref.func $thread2))) + (suspend $spawn (cont.bind (type $cont) (global.get $depth) (cont.new (type $pcont) (ref.func $thread2)))) (call $log (i32.const 2)) - (suspend $spawn (ref.func $thread3)) + (suspend $spawn (cont.new (type $cont) (ref.func $thread3))) (call $log (i32.const 3)) ) @@ -375,9 +378,9 @@ (suspend $yield) (call $log (i32.const 23)) (suspend $spawn - (func.bind (type $proc) + (cont.bind (type $cont) (i32.sub (local.get $d) (i32.const 1)) - (ref.func $thread2) + (cont.new (type $pcont) (ref.func $thread2)) ) ) (call $log (i32.const 24)) @@ -401,7 +404,7 @@ (global.set $depth (local.get $depth)) (global.set $width (local.get $width)) (call $log (i32.const -1)) - (call $scheduler (ref.func $main)) + (call $scheduler (cont.new (type $cont) (ref.func $main))) (call $log (i32.const -2)) ) ) @@ -419,8 +422,8 @@ (func $log (import "spectest" "print_i64") (param i64)) (tag $syield (import "scheduler" "yield")) - (tag $spawn (import "scheduler" "spawn") (param (ref $proc))) - (func $scheduler (import "scheduler" "scheduler") (param $main (ref $proc))) + (tag $spawn (import "scheduler" "spawn") (param (ref $cont))) + (func $scheduler (import "scheduler" "scheduler") (param $main (ref $cont))) (type $ghook (func (param i64))) (func $gsum (import "generator" "sum") (param i64 i64) (result i64)) @@ -447,17 +450,20 @@ ) (func $main (param $i i64) (param $j i64) - (suspend $spawn (ref.func $bg-thread)) + (suspend $spawn (cont.new (type $cont) (ref.func $bg-thread))) (global.set $ghook (ref.func $syield)) (global.set $result (call $gsum (local.get $i) (local.get $j))) (global.set $done (i32.const 1)) ) (type $proc (func)) + (type $pproc (func (param i64 i64))) + (type $cont (cont $proc)) + (type $pcont (cont $pproc)) (func (export "sum") (param $i i64) (param $j i64) (result i64) (call $log (i64.const -1)) (call $scheduler - (func.bind (type $proc) (local.get $i) (local.get $j) (ref.func $main)) + (cont.bind (type $cont) (local.get $i) (local.get $j) (cont.new (type $pcont) (ref.func $main))) ) (call $log (i64.const -2)) (global.get $result) From f4a1f12c0704a6e9af2e67ded9ab34efc9a8faeb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Mon, 13 Mar 2023 12:01:25 +0100 Subject: [PATCH 53/82] Fix compilation errors after merge. This commit fixes the errors introduced by the merge of function-references/main into this tree. --- interpreter/binary/decode.ml | 25 ++---- interpreter/binary/encode.ml | 8 +- interpreter/exec/eval.ml | 49 ++++++----- interpreter/host/spectest.ml | 8 +- interpreter/runtime/instance.ml | 2 +- interpreter/script/js.ml | 1 + interpreter/syntax/free.ml | 4 +- interpreter/syntax/types.ml | 141 ++++++++++++++++++++++++------ interpreter/text/arrange.ml | 2 +- interpreter/text/lexer.mll | 3 + interpreter/text/parser.conflicts | 0 interpreter/text/parser.mly | 53 ++++++----- interpreter/valid/match.ml | 11 ++- interpreter/valid/valid.ml | 136 ++++++++++++++-------------- test/core/cont.wast | 2 +- 15 files changed, 265 insertions(+), 180 deletions(-) delete mode 100644 interpreter/text/parser.conflicts diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index 9f815f7e5..0d7ec86c1 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -144,15 +144,8 @@ let sized f s = open Types -let var s = vu32 s let zero s = expect 0x00 s "zero byte expected" -let var_type s = - let pos = pos s in - match vs33 s with - | i when i >= 0l -> SynVar i - | _ -> error s pos "malformed type index" - let num_type s = match s7 s with | -0x01 -> I32T @@ -208,12 +201,12 @@ let func_type s = FuncT (ts1, ts2) let cont_type s = - ContType (var_type s) + ContT (Stat (var_type s)) let def_type s = match s7 s with | -0x20 -> DefFuncT (func_type s) - | -0x21 -> ContDefType (cont_type s) + | -0x21 -> DefContT (cont_type s) | _ -> error s (pos s - 1) "malformed definition type" @@ -234,8 +227,8 @@ let memory_type s = let tag_type s = zero s; - let x = var_type s in - TagType x + let x = Stat (var_type s) in + TagT x let mutability s = match byte s with @@ -329,7 +322,7 @@ let rec instr s = let ct = catch_list s in let ca = if peek s = Some 0x19 then begin - ignore (u8 s); + ignore (byte s); Some (instr_block s) end else None @@ -372,13 +365,11 @@ let rec instr s = | 0x14 -> call_ref (at var s) | 0x15 -> return_call_ref (at var s) - | 0x16 as b -> illegal s pos b + | (0x16 | 0x17) as b -> illegal s pos b | 0x18 -> error s pos "misplaced DELEGATE opcode" | 0x19 -> error s pos "misplaced CATCH_ALL opcode" - | 0x17 | 0x19 as b -> illegal s pos b - | 0x1a -> drop | 0x1b -> select None | 0x1c -> select (Some (vec val_type s)) @@ -900,7 +891,7 @@ and instr_block' s es = instr_block' s (Source.(e' @@ region s pos pos) :: es) and catch_list s = if peek s = Some 0x07 then begin - ignore (u8 s); + ignore (byte s); let tag = at var s in let instrs = instr_block s in (tag, instrs) :: catch_list s @@ -1244,7 +1235,7 @@ let module_ s = s (len s) "data count section required"; let funcs = List.map2 (fun t f -> {f.it with ftype = t} @@ f.at) func_types func_bodies - in {types; tables; memories; globals; funcs; imports; exports; elems; datas; start} + in {types; tables; memories; tags; globals; funcs; imports; exports; elems; datas; start} let decode name bs = at module_ (stream name bs) diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 26d4cfca0..abe07f75a 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -130,11 +130,11 @@ struct | FuncT (ts1, ts2) -> vec val_type ts1; vec val_type ts2 let cont_type = function - | ContType x -> var_type x + | ContT x -> var_type x let def_type = function | DefFuncT ft -> s7 (-0x20); func_type ft - | ContDefType ct -> vs7 (-0x21); cont_type ct + | DefContT ct -> s7 (-0x21); cont_type ct (* TODO(dhil): I think the GC proposal claims opcode -0x21 for one of the struct/array types. *) let limits vu {min; max} = bool (max <> None); vu min; opt vu max @@ -152,8 +152,8 @@ struct let global_type = function | GlobalT (mut, t) -> val_type t; mutability mut - let tag_type (TagType x) = - vu32 0x00l; var_type x + let tag_type (TagT x) = + u32 0x00l; var_type x (* Instructions *) diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 253df15b6..aa6c99992 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -64,9 +64,8 @@ and admin_instr' = | Plain of instr' | Refer of ref_ | Invoke of func_inst - | Label of int * instr list * code - | Frame of int * frame * code - | Local of int32 * value list * code + | Label of int32 * instr list * code + | Frame of int32 * frame * code | Handle of (tag_inst * idx) list option * code | Trapping of string | Throwing of tag_inst * value stack @@ -88,7 +87,7 @@ type ref_ += ContRef of cont option ref let () = let type_of_ref' = !Value.type_of_ref' in Value.type_of_ref' := function - | ContRef _ -> BotHeapType (* TODO *) + | ContRef _ -> BotHT (* TODO *) | r -> type_of_ref' r let () = @@ -199,7 +198,7 @@ let rec step (c : config) : config = match e.it, vs with | Plain e', vs -> (match e', vs with - | Unreachable, vs -> + | Unreachable, vs -> vs, [Trapping "unreachable executed" @@ e.at] | Nop, vs -> @@ -207,14 +206,14 @@ let rec step (c : config) : config = | Block (bt, es'), vs -> let InstrT (ts1, ts2, _xs) = block_type c.frame.inst bt e.at in - let n1 = List.length ts1 in - let n2 = List.length ts2 in + let n1 = Lib.List32.length ts1 in + let n2 = Lib.List32.length ts2 in let args, vs' = take n1 vs e.at, drop n1 vs e.at in vs', [Label (n2, [], (args, List.map plain es')) @@ e.at] | Loop (bt, es'), vs -> let InstrT (ts1, ts2, _xs) = block_type c.frame.inst bt e.at in - let n1 = List.length ts1 in + let n1 = Lib.List32.length ts1 in let args, vs' = take n1 vs e.at, drop n1 vs e.at in vs', [Label (n1, [e' @@ e.at], (args, List.map plain es')) @@ e.at] @@ -227,7 +226,7 @@ let rec step (c : config) : config = | Throw x, vs -> let tagt = tag c.frame.inst x in let TagT x' = Tag.type_of tagt in - let FuncT (ts, _) = as_func_def_type (def_of (as_sem_var x')) in + let FuncT (ts, _) = as_func_def_type (def_of (as_dyn_var x')) in let vs0, vs' = split (Lib.List32.length ts) vs e.at in vs', [Throwing (tagt, vs0) @@ e.at] @@ -235,7 +234,7 @@ let rec step (c : config) : config = vs, [Rethrowing (x.it, fun e -> e) @@ e.at] | TryCatch (bt, es', cts, ca), vs -> - let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in + let InstrT (ts1, ts2, _xs) = block_type c.frame.inst bt e.at in let n1 = Lib.List32.length ts1 in let n2 = Lib.List32.length ts2 in let args, vs' = take n1 vs e.at, drop n1 vs e.at in @@ -243,7 +242,7 @@ let rec step (c : config) : config = vs', [Label (n2, [], ([], [Catch (n2, cts', ca, (args, List.map plain es')) @@ e.at])) @@ e.at] | TryDelegate (bt, es', x), vs -> - let FuncType (ts1, ts2) = block_type c.frame.inst bt e.at in + let InstrT (ts1, ts2, _xs) = block_type c.frame.inst bt e.at in let n1 = Lib.List32.length ts1 in let n2 = Lib.List32.length ts2 in let args, vs' = take n1 vs e.at, drop n1 vs e.at in @@ -315,7 +314,7 @@ let rec step (c : config) : config = vs, [Trapping "null function reference" @@ e.at] | ContNew x, Ref (FuncRef f) :: vs -> - let FuncType (ts, _) = Func.type_of f in + let FuncT (ts, _) = Func.type_of f in let ctxt code = compose code ([], [Invoke f @@ e.at]) in Ref (ContRef (ref (Some (Lib.List32.length ts, ctxt)))) :: vs, [] @@ -326,8 +325,8 @@ let rec step (c : config) : config = vs, [Trapping "continuation already consumed" @@ e.at] | ContBind x, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> - let ContType z = cont_type c.frame.inst x in - let FuncType (ts', _) = as_func_def_type (def_of (as_sem_var z)) in + let ContT z = cont_type c.frame.inst x in + let FuncT (ts', _) = as_func_def_type (def_of (as_dyn_var z)) in let args, vs' = try split (Int32.sub n (Lib.List32.length ts')) vs e.at with Failure _ -> Crash.error e.at "type mismatch at continuation bind" @@ -339,7 +338,7 @@ let rec step (c : config) : config = | Suspend x, vs -> let tagt = tag c.frame.inst x in let TagT x' = Tag.type_of tagt in - let FuncT (ts, _) = as_func_def_type (def_of (as_sem_var x')) in + let FuncT (ts, _) = as_func_def_type (def_of (as_dyn_var x')) in let args, vs' = split (Lib.List32.length ts) vs e.at in vs', [Suspending (tagt, args, fun code -> code) @@ e.at] @@ -364,14 +363,14 @@ let rec step (c : config) : config = | ResumeThrow x, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> let tagt = tag c.frame.inst x in let TagT x' = Tag.type_of tagt in - let FuncType (ts, _) = as_func_def_type (def_of (as_sem_var x')) in + let FuncT (ts, _) = as_func_def_type (def_of (as_dyn_var x')) in let args, vs' = split (Lib.List32.length ts) vs e.at in let vs1', es1' = ctxt (args, [Plain (Throw x) @@ e.at]) in cont := None; vs1' @ vs', es1' | Barrier (bt, es'), vs -> - let FuncType (ts1, _) = block_type c.frame.inst bt e.at in + let InstrT (ts1, _, _xs) = block_type c.frame.inst bt e.at in let args, vs' = split (Lib.List32.length ts1) vs e.at in vs', [ Handle (None, @@ -821,6 +820,12 @@ let rec step (c : config) : config = | Frame (n, frame', (vs', [])), vs -> vs' @ vs, [] + | Frame (n, frame', (vs', {it = Trapping msg; at} :: es')), vs -> + vs, [Trapping msg @@ at] + + | Frame (n, frame', (vs', {it = Throwing (a, vs0); at} :: es')), vs -> + vs, [Throwing (a, vs0) @@ at] + | Frame (n, frame', (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs -> let ctxt' code = [], [Frame (n, frame', compose (ctxt code) (vs', es')) @@ e.at] in vs, [Suspending (tagt, vs1, ctxt') @@ at] @@ -830,7 +835,7 @@ let rec step (c : config) : config = | Frame (n, frame', (vs', {it = ReturningInvoke (vs0, f); at} :: es')), vs -> let FuncT (ts1, _ts2) = Func.type_of f in - take (List.length ts1) vs0 e.at @ vs, [Invoke f @@ at] + take (Lib.List32.length ts1) vs0 e.at @ vs, [Invoke f @@ at] | Frame (n, frame', code'), vs -> let c' = step {frame = frame'; code = code'; budget = c.budget - 1} in @@ -895,10 +900,10 @@ let rec step (c : config) : config = | Invoke f, vs -> let FuncT (ts1, ts2) = Func.type_of f in - let n1, n2 = List.length ts1, List.length ts2 in + let n1, n2 = Lib.List32.length ts1, Lib.List32.length ts2 in let args, vs' = split n1 vs e.at in (match f with - | Func.AstFunc (_, inst', func) -> + | Func.AstFunc (_, inst', func) -> let {locals; body; _} = func.it in let m = Lib.Promise.value inst' in let ts = List.map (fun loc -> Types.dyn_val_type m.types loc.it.ltype) locals in @@ -921,7 +926,7 @@ let rec step (c : config) : config = | Handle (Some hs, (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs when List.mem_assq tagt hs -> let TagT x' = Tag.type_of tagt in - let FuncT (_, ts) = as_func_def_type (def_of (as_sem_var x')) in + let FuncT (_, ts) = as_func_def_type (def_of (as_dyn_var x')) in let ctxt' code = compose (ctxt code) (vs', es') in [Ref (ContRef (ref (Some (Lib.List32.length ts, ctxt'))))] @ vs1 @ vs, [Plain (Br (List.assq tagt hs)) @@ e.at] @@ -1025,7 +1030,7 @@ let create_global (inst : module_inst) (glob : global) : global_inst = let create_tag (inst : module_inst) (tag : tag) : tag_inst = let {tagtype} = tag.it in - Tag.alloc (Types.sem_tag_type inst.types tagtype) + Tag.alloc (Types.dyn_tag_type inst.types tagtype) let create_export (inst : module_inst) (ex : export) : export_inst = let {name; edesc} = ex.it in diff --git a/interpreter/host/spectest.ml b/interpreter/host/spectest.ml index 6c13c8bb1..598ec05e9 100644 --- a/interpreter/host/spectest.ml +++ b/interpreter/host/spectest.ml @@ -26,11 +26,11 @@ let memory = Memory.alloc (MemoryT {min = 1l; max = Some 2l}) let func f ft = Func.alloc_host (Types.alloc (DefFuncT ft)) (f ft) let tag = - let p = Types.alloc (FuncDefType (FuncType ([NumType I32Type], [NumType I32Type]))) in - Tag.alloc (TagType (SemVar p)) + let p = Types.alloc (DefFuncT (FuncT ([NumT I32T], [NumT I32T]))) in + Tag.alloc (TagT (Dyn p)) let except = - let p = Types.alloc (FuncDefType (FuncType ([NumType I32Type], []))) in - Tag.alloc (TagType (SemVar p)) + let p = Types.alloc (DefFuncT (FuncT ([NumT I32T], []))) in + Tag.alloc (TagT (Dyn p)) let print_value v = Printf.printf "%s : %s\n" diff --git a/interpreter/runtime/instance.ml b/interpreter/runtime/instance.ml index e6bf09207..8ab5fffc0 100644 --- a/interpreter/runtime/instance.ml +++ b/interpreter/runtime/instance.ml @@ -66,7 +66,7 @@ let extern_type_of c = function | ExternTable tab -> ExternTableT (Table.type_of tab) | ExternMemory mem -> ExternMemoryT (Memory.type_of mem) | ExternGlobal glob -> ExternGlobalT (Global.type_of glob) - | ExternTag tag -> ExternTagType (Tag.type_of tag) + | ExternTag tag -> ExternTagT (Tag.type_of tag) let export inst name = try Some (List.assoc name inst.exports) with Not_found -> None diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml index f02003020..7f660b74d 100644 --- a/interpreter/script/js.ml +++ b/interpreter/script/js.ml @@ -288,6 +288,7 @@ let null_heap_type_of = function | Types.DefHT (Dyn a) -> match Types.def_of a with | Types.DefFuncT _ -> FuncHT + | Types.DefContT _ -> assert false let value v = match v.it with diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml index ce0c5a940..dd22343c8 100644 --- a/interpreter/syntax/free.ml +++ b/interpreter/syntax/free.ml @@ -90,11 +90,11 @@ let val_type = function | BotT -> empty let func_type (FuncT (ins, out)) = list val_type ins ++ list val_type out -let cont_type (ContType x) = var_type x +let cont_type (ContT x) = var_type x let global_type (GlobalT (_mut, t)) = val_type t let table_type (TableT (_lim, t)) = ref_type t let memory_type (MemoryT (_lim)) = empty -let tag_type (TagType x) = var_type x +let tag_type (TagT x) = var_type x let def_type = function | DefFuncT ft -> func_type ft diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml index d76dd2e59..c93089d1b 100644 --- a/interpreter/syntax/types.ml +++ b/interpreter/syntax/types.ml @@ -70,30 +70,6 @@ let defaultable : val_type -> bool = function | BotT -> assert false -(* Projections *) - -let as_syn_var = function - | SynVar x -> x - | SemVar _ -> assert false - -let as_sem_var = function - | SynVar _ -> assert false - | SemVar x -> x - -let as_func_def_type (dt : def_type) : func_type = - match dt with - | DefFuncT ft -> ft - | _ -> assert false - -let as_cont_def_type (dt : def_type) : cont_type = - match dt with - | DefContT ct -> ct - | _ -> assert false - -let extern_type_of_import_type (ImportT (et, _, _)) = et -let extern_type_of_export_type (ExportT (et, _)) = et - - (* Filters *) let funcs (ets : extern_type list) : func_type list = @@ -107,6 +83,96 @@ let globals (ets : extern_type list) : global_type list = let tags (ets : extern_type list) : tag_type list = Lib.List.map_filter (function ExternTagT t -> Some t | _ -> None) ets +(* String conversion *) + +let string_of_idx x = + I32.to_string_u x + +let string_of_name n = + let b = Buffer.create 16 in + let escape uc = + if uc < 0x20 || uc >= 0x7f then + Buffer.add_string b (Printf.sprintf "\\u{%02x}" uc) + else begin + let c = Char.chr uc in + if c = '\"' || c = '\\' then Buffer.add_char b '\\'; + Buffer.add_char b c + end + in + List.iter escape n; + Buffer.contents b + +let string_of_null : null -> string = function + | NoNull -> "" + | Null -> "null " + +let string_of_addr' = ref (fun (a : type_addr) -> assert false) +let string_of_addr a = !string_of_addr' a + +let string_of_var : var -> string = function + | Stat x -> I32.to_string_u x + | Dyn a -> string_of_addr a + +let string_of_num_type : num_type -> string = function + | I32T -> "i32" + | I64T -> "i64" + | F32T -> "f32" + | F64T -> "f64" + +let string_of_vec_type : vec_type -> string = function + | V128T -> "v128" + +let string_of_heap_type : heap_type -> string = function + | FuncHT -> "func" + | ExternHT -> "extern" + | DefHT x -> string_of_var x + | BotHT -> "something" + +let string_of_ref_type : ref_type -> string = function + | (nul, t) -> + "(ref " ^ string_of_null nul ^ string_of_heap_type t ^ ")" + +let string_of_val_type : val_type -> string = function + | NumT t -> string_of_num_type t + | VecT t -> string_of_vec_type t + | RefT t -> string_of_ref_type t + | BotT -> "(something)" + +let string_of_result_type : result_type -> string = function + | ts -> "[" ^ String.concat " " (List.map string_of_val_type ts) ^ "]" + +let string_of_func_type : func_type -> string = function + | FuncT (ts1, ts2) -> + string_of_result_type ts1 ^ " -> " ^ string_of_result_type ts2 + +let string_of_cont_type = function + | ContT x -> string_of_var x + +let string_of_def_type : def_type -> string = function + | DefFuncT ft -> "func " ^ string_of_func_type ft + | DefContT ct -> "cont " ^ string_of_cont_type ct + +let string_of_tag_type (TagT x) = string_of_var x + +let string_of_limits : I32.t limits -> string = function + | {min; max} -> + I32.to_string_u min ^ + (match max with None -> "" | Some n -> " " ^ I32.to_string_u n) + +let string_of_memory_type : memory_type -> string = function + | MemoryT lim -> string_of_limits lim + +let string_of_table_type : table_type -> string = function + | TableT (lim, t) -> string_of_limits lim ^ " " ^ string_of_ref_type t + +let string_of_global_type : global_type -> string = function + | GlobalT (Cons, t) -> string_of_val_type t + | GlobalT (Var, t) -> "(mut " ^ string_of_val_type t ^ ")" + +let string_of_local_type : local_type -> string = function + | LocalT (Set, t) -> string_of_val_type t + | LocalT (Unset, t) -> "(unset " ^ string_of_val_type t ^ ")" + let string_of_extern_type : extern_type -> string = function | ExternFuncT ft -> "func " ^ string_of_func_type ft | ExternTableT tt -> "table " ^ string_of_table_type tt @@ -132,11 +198,6 @@ let string_of_module_type : module_type -> string = function List.map (fun et -> "export " ^ string_of_export_type et ^ "\n") ets ) -let string_of_tag_type (TagT x) = string_of_var x - -let string_of_cont_type = function - | ContT x -> string_of_var x - (* Dynamic Types *) type type_addr += Addr of def_type Lib.Promise.t @@ -238,3 +299,25 @@ let dyn_module_type = function let its = List.map (dyn_import_type c) its in let ets = List.map (dyn_export_type c) ets in ModuleT ([], its, ets) + +(* Projections *) +let as_stat_var = function + | Stat x -> x + | Dyn _ -> assert false + +let as_dyn_var = function + | Dyn a -> a + | Stat _ -> assert false + +let as_func_def_type (dt : def_type) : func_type = + match dt with + | DefFuncT ft -> ft + | _ -> assert false + +let as_cont_def_type (dt : def_type) : cont_type = + match dt with + | DefContT ct -> ct + | _ -> assert false + +let extern_type_of_import_type (ImportT (et, _, _)) = et +let extern_type_of_export_type (ExportT (et, _)) = et diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index b4e6914eb..2b2bfc439 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -576,7 +576,7 @@ let memory off i mem = Node ("memory $" ^ nat (off + i) ^ " " ^ limits nat32 lim, []) let tag off i tag = - let {tagtype = TagType x} = tag.it in + let {tagtype = TagT x} = tag.it in Node ("tag $" ^ nat (off + i), [Node ("type", [atom var_type x])] ) diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index e985ca07a..def5aeb99 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -154,6 +154,7 @@ rule token = parse | "ref" -> REF | "null" -> NULL | "mut" -> MUT + | "tag" -> TAG | "cont" -> CONT | "nop" -> NOP @@ -711,6 +712,8 @@ rule token = parse | "assert_return" -> ASSERT_RETURN | "assert_trap" -> ASSERT_TRAP | "assert_exhaustion" -> ASSERT_EXHAUSTION + | "assert_exception" -> ASSERT_EXCEPTION + | "assert_suspension" -> ASSERT_SUSPENSION | "nan:canonical" -> NAN Script.CanonicalNan | "nan:arithmetic" -> NAN Script.ArithmeticNan | "input" -> INPUT diff --git a/interpreter/text/parser.conflicts b/interpreter/text/parser.conflicts deleted file mode 100644 index e69de29bb..000000000 diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index e974d0e61..b51ff6843 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -163,7 +163,7 @@ let label (c : context) x = lookup "label " c.labels x let func_type (c : context) x = match (Lib.List32.nth c.types.list x.it).it with | DefFuncT ft -> ft - | DefContT ct -> ct + | _ -> error x.at ("non-function type " ^ Int32.to_string x.it) | exception Failure _ -> error x.at ("unknown type " ^ Int32.to_string x.it) let handlers (c : context) h = @@ -263,7 +263,7 @@ let inline_func_type_explicit (c : context) x ft at = %token VEC_SHIFT VEC_BITMASK VEC_SPLAT %token VEC_SHUFFLE %token Ast.instr'> VEC_EXTRACT VEC_REPLACE -%token FUNC START TYPE PARAM RESULT LOCAL GLOBAL TAG +%token FUNC START TYPE PARAM RESULT LOCAL GLOBAL TAG CONT %token TABLE ELEM MEMORY DATA DECLARE OFFSET ITEM IMPORT EXPORT %token MODULE BIN QUOTE %token SCRIPT REGISTER INVOKE GET @@ -321,15 +321,15 @@ global_type : def_type : | LPAR FUNC func_type RPAR { fun c -> DefFuncT ($3 c) } - | LPAR CONT cont_type RPAR { fun c -> DefContT (ContT (SynVar ($3 c).it)) } + | LPAR CONT cont_type RPAR { fun c -> DefContT (ContT (Stat ($3 c).it)) } cont_type : | type_use cont_type_params { let at1 = ati 1 in fun c -> match $2 c with - | FuncType ([], []) -> $1 c type_ - | ft -> inline_func_type_explicit c ($1 c type_) ft at1 } + | FuncT ([], []) -> $1 c + | ft -> inline_func_type_explicit c ($1 c) ft at1 } | cont_type_params /* TODO: the inline type is broken for now */ { let at = at () in fun c -> inline_func_type c ($1 c) at } @@ -337,19 +337,18 @@ cont_type : { fun c -> $1 c type_ } cont_type_params : - | LPAR PARAM value_type_list RPAR cont_type_params - { fun c -> let FuncType (ts1, ts2) = $5 c in - FuncType (snd $3 c @ ts1, ts2) } + | LPAR PARAM val_type_list RPAR cont_type_params + { fun c -> let FuncT (ts1, ts2) = $5 c in + FuncT (snd $3 c @ ts1, ts2) } | cont_type_results - { fun c -> FuncType ([], $1 c) } + { fun c -> FuncT ([], $1 c) } cont_type_results : - | LPAR RESULT value_type_list RPAR cont_type_results + | LPAR RESULT val_type_list RPAR cont_type_results { fun c -> snd $3 c @ $5 c } | /* empty */ { fun c -> [] } - func_type : | func_type_result { fun c -> FuncT ([], $1 c) } @@ -368,9 +367,9 @@ func_type_result : tag_type : | type_use - { fun c -> TagType (SynVar ($1 c type_).it) } + { fun c -> TagT (Stat ($1 c).it) } | func_type - { let at = at () in fun c -> TagType (SynVar (inline_func_type c ($1 c) at).it) } + { let at = at () in fun c -> TagT (Stat (inline_func_type c ($1 c) at).it) } table_type : | limits ref_type { fun c -> TableT ($1, $2 c) } @@ -631,16 +630,15 @@ catch : catch_all : | CATCH_ALL instr_list { $2 } -resume_instr : - | RESUME resume_instr_handler - { let at = at () in fun c -> resume ($2 c) @@ at } - -resume_instr_handler : - | LPAR TAG var var RPAR resume_instr_handler - { fun c -> ($3 c tag, $4 c label) :: $6 c } - | /* empty */ - { fun c -> [] } +/* resume_instr : */ +/* | RESUME resume_instr_handler */ +/* { let at = at () in fun c -> resume ($2 c) @@ at } */ +/* resume_instr_handler : */ +/* | LPAR TAG var var RPAR resume_instr_handler */ +/* { fun c -> ($3 c tag, $4 c label) :: $6 c } */ +/* | /\* empty *\/ */ +/* { fun c -> [] } */ resume_instr_instr : | RESUME resume_instr_handler_instr @@ -650,10 +648,9 @@ resume_instr_instr : resume_instr_handler_instr : | LPAR TAG var var RPAR resume_instr_handler_instr { fun c -> let hs, es = $6 c in ($3 c tag, $4 c label) :: hs, es } - | instr + | instr1 { fun c -> [], $1 c } - block_instr : | BLOCK labeling_opt block END labeling_end_opt { fun c -> let c' = $2 c $5 in let bt, es = $3 c' in block bt es } @@ -812,7 +809,7 @@ try_block : { let at = at () in fun c c' -> let body = $2 c in - let bt = VarBlockType (SynVar (inline_func_type_explicit c' ($1 c' type_) (fst body) at).it) in + let bt = VarBlockType (inline_func_type_explicit c' ($1 c') (fst body) at) in snd body bt c c' } | try_block_param_body /* Sugar */ { let at = at () in @@ -822,19 +819,19 @@ try_block : match fst body with | FuncT ([], []) -> ValBlockType None | FuncT ([], [t]) -> ValBlockType (Some t) - | ft -> VarBlockT (SynVar (inline_func_type c' ft at).it) + | ft -> VarBlockType (inline_func_type c' ft at) in snd body bt c c' } try_block_param_body : | try_block_result_body { $1 } - | LPAR PARAM value_type_list RPAR try_block_param_body + | LPAR PARAM val_type_list RPAR try_block_param_body { fun c -> let FuncT (ins, out) = fst ($5 c) in FuncT ((snd $3) c @ ins, out), snd ($5 c) } try_block_result_body : | try_ { fun _c -> FuncT ([], []), $1 } - | LPAR RESULT value_type_list RPAR try_block_result_body + | LPAR RESULT val_type_list RPAR try_block_result_body { fun c -> let FuncT (ins, out) = fst ($5 c) in let vs = (snd $3) c in diff --git a/interpreter/valid/match.ml b/interpreter/valid/match.ml index b00adfd58..7bc1a0f56 100644 --- a/interpreter/valid/match.ml +++ b/interpreter/valid/match.ml @@ -64,7 +64,8 @@ and eq_cont_type c (ContT x1) (ContT x2) = and eq_def_type c dt1 dt2 = match dt1, dt2 with | DefFuncT ft1, DefFuncT ft2 -> eq_func_type c ft1 ft2 - | DefContT ct1, ContDefT ct2 -> eq_cont_type c ct1 ct2 + | DefContT ct1, DefContT ct2 -> eq_cont_type c ct1 ct2 + | _, _ -> false and eq_var_type c x1 x2 = eq_var x1 x2 || @@ -80,7 +81,7 @@ let eq_memory_type c (MemoryT lim1) (MemoryT lim2) = let eq_global_type c (GlobalT (mut1, t1)) (GlobalT (mut2, t2)) = eq_mutability c mut1 mut2 && eq_val_type c t1 t2 -and eq_tag_type c (TagT x1) (TagT x2) = +let eq_tag_type c (TagT x1) (TagT x2) = eq_var_type c x1 x2 let eq_extern_type c et1 et2 = @@ -147,6 +148,8 @@ and match_func_type c ft1 ft2 = and match_def_type c dt1 dt2 = match dt1, dt2 with | DefFuncT ft1, DefFuncT ft2 -> match_func_type c ft1 ft2 + | DefContT ct1, DefContT ct2 -> match_cont_type c ct1 ct2 + | _, _ -> false and match_var_type c x1 x2 = eq_var x1 x2 || @@ -167,8 +170,8 @@ let match_global_type c (GlobalT (mut1, t1)) (GlobalT (mut2, t2)) = | Cons -> match_val_type c t1 t2 | Var -> eq_val_type c t1 t2 -and match_tag_type c (TagT x1) (TagT x2) = - match_var_type c x1 x2 +let match_tag_type c tt1 tt2 = + eq_tag_type c tt1 tt2 let match_extern_type c et1 et2 = match et1, et2 with diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 3f81e49f3..0eeb0beac 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -76,9 +76,6 @@ let cont_type (c : context) x = | DefContT ct -> ct | _ -> error x.at ("non-continuation type " ^ Int32.to_string x.it) - -let func (c : context) x = func_type c (func_var c x @@ x.at) - let refer category (s : Free.Set.t) x = if not (Free.Set.mem x.it s) then error x.at @@ -133,7 +130,7 @@ let check_func_type (c : context) (ft : func_type) at = let check_cont_type (c : context) (ct : cont_type) at = let ContT x = ct in - ignore (func_type c (as_syn_var x @@ at)) + ignore (func_type c (as_stat_var x @@ at)) let check_table_type (c : context) (tt : table_type) at = let TableT (lim, t) = tt in @@ -146,8 +143,8 @@ let check_memory_type (c : context) (mt : memory_type) at = "memory size must be at most 65536 pages (4GiB)" let check_tag_type (c : context) (et : tag_type) at = - let TagType x = et in - ignore (func_type c (as_syn_var x @@ at)) + let TagT x = et in + ignore (func_type c (as_stat_var x @@ at)) let check_global_type (c : context) (gt : global_type) at = let GlobalT (_mut, t) = gt in @@ -178,6 +175,7 @@ type infer_instr_type = infer_func_type * idx list let stack ts = (NoEllipses, ts) let (-->) ts1 ts2 = {ins = NoEllipses, ts1; outs = NoEllipses, ts2} +let (-->..) ts1 ts2 = {ins = Ellipses, ts1; outs = NoEllipses, ts2} let (-->...) ts1 ts2 = {ins = Ellipses, ts1; outs = Ellipses, ts2} let check_stack (c : context) ts1 ts2 at = @@ -360,72 +358,76 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in | Block (bt, es) -> let InstrT (ts1, ts2, xs) as it = check_block_type c bt e.at in - check_block {c with labels = ts2 :: c.labels} es it e.at; + check_block {c with labels = (BlockLabel, ts2) :: c.labels} es it e.at; ts1 --> ts2, List.map (fun x -> x @@ e.at) xs | Loop (bt, es) -> let InstrT (ts1, ts2, xs) as it = check_block_type c bt e.at in - check_block {c with labels = ts1 :: c.labels} es it e.at; + check_block {c with labels = (BlockLabel, ts1) :: c.labels} es it e.at; ts1 --> ts2, List.map (fun x -> x @@ e.at) xs | If (bt, es1, es2) -> let InstrT (ts1, ts2, xs) as it = check_block_type c bt e.at in - check_block {c with labels = ts2 :: c.labels} es1 it e.at; - check_block {c with labels = ts2 :: c.labels} es2 it e.at; + check_block {c with labels = (BlockLabel, ts2) :: c.labels} es1 it e.at; + check_block {c with labels = (BlockLabel, ts2) :: c.labels} es2 it e.at; (ts1 @ [NumT I32T]) --> ts2, List.map (fun x -> x @@ e.at) xs | Throw x -> - let TagType y = tag c x in - let FuncType (ts1, _) = func_type c (as_syn_var y @@ e.at) in - ts1 -->... [] + let TagT y = tag c x in + let FuncT (ts1, _) = func_type c (as_stat_var y @@ e.at) in + ts1 -->... [], [] | Rethrow x -> let (kind, _) = label c x in require (kind = CatchLabel) e.at "invalid rethrow label"; - [] -->... [] + [] -->... [], [] | TryCatch (bt, es, cts, ca) -> - let FuncType (ts1, ts2) as ft = check_block_type c bt e.at in + let InstrT (ts1, ts2, xs) as ft = check_block_type c bt e.at in let c_try = {c with labels = (BlockLabel, ts2) :: c.labels} in let c_catch = {c with labels = (CatchLabel, ts2) :: c.labels} in check_block c_try es ft e.at; List.iter (fun ct -> check_catch ct c_catch ft e.at) cts; Lib.Option.app (fun es -> check_block c_catch es ft e.at) ca; - ts1 --> ts2 + ts1 --> ts2, List.map (fun x -> x @@ e.at) xs | TryDelegate (bt, es, x) -> - let FuncType (ts1, ts2) as ft = check_block_type c bt e.at in + let InstrT (ts1, ts2, xs) as ft = check_block_type c bt e.at in ignore (label c x); check_block {c with labels = (BlockLabel, ts2) :: c.labels} es ft e.at; - ts1 --> ts2 + ts1 --> ts2, List.map (fun x -> x @@ e.at) xs | Br x -> - label c x -->... [], [] + let (_, ts) = label c x in + ts -->... [], [] | BrIf x -> - (label c x @ [NumT I32T]) --> label c x, [] + let (_, ts) = label c x in + (ts @ [NumT I32T]) --> ts, [] | BrTable (xs, x) -> - let n = List.length (label c x) in + let n = List.length (snd (label c x)) in let ts = Lib.List.table n (fun i -> peek (n - i) s) in - check_stack c ts (label c x) x.at; - List.iter (fun x' -> check_stack c ts (label c x') x'.at) xs; + check_stack c ts (snd (label c x)) x.at; + List.iter (fun x' -> check_stack c ts (snd (label c x')) x'.at) xs; (ts @ [NumT I32T]) -->... [], [] | BrOnNull x -> let (_, ht) = peek_ref 0 s e.at in - (label c x @ [RefT (Null, ht)]) --> (label c x @ [RefT (NoNull, ht)]), [] + let (_, ts) = label c x in + (ts @ [RefT (Null, ht)]) --> (ts @ [RefT (NoNull, ht)]), [] | BrOnNonNull x -> let (_, ht) = peek_ref 0 s e.at in let t' = RefT (NoNull, ht) in - require (label c x <> []) e.at + let (_, ts) = label c x in + require (ts <> []) e.at ("type mismatch: instruction requires type " ^ string_of_val_type t' ^ - " but label has " ^ string_of_result_type (label c x)); - let ts0, t1 = Lib.List.split_last (label c x) in + " but label has " ^ string_of_result_type ts); + let ts0, t1 = Lib.List.split_last ts in require (match_val_type c.types t' t1) e.at ("type mismatch: instruction requires type " ^ string_of_val_type t' ^ - " but label has " ^ string_of_result_type (label c x)); + " but label has " ^ string_of_result_type ts); (ts0 @ [RefT (Null, ht)]) --> ts0, [] | Return -> @@ -474,86 +476,86 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in | ContNew x -> let ContT y = cont_type c x in - [RefType (NonNullable, DefHeapType y)] --> - [RefType (NonNullable, DefHeapType (SynVar x.it))] + [RefT (NoNull, DefHT y)] --> + [RefT (NoNull, DefHT (Stat x.it))], [] | ContBind x -> (match peek_ref 0 s e.at with - | nul, DefHeapType (SynVar y) -> + | nul, DefHT (Stat y) -> let ContT z = cont_type c (y @@ e.at) in - let FuncT (ts1, ts2) = func_type c (as_syn_var z @@ e.at) in + let FuncT (ts1, ts2) = func_type c (as_stat_var z @@ e.at) in let ContT z' = cont_type c x in - let FuncT (ts1', _) as ft' = func_type c (as_syn_var z' @@ x.at) in + let FuncT (ts1', _) as ft' = func_type c (as_stat_var z' @@ x.at) in require (List.length ts1 >= List.length ts1') x.at "type mismatch in continuation arguments"; let ts11, ts12 = Lib.List.split (List.length ts1 - List.length ts1') ts1 in - require (match_func_type c.types [] (FuncType (ts12, ts2)) ft') e.at + require (match_func_type c.types (FuncT (ts12, ts2)) ft') e.at "type mismatch in continuation type"; - (ts11 @ [RefType (nul, DefHeapType (SynVar y))]) --> - [RefType (NonNullable, DefHeapType (SynVar x.it))] - | (_, BotHeapType) as rt -> - [RefType rt] -->.. [RefType (NonNullable, DefHeapType (SynVar x.it))] + (ts11 @ [RefT (nul, DefHT (Stat y))]) --> + [RefT (NoNull, DefHT (Stat x.it))], [] + | (_, BotHT) as rt -> + [RefT rt] -->.. [RefT (NoNull, DefHT (Stat x.it))], [] | rt -> error e.at ("type mismatch: instruction requires continuation reference type" ^ - " but stack has " ^ string_of_value_type (RefType rt)) + " but stack has " ^ string_of_val_type (RefT rt)) ) | Suspend x -> let TagT x' = tag c x in - let FuncT (ts1, ts2) = func_type c (as_syn_var x' @@ x.at) in - ts1 --> ts2 + let FuncT (ts1, ts2) = func_type c (as_stat_var x' @@ x.at) in + ts1 --> ts2, [] | Resume xys -> (match peek_ref 0 s e.at with - | nul, DefHeapType (SynVar y) -> + | nul, DefHT (Stat y) -> let ContT z = cont_type c (y @@ e.at) in - let FuncT (ts1, ts2) = func_type c (as_syn_var z @@ e.at) in + let FuncT (ts1, ts2) = func_type c (as_stat_var z @@ e.at) in List.iter (fun (x1, x2) -> let TagT x1' = tag c x1 in - let FuncT (ts3, ts4) = func_type c (as_syn_var x1' @@ x1.at) in + let FuncT (ts3, ts4) = func_type c (as_stat_var x1' @@ x1.at) in let (_, ts') = label c x2 in match Lib.List.last_opt ts' with - | Some (RefType (nul', DefHeapType (SynVar y'))) -> + | Some (RefT (nul', DefHT (Stat y'))) -> let ContT z' = cont_type c (y' @@ x2.at) in - let ft' = func_type c (as_syn_var z' @@ x2.at) in - require (match_func_type c.types [] (FuncType (ts4, ts2)) ft') x2.at + let ft' = func_type c (as_stat_var z' @@ x2.at) in + require (match_func_type c.types (FuncT (ts4, ts2)) ft') x2.at "type mismatch in continuation type"; - check_stack c (ts3 @ [RefType (nul', DefHeapType (SynVar y'))]) ts' x2.at + check_stack c (ts3 @ [RefT (nul', DefHT (Stat y'))]) ts' x2.at | _ -> error e.at ("type mismatch: instruction requires continuation reference type" ^ " but label has " ^ string_of_result_type ts') ) xys; - (ts1 @ [RefType (nul, DefHeapType (SynVar y))]) --> ts2 - | _, BotHeapType -> - [] -->... [] + (ts1 @ [RefT (nul, DefHT (Stat y))]) --> ts2, [] + | _, BotHT -> + [] -->... [], [] | rt -> error e.at ("type mismatch: instruction requires continuation reference type" ^ - " but stack has " ^ string_of_value_type (RefType rt)) + " but stack has " ^ string_of_val_type (RefT rt)) ) | ResumeThrow x -> let TagT x' = tag c x in - let FuncT (ts0, _) = func_type c (as_syn_var x' @@ x.at) in + let FuncT (ts0, _) = func_type c (as_stat_var x' @@ x.at) in (match peek_ref 0 s e.at with - | nul, DefHeapType (SynVar y) -> + | nul, DefHT (Stat y) -> let ContT z = cont_type c (y @@ e.at) in - let FuncT (ts1, ts2) = func_type c (as_syn_var z @@ e.at) in - (ts0 @ [RefType (nul, DefHeapType (SynVar y))]) --> ts2 - | _, BotHeapType -> - [] -->... [] + let FuncT (ts1, ts2) = func_type c (as_stat_var z @@ e.at) in + (ts0 @ [RefT (nul, DefHT (Stat y))]) --> ts2, [] + | _, BotHT -> + [] -->... [], [] | rt -> error e.at ("type mismatch: instruction requires continuation reference type" ^ - " but stack has " ^ string_of_value_type (RefType rt)) + " but stack has " ^ string_of_val_type (RefT rt)) ) | Barrier (bt, es) -> - let FuncT (ts1, ts2) as ft = check_block_type c bt e.at in + let InstrT (ts1, ts2, xs) as ft = check_block_type c bt e.at in check_block {c with labels = (BlockLabel, ts2) :: c.labels} es ft e.at; - ts1 --> ts2 + ts1 --> ts2, List.map (fun x -> x @@ e.at) xs | LocalGet x -> let LocalT (init, t) = local c x in @@ -799,12 +801,12 @@ and check_block (c : context) (es : instr list) (it : instr_type) at = ("type mismatch: block requires " ^ string_of_result_type ts2 ^ " but stack has " ^ string_of_result_type (snd s)) -and check_catch (ct : idx * instr list) (c : context) (ft : func_type) at = +and check_catch (ct : idx * instr list) (c : context) (ft : instr_type) at = let (x, es) = ct in - let TagType y = tag c x in - let FuncType (ts1, _) = func_type c (as_syn_var y @@ at) in - let FuncType (_, ts2) = ft in - check_block c es (FuncType (ts1, ts2)) at + let TagT y = tag c x in + let FuncT (ts1, _) = func_type c (as_stat_var y @@ at) in + let InstrT (_, ts2, xs) = ft in + check_block c es (InstrT (ts1, ts2, xs)) at (* Functions & Constants *) @@ -933,7 +935,7 @@ let check_import (c : context) (im : import) : context = {c with globals = c.globals @ [gt]} | TagImport et -> check_tag_type c et idesc.at; - {c with tags = et :: c.tags} + {c with tags = c.tags @ [et]} module NameSet = Set.Make(struct type t = Ast.name let compare = compare end) diff --git a/test/core/cont.wast b/test/core/cont.wast index 6830c9e31..ae02ae2e7 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -204,7 +204,7 @@ (func $gen (export "start") (param $i i64) (loop $l (br_if 1 (suspend $yield (local.get $i))) - (call_ref (local.get $i) (global.get $hook)) + (call_ref $gen (local.get $i) (global.get $hook)) (local.set $i (i64.add (local.get $i) (i64.const 1))) (br $l) ) From c9e60d885fe7948c49a37e3b8fceda4b94ef2329 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Wed, 22 Mar 2023 10:43:55 +0100 Subject: [PATCH 54/82] Update `resume_throw` (#26) This PR updates `resume_throw` such that it is parameterised by both an exception and an optional filter list. Co-authored-by: Andreas Rossberg --- interpreter/binary/decode.ml | 5 ++++- interpreter/binary/encode.ml | 2 +- interpreter/exec/eval.ml | 10 ++++----- interpreter/syntax/ast.ml | 2 +- interpreter/syntax/free.ml | 3 ++- interpreter/syntax/operators.ml | 2 +- interpreter/text/arrange.ml | 4 +++- interpreter/text/parser.mly | 21 +++++++++--------- interpreter/valid/valid.ml | 39 ++++++++++++++++++--------------- 9 files changed, 48 insertions(+), 40 deletions(-) diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index 0d7ec86c1..604b3f26d 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -573,7 +573,10 @@ let rec instr s = | 0xe1 -> cont_bind (at var s) | 0xe2 -> suspend (at var s) | 0xe3 -> resume (vec var_pair s) - | 0xe4 -> resume_throw (at var s) + | 0xe4 -> + let tag = at var s in + let xls = vec var_pair s in + resume_throw tag xls | 0xe5 -> let bt = block_type s in let es' = instr_block s in diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index abe07f75a..2745ae8a9 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -233,7 +233,7 @@ struct | ContBind x -> op 0xe1; var x | Suspend x -> op 0xe2; var x | Resume xls -> op 0xe3; vec var_pair xls - | ResumeThrow x -> op 0xe4; var x + | ResumeThrow (x, xls) -> op 0xe4; var x; vec var_pair xls | Barrier (bt, es) -> op 0xe5; block_type bt; list instr es; end_ () | Drop -> op 0x1a diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index aa6c99992..ccc9f6782 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -354,20 +354,20 @@ let rec step (c : config) : config = cont := None; vs', [Handle (Some hs, ctxt (args, [])) @@ e.at] - | ResumeThrow x, Ref (NullRef _) :: vs -> + | ResumeThrow (x, xls), Ref (NullRef _) :: vs -> vs, [Trapping "null continuation reference" @@ e.at] - | ResumeThrow x, Ref (ContRef {contents = None}) :: vs -> + | ResumeThrow (x, xls), Ref (ContRef {contents = None}) :: vs -> vs, [Trapping "continuation already consumed" @@ e.at] - | ResumeThrow x, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> + | ResumeThrow (x, xls), Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> let tagt = tag c.frame.inst x in let TagT x' = Tag.type_of tagt in let FuncT (ts, _) = as_func_def_type (def_of (as_dyn_var x')) in + let hs = List.map (fun (x, l) -> tag c.frame.inst x, l) xls in let args, vs' = split (Lib.List32.length ts) vs e.at in - let vs1', es1' = ctxt (args, [Plain (Throw x) @@ e.at]) in cont := None; - vs1' @ vs', es1' + vs', [Handle (Some hs, ctxt (args, [Plain (Throw x) @@ e.at])) @@ e.at] | Barrier (bt, es'), vs -> let InstrT (ts1, _, _xs) = block_type c.frame.inst bt e.at in diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml index 0a958282c..ee511ee94 100644 --- a/interpreter/syntax/ast.ml +++ b/interpreter/syntax/ast.ml @@ -169,7 +169,7 @@ and instr' = | ContBind of idx (* bind continuation arguments *) | Suspend of idx (* suspend continuation *) | Resume of (idx * idx) list (* resume continuation *) - | ResumeThrow of idx (* abort continuation *) + | ResumeThrow of idx * (idx * idx) list (* abort continuation *) | Barrier of block_type * instr list (* guard against suspension *) | LocalGet of idx (* read local idxiable *) | LocalSet of idx (* write local idxiable *) diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml index dd22343c8..2d669cdf9 100644 --- a/interpreter/syntax/free.ml +++ b/interpreter/syntax/free.ml @@ -129,8 +129,9 @@ let rec instr (e : instr) = | Some es -> block es in block es ++ (list catch ct) ++ catch_all ca | TryDelegate (bt, es, x) -> block es ++ tags (idx x) - | Throw x | ResumeThrow x | Suspend x -> tags (idx x) + | Throw x | Suspend x -> tags (idx x) | Rethrow x -> labels (idx x) + | ResumeThrow (x, xys) -> tags (idx x) ++ list (fun (x, y) -> tags (idx x) ++ labels (idx y)) xys | Resume xys -> list (fun (x, y) -> tags (idx x) ++ labels (idx y)) xys | LocalGet x | LocalSet x | LocalTee x -> locals (idx x) | GlobalGet x | GlobalSet x -> globals (idx x) diff --git a/interpreter/syntax/operators.ml b/interpreter/syntax/operators.ml index 6e4012ebb..b794e30bf 100644 --- a/interpreter/syntax/operators.ml +++ b/interpreter/syntax/operators.ml @@ -47,7 +47,7 @@ let cont_new x = ContNew x let cont_bind x = ContBind x let suspend x = Suspend x let resume xys = Resume xys -let resume_throw x = ResumeThrow x +let resume_throw x xys = ResumeThrow (x, xys) let barrier bt es = Barrier (bt, es) let local_get x = LocalGet x diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index 2b2bfc439..5bb4b30fe 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -486,7 +486,9 @@ let rec instr e = | Resume xys -> "resume", List.map (fun (x, y) -> Node ("tag " ^ var x ^ " " ^ var y, [])) xys - | ResumeThrow x -> "resume_throw " ^ var x, [] + | ResumeThrow (x, xys) -> + "resume_throw " ^ var x, + List.map (fun (x, y) -> Node ("tag " ^ var x ^ " " ^ var y, [])) xys | Barrier (bt, es) -> "barrier", block_type bt @ list instr es | LocalGet x -> "local.get " ^ var x, [] | LocalSet x -> "local.set " ^ var x, [] diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index b51ff6843..708a5ca30 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -476,7 +476,6 @@ plain_instr : | CONT_NEW LPAR TYPE var RPAR { fun c -> cont_new ($4 c type_) } | CONT_BIND LPAR TYPE var RPAR { fun c -> cont_bind ($4 c type_) } | SUSPEND var { fun c -> suspend ($2 c tag) } - | RESUME_THROW var { fun c -> resume_throw ($2 c tag) } | LOCAL_GET var { fun c -> local_get ($2 c local) } | LOCAL_SET var { fun c -> local_set ($2 c local) } | LOCAL_TEE var { fun c -> local_tee ($2 c local) } @@ -630,20 +629,15 @@ catch : catch_all : | CATCH_ALL instr_list { $2 } -/* resume_instr : */ -/* | RESUME resume_instr_handler */ -/* { let at = at () in fun c -> resume ($2 c) @@ at } */ - -/* resume_instr_handler : */ -/* | LPAR TAG var var RPAR resume_instr_handler */ -/* { fun c -> ($3 c tag, $4 c label) :: $6 c } */ -/* | /\* empty *\/ */ -/* { fun c -> [] } */ - resume_instr_instr : | RESUME resume_instr_handler_instr { let at1 = ati 1 in fun c -> let hs, es = $2 c in resume hs @@ at1, es } + | RESUME_THROW var resume_instr_handler_instr + { let at1 = ati 1 in + fun c -> + let tag = $2 c tag in + let hs, es = $3 c in resume_throw tag hs @@ at1, es } resume_instr_handler_instr : | LPAR TAG var var RPAR resume_instr_handler_instr @@ -719,6 +713,11 @@ expr1 : /* Sugar */ fun c -> let x, es = $2 c in es, return_call_indirect (0l @@ at1) x } | RESUME resume_expr_handler { fun c -> let hs, es = $2 c in es, resume hs } + | RESUME_THROW var resume_expr_handler + { fun c -> + let tag = $2 c tag in + let hs, es = $3 c in + es, resume_throw tag hs } | BLOCK labeling_opt block { fun c -> let c' = $2 c [] in let bt, es = $3 c' in [], block bt es } | LOOP labeling_opt block diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 0eeb0beac..e4e8dec64 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -156,7 +156,6 @@ let check_def_type (c : context) (dt : def_type) at = | DefContT ct -> check_cont_type c ct at - (* Stack typing *) (* @@ -325,6 +324,24 @@ let check_memop (c : context) (memop : ('t, 's) memop) ty_size get_sz at = * declarative typing rules. *) +let check_resume_table (c : context) ts2 (xys : (idx * idx) list) at = + List.iter (fun (x1, x2) -> + let TagT x1' = tag c x1 in + let FuncT (ts3, ts4) = func_type c (as_stat_var x1' @@ x1.at) in + let (_, ts') = label c x2 in + match Lib.List.last_opt ts' with + | Some (RefT (nul', DefHT (Stat y'))) -> + let ContT z' = cont_type c (y' @@ x2.at) in + let ft' = func_type c (as_stat_var z' @@ x2.at) in + require (match_func_type c.types (FuncT (ts4, ts2)) ft') x2.at + "type mismatch in continuation type"; + check_stack c (ts3 @ [RefT (nul', DefHT (Stat y'))]) ts' x2.at + | _ -> + error at + ("type mismatch: instruction requires continuation reference type" ^ + " but label has " ^ string_of_result_type ts') + ) xys + let check_block_type (c : context) (bt : block_type) at : instr_type = match bt with | ValBlockType None -> InstrT ([], [], []) @@ -511,22 +528,7 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in | nul, DefHT (Stat y) -> let ContT z = cont_type c (y @@ e.at) in let FuncT (ts1, ts2) = func_type c (as_stat_var z @@ e.at) in - List.iter (fun (x1, x2) -> - let TagT x1' = tag c x1 in - let FuncT (ts3, ts4) = func_type c (as_stat_var x1' @@ x1.at) in - let (_, ts') = label c x2 in - match Lib.List.last_opt ts' with - | Some (RefT (nul', DefHT (Stat y'))) -> - let ContT z' = cont_type c (y' @@ x2.at) in - let ft' = func_type c (as_stat_var z' @@ x2.at) in - require (match_func_type c.types (FuncT (ts4, ts2)) ft') x2.at - "type mismatch in continuation type"; - check_stack c (ts3 @ [RefT (nul', DefHT (Stat y'))]) ts' x2.at - | _ -> - error e.at - ("type mismatch: instruction requires continuation reference type" ^ - " but label has " ^ string_of_result_type ts') - ) xys; + check_resume_table c ts2 xys e.at; (ts1 @ [RefT (nul, DefHT (Stat y))]) --> ts2, [] | _, BotHT -> [] -->... [], [] @@ -536,13 +538,14 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in " but stack has " ^ string_of_val_type (RefT rt)) ) - | ResumeThrow x -> + | ResumeThrow (x, xys) -> let TagT x' = tag c x in let FuncT (ts0, _) = func_type c (as_stat_var x' @@ x.at) in (match peek_ref 0 s e.at with | nul, DefHT (Stat y) -> let ContT z = cont_type c (y @@ e.at) in let FuncT (ts1, ts2) = func_type c (as_stat_var z @@ e.at) in + check_resume_table c ts2 xys e.at; (ts0 @ [RefT (nul, DefHT (Stat y))]) --> ts2, [] | _, BotHT -> [] -->... [], [] From 5331635502d3a670903f04112c84172ad3f81056 Mon Sep 17 00:00:00 2001 From: Matija Pretnar Date: Mon, 10 Apr 2023 17:41:34 +0200 Subject: [PATCH 55/82] Fix all examples apart from delimited control (#27) - replaced exceptions with tags - removed let blocks - removed now unnecessary (unreachable)s The output of all examples is as before. --- .../continuations/examples/actor-lwt.wast | 60 ++++----- proposals/continuations/examples/actor.wast | 56 ++++----- .../continuations/examples/async-await.wast | 59 ++++----- .../continuations/examples/fun-actor-lwt.wast | 118 +++++++++--------- proposals/continuations/examples/fun-lwt.wast | 16 +-- 5 files changed, 153 insertions(+), 156 deletions(-) diff --git a/proposals/continuations/examples/actor-lwt.wast b/proposals/continuations/examples/actor-lwt.wast index ead651eea..160072c09 100644 --- a/proposals/continuations/examples/actor-lwt.wast +++ b/proposals/continuations/examples/actor-lwt.wast @@ -73,7 +73,7 @@ (table $queue 0 (ref null $cont)) (memory 1) - (exception $too-many-mailboxes) + (tag $too-many-mailboxes) (global $qdelta i32 (i32.const 10)) @@ -190,8 +190,8 @@ (func $log (import "spectest" "print_i32") (param i32)) - (exception $too-many-mailboxes) - (exception $too-many-messages) + (tag $too-many-mailboxes) + (tag $too-many-messages) (memory 1) @@ -397,8 +397,8 @@ ;; -1 means empty - (exception $too-many-mailboxes) - (exception $too-many-messages) + (tag $too-many-mailboxes) + (tag $too-many-messages) (memory 1) @@ -489,6 +489,10 @@ (elem declare func $actk) (func $actk (param $mine i32) (param $nextk (ref $cont)) + (local $ik (ref $i-cont)) + (local $k (ref $cont)) + (local $you (ref $cont)) + (local $yours i32) (loop $l (block $on_self (result (ref $i-cont)) (block $on_spawn (result (ref $cont) (ref $i-cont)) @@ -502,39 +506,35 @@ ) (return) ) ;; $on_recv (result (ref $i-cont)) - (let (local $ik (ref $i-cont)) - ;; block this thread until the mailbox is non-empty - (loop $blocked - (if (call $empty-mb (local.get $mine)) - (then (suspend $yield) - (br $blocked)) - ) + (local.set $ik) + ;; block this thread until the mailbox is non-empty + (loop $blocked + (if (call $empty-mb (local.get $mine)) + (then (suspend $yield) + (br $blocked)) ) - (local.set $nextk (cont.bind (type $cont) (call $recv-from-mb (local.get $mine)) (local.get $ik))) ) + (local.set $nextk (cont.bind (type $cont) (call $recv-from-mb (local.get $mine)) (local.get $ik))) (br $l) ) ;; $on_send (result i32 i32 (ref $cont)) - (let (param i32 i32) (local $k (ref $cont)) - (call $send-to-mb) - (local.set $nextk (local.get $k)) - ) + (local.set $k) + (call $send-to-mb) + (local.set $nextk (local.get $k)) (br $l) ) ;; $on_spawn (result (ref $cont) (ref $i-cont)) - (let (local $you (ref $cont)) (local $ik (ref $i-cont)) - (call $new-mb) - (let (local $yours i32) - (suspend $fork (cont.bind (type $cont) - (local.get $yours) - (local.get $you) - (cont.new (type $ic-cont) (ref.func $actk)))) - (local.set $nextk (cont.bind (type $cont) (local.get $yours) (local.get $ik))) - ) - ) + (local.set $ik) + (local.set $you) + (call $new-mb) + (local.set $yours) + (suspend $fork (cont.bind (type $cont) + (local.get $yours) + (local.get $you) + (cont.new (type $ic-cont) (ref.func $actk)))) + (local.set $nextk (cont.bind (type $cont) (local.get $yours) (local.get $ik))) (br $l) ) ;; $on_self (result (ref $i-cont)) - (let (local $ik (ref $i-cont)) - (local.set $nextk (cont.bind (type $cont) (local.get $mine) (local.get $ik))) - ) + (local.set $ik) + (local.set $nextk (cont.bind (type $cont) (local.get $mine) (local.get $ik))) (br $l) ) ) diff --git a/proposals/continuations/examples/actor.wast b/proposals/continuations/examples/actor.wast index 3a8d36f48..9f86e8e0d 100644 --- a/proposals/continuations/examples/actor.wast +++ b/proposals/continuations/examples/actor.wast @@ -73,7 +73,7 @@ (table $queue 0 (ref null $cont)) (memory 1) - (exception $too-many-mailboxes) + (tag $too-many-mailboxes) (global $qdelta i32 (i32.const 10)) @@ -190,8 +190,8 @@ (func $log (import "spectest" "print_i32") (param i32)) - (exception $too-many-mailboxes) - (exception $too-many-messages) + (tag $too-many-mailboxes) + (tag $too-many-messages) (memory 1) @@ -317,6 +317,10 @@ (func $run (export "run") (param $nextk (ref null $cont)) (local $mine i32) ;; current mailbox + (local $ik (ref $i-cont)) + (local $k (ref $cont)) + (local $you (ref $cont)) + (local $yours i32) (call $init) (local.set $mine (call $new-mb)) (loop $l @@ -335,38 +339,34 @@ (local.set $nextk (call $dequeue-k)) (br $l) ) ;; $on_recv (result (ref $i-cont)) - (let (local $ik (ref $i-cont)) - ;; block this thread until the mailbox is non-empty - (if (call $empty-mb (local.get $mine)) - (then (call $enqueue-mb (local.get $mine)) - (call $enqueue-k (call $recv-again (local.get $ik))) - (local.set $mine (call $dequeue-mb)) - (local.set $nextk (call $dequeue-k)) - (br $l)) - ) - (local.set $nextk (cont.bind (type $cont) (call $recv-from-mb (local.get $mine)) (local.get $ik))) + (local.set $ik) + ;; block this thread until the mailbox is non-empty + (if (call $empty-mb (local.get $mine)) + (then (call $enqueue-mb (local.get $mine)) + (call $enqueue-k (call $recv-again (local.get $ik))) + (local.set $mine (call $dequeue-mb)) + (local.set $nextk (call $dequeue-k)) + (br $l)) ) + (local.set $nextk (cont.bind (type $cont) (call $recv-from-mb (local.get $mine)) (local.get $ik))) (br $l) ) ;; $on_send (result i32 i32 (ref $cont)) - (let (param i32 i32) (local $k (ref $cont)) - (call $send-to-mb) - (local.set $nextk (local.get $k)) - ) + (local.set $k) + (call $send-to-mb) + (local.set $nextk (local.get $k)) (br $l) ) ;; $on_spawn (result (ref $cont) (ref $i-cont)) - (let (local $you (ref $cont)) (local $ik (ref $i-cont)) - (call $new-mb) - (let (local $yours i32) - (call $enqueue-mb (local.get $yours)) - (call $enqueue-k (local.get $you)) - (local.set $nextk (cont.bind (type $cont) (local.get $yours) (local.get $ik))) - ) - ) + (local.set $ik) + (local.set $you) + (call $new-mb) + (local.set $yours) + (call $enqueue-mb (local.get $yours)) + (call $enqueue-k (local.get $you)) + (local.set $nextk (cont.bind (type $cont) (local.get $yours) (local.get $ik))) (br $l) ) ;; $on_self (result (ref $i-cont)) - (let (local $ik (ref $i-cont)) - (local.set $nextk (cont.bind (type $cont) (local.get $mine) (local.get $ik))) - ) + (local.set $ik) + (local.set $nextk (cont.bind (type $cont) (local.get $mine) (local.get $ik))) (br $l) ) ) diff --git a/proposals/continuations/examples/async-await.wast b/proposals/continuations/examples/async-await.wast index 514ed4170..fa2ea9dcf 100644 --- a/proposals/continuations/examples/async-await.wast +++ b/proposals/continuations/examples/async-await.wast @@ -163,8 +163,8 @@ ;; a simplistic implementation of promises that assumes a maximum of ;; 1000 promises and a maximum of one observer per promise - (exception $too-many-promises) - (exception $too-many-observers) + (tag $too-many-promises) + (tag $too-many-observers) (global $num-promises (mut i32) (i32.const 0)) (global $max-promises i32 (i32.const 1000)) @@ -254,6 +254,11 @@ (func $fulfill-promise (import "promise" "fulfill") (param $p i32) (param $v i32) (result (ref null $cont))) (func $run (export "run") (param $nextk (ref null $cont)) + (local $p i32) + (local $v i32) + (local $ik (ref $i-cont)) + (local $ak (ref $i-cont)) + (local $k (ref null $cont)) (loop $l (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) @@ -269,38 +274,36 @@ (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated ) ;; $on_await (result i32 (ref $i-cont)) - (let (local $p i32) (local $ik (ref $i-cont)) - (if (call $promise-fulfilled (local.get $p)) - ;; if promise fulfilled then run continuation partially applied to value - (then (local.set $nextk (cont.bind (type $cont) (call $promise-value (local.get $p)) (local.get $ik)))) - ;; else add continuation to promise and run next continuation from the queue - (else (call $await-promise (local.get $p) (local.get $ik)) - (local.set $nextk (call $dequeue))) - ) + (local.set $ik) + (local.set $p) + (if (call $promise-fulfilled (local.get $p)) + ;; if promise fulfilled then run continuation partially applied to value + (then (local.set $nextk (cont.bind (type $cont) (call $promise-value (local.get $p)) (local.get $ik)))) + ;; else add continuation to promise and run next continuation from the queue + (else (call $await-promise (local.get $p) (local.get $ik)) + (local.set $nextk (call $dequeue))) ) (br $l) ) ;; $on_async (result (ref $i-func) (ref $i-cont)) - (let (local $ak (ref $i-cont)) (local $ik (ref $i-cont)) - ;; create new promise - (call $new-promise) - (let (local $p i32) - ;; enqueue continuation partially applied to promise - (call $enqueue (cont.bind (type $cont) (local.get $p) (local.get $ik))) - ;; run computation partially applied to promise - (local.set $nextk (cont.bind (type $cont) (local.get $p) (local.get $ak))) - ) - ) + (local.set $ik) + (local.set $ak) + ;; create new promise + (call $new-promise) + (local.set $p) + ;; enqueue continuation partially applied to promise + (call $enqueue (cont.bind (type $cont) (local.get $p) (local.get $ik))) + ;; run computation partially applied to promise + (local.set $nextk (cont.bind (type $cont) (local.get $p) (local.get $ak))) (br $l) ) ;; $on_fulfill (result i32 i32 (ref $cont)) (local.set $nextk) - (let (local $p i32) (local $v i32) - (call $fulfill-promise (local.get $p) (local.get $v)) - (let (local $k (ref null $cont)) - (if (ref.is_null (local.get $k)) - (then) - (else (call $enqueue (local.get $k))) - ) - ) + (local.set $v) + (local.set $p) + (call $fulfill-promise (local.get $p) (local.get $v)) + (local.set $k) + (if (ref.is_null (local.get $k)) + (then) + (else (call $enqueue (local.get $k))) ) (br $l) ) ;; $on_yield (result (ref $cont)) diff --git a/proposals/continuations/examples/fun-actor-lwt.wast b/proposals/continuations/examples/fun-actor-lwt.wast index 2b1f95fd8..d79296fa8 100644 --- a/proposals/continuations/examples/fun-actor-lwt.wast +++ b/proposals/continuations/examples/fun-actor-lwt.wast @@ -169,8 +169,8 @@ ;; -1 means empty - (exception $too-many-mailboxes) - (exception $too-many-messages) + (tag $too-many-mailboxes) + (tag $too-many-messages) (memory 1) @@ -253,6 +253,9 @@ ;; resume with $ik applied to $res (func $act-res (param $mine i32) (param $res i32) (param $ik (ref $i-cont)) + (local $yours i32) + (local $k (ref $cont)) + (local $you (ref $cont)) (block $on_self (result (ref $i-cont)) (block $on_spawn (result (ref $cont) (ref $i-cont)) (block $on_send (result i32 i32 (ref $cont)) @@ -267,45 +270,42 @@ ) (return) ) ;; $on_recv (result (ref $i-cont)) - (let (local $ik (ref $i-cont)) - ;; block this thread until the mailbox is non-empty - (loop $l - (if (call $empty-mb (local.get $mine)) - (then (suspend $yield) - (br $l)) - ) + (local.set $ik) + ;; block this thread until the mailbox is non-empty + (loop $l + (if (call $empty-mb (local.get $mine)) + (then (suspend $yield) + (br $l)) ) - (call $recv-from-mb (local.get $mine)) - (local.set $res) - (return_call $act-res (local.get $mine) (local.get $res) (local.get $ik))) - (unreachable) + ) + (call $recv-from-mb (local.get $mine)) + (local.set $res) + (return_call $act-res (local.get $mine) (local.get $res) (local.get $ik)) ) ;; $on_send (result i32 i32 (ref $cont)) - (let (param i32 i32) (local $k (ref $cont)) - (call $send-to-mb) - (return_call $act-nullary (local.get $mine) (local.get $k))) - (unreachable) + (local.set $k) + (call $send-to-mb) + (return_call $act-nullary (local.get $mine) (local.get $k)) ) ;; $on_spawn (result (ref $cont) (ref $i-cont)) - (let (local $you (ref $cont)) (local $ik (ref $i-cont)) - (call $new-mb) - (let (local $yours i32) - (suspend $fork (cont.bind (type $cont) - (local.get $yours) - (local.get $you) - (cont.new (type $icont-cont) (ref.func $act-nullary)))) - (return_call $act-res (local.get $mine) (local.get $yours) (local.get $ik)) - ) - ) - (unreachable) + (local.set $ik) + (local.set $you) + (call $new-mb) + (local.set $yours) + (suspend $fork (cont.bind (type $cont) + (local.get $yours) + (local.get $you) + (cont.new (type $icont-cont) (ref.func $act-nullary)))) + (return_call $act-res (local.get $mine) (local.get $yours) (local.get $ik)) ) ;; $on_self (result (ref $i-cont)) - (let (local $ik (ref $i-cont)) - (return_call $act-res (local.get $mine) (local.get $mine) (local.get $ik)) - ) - (unreachable) + (local.set $ik) + (return_call $act-res (local.get $mine) (local.get $mine) (local.get $ik)) ) ;; resume with nullary continuation (func $act-nullary (param $mine i32) (param $k (ref $cont)) (local $res i32) + (local $ik (ref $i-cont)) + (local $you (ref $cont)) + (local $yours i32) (block $on_self (result (ref $i-cont)) (block $on_spawn (result (ref $cont) (ref $i-cont)) (block $on_send (result i32 i32 (ref $cont)) @@ -320,40 +320,34 @@ ) (return) ) ;; $on_recv (result (ref $i-cont)) - (let (local $ik (ref $i-cont)) - ;; block this thread until the mailbox is non-empty - (loop $l - (if (call $empty-mb (local.get $mine)) - (then (suspend $yield) - (br $l)) - ) + (local.set $ik) + ;; block this thread until the mailbox is non-empty + (loop $l + (if (call $empty-mb (local.get $mine)) + (then (suspend $yield) + (br $l)) ) - (call $recv-from-mb (local.get $mine)) - (local.set $res) - (return_call $act-res (local.get $mine) (local.get $res) (local.get $ik))) - (unreachable) + ) + (call $recv-from-mb (local.get $mine)) + (local.set $res) + (return_call $act-res (local.get $mine) (local.get $res) (local.get $ik)) ) ;; $on_send (result i32 i32 (ref $cont)) - (let (param i32 i32) (local $k (ref $cont)) - (call $send-to-mb) - (return_call $act-nullary (local.get $mine) (local.get $k))) - (unreachable) + (local.set $k) + (call $send-to-mb) + (return_call $act-nullary (local.get $mine) (local.get $k)) ) ;; $on_spawn (result (ref $cont) (ref $i-cont)) - (let (local $you (ref $cont)) (local $ik (ref $i-cont)) - (call $new-mb) - (let (local $yours i32) - (suspend $fork (cont.bind (type $cont) - (local.get $yours) - (local.get $you) - (cont.new (type $icont-cont) (ref.func $act-nullary)))) - (return_call $act-res (local.get $mine) (local.get $yours) (local.get $ik)) - ) - ) - (unreachable) + (local.set $ik) + (local.set $you) + (call $new-mb) + (local.set $yours) + (suspend $fork (cont.bind (type $cont) + (local.get $yours) + (local.get $you) + (cont.new (type $icont-cont) (ref.func $act-nullary)))) + (return_call $act-res (local.get $mine) (local.get $yours) (local.get $ik)) ) ;; $on_self (result (ref $i-cont)) - (let (local $ik (ref $i-cont)) - (return_call $act-res (local.get $mine) (local.get $mine) (local.get $ik)) - ) - (unreachable) + (local.set $ik) + (return_call $act-res (local.get $mine) (local.get $mine) (local.get $ik)) ) (func $act (export "act") (param $k (ref $cont)) diff --git a/proposals/continuations/examples/fun-lwt.wast b/proposals/continuations/examples/fun-lwt.wast index 0da82ee55..943b8804f 100644 --- a/proposals/continuations/examples/fun-lwt.wast +++ b/proposals/continuations/examples/fun-lwt.wast @@ -139,9 +139,9 @@ ) (return_call $sync (call $dequeue)) ) ;; $on_fork (result (ref $func) (ref $cont)) - (let (param (ref $cont)) (result (ref $cont)) (local $nextk (ref $cont)) + (local.set $nextk) (call $enqueue) - (return_call $sync (local.get $nextk))) + (return_call $sync (local.get $nextk)) ) ;; $on_yield (result (ref $cont)) (return_call $sync) ) @@ -166,9 +166,9 @@ ) (return_call $tk (call $dequeue)) ) ;; $on_fork (result (ref $func) (ref $cont)) - (let (param (ref $cont)) (result (ref $cont)) (local $nextk (ref $cont)) + (local.set $nextk) (call $enqueue) - (return_call $tk (local.get $nextk))) + (return_call $tk (local.get $nextk)) ) ;; $on_yield (result (ref $cont)) (call $enqueue) (return_call $tk (call $dequeue)) @@ -213,16 +213,16 @@ ;; yield on fork, new thread first (func $ytk (export "ytk") (param $nextk (ref null $cont)) + (local $k (ref $cont)) (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) (resume (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk)) (return_call $ytk (call $dequeue)) ) ;; $on_fork (result (ref $cont) (ref $cont)) - (let (param (ref $cont)) (local $k (ref $cont)) - (call $enqueue) - (call $enqueue (local.get $k)) - ) + (local.set $k) + (call $enqueue) + (call $enqueue (local.get $k)) (return_call $ytk (call $dequeue)) ) ;; $on_yield (result (ref $cont)) (call $enqueue) From 2877ce4ae25bf785c96d43bee2eb84db20dbe9bc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Mon, 10 Apr 2023 18:23:12 +0200 Subject: [PATCH 56/82] Change opcode for cont (#28) --- interpreter/binary/decode.ml | 2 +- interpreter/binary/encode.ml | 5 ++++- 2 files changed, 5 insertions(+), 2 deletions(-) diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index 604b3f26d..ca2c2020e 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -206,7 +206,7 @@ let cont_type s = let def_type s = match s7 s with | -0x20 -> DefFuncT (func_type s) - | -0x21 -> DefContT (cont_type s) + | -0x23 -> DefContT (cont_type s) (* TODO(dhil): See comment in encode.ml *) | _ -> error s (pos s - 1) "malformed definition type" diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 2745ae8a9..85ac41967 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -134,7 +134,10 @@ struct let def_type = function | DefFuncT ft -> s7 (-0x20); func_type ft - | DefContT ct -> s7 (-0x21); cont_type ct (* TODO(dhil): I think the GC proposal claims opcode -0x21 for one of the struct/array types. *) + | DefContT ct -> s7 (-0x23); cont_type ct + (* TODO(dhil): This might need to change again in the future as a + different proposal might claim this opcode! GC proposal claimed + the previous opcode we were using. *) let limits vu {min; max} = bool (max <> None); vu min; opt vu max From 7ad4f4b7089de53314412c0c478a03f3f0587fd2 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Mon, 10 Apr 2023 23:35:51 +0200 Subject: [PATCH 57/82] Add type annotations to continuation instructions (#29) * Add type annotations to continuation instructions This patch annotates the following continuation instructions with a continuation type: * `cont.bind $src $dst`: The annotation `$src` specifies the type of the source continuation, and `$dst` specifices the type of the target continuation (i.e. the continuation type after the partial continuation application). The latter type annotation was already present. * `resume $kt`: The annotation `$kt` specifices the type of the continuation argument to `resume`. * `resume $kt $tagt`: The annotation `$kt` specifies the type of the continuation argument to `resume_throw`, whilst `$tagt` specifices the type of the tag argument. The latter type annotation was already present. This patch also drops the verbose `(type $t)` syntax on continuation instructions in favour of simply `$t`. * Update interpreter/valid/valid.ml Co-authored-by: Andreas Rossberg * Update interpreter/valid/valid.ml Co-authored-by: Andreas Rossberg * Address Andreas' comments. * Update interpreter/valid/valid.ml Co-authored-by: Andreas Rossberg * Update interpreter/valid/valid.ml Co-authored-by: Andreas Rossberg * Address Andreas' feedback 2 --------- Co-authored-by: Andreas Rossberg --- interpreter/binary/decode.ml | 17 +++++-- interpreter/binary/encode.ml | 6 +-- interpreter/exec/eval.ml | 22 ++++----- interpreter/syntax/ast.ml | 6 +-- interpreter/syntax/free.ml | 7 +-- interpreter/syntax/operators.ml | 6 +-- interpreter/text/arrange.ml | 12 ++--- interpreter/text/parser.mly | 32 +++++++----- interpreter/valid/valid.ml | 76 +++++++++-------------------- test/core/cont.wast | 86 ++++++++++++++++----------------- 10 files changed, 128 insertions(+), 142 deletions(-) diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index ca2c2020e..c64a757d8 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -570,13 +570,20 @@ let rec instr s = | 0xd6 -> br_on_non_null (at var s) | 0xe0 -> cont_new (at var s) - | 0xe1 -> cont_bind (at var s) + | 0xe1 -> + let x = at var s in + let y = at var s in + cont_bind x y | 0xe2 -> suspend (at var s) - | 0xe3 -> resume (vec var_pair s) + | 0xe3 -> + let x = at var s in + let xls = vec var_pair s in + resume x xls | 0xe4 -> - let tag = at var s in - let xls = vec var_pair s in - resume_throw tag xls + let x = at var s in + let tag = at var s in + let xls = vec var_pair s in + resume_throw x tag xls | 0xe5 -> let bt = block_type s in let es' = instr_block s in diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 85ac41967..0c65cdbdf 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -233,10 +233,10 @@ struct | ContNew x -> op 0xe0; var x - | ContBind x -> op 0xe1; var x + | ContBind (x, y) -> op 0xe1; var x; var y | Suspend x -> op 0xe2; var x - | Resume xls -> op 0xe3; vec var_pair xls - | ResumeThrow (x, xls) -> op 0xe4; var x; vec var_pair xls + | Resume (x, xls) -> op 0xe3; var x; vec var_pair xls + | ResumeThrow (x, y, xls) -> op 0xe4; var x; var y; vec var_pair xls | Barrier (bt, es) -> op 0xe5; block_type bt; list instr es; end_ () | Drop -> op 0x1a diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index ccc9f6782..22742cd53 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -318,14 +318,14 @@ let rec step (c : config) : config = let ctxt code = compose code ([], [Invoke f @@ e.at]) in Ref (ContRef (ref (Some (Lib.List32.length ts, ctxt)))) :: vs, [] - | ContBind x, Ref (NullRef _) :: vs -> + | ContBind (x, y), Ref (NullRef _) :: vs -> vs, [Trapping "null continuation reference" @@ e.at] - | ContBind x, Ref (ContRef {contents = None}) :: vs -> + | ContBind (x, y), Ref (ContRef {contents = None}) :: vs -> vs, [Trapping "continuation already consumed" @@ e.at] - | ContBind x, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> - let ContT z = cont_type c.frame.inst x in + | ContBind (x, y), Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> + let ContT z = cont_type c.frame.inst y in let FuncT (ts', _) = as_func_def_type (def_of (as_dyn_var z)) in let args, vs' = try split (Int32.sub n (Lib.List32.length ts')) vs e.at @@ -342,26 +342,26 @@ let rec step (c : config) : config = let args, vs' = split (Lib.List32.length ts) vs e.at in vs', [Suspending (tagt, args, fun code -> code) @@ e.at] - | Resume xls, Ref (NullRef _) :: vs -> + | Resume (x, xls), Ref (NullRef _) :: vs -> vs, [Trapping "null continuation reference" @@ e.at] - | Resume xls, Ref (ContRef {contents = None}) :: vs -> + | Resume (x, xls), Ref (ContRef {contents = None}) :: vs -> vs, [Trapping "continuation already consumed" @@ e.at] - | Resume xls, Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> + | Resume (x, xls), Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> let hs = List.map (fun (x, l) -> tag c.frame.inst x, l) xls in let args, vs' = split n vs e.at in cont := None; vs', [Handle (Some hs, ctxt (args, [])) @@ e.at] - | ResumeThrow (x, xls), Ref (NullRef _) :: vs -> + | ResumeThrow (x, y, xls), Ref (NullRef _) :: vs -> vs, [Trapping "null continuation reference" @@ e.at] - | ResumeThrow (x, xls), Ref (ContRef {contents = None}) :: vs -> + | ResumeThrow (x, y, xls), Ref (ContRef {contents = None}) :: vs -> vs, [Trapping "continuation already consumed" @@ e.at] - | ResumeThrow (x, xls), Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> - let tagt = tag c.frame.inst x in + | ResumeThrow (x, y, xls), Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> + let tagt = tag c.frame.inst y in let TagT x' = Tag.type_of tagt in let FuncT (ts, _) = as_func_def_type (def_of (as_dyn_var x')) in let hs = List.map (fun (x, l) -> tag c.frame.inst x, l) xls in diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml index ee511ee94..4b605fa40 100644 --- a/interpreter/syntax/ast.ml +++ b/interpreter/syntax/ast.ml @@ -166,10 +166,10 @@ and instr' = | ReturnCallRef of idx (* tail call through reference *) | ReturnCallIndirect of idx * idx (* tail-call function through table *) | ContNew of idx (* create continuation *) - | ContBind of idx (* bind continuation arguments *) + | ContBind of idx * idx (* bind continuation arguments *) | Suspend of idx (* suspend continuation *) - | Resume of (idx * idx) list (* resume continuation *) - | ResumeThrow of idx * (idx * idx) list (* abort continuation *) + | Resume of idx * (idx * idx) list (* resume continuation *) + | ResumeThrow of idx * idx * (idx * idx) list (* abort continuation *) | Barrier of block_type * instr list (* guard against suspension *) | LocalGet of idx (* read local idxiable *) | LocalSet of idx (* write local idxiable *) diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml index 2d669cdf9..e797da6d2 100644 --- a/interpreter/syntax/free.ml +++ b/interpreter/syntax/free.ml @@ -121,7 +121,8 @@ let rec instr (e : instr) = | CallRef x | ReturnCallRef x -> types (idx x) | CallIndirect (x, y) | ReturnCallIndirect (x, y) -> tables (idx x) ++ types (idx y) - | ContNew x | ContBind x -> types (idx x) + | ContNew x -> types (idx x) + | ContBind (x, y) -> types (idx x) ++ types (idx y) | TryCatch (bt, es, ct, ca) -> let catch (tag, es) = tags (idx tag) ++ block es in let catch_all = function @@ -131,8 +132,8 @@ let rec instr (e : instr) = | TryDelegate (bt, es, x) -> block es ++ tags (idx x) | Throw x | Suspend x -> tags (idx x) | Rethrow x -> labels (idx x) - | ResumeThrow (x, xys) -> tags (idx x) ++ list (fun (x, y) -> tags (idx x) ++ labels (idx y)) xys - | Resume xys -> list (fun (x, y) -> tags (idx x) ++ labels (idx y)) xys + | ResumeThrow (x, y, xys) -> types (idx x) ++ tags (idx y) ++ list (fun (x, y) -> tags (idx x) ++ labels (idx y)) xys + | Resume (x, xys) -> types (idx x) ++ list (fun (x, y) -> tags (idx x) ++ labels (idx y)) xys | LocalGet x | LocalSet x | LocalTee x -> locals (idx x) | GlobalGet x | GlobalSet x -> globals (idx x) | TableGet x | TableSet x | TableSize x | TableGrow x | TableFill x -> diff --git a/interpreter/syntax/operators.ml b/interpreter/syntax/operators.ml index b794e30bf..fc05f7e53 100644 --- a/interpreter/syntax/operators.ml +++ b/interpreter/syntax/operators.ml @@ -44,10 +44,10 @@ let return_call_ref x = ReturnCallRef x let return_call_indirect x y = ReturnCallIndirect (x, y) let cont_new x = ContNew x -let cont_bind x = ContBind x +let cont_bind x y = ContBind (x, y) let suspend x = Suspend x -let resume xys = Resume xys -let resume_throw x xys = ResumeThrow (x, xys) +let resume x xys = Resume (x, xys) +let resume_throw x y xys = ResumeThrow (x, y, xys) let barrier bt es = Barrier (bt, es) let local_get x = LocalGet x diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index 5bb4b30fe..78c54e273 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -480,14 +480,14 @@ let rec instr e = | ReturnCallRef x -> "return_call_ref " ^ var x, [] | ReturnCallIndirect (x, y) -> "return_call_indirect " ^ var x, [Node ("type " ^ var y, [])] - | ContNew x -> "cont.new", [Node ("type " ^ var x, [])] - | ContBind x -> "cont.bind", [Node ("type " ^ var x, [])] + | ContNew x -> "cont.new " ^ var x, [] + | ContBind (x, y) -> "cont.bind " ^ var x ^ " " ^ var y, [] | Suspend x -> "suspend " ^ var x, [] - | Resume xys -> - "resume", + | Resume (x, xys) -> + "resume " ^ var x, List.map (fun (x, y) -> Node ("tag " ^ var x ^ " " ^ var y, [])) xys - | ResumeThrow (x, xys) -> - "resume_throw " ^ var x, + | ResumeThrow (x, y, xys) -> + "resume_throw " ^ var x ^ " " ^ var y, List.map (fun (x, y) -> Node ("tag " ^ var x ^ " " ^ var y, [])) xys | Barrier (bt, es) -> "barrier", block_type bt @ list instr es | LocalGet x -> "local.get " ^ var x, [] diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index 708a5ca30..6f458cfe0 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -473,8 +473,8 @@ plain_instr : | CALL_REF var { fun c -> call_ref ($2 c type_) } | RETURN_CALL var { fun c -> return_call ($2 c func) } | RETURN_CALL_REF var { fun c -> return_call_ref ($2 c type_) } - | CONT_NEW LPAR TYPE var RPAR { fun c -> cont_new ($4 c type_) } - | CONT_BIND LPAR TYPE var RPAR { fun c -> cont_bind ($4 c type_) } + | CONT_NEW var { fun c -> cont_new ($2 c type_) } + | CONT_BIND var var { fun c -> cont_bind ($2 c type_) ($3 c type_) } | SUSPEND var { fun c -> suspend ($2 c tag) } | LOCAL_GET var { fun c -> local_get ($2 c local) } | LOCAL_SET var { fun c -> local_set ($2 c local) } @@ -630,14 +630,17 @@ catch_all : | CATCH_ALL instr_list { $2 } resume_instr_instr : - | RESUME resume_instr_handler_instr + | RESUME var resume_instr_handler_instr { let at1 = ati 1 in - fun c -> let hs, es = $2 c in resume hs @@ at1, es } - | RESUME_THROW var resume_instr_handler_instr + fun c -> + let x = $2 c type_ in + let hs, es = $3 c in resume x hs @@ at1, es } + | RESUME_THROW var var resume_instr_handler_instr { let at1 = ati 1 in fun c -> - let tag = $2 c tag in - let hs, es = $3 c in resume_throw tag hs @@ at1, es } + let x = $2 c type_ in + let tag = $3 c tag in + let hs, es = $4 c in resume_throw x tag hs @@ at1, es } resume_instr_handler_instr : | LPAR TAG var var RPAR resume_instr_handler_instr @@ -711,13 +714,16 @@ expr1 : /* Sugar */ | RETURN_CALL_INDIRECT call_expr_type /* Sugar */ { let at1 = ati 1 in fun c -> let x, es = $2 c in es, return_call_indirect (0l @@ at1) x } - | RESUME resume_expr_handler - { fun c -> let hs, es = $2 c in es, resume hs } - | RESUME_THROW var resume_expr_handler + | RESUME var resume_expr_handler + { fun c -> + let x = $2 c type_ in + let hs, es = $3 c in es, resume x hs } + | RESUME_THROW var var resume_expr_handler { fun c -> - let tag = $2 c tag in - let hs, es = $3 c in - es, resume_throw tag hs } + let x = $2 c type_ in + let tag = $3 c tag in + let hs, es = $4 c in + es, resume_throw x tag hs } | BLOCK labeling_opt block { fun c -> let c' = $2 c [] in let bt, es = $3 c' in [], block bt es } | LOOP labeling_opt block diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index e4e8dec64..aae28d03f 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -174,7 +174,6 @@ type infer_instr_type = infer_func_type * idx list let stack ts = (NoEllipses, ts) let (-->) ts1 ts2 = {ins = NoEllipses, ts1; outs = NoEllipses, ts2} -let (-->..) ts1 ts2 = {ins = Ellipses, ts1; outs = NoEllipses, ts2} let (-->...) ts1 ts2 = {ins = Ellipses, ts1; outs = Ellipses, ts2} let check_stack (c : context) ts1 ts2 at = @@ -496,64 +495,37 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in [RefT (NoNull, DefHT y)] --> [RefT (NoNull, DefHT (Stat x.it))], [] - | ContBind x -> - (match peek_ref 0 s e.at with - | nul, DefHT (Stat y) -> - let ContT z = cont_type c (y @@ e.at) in - let FuncT (ts1, ts2) = func_type c (as_stat_var z @@ e.at) in - let ContT z' = cont_type c x in - let FuncT (ts1', _) as ft' = func_type c (as_stat_var z' @@ x.at) in - require (List.length ts1 >= List.length ts1') x.at - "type mismatch in continuation arguments"; - let ts11, ts12 = Lib.List.split (List.length ts1 - List.length ts1') ts1 in - require (match_func_type c.types (FuncT (ts12, ts2)) ft') e.at - "type mismatch in continuation type"; - (ts11 @ [RefT (nul, DefHT (Stat y))]) --> - [RefT (NoNull, DefHT (Stat x.it))], [] - | (_, BotHT) as rt -> - [RefT rt] -->.. [RefT (NoNull, DefHT (Stat x.it))], [] - | rt -> - error e.at - ("type mismatch: instruction requires continuation reference type" ^ - " but stack has " ^ string_of_val_type (RefT rt)) - ) + | ContBind (x, y) -> + let ContT z = cont_type c x in + let FuncT (ts1, ts2) = func_type c (as_stat_var z @@ e.at) in + let ContT z' = cont_type c y in + let FuncT (ts1', _) as ft' = func_type c (as_stat_var z' @@ e.at) in + require (List.length ts1 >= List.length ts1') x.at + "type mismatch in continuation arguments"; + let ts11, ts12 = Lib.List.split (List.length ts1 - List.length ts1') ts1 in + require (match_func_type c.types (FuncT (ts12, ts2)) ft') e.at + "type mismatch in continuation types"; + (ts11 @ [RefT (Null, DefHT (Stat x.it))]) --> + [RefT (NoNull, DefHT (Stat y.it))], [] | Suspend x -> let TagT x' = tag c x in let FuncT (ts1, ts2) = func_type c (as_stat_var x' @@ x.at) in ts1 --> ts2, [] - | Resume xys -> - (match peek_ref 0 s e.at with - | nul, DefHT (Stat y) -> - let ContT z = cont_type c (y @@ e.at) in - let FuncT (ts1, ts2) = func_type c (as_stat_var z @@ e.at) in - check_resume_table c ts2 xys e.at; - (ts1 @ [RefT (nul, DefHT (Stat y))]) --> ts2, [] - | _, BotHT -> - [] -->... [], [] - | rt -> - error e.at - ("type mismatch: instruction requires continuation reference type" ^ - " but stack has " ^ string_of_val_type (RefT rt)) - ) + | Resume (x, xys) -> + let ContT z = cont_type c x in + let FuncT (ts1, ts2) = func_type c (as_stat_var z @@ e.at) in + check_resume_table c ts2 xys e.at; + (ts1 @ [RefT (Null, DefHT (Stat x.it))]) --> ts2, [] - | ResumeThrow (x, xys) -> - let TagT x' = tag c x in - let FuncT (ts0, _) = func_type c (as_stat_var x' @@ x.at) in - (match peek_ref 0 s e.at with - | nul, DefHT (Stat y) -> - let ContT z = cont_type c (y @@ e.at) in - let FuncT (ts1, ts2) = func_type c (as_stat_var z @@ e.at) in - check_resume_table c ts2 xys e.at; - (ts0 @ [RefT (nul, DefHT (Stat y))]) --> ts2, [] - | _, BotHT -> - [] -->... [], [] - | rt -> - error e.at - ("type mismatch: instruction requires continuation reference type" ^ - " but stack has " ^ string_of_val_type (RefT rt)) - ) + | ResumeThrow (x, y, xys) -> + let ContT z = cont_type c x in + let FuncT (ts1, ts2) = func_type c (as_stat_var z @@ e.at) in + let TagT y' = tag c y in + let FuncT (ts0, _) = func_type c (as_stat_var y' @@ x.at) in + check_resume_table c ts2 xys e.at; + (ts0 @ [RefT (Null, DefHT (Stat x.it))]) --> ts2, [] | Barrier (bt, es) -> let InstrT (ts1, ts2, xs) as ft = check_block_type c bt e.at in diff --git a/test/core/cont.wast b/test/core/cont.wast index ae02ae2e7..041c4ab34 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -13,12 +13,12 @@ ) (func (export "unhandled-2") - (resume (cont.new (type $k1) (ref.func $f1))) + (resume $k1 (cont.new $k1 (ref.func $f1))) ) (func (export "unhandled-3") (block $h (result (ref $k1)) - (resume (tag $e2 $h) (cont.new (type $k1) (ref.func $f1))) + (resume $k1 (tag $e2 $h) (cont.new $k1 (ref.func $f1))) (unreachable) ) (drop) @@ -26,7 +26,7 @@ (func (export "handled") (block $h (result (ref $k1)) - (resume (tag $e1 $h) (cont.new (type $k1) (ref.func $f1))) + (resume $k1 (tag $e1 $h) (cont.new $k1 (ref.func $f1))) (unreachable) ) (drop) @@ -39,7 +39,7 @@ (func (export "uncaught-1") (block $h (result (ref $k1)) - (resume (tag $e1 $h) (cont.new (type $k1) (ref.func $f2))) + (resume $k1 (tag $e1 $h) (cont.new $k1 (ref.func $f2))) (unreachable) ) (drop) @@ -47,10 +47,10 @@ (func (export "uncaught-2") (block $h (result (ref $k1)) - (resume (tag $e1 $h) (cont.new (type $k1) (ref.func $f1))) + (resume $k1 (tag $e1 $h) (cont.new $k1 (ref.func $f1))) (unreachable) ) - (resume_throw $exn) + (resume_throw $k1 $exn) ) (elem declare func $f3) @@ -63,10 +63,10 @@ (func (export "barrier") (block $h (result (ref $k1)) - (resume (tag $e1 $h) (cont.new (type $k1) (ref.func $f3))) + (resume $k1 (tag $e1 $h) (cont.new $k1 (ref.func $f3))) (unreachable) ) - (resume_throw $exn) + (resume_throw $k1 $exn) ) (elem declare func $r0 $r1) @@ -74,47 +74,47 @@ (func $r1 (suspend $e1) (suspend $e1)) (func $nl1 (param $k (ref $k1)) - (resume (local.get $k)) - (resume (local.get $k)) + (resume $k1 (local.get $k)) + (resume $k1 (local.get $k)) ) (func $nl2 (param $k (ref $k1)) (block $h (result (ref $k1)) - (resume (tag $e1 $h) (local.get $k)) + (resume $k1 (tag $e1 $h) (local.get $k)) (unreachable) ) - (resume (local.get $k)) + (resume $k1 (local.get $k)) (unreachable) ) (func $nl3 (param $k (ref $k1)) (local $k' (ref null $k1)) (block $h1 (result (ref $k1)) - (resume (tag $e1 $h1) (local.get $k)) + (resume $k1 (tag $e1 $h1) (local.get $k)) (unreachable) ) (local.set $k') (block $h2 (result (ref $k1)) - (resume (tag $e1 $h2) (local.get $k')) + (resume $k1 (tag $e1 $h2) (local.get $k')) (unreachable) ) - (resume (local.get $k')) + (resume $k1 (local.get $k')) (unreachable) ) (func $nl4 (param $k (ref $k1)) - (drop (cont.bind (type $k1) (local.get $k))) - (resume (local.get $k)) + (drop (cont.bind $k1 $k1 (local.get $k))) + (resume $k1 (local.get $k)) ) (func (export "non-linear-1") - (call $nl1 (cont.new (type $k1) (ref.func $r0))) + (call $nl1 (cont.new $k1 (ref.func $r0))) ) (func (export "non-linear-2") - (call $nl2 (cont.new (type $k1) (ref.func $r1))) + (call $nl2 (cont.new $k1 (ref.func $r1))) ) (func (export "non-linear-3") - (call $nl3 (cont.new (type $k1) (ref.func $r1))) + (call $nl3 (cont.new $k1 (ref.func $r1))) ) (func (export "non-linear-4") - (call $nl4 (cont.new (type $k1) (ref.func $r1))) + (call $nl4 (cont.new $k1 (ref.func $r1))) ) ) @@ -147,7 +147,7 @@ (loop $loop (block $on_get (result (ref $k)) (block $on_set (result i32 (ref $k)) - (resume (tag $get $on_get) (tag $set $on_set) + (resume $k (tag $get $on_get) (tag $set $on_set) (local.get $s) (local.get $k) ) (return) @@ -180,7 +180,7 @@ (elem declare func $f) (func (export "run") (result i32) - (call $runner (i32.const 0) (cont.new (type $k) (ref.func $f))) + (call $runner (i32.const 0) (cont.new $k (ref.func $f))) ) ) @@ -217,9 +217,9 @@ (local $n i64) (local $k (ref null $cont)) (local.get $i) - (cont.new (type $cont0) (ref.func $gen)) + (cont.new $cont0 (ref.func $gen)) (block $on_first_yield (param i64 (ref $cont0)) (result i64 (ref $cont)) - (resume (tag $yield $on_first_yield)) + (resume $cont0 (tag $yield $on_first_yield)) (unreachable) ) (loop $on_yield (param i64) (param (ref $cont)) @@ -228,7 +228,7 @@ (local.set $sum (i64.add (local.get $sum) (local.get $n))) (i64.eq (local.get $n) (local.get $j)) (local.get $k) - (resume (tag $yield $on_yield)) + (resume $cont (tag $yield $on_yield)) ) (return (local.get $sum)) ) @@ -310,7 +310,7 @@ (if (call $queue-empty) (then (return))) (block $on_yield (result (ref $cont)) (block $on_spawn (result (ref $cont) (ref $cont)) - (resume (tag $yield $on_yield) (tag $spawn $on_spawn) + (resume $cont (tag $yield $on_yield) (tag $spawn $on_spawn) (call $dequeue) ) (br $l) ;; thread terminated @@ -347,11 +347,11 @@ (func $main (call $log (i32.const 0)) - (suspend $spawn (cont.new (type $cont) (ref.func $thread1))) + (suspend $spawn (cont.new $cont (ref.func $thread1))) (call $log (i32.const 1)) - (suspend $spawn (cont.bind (type $cont) (global.get $depth) (cont.new (type $pcont) (ref.func $thread2)))) + (suspend $spawn (cont.bind $pcont $cont (global.get $depth) (cont.new $pcont (ref.func $thread2)))) (call $log (i32.const 2)) - (suspend $spawn (cont.new (type $cont) (ref.func $thread3))) + (suspend $spawn (cont.new $cont (ref.func $thread3))) (call $log (i32.const 3)) ) @@ -378,9 +378,9 @@ (suspend $yield) (call $log (i32.const 23)) (suspend $spawn - (cont.bind (type $cont) + (cont.bind $pcont $cont (i32.sub (local.get $d) (i32.const 1)) - (cont.new (type $pcont) (ref.func $thread2)) + (cont.new $pcont (ref.func $thread2)) ) ) (call $log (i32.const 24)) @@ -404,7 +404,7 @@ (global.set $depth (local.get $depth)) (global.set $width (local.get $width)) (call $log (i32.const -1)) - (call $scheduler (cont.new (type $cont) (ref.func $main))) + (call $scheduler (cont.new $cont (ref.func $main))) (call $log (i32.const -2)) ) ) @@ -450,7 +450,7 @@ ) (func $main (param $i i64) (param $j i64) - (suspend $spawn (cont.new (type $cont) (ref.func $bg-thread))) + (suspend $spawn (cont.new $cont (ref.func $bg-thread))) (global.set $ghook (ref.func $syield)) (global.set $result (call $gsum (local.get $i) (local.get $j))) (global.set $done (i32.const 1)) @@ -463,7 +463,7 @@ (func (export "sum") (param $i i64) (param $j i64) (result i64) (call $log (i64.const -1)) (call $scheduler - (cont.bind (type $cont) (local.get $i) (local.get $j) (cont.new (type $pcont) (ref.func $main))) + (cont.bind $pcont $cont (local.get $i) (local.get $j) (cont.new $pcont (ref.func $main))) ) (call $log (i64.const -2)) (global.get $result) @@ -494,10 +494,10 @@ (local $k6 (ref null $k6)) (local $k4 (ref null $k4)) (local $k2 (ref null $k2)) - (local.set $k6 (cont.new (type $k6) (ref.func $f))) - (local.set $k4 (cont.bind (type $k4) (i32.const 1) (i32.const 2) (local.get $k6))) - (local.set $k2 (cont.bind (type $k2) (i32.const 3) (i32.const 4) (local.get $k4))) - (resume (i32.const 5) (i32.const 6) (local.get $k2)) + (local.set $k6 (cont.new $k6 (ref.func $f))) + (local.set $k4 (cont.bind $k6 $k4 (i32.const 1) (i32.const 2) (local.get $k6))) + (local.set $k2 (cont.bind $k4 $k2 (i32.const 3) (i32.const 4) (local.get $k4))) + (resume $k2 (i32.const 5) (i32.const 6) (local.get $k2)) ) ) @@ -530,13 +530,13 @@ (local $k4 (ref null $k4)) (local $k2 (ref null $k2)) (block $l (result (ref $k6)) - (resume (tag $e $l) (cont.new (type $k0) (ref.func $f))) + (resume $k0 (tag $e $l) (cont.new $k0 (ref.func $f))) (unreachable) ) (local.set $k6) - (local.set $k4 (cont.bind (type $k4) (i32.const 1) (i32.const 2) (local.get $k6))) - (local.set $k2 (cont.bind (type $k2) (i32.const 3) (i32.const 4) (local.get $k4))) - (resume (i32.const 5) (i32.const 6) (local.get $k2)) + (local.set $k4 (cont.bind $k6 $k4 (i32.const 1) (i32.const 2) (local.get $k6))) + (local.set $k2 (cont.bind $k4 $k2 (i32.const 3) (i32.const 4) (local.get $k4))) + (resume $k2 (i32.const 5) (i32.const 6) (local.get $k2)) ) ) From d24a9bdd475278a19651b13e8c36291dbc2949aa Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Tue, 11 Apr 2023 19:27:18 +0200 Subject: [PATCH 58/82] Update examples to conform with the recent changes to the syntax (control-lwt.wast still needs to be refactored to use cont.bind+new syntax) (#30) --- .../continuations/examples/actor-lwt.wast | 30 ++++++++-------- proposals/continuations/examples/actor.wast | 24 ++++++------- .../continuations/examples/async-await.wast | 26 +++++++------- .../continuations/examples/fun-actor-lwt.wast | 36 +++++++++---------- proposals/continuations/examples/fun-lwt.wast | 26 +++++++------- .../continuations/examples/fun-pipes.wast | 8 ++--- .../continuations/examples/fun-state.wast | 6 ++-- proposals/continuations/examples/lwt.wast | 26 +++++++------- proposals/continuations/examples/pipes.wast | 8 ++--- .../continuations/examples/static-lwt.wast | 10 +++--- 10 files changed, 100 insertions(+), 100 deletions(-) diff --git a/proposals/continuations/examples/actor-lwt.wast b/proposals/continuations/examples/actor-lwt.wast index 160072c09..60d879591 100644 --- a/proposals/continuations/examples/actor-lwt.wast +++ b/proposals/continuations/examples/actor-lwt.wast @@ -52,7 +52,7 @@ (loop $l (if (i32.eqz (local.get $n)) (then (suspend $send (i32.const 42) (local.get $p))) - (else (local.set $p (suspend $spawn (cont.bind (type $cont) (local.get $p) (cont.new (type $i-cont) (ref.func $next))))) + (else (local.set $p (suspend $spawn (cont.bind $i-cont $cont (local.get $p) (cont.new $i-cont (ref.func $next))))) (local.set $n (i32.sub (local.get $n) (i32.const 1))) (br $l)) ) @@ -274,7 +274,7 @@ (loop $l (if (i32.eqz (local.get $n)) (then (suspend $send (i32.const 42) (local.get $p))) - (else (local.set $p (suspend $spawn (cont.bind (type $cont) (local.get $p) (cont.new (type $i-cont) (ref.func $next))))) + (else (local.set $p (suspend $spawn (cont.bind $i-cont $cont (local.get $p) (cont.new $i-cont (ref.func $next))))) (local.set $n (i32.sub (local.get $n) (i32.const 1))) (br $l)) ) @@ -371,7 +371,7 @@ (if (call $queue-empty) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (tag $yield $on_yield) (tag $fork $on_fork) + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (call $dequeue) ) (br $l) ;; thread terminated @@ -498,11 +498,11 @@ (block $on_spawn (result (ref $cont) (ref $i-cont)) (block $on_send (result i32 i32 (ref $cont)) (block $on_recv (result (ref $i-cont)) - (resume (tag $self $on_self) - (tag $spawn $on_spawn) - (tag $send $on_send) - (tag $recv $on_recv) - (local.get $nextk) + (resume $cont (tag $self $on_self) + (tag $spawn $on_spawn) + (tag $send $on_send) + (tag $recv $on_recv) + (local.get $nextk) ) (return) ) ;; $on_recv (result (ref $i-cont)) @@ -514,7 +514,7 @@ (br $blocked)) ) ) - (local.set $nextk (cont.bind (type $cont) (call $recv-from-mb (local.get $mine)) (local.get $ik))) + (local.set $nextk (cont.bind $i-cont $cont (call $recv-from-mb (local.get $mine)) (local.get $ik))) (br $l) ) ;; $on_send (result i32 i32 (ref $cont)) (local.set $k) @@ -526,15 +526,15 @@ (local.set $you) (call $new-mb) (local.set $yours) - (suspend $fork (cont.bind (type $cont) + (suspend $fork (cont.bind $ic-cont $cont (local.get $yours) (local.get $you) - (cont.new (type $ic-cont) (ref.func $actk)))) - (local.set $nextk (cont.bind (type $cont) (local.get $yours) (local.get $ik))) + (cont.new $ic-cont (ref.func $actk)))) + (local.set $nextk (cont.bind $i-cont $cont (local.get $yours) (local.get $ik))) (br $l) ) ;; $on_self (result (ref $i-cont)) (local.set $ik) - (local.set $nextk (cont.bind (type $cont) (local.get $mine) (local.get $ik))) + (local.set $nextk (cont.bind $i-cont $cont (local.get $mine) (local.get $ik))) (br $l) ) ) @@ -560,7 +560,7 @@ (func $scheduler (import "scheduler" "run") (param $k (ref $cont))) (func $run-actor (export "run-actor") (param $k (ref $cont)) - (call $scheduler (cont.bind (type $cont) (local.get $k) (cont.new (type $cont-cont) (ref.func $act)))) + (call $scheduler (cont.bind $cont-cont $cont (local.get $k) (cont.new $cont-cont (ref.func $act)))) ) ) (register "actor-scheduler") @@ -578,7 +578,7 @@ (func $chain (import "chain" "chain") (param $n i32)) (func $run-chain (export "run-chain") (param $n i32) - (call $run-actor (cont.bind (type $cont) (local.get $n) (cont.new (type $i-cont) (ref.func $chain)))) + (call $run-actor (cont.bind $i-cont $cont (local.get $n) (cont.new $i-cont (ref.func $chain)))) ) ) diff --git a/proposals/continuations/examples/actor.wast b/proposals/continuations/examples/actor.wast index 9f86e8e0d..151c08d58 100644 --- a/proposals/continuations/examples/actor.wast +++ b/proposals/continuations/examples/actor.wast @@ -52,7 +52,7 @@ (loop $l (if (i32.eqz (local.get $n)) (then (suspend $send (i32.const 42) (local.get $p))) - (else (local.set $p (suspend $spawn (cont.bind (type $cont) (local.get $p) (cont.new (type $i-cont) (ref.func $next))))) + (else (local.set $p (suspend $spawn (cont.bind $i-cont $cont (local.get $p) (cont.new $i-cont (ref.func $next))))) (local.set $n (i32.sub (local.get $n) (i32.const 1))) (br $l)) ) @@ -296,10 +296,10 @@ (local $res i32) (suspend $recv) (local.set $res) - (resume (local.get $res) (local.get $ik)) + (resume $i-cont (local.get $res) (local.get $ik)) ) (func $recv-again (param $ik (ref $i-cont)) (result (ref $cont)) - (cont.bind (type $cont) (local.get $ik) (cont.new (type $i-cont-cont) (ref.func $recv-againf))) + (cont.bind $i-cont-cont $cont (local.get $ik) (cont.new $i-cont-cont (ref.func $recv-againf))) ) ;; There are multiple ways of avoiding the need for @@ -329,11 +329,11 @@ (block $on_spawn (result (ref $cont) (ref $i-cont)) (block $on_send (result i32 i32 (ref $cont)) (block $on_recv (result (ref $i-cont)) - (resume (tag $self $on_self) - (tag $spawn $on_spawn) - (tag $send $on_send) - (tag $recv $on_recv) - (local.get $nextk) + (resume $cont (tag $self $on_self) + (tag $spawn $on_spawn) + (tag $send $on_send) + (tag $recv $on_recv) + (local.get $nextk) ) (local.set $mine (call $dequeue-mb)) (local.set $nextk (call $dequeue-k)) @@ -348,7 +348,7 @@ (local.set $nextk (call $dequeue-k)) (br $l)) ) - (local.set $nextk (cont.bind (type $cont) (call $recv-from-mb (local.get $mine)) (local.get $ik))) + (local.set $nextk (cont.bind $i-cont $cont (call $recv-from-mb (local.get $mine)) (local.get $ik))) (br $l) ) ;; $on_send (result i32 i32 (ref $cont)) (local.set $k) @@ -362,11 +362,11 @@ (local.set $yours) (call $enqueue-mb (local.get $yours)) (call $enqueue-k (local.get $you)) - (local.set $nextk (cont.bind (type $cont) (local.get $yours) (local.get $ik))) + (local.set $nextk (cont.bind $i-cont $cont (local.get $yours) (local.get $ik))) (br $l) ) ;; $on_self (result (ref $i-cont)) (local.set $ik) - (local.set $nextk (cont.bind (type $cont) (local.get $mine) (local.get $ik))) + (local.set $nextk (cont.bind $i-cont $cont (local.get $mine) (local.get $ik))) (br $l) ) ) @@ -388,7 +388,7 @@ (func $chain (import "chain" "chain") (param $n i32)) (func $run-chain (export "run-chain") (param $n i32) - (call $act (cont.bind (type $cont) (local.get $n) (cont.new (type $i-cont) (ref.func $chain)))) + (call $act (cont.bind $i-cont $cont (local.get $n) (cont.new $i-cont (ref.func $chain)))) ) ) diff --git a/proposals/continuations/examples/async-await.wast b/proposals/continuations/examples/async-await.wast index fa2ea9dcf..53570c3bc 100644 --- a/proposals/continuations/examples/async-await.wast +++ b/proposals/continuations/examples/async-await.wast @@ -72,11 +72,11 @@ (local $y i32) (call $log (i32.const -1)) - (local.set $p (suspend $async (cont.bind (type $i-cont) (i32.const 1) (i32.const 3) (cont.new (type $iii-cont) (ref.func $sum))))) + (local.set $p (suspend $async (cont.bind $iii-cont $i-cont (i32.const 1) (i32.const 3) (cont.new $iii-cont (ref.func $sum))))) (call $log (i32.const -2)) - (local.set $q (suspend $async (cont.bind (type $i-cont) (i32.const 5) (i32.const 7) (cont.new (type $iii-cont) (ref.func $sum))))) + (local.set $q (suspend $async (cont.bind $iii-cont $i-cont (i32.const 5) (i32.const 7) (cont.new $iii-cont (ref.func $sum))))) (call $log (i32.const -3)) - (local.set $r (suspend $async (cont.bind (type $i-cont) (i32.const 10) (i32.const 15) (cont.new (type $iii-cont) (ref.func $sum))))) + (local.set $r (suspend $async (cont.bind $iii-cont $i-cont (i32.const 10) (i32.const 15) (cont.new $iii-cont (ref.func $sum))))) (call $log (i32.const -4)) (local.set $x (i32.mul (suspend $await (local.get $p)) @@ -217,7 +217,7 @@ (if (ref.is_null (local.get $k)) (then (return (ref.null $cont))) ) - (return (cont.bind (type $cont) (local.get $v) (local.get $k))) + (return (cont.bind $i-cont $cont (local.get $v) (local.get $k))) ) ) (register "promise") @@ -265,11 +265,11 @@ (block $on_fulfill (result i32 i32 (ref $cont)) (block $on_async (result (ref $i-cont) (ref $i-cont)) (block $on_await (result i32 (ref $i-cont)) - (resume (tag $yield $on_yield) - (tag $fulfill $on_fulfill) - (tag $async $on_async) - (tag $await $on_await) - (local.get $nextk) + (resume $cont (tag $yield $on_yield) + (tag $fulfill $on_fulfill) + (tag $async $on_async) + (tag $await $on_await) + (local.get $nextk) ) (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated @@ -278,7 +278,7 @@ (local.set $p) (if (call $promise-fulfilled (local.get $p)) ;; if promise fulfilled then run continuation partially applied to value - (then (local.set $nextk (cont.bind (type $cont) (call $promise-value (local.get $p)) (local.get $ik)))) + (then (local.set $nextk (cont.bind $i-cont $cont (call $promise-value (local.get $p)) (local.get $ik)))) ;; else add continuation to promise and run next continuation from the queue (else (call $await-promise (local.get $p) (local.get $ik)) (local.set $nextk (call $dequeue))) @@ -291,9 +291,9 @@ (call $new-promise) (local.set $p) ;; enqueue continuation partially applied to promise - (call $enqueue (cont.bind (type $cont) (local.get $p) (local.get $ik))) + (call $enqueue (cont.bind $i-cont $cont (local.get $p) (local.get $ik))) ;; run computation partially applied to promise - (local.set $nextk (cont.bind (type $cont) (local.get $p) (local.get $ak))) + (local.set $nextk (cont.bind $i-cont $cont (local.get $p) (local.get $ak))) (br $l) ) ;; $on_fulfill (result i32 i32 (ref $cont)) (local.set $nextk) @@ -328,7 +328,7 @@ (elem declare func $run-example) (func (export "run") - (call $scheduler (cont.new (type $cont) (ref.func $run-example))) + (call $scheduler (cont.new $cont (ref.func $run-example))) ) ) diff --git a/proposals/continuations/examples/fun-actor-lwt.wast b/proposals/continuations/examples/fun-actor-lwt.wast index d79296fa8..a9cfff911 100644 --- a/proposals/continuations/examples/fun-actor-lwt.wast +++ b/proposals/continuations/examples/fun-actor-lwt.wast @@ -45,7 +45,7 @@ (loop $l (if (i32.eqz (local.get $n)) (then (suspend $send (i32.const 42) (local.get $p))) - (else (local.set $p (suspend $spawn (cont.bind (type $cont) (local.get $p) (cont.new (type $i-cont) (ref.func $next))))) + (else (local.set $p (suspend $spawn (cont.bind $i-cont $cont (local.get $p) (cont.new $i-cont (ref.func $next))))) (local.set $n (i32.sub (local.get $n) (i32.const 1))) (br $l)) ) @@ -143,7 +143,7 @@ (if (call $queue-empty) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (tag $yield $on_yield) (tag $fork $on_fork) + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (call $dequeue) ) (br $l) ;; thread terminated @@ -262,11 +262,11 @@ (block $on_recv (result (ref $i-cont)) ;; this should really be a tail call to the continuation ;; do we need a 'return_resume' operator? - (resume (tag $self $on_self) - (tag $spawn $on_spawn) - (tag $send $on_send) - (tag $recv $on_recv) - (local.get $res) (local.get $ik) + (resume $i-cont (tag $self $on_self) + (tag $spawn $on_spawn) + (tag $send $on_send) + (tag $recv $on_recv) + (local.get $res) (local.get $ik) ) (return) ) ;; $on_recv (result (ref $i-cont)) @@ -290,10 +290,10 @@ (local.set $you) (call $new-mb) (local.set $yours) - (suspend $fork (cont.bind (type $cont) + (suspend $fork (cont.bind $icont-cont $cont (local.get $yours) (local.get $you) - (cont.new (type $icont-cont) (ref.func $act-nullary)))) + (cont.new $icont-cont (ref.func $act-nullary)))) (return_call $act-res (local.get $mine) (local.get $yours) (local.get $ik)) ) ;; $on_self (result (ref $i-cont)) (local.set $ik) @@ -312,11 +312,11 @@ (block $on_recv (result (ref $i-cont)) ;; this should really be a tail call to the continuation ;; do we need a 'return_resume' operator? - (resume (tag $self $on_self) - (tag $spawn $on_spawn) - (tag $send $on_send) - (tag $recv $on_recv) - (local.get $k) + (resume $cont (tag $self $on_self) + (tag $spawn $on_spawn) + (tag $send $on_send) + (tag $recv $on_recv) + (local.get $k) ) (return) ) ;; $on_recv (result (ref $i-cont)) @@ -340,10 +340,10 @@ (local.set $you) (call $new-mb) (local.set $yours) - (suspend $fork (cont.bind (type $cont) + (suspend $fork (cont.bind $icont-cont $cont (local.get $yours) (local.get $you) - (cont.new (type $icont-cont) (ref.func $act-nullary)))) + (cont.new $icont-cont (ref.func $act-nullary)))) (return_call $act-res (local.get $mine) (local.get $yours) (local.get $ik)) ) ;; $on_self (result (ref $i-cont)) (local.set $ik) @@ -373,7 +373,7 @@ (func $scheduler (import "scheduler" "run") (param $k (ref $cont))) (func $run-actor (export "run-actor") (param $k (ref $cont)) - (call $scheduler (cont.bind (type $cont) (local.get $k) (cont.new (type $cont-cont) (ref.func $act)))) + (call $scheduler (cont.bind $cont-cont $cont (local.get $k) (cont.new $cont-cont (ref.func $act)))) ) ) (register "actor-scheduler") @@ -391,7 +391,7 @@ (func $chain (import "chain" "chain") (param $n i32)) (func $run-chain (export "run-chain") (param $n i32) - (call $run-actor (cont.bind (type $cont) (local.get $n) (cont.new (type $i-cont) (ref.func $chain)))) + (call $run-actor (cont.bind $i-cont $cont (local.get $n) (cont.new $i-cont (ref.func $chain)))) ) ) diff --git a/proposals/continuations/examples/fun-lwt.wast b/proposals/continuations/examples/fun-lwt.wast index 943b8804f..2b57b53df 100644 --- a/proposals/continuations/examples/fun-lwt.wast +++ b/proposals/continuations/examples/fun-lwt.wast @@ -23,11 +23,11 @@ (func $main (export "main") (call $log (i32.const 0)) - (suspend $fork (cont.new (type $cont) (ref.func $thread1))) + (suspend $fork (cont.new $cont (ref.func $thread1))) (call $log (i32.const 1)) - (suspend $fork (cont.new (type $cont) (ref.func $thread2))) + (suspend $fork (cont.new $cont (ref.func $thread2))) (call $log (i32.const 2)) - (suspend $fork (cont.new (type $cont) (ref.func $thread3))) + (suspend $fork (cont.new $cont (ref.func $thread3))) (call $log (i32.const 3)) ) @@ -132,7 +132,7 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk) @@ -159,7 +159,7 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk) @@ -179,7 +179,7 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk)) @@ -196,7 +196,7 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk) @@ -217,7 +217,7 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk)) + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk)) (return_call $ytk (call $dequeue)) ) ;; $on_fork (result (ref $cont) (ref $cont)) (local.set $k) @@ -250,15 +250,15 @@ (func (export "run") (call $log (i32.const -1)) - (call $scheduler-sync (cont.new (type $cont) (ref.func $main))) + (call $scheduler-sync (cont.new $cont (ref.func $main))) (call $log (i32.const -2)) - (call $scheduler-kt (cont.new (type $cont) (ref.func $main))) + (call $scheduler-kt (cont.new $cont (ref.func $main))) (call $log (i32.const -3)) - (call $schedule-tk (cont.new (type $cont) (ref.func $main))) + (call $schedule-tk (cont.new $cont (ref.func $main))) (call $log (i32.const -4)) - (call $scheduler-ykt (cont.new (type $cont) (ref.func $main))) + (call $scheduler-ykt (cont.new $cont (ref.func $main))) (call $log (i32.const -5)) - (call $scheduler-ytk (cont.new (type $cont) (ref.func $main))) + (call $scheduler-ytk (cont.new $cont (ref.func $main))) (call $log (i32.const -6)) ) ) diff --git a/proposals/continuations/examples/fun-pipes.wast b/proposals/continuations/examples/fun-pipes.wast index 55697ad21..4c4008de7 100644 --- a/proposals/continuations/examples/fun-pipes.wast +++ b/proposals/continuations/examples/fun-pipes.wast @@ -10,7 +10,7 @@ (func $piper (param $n i32) (param $p (ref $producer)) (param $c (ref $consumer)) (block $on-receive (result (ref $consumer)) - (resume (tag $receive $on-receive) (local.get $n) (local.get $c)) + (resume $consumer (tag $receive $on-receive) (local.get $n) (local.get $c)) (return) ) ;; receive (local.set $c) @@ -20,7 +20,7 @@ (func $copiper (param $c (ref $consumer)) (param $p (ref $producer)) (local $n i32) (block $on-send (result i32 (ref $producer)) - (resume (tag $send $on-send) (local.get $p)) + (resume $producer (tag $send $on-send) (local.get $p)) (return) ) ;; send (local.set $p) @@ -79,8 +79,8 @@ ) (func (export "run") (param $n i32) - (call $pipe (cont.bind (type $producer) (local.get $n) (cont.new (type $consumer) (ref.func $nats))) - (cont.new (type $consumer) (ref.func $sum)) + (call $pipe (cont.bind $consumer $producer (local.get $n) (cont.new $consumer (ref.func $nats))) + (cont.new $consumer (ref.func $sum)) ) ) ) diff --git a/proposals/continuations/examples/fun-state.wast b/proposals/continuations/examples/fun-state.wast index 23d6c62a9..440aaedfb 100644 --- a/proposals/continuations/examples/fun-state.wast +++ b/proposals/continuations/examples/fun-state.wast @@ -12,7 +12,7 @@ (func $getting (param $k (ref $gk)) (param $s i32) (result i32) (block $on_get (result (ref $gk)) (block $on_set (result i32 (ref $sk)) - (resume (tag $get $on_get) (tag $set $on_set) + (resume $gk (tag $get $on_get) (tag $set $on_set) (local.get $s) (local.get $k) ) (return) @@ -26,7 +26,7 @@ (func $setting (param $s i32) (param $k (ref $sk)) (result i32) (block $on_get (result (ref $gk)) (block $on_set (result i32 (ref $sk)) - (resume (tag $get $on_get) (tag $set $on_set) + (resume $sk (tag $get $on_get) (tag $set $on_set) (local.get $k) ) (return) @@ -54,7 +54,7 @@ (elem declare func $f) (func (export "run") (result i32) - (call $setting (i32.const 0) (cont.new (type $sk) (ref.func $f))) + (call $setting (i32.const 0) (cont.new $sk (ref.func $f))) ) ) diff --git a/proposals/continuations/examples/lwt.wast b/proposals/continuations/examples/lwt.wast index 6a5955a58..65232d5bc 100644 --- a/proposals/continuations/examples/lwt.wast +++ b/proposals/continuations/examples/lwt.wast @@ -23,11 +23,11 @@ (func $main (export "main") (call $log (i32.const 0)) - (suspend $fork (cont.new (type $cont) (ref.func $thread1))) + (suspend $fork (cont.new $cont (ref.func $thread1))) (call $log (i32.const 1)) - (suspend $fork (cont.new (type $cont) (ref.func $thread2))) + (suspend $fork (cont.new $cont (ref.func $thread2))) (call $log (i32.const 2)) - (suspend $fork (cont.new (type $cont) (ref.func $thread3))) + (suspend $fork (cont.new $cont (ref.func $thread3))) (call $log (i32.const 3)) ) @@ -134,7 +134,7 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk) @@ -165,7 +165,7 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk) @@ -189,7 +189,7 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk) @@ -213,7 +213,7 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk) @@ -238,7 +238,7 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk) @@ -278,15 +278,15 @@ (func (export "run") (call $log (i32.const -1)) - (call $scheduler-sync (cont.new (type $cont) (ref.func $main))) + (call $scheduler-sync (cont.new $cont (ref.func $main))) (call $log (i32.const -2)) - (call $scheduler-kt (cont.new (type $cont) (ref.func $main))) + (call $scheduler-kt (cont.new $cont (ref.func $main))) (call $log (i32.const -3)) - (call $schedule-tk (cont.new (type $cont) (ref.func $main))) + (call $schedule-tk (cont.new $cont (ref.func $main))) (call $log (i32.const -4)) - (call $scheduler-ykt (cont.new (type $cont) (ref.func $main))) + (call $scheduler-ykt (cont.new $cont (ref.func $main))) (call $log (i32.const -5)) - (call $scheduler-ytk (cont.new (type $cont) (ref.func $main))) + (call $scheduler-ytk (cont.new $cont (ref.func $main))) (call $log (i32.const -6)) ) ) diff --git a/proposals/continuations/examples/pipes.wast b/proposals/continuations/examples/pipes.wast index 573b9491a..e35817856 100644 --- a/proposals/continuations/examples/pipes.wast +++ b/proposals/continuations/examples/pipes.wast @@ -19,7 +19,7 @@ (if (local.get $consuming) (then (block $on-receive (result (ref $consumer)) - (resume (tag $receive $on-receive) (local.get $n) (local.get $c)) + (resume $consumer (tag $receive $on-receive) (local.get $n) (local.get $c)) (return) ) ;; receive (local.set $c) @@ -28,7 +28,7 @@ ) ) ;; else producing (block $on-send (result i32 (ref $producer)) - (resume (tag $send $on-send) (local.get $p)) + (resume $producer (tag $send $on-send) (local.get $p)) (return) ) ;; send (local.set $p) @@ -86,8 +86,8 @@ ) (func (export "run") (param $n i32) - (call $pipe (cont.bind (type $producer) (local.get $n) (cont.new (type $consumer) (ref.func $nats))) - (cont.new (type $consumer) (ref.func $sum)) + (call $pipe (cont.bind $consumer $producer (local.get $n) (cont.new $consumer (ref.func $nats))) + (cont.new $consumer (ref.func $sum)) ) ) ) diff --git a/proposals/continuations/examples/static-lwt.wast b/proposals/continuations/examples/static-lwt.wast index 0bd0b376b..22bd0f34d 100644 --- a/proposals/continuations/examples/static-lwt.wast +++ b/proposals/continuations/examples/static-lwt.wast @@ -110,8 +110,8 @@ (loop $l (if (call $queue-empty) (then (return))) (block $on_yield (result (ref $cont)) - (resume (tag $yield $on_yield) - (call $dequeue) + (resume $cont (tag $yield $on_yield) + (call $dequeue) ) (br $l) ;; thread terminated ) ;; $on_yield (result (ref $cont)) @@ -138,9 +138,9 @@ (elem declare func $thread1 $thread2 $thread3) (func (export "run") - (call $enqueue (cont.new (type $cont) (ref.func $thread1))) - (call $enqueue (cont.new (type $cont) (ref.func $thread2))) - (call $enqueue (cont.new (type $cont) (ref.func $thread3))) + (call $enqueue (cont.new $cont (ref.func $thread1))) + (call $enqueue (cont.new $cont (ref.func $thread2))) + (call $enqueue (cont.new $cont (ref.func $thread3))) (call $log (i32.const -1)) (call $scheduler) From b7e4ed52520945c0a2648f64e6cd019d422e534b Mon Sep 17 00:00:00 2001 From: Matija Pretnar Date: Thu, 13 Apr 2023 15:58:57 +0200 Subject: [PATCH 59/82] Add a simple and more involved generator example (#31) * Add a simple and more involved generator example * More examples --- .../continuations/examples/generators.wast | 166 ++++++++++++++++++ 1 file changed, 166 insertions(+) create mode 100644 proposals/continuations/examples/generators.wast diff --git a/proposals/continuations/examples/generators.wast b/proposals/continuations/examples/generators.wast new file mode 100644 index 000000000..a7ce4e057 --- /dev/null +++ b/proposals/continuations/examples/generators.wast @@ -0,0 +1,166 @@ +;; Generators + +;; generator interface +(module $generator + (tag $yield (export "yield") (param i32)) +) +(register "generator") + +(module $examples + (type $func (func)) + (type $cont (cont $func)) + + (tag $yield (import "generator" "yield") (param i32)) + + (func $log (import "spectest" "print_i32") (param i32)) + + ;; yields successive natural numbers + (func $naturals (export "naturals") + (local $n i32) + (loop $l + (suspend $yield (local.get $n)) + (local.set $n (i32.add (local.get $n) (i32.const 1))) + (br $l) + ) + ) + + ;; yields 1-2-3 + (func $one-two-three (export "one-two-three") + (suspend $yield (i32.const 1)) + (suspend $yield (i32.const 2)) + (suspend $yield (i32.const 3)) + ) + + ;; yields successive Fibonacci numbers + (func $fibonacci (export "fibonacci") + (local $a i32) + (local $b i32) + (local $t i32) + (local.set $b (i32.const 1)) + (loop $l + (suspend $yield (local.get $a)) + (local.set $t (local.get $a)) + (local.set $a (local.get $b)) + (local.set $b (i32.add (local.get $t) (local.get $a))) + (br $l) + ) + ) + + (func $print-first (export "print-first") (param $n i32) (param $k (ref $cont)) + (loop $l + (block $on_yield (result i32 (ref $cont)) + (if (local.get $n) + (then (resume $cont (tag $yield $on_yield) (local.get $k))) + ) + (return) + ) ;; $on_yield (result i32 (ref $cont)) + (local.set $k) + (call $log) + (local.set $n (i32.add (local.get $n) (i32.const -1))) + (br $l) + ) + (unreachable) + ) + + (func $sum-first (export "sum-first") (param $n i32) (param $k (ref $cont)) (result i32) + (local $sum i32) + (loop $l + (block $on_yield (result i32 (ref $cont)) + (if (local.get $n) + (then (resume $cont (tag $yield $on_yield) (local.get $k))) + ) + (return (local.get $sum)) + ) ;; $on_yield (result i32 (ref $cont)) + (local.set $k) + (local.set $sum (i32.add (local.get $sum))) + (local.set $n (i32.add (local.get $n) (i32.const -1))) + (br $l) + ) + (unreachable) + ) +) +(register "examples") + +;; storing generators in a global table and then accessing them through i32 handles +;; without knowledge of handlers +(module $manager + (type $func (func)) + (type $cont (cont $func)) + + (tag $yield (import "generator" "yield") (param i32)) + + (table $active 0 (ref null $cont)) + + (func $init (export "init") (param $k (ref $cont)) (result i32) + (table.grow $active (local.get $k) (i32.const 1)) + ) + + (func $next (export "next") (param $g i32) (result i32) + (local $next_k (ref $cont)) + (local $next_v i32) + (block $on_yield (result i32 (ref $cont)) + (resume $cont (tag $yield $on_yield) + (table.get $active (local.get $g)) + ) + (return (i32.const -1)) + ) ;; $on_yield (result i32 (ref $cont)) + (local.set $next_k) + (local.set $next_v) + (table.set (local.get $g) (local.get $next_k)) + (return (local.get $next_v)) + ) +) +(register "manager") + +(module + (type $func (func)) + (type $cont (cont $func)) + + (elem declare func $naturals $fibonacci $one-two-three) + + (func $log (import "spectest" "print_i32") (param i32)) + (func $naturals (import "examples" "naturals")) + (func $fibonacci (import "examples" "fibonacci")) + (func $one-two-three (import "examples" "one-two-three")) + (func $print-first (import "examples" "print-first") (param $n i32) (param $k (ref $cont))) + (func $sum-first (import "examples" "sum-first") (param $n i32) (param $k (ref $cont)) (result i32)) + (func $init (import "manager" "init") (param $k (ref $cont)) (result i32)) + (func $next (import "manager" "next") (param i32) (result i32)) + + (func $print-with-next (param $n i32) (param $gen i32) + (loop $l + (if (i32.eqz (local.get $n)) (then (return))) + (call $next (local.get $gen)) + (call $log) + (local.set $n (i32.add (local.get $n) (i32.const -1))) + (br $l) + ) + ) + + (func $interleave-naturals-and-fib + (local $gen1 i32) + (local $gen2 i32) + (local.set $gen1 (call $init (cont.new $cont (ref.func $naturals)))) + (local.set $gen2 (call $init (cont.new $cont (ref.func $fibonacci)))) + (call $print-with-next (i32.const 5) (local.get $gen1)) + (call $print-with-next (i32.const 5) (local.get $gen2)) + (call $print-with-next (i32.const 5) (local.get $gen1)) + (call $print-with-next (i32.const 5) (local.get $gen2)) + (call $print-with-next (i32.const 5) (local.get $gen1)) + (call $print-with-next (i32.const 5) (local.get $gen2)) + (call $print-with-next (i32.const 5) (local.get $gen1)) + (call $print-with-next (i32.const 5) (local.get $gen2)) + ) + + (func $main (export "main") + (call $interleave-naturals-and-fib) + (call $print-first (i32.const 42) (cont.new $cont (ref.func $naturals))) + (call $print-first (i32.const 42) (cont.new $cont (ref.func $fibonacci))) + (call $sum-first (i32.const 101) (cont.new $cont (ref.func $naturals))) + (call $log) + (call $sum-first (i32.const 10) (cont.new $cont (ref.func $one-two-three))) + (call $log) + ) +) + +(invoke "main") From 08de56bbc13d562e32e1f36ec99ede51a105b585 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Fri, 1 Sep 2023 15:32:33 +0200 Subject: [PATCH 60/82] Disable JS testsuite --- .github/workflows/ci-interpreter.yml | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci-interpreter.yml b/.github/workflows/ci-interpreter.yml index 6edfa0c46..edc19867e 100644 --- a/.github/workflows/ci-interpreter.yml +++ b/.github/workflows/ci-interpreter.yml @@ -1,4 +1,4 @@ -name: CI for interpreter & tests +2name: CI for interpreter & tests on: push: @@ -31,4 +31,5 @@ jobs: - name: Build interpreter run: cd interpreter && opam exec make - name: Run tests - run: cd interpreter && opam exec make JS=node ci + run: cd interpreter && opam exec make test + #run: cd interpreter && opam exec make JS=node ci From af789d0dca27ee86e86cc51df77d4bf8d87c7e28 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Thu, 21 Sep 2023 15:55:43 +0200 Subject: [PATCH 61/82] Merge with WebAssembly/function-references The `tag_type` and `cont_type` types have been adapted to align with type substitution. --- .github/workflows/ci-interpreter.yml | 7 +- README.md | 4 +- document/core/appendix/embedding.rst | 83 ++--- document/core/appendix/index-instructions.py | 6 +- document/core/appendix/index-rules.rst | 4 +- document/core/appendix/index-types.rst | 8 +- document/core/appendix/properties.rst | 172 ++++------ document/core/binary/instructions.rst | 4 +- document/core/binary/types.rst | 4 +- document/core/exec/instructions.rst | 69 ++-- document/core/exec/modules.rst | 143 +++----- document/core/exec/runtime.rst | 39 +-- document/core/exec/types.rst | 60 +--- document/core/exec/values.rst | 16 +- document/core/syntax/types.rst | 93 +++--- document/core/text/modules.rst | 2 +- document/core/util/macros.def | 22 +- document/core/valid/conventions.rst | 6 +- document/core/valid/instructions.rst | 22 +- document/core/valid/matching.rst | 40 ++- document/core/valid/modules.rst | 4 +- document/core/valid/types.rst | 43 +-- interpreter/README.md | 11 +- interpreter/binary/decode.ml | 20 +- interpreter/binary/encode.ml | 23 +- interpreter/exec/eval.ml | 210 ++++++------ interpreter/host/env.ml | 6 +- interpreter/host/spectest.ml | 21 +- interpreter/runtime/func.ml | 16 +- interpreter/runtime/func.mli | 9 +- interpreter/runtime/global.ml | 4 +- interpreter/runtime/instance.ml | 12 +- interpreter/runtime/table.ml | 2 +- interpreter/script/import.ml | 2 +- interpreter/script/js.ml | 17 +- interpreter/script/run.ml | 4 +- interpreter/syntax/ast.ml | 37 ++- interpreter/syntax/free.ml | 14 +- interpreter/syntax/types.ml | 275 +++++++--------- interpreter/text/arrange.ml | 14 +- interpreter/text/parser.mly | 51 +-- interpreter/util/lib.ml | 4 - interpreter/util/lib.mli | 1 - interpreter/valid/match.ml | 184 +++++------ interpreter/valid/match.mli | 44 ++- interpreter/valid/valid.ml | 327 ++++++++++--------- proposals/function-references/Overview.md | 14 +- test/core/data.wast | 9 - test/core/elem.wast | 24 +- test/core/global.wast | 9 - test/core/table.wast | 25 ++ test/core/type-equivalence.wast | 10 +- 52 files changed, 1007 insertions(+), 1243 deletions(-) diff --git a/.github/workflows/ci-interpreter.yml b/.github/workflows/ci-interpreter.yml index edc19867e..44cc511b6 100644 --- a/.github/workflows/ci-interpreter.yml +++ b/.github/workflows/ci-interpreter.yml @@ -21,7 +21,7 @@ jobs: - name: Setup OCaml uses: ocaml/setup-ocaml@v2 with: - ocaml-compiler: 4.12.x + ocaml-compiler: 4.14.x - name: Setup OCaml tools run: opam install --yes ocamlbuild.0.14.0 ocamlfind.1.9.5 js_of_ocaml.4.0.0 js_of_ocaml-ppx.4.0.0 - name: Setup Node.js @@ -31,5 +31,6 @@ jobs: - name: Build interpreter run: cd interpreter && opam exec make - name: Run tests - run: cd interpreter && opam exec make test - #run: cd interpreter && opam exec make JS=node ci + # TODO: disable node.js run until it fully implements proposal + # run: cd interpreter && opam exec make JS=node ci + run: cd interpreter && opam exec make ci diff --git a/README.md b/README.md index cce1df8d7..1c529cb0c 100644 --- a/README.md +++ b/README.md @@ -1,5 +1,5 @@ -[![CI for specs](https://github.com/WebAssembly/spec/actions/workflows/ci-spec.yml/badge.svg)](https://github.com/WebAssembly/spec/actions/workflows/ci-spec.yml) -[![CI for interpreter & tests](https://github.com/WebAssembly/spec/actions/workflows/ci-interpreter.yml/badge.svg)](https://github.com/WebAssembly/spec/actions/workflows/ci-interpreter.yml) +[![CI for specs](https://github.com/wasmfx/specfx/actions/workflows/ci-spec.yml/badge.svg)](https://github.com/wasmfx/specfx/actions/workflows/ci-spec.yml) +[![CI for interpreter & tests](https://github.com/wasmfx/specfx/actions/workflows/ci-interpreter.yml/badge.svg)](https://github.com/wasmfx/specfx/actions/workflows/ci-interpreter.yml) # Typed Continuations Proposal for WebAssembly diff --git a/document/core/appendix/embedding.rst b/document/core/appendix/embedding.rst index aa297a0e7..31e956401 100644 --- a/document/core/appendix/embedding.rst +++ b/document/core/appendix/embedding.rst @@ -167,7 +167,7 @@ Modules :math:`\F{module\_imports}(\module) : (\name, \name, \externtype)^\ast` ....................................................................... -1. Pre-condition: :math:`\module` is :ref:`valid ` with the :ref:`dynamic ` external import types :math:`\externtype^\ast` and external export types :math:`{\externtype'}^\ast`. +1. Pre-condition: :math:`\module` is :ref:`valid ` with the external import types :math:`\externtype^\ast` and external export types :math:`{\externtype'}^\ast`. 2. Let :math:`\import^\ast` be the :ref:`imports ` :math:`\module.\MIMPORTS`. @@ -179,7 +179,7 @@ Modules 5. Return the concatenation of all :math:`\X{result}_i`, in index order. -6. Post-condition: each :ref:`dynamic ` :math:`\externtype_i` is :ref:`valid `. +6. Post-condition: each :math:`\externtype_i` is :ref:`valid ` under the empty :ref:`context `. .. math:: ~ \\ @@ -195,7 +195,7 @@ Modules :math:`\F{module\_exports}(\module) : (\name, \externtype)^\ast` ................................................................ -1. Pre-condition: :math:`\module` is :ref:`valid ` with the :ref:`dynamic ` external import types :math:`\externtype^\ast` and external export types :math:`{\externtype'}^\ast`. +1. Pre-condition: :math:`\module` is :ref:`valid ` with the external import types :math:`\externtype^\ast` and external export types :math:`{\externtype'}^\ast`. 2. Let :math:`\export^\ast` be the :ref:`exports ` :math:`\module.\MEXPORTS`. @@ -207,7 +207,7 @@ Modules 5. Return the concatenation of all :math:`\X{result}_i`, in index order. -6. Post-condition: each :ref:`dynamic ` :math:`\externtype'_i` is :ref:`valid `. +6. Post-condition: each :math:`\externtype'_i` is :ref:`valid ` under the empty :ref:`context `. .. math:: ~ \\ @@ -246,29 +246,6 @@ Module Instances \end{array} -.. index:: type, type instance, function type -.. _embed-type: - -Types -~~~~~ - -.. _embed-type-alloc: - -:math:`\F{type\_alloc}(\store, \functype) : (\store, \typeaddr)` -........................................................................... - -1. Pre-condition: the :ref:`dynamic ` :math:`\functype` is :ref:`valid `. - -2. Let :math:`\typeaddr` be the result of :ref:`allocating a type ` in :math:`\store` for :ref:`function type ` :math:`\functype`. - -3. Return the new store paired with :math:`\typeaddr`. - -.. math:: - \begin{array}{lclll} - \F{type\_alloc}(S, \X{ft}) &=& (S', \X{a}) && (\iff \alloctype(S, \X{ft}) = S', \X{a}) \\ - \end{array} - - .. index:: function, host function, function address, function instance, function type, store .. _embed-func: @@ -277,12 +254,12 @@ Functions .. _embed-func-alloc: -:math:`\F{func\_alloc}(\store, \typeaddr, \hostfunc) : (\store, \funcaddr)` +:math:`\F{func\_alloc}(\store, \functype, \hostfunc) : (\store, \funcaddr)` ........................................................................... -1. Pre-condition: the :ref:`dynamic ` :math:`\functype` is :ref:`valid `. +1. Pre-condition: the :math:`\functype` is :ref:`valid ` under the empty :ref:`context `. -2. Let :math:`\funcaddr` be the result of :ref:`allocating a host function ` in :math:`\store` with :ref:`type address ` :math:`\typeaddr` and host function code :math:`\hostfunc`. +2. Let :math:`\funcaddr` be the result of :ref:`allocating a host function ` in :math:`\store` with :ref:`function type ` :math:`\functype` and host function code :math:`\hostfunc`. 3. Return the new store paired with :math:`\funcaddr`. @@ -302,15 +279,15 @@ Functions :math:`\F{func\_type}(\store, \funcaddr) : \functype` ..................................................... -1. Let :math:`\typeaddr` be the :ref:`type address ` :math:`S.\SFUNCS[a].\FITYPE`. +1. Let :math:`\functype` be the :ref:`function type ` :math:`S.\SFUNCS[a].\FITYPE`. -2. Return :math:`S.\STYPES[\typeaddr]`. +2. Return :math:`\functype`. -3. Post-condition: the returned :ref:`dynamic ` :ref:`function type ` is :ref:`valid `. +3. Post-condition: the returned :ref:`function type ` is :ref:`valid `. .. math:: \begin{array}{lclll} - \F{func\_type}(S, a) &=& S.\STYPES[S.\SFUNCS[a].\FITYPE] \\ + \F{func\_type}(S, a) &=& S.\SFUNCS[a].\FITYPE \\ \end{array} @@ -350,7 +327,7 @@ Tables :math:`\F{table\_alloc}(\store, \tabletype, \reff) : (\store, \tableaddr)` .......................................................................... -1. Pre-condition: the :ref:`dynamic ` :math:`\tabletype` is :ref:`valid `. +1. Pre-condition: the :math:`\tabletype` is :ref:`valid ` under the empty :ref:`context `. 2. Let :math:`\tableaddr` be the result of :ref:`allocating a table ` in :math:`\store` with :ref:`table type ` :math:`\tabletype` and initialization value :math:`\reff`. @@ -369,7 +346,7 @@ Tables 1. Return :math:`S.\STABLES[a].\TITYPE`. -2. Post-condition: the returned :ref:`dynamic ` :ref:`table type ` is :ref:`valid `. +2. Post-condition: the returned :ref:`table type ` is :ref:`valid ` under the empty :ref:`context `. .. math:: \begin{array}{lclll} @@ -462,7 +439,7 @@ Memories :math:`\F{mem\_alloc}(\store, \memtype) : (\store, \memaddr)` ................................................................ -1. Pre-condition: the :ref:`dynamic ` :math:`\memtype` is :ref:`valid `. +1. Pre-condition: the :math:`\memtype` is :ref:`valid ` under the empty :ref:`context `. 2. Let :math:`\memaddr` be the result of :ref:`allocating a memory ` in :math:`\store` with :ref:`memory type ` :math:`\memtype`. @@ -481,7 +458,7 @@ Memories 1. Return :math:`S.\SMEMS[a].\MITYPE`. -2. Post-condition: the returned :ref:`dynamic ` :ref:`memory type ` is :ref:`valid `. +2. Post-condition: the returned :ref:`memory type ` is :ref:`valid ` under the empty :ref:`context `. .. math:: \begin{array}{lclll} @@ -575,7 +552,7 @@ Globals :math:`\F{global\_alloc}(\store, \globaltype, \val) : (\store, \globaladdr)` ............................................................................ -1. Pre-condition: the :ref:`dynamic ` :math:`\globaltype` is :ref:`valid `. +1. Pre-condition: the :math:`\globaltype` is :ref:`valid ` under the empty :ref:`context `. 2. Let :math:`\globaladdr` be the result of :ref:`allocating a global ` in :math:`\store` with :ref:`global type ` :math:`\globaltype` and initialization value :math:`\val`. @@ -594,7 +571,7 @@ Globals 1. Return :math:`S.\SGLOBALS[a].\GITYPE`. -2. Post-condition: the returned :ref:`dynamic ` :ref:`global type ` is :ref:`valid `. +2. Post-condition: the returned :ref:`global type ` is :ref:`valid ` under the empty :ref:`context `. .. math:: \begin{array}{lclll} @@ -638,3 +615,29 @@ Globals \F{global\_write}(S, a, v) &=& S' && (\iff S.\SGLOBALS[a].\GITYPE = \MVAR~t \wedge S' = S \with \SGLOBALS[a].\GIVALUE = v) \\ \F{global\_write}(S, a, v) &=& \ERROR && (\otherwise) \\ \end{array} + + +.. index:: reference, reference type +.. _embed-ref: + +References +~~~~~~~~~~ + +:math:`\F{ref\_type}(\store, \reff) : \reftype` +............................................... + +1. Pre-condition: the :ref:`reference ` :math:`\reff` is :ref:`valid ` under store :math:`S`. + +2. Return the :ref:`reference type ` :math:`t` with which :math:`\reff` is valid. + +3. Post-condition: the returned :ref:`reference type ` is :ref:`valid ` under the empty :ref:`context `. + +.. math:: + \begin{array}{lclll} + \F{ref\_type}(S, r) &=& t && (\iff S \vdashval r : t) \\ + \end{array} + +.. note:: + In future versions of WebAssembly, + not all references may carry precise type information at run time. + In such cases, this function may return a less precise supertype. diff --git a/document/core/appendix/index-instructions.py b/document/core/appendix/index-instructions.py index 31cee56b3..0c0ea6f0a 100755 --- a/document/core/appendix/index-instructions.py +++ b/document/core/appendix/index-instructions.py @@ -280,9 +280,9 @@ def Instruction(name, opcode, type=None, validation=None, execution=None, operat Instruction(r'\REFNULL~\X{ht}', r'\hex{D0}', r'[] \to [(\REF~\NULL~\X{ht})]', r'valid-ref.null', r'exec-ref.null'), Instruction(r'\REFISNULL', r'\hex{D1}', r'[(\REF~\NULL~\X{ht})] \to [\I32]', r'valid-ref.is_null', r'exec-ref.is_null'), Instruction(r'\REFFUNC~x', r'\hex{D2}', r'[] \to [\FUNCREF]', r'valid-ref.func', r'exec-ref.func'), - Instruction(r'\REFASNONNULL', r'\hex{D3}', r'[(\REF~\NULL~\X{ht})] \to [(\REF~\X{ht})]', r'valid-ref.as_non_null', r'exec-ref.as_non_null'), - Instruction(r'\BRONNULL~l', r'\hex{D4}', r'[t^\ast~(\REF~\NULL~\X{ht})] \to [t^\ast~(\REF~\X{ht})]', r'valid-br_on_null', r'exec-br_on_null'), - Instruction(None, r'\hex{D5}'), + Instruction(None, r'\hex{D3}'), + Instruction(r'\REFASNONNULL', r'\hex{D4}', r'[(\REF~\NULL~\X{ht})] \to [(\REF~\X{ht})]', r'valid-ref.as_non_null', r'exec-ref.as_non_null'), + Instruction(r'\BRONNULL~l', r'\hex{D5}', r'[t^\ast~(\REF~\NULL~\X{ht})] \to [t^\ast~(\REF~\X{ht})]', r'valid-br_on_null', r'exec-br_on_null'), Instruction(r'\BRONNONNULL~l', r'\hex{D6}', r'[t^\ast~(\REF~\NULL~\X{ht})] \to [t^\ast]', r'valid-br_on_non_null', r'exec-br_on_non_null'), Instruction(None, r'\hex{D7}'), Instruction(None, r'\hex{D8}'), diff --git a/document/core/appendix/index-rules.rst b/document/core/appendix/index-rules.rst index ba337a76d..64f91a514 100644 --- a/document/core/appendix/index-rules.rst +++ b/document/core/appendix/index-rules.rst @@ -29,7 +29,7 @@ Construct Judgement :ref:`Instruction ` :math:`S;C \vdashinstr \instr : \functype` :ref:`Instruction sequence ` :math:`S;C \vdashinstrseq \instr^\ast : \functype` :ref:`Expression ` :math:`C \vdashexpr \expr : \resulttype` -:ref:`Function ` :math:`C \vdashfunc \func : \typeid` +:ref:`Function ` :math:`C \vdashfunc \func : \functype` :ref:`Local ` :math:`C \vdashlocal \local : \localtype` :ref:`Table ` :math:`C \vdashtable \table : \tabletype` :ref:`Memory ` :math:`C \vdashmem \mem : \memtype` @@ -58,7 +58,6 @@ Construct Judgement :ref:`Value ` :math:`S \vdashval \val : \valtype` :ref:`Result ` :math:`S \vdashresult \result : \resulttype` :ref:`External value ` :math:`S \vdashexternval \externval : \externtype` -:ref:`Type instance ` :math:`S \vdashtypeinst \typeinst \ok` :ref:`Function instance ` :math:`S \vdashfuncinst \funcinst : \functype` :ref:`Table instance ` :math:`S \vdashtableinst \tableinst : \tabletype` :ref:`Memory instance ` :math:`S \vdashmeminst \meminst : \memtype` @@ -122,7 +121,6 @@ Store Extension =============================================== =============================================================================== Construct Judgement =============================================== =============================================================================== -:ref:`Type instance ` :math:`\vdashtypeinstextends \typeinst_1 \extendsto \typeinst_2` :ref:`Function instance ` :math:`\vdashfuncinstextends \funcinst_1 \extendsto \funcinst_2` :ref:`Table instance ` :math:`\vdashtableinstextends \tableinst_1 \extendsto \tableinst_2` :ref:`Memory instance ` :math:`\vdashmeminstextends \meminst_1 \extendsto \meminst_2` diff --git a/document/core/appendix/index-types.rst b/document/core/appendix/index-types.rst index 9db74d3b3..c1f459495 100644 --- a/document/core/appendix/index-types.rst +++ b/document/core/appendix/index-types.rst @@ -16,10 +16,10 @@ Category Constructor (reserved) :math:`\hex{7A}` .. :math:`\hex{71}` :ref:`Heap type ` |FUNC| :math:`\hex{70}` (-16 as |Bs7|) :ref:`Heap type ` |EXTERN| :math:`\hex{6F}` (-17 as |Bs7|) -(reserved) :math:`\hex{6E}` .. :math:`\hex{6D}` -:ref:`Reference type ` |REF| |NULL| :math:`\hex{6C}` (-20 as |Bs7|) -:ref:`Reference type ` |REF| :math:`\hex{6B}` (-21 as |Bs7|) -(reserved) :math:`\hex{6A}` .. :math:`\hex{61}` +(reserved) :math:`\hex{6E}` .. :math:`\hex{65}` +:ref:`Reference type ` |REF| :math:`\hex{64}` (-28 as |Bs7|) +:ref:`Reference type ` |REF| |NULL| :math:`\hex{63}` (-29 as |Bs7|) +(reserved) :math:`\hex{62}` .. :math:`\hex{61}` :ref:`Function type ` :math:`[\valtype^\ast] \toF[\valtype^\ast]` :math:`\hex{60}` (-32 as |Bs7|) (reserved) :math:`\hex{5F}` .. :math:`\hex{41}` :ref:`Result type ` :math:`[\epsilon]` :math:`\hex{40}` (-64 as |Bs7|) diff --git a/document/core/appendix/properties.rst b/document/core/appendix/properties.rst index f4b3d5553..d0cb4726c 100644 --- a/document/core/appendix/properties.rst +++ b/document/core/appendix/properties.rst @@ -26,14 +26,14 @@ In order to state and prove soundness precisely, the typing rules must be extend Results ~~~~~~~ -:ref:`Results ` can be classified by :ref:`dynamic ` :ref:`result types ` as follows. +:ref:`Results ` can be classified by :ref:`result types ` as follows. :ref:`Results ` :math:`\val^\ast` ................................................ * For each :ref:`value ` :math:`\val_i` in :math:`\val^\ast`: - * The value :math:`\val_i` is :ref:`valid ` with some :ref:`dynamic ` :ref:`value type ` :math:`t_i`. + * The value :math:`\val_i` is :ref:`valid ` with some :ref:`value type ` :math:`t_i`. * Let :math:`t^\ast` be the concatenation of all :math:`t_i`. @@ -50,11 +50,11 @@ Results :ref:`Results ` :math:`\TRAP` ............................................ -* The result is valid with :ref:`result type ` :math:`[t^\ast]`, for any :ref:`valid ` :ref:`dynamic ` :ref:`result types `. +* The result is valid with :ref:`result type ` :math:`[t^\ast]`, for any :ref:`valid ` :ref:`closed ` :ref:`result types `. .. math:: \frac{ - S \vdashresulttype [t^\ast] \ok + \vdashresulttype [t^\ast] \ok }{ S \vdashresult \TRAP : [t^\ast] } @@ -80,9 +80,7 @@ Module instances are classified by *module contexts*, which are regular :ref:`co :ref:`Store ` :math:`S` ..................................... -* Each :ref:`type instance ` :math:`\typeinst_i` in :math:`S.\STYPES` must be :ref:`valid ` in a store :math:`S'_i` only containing the sequence :math:`\typeinst_0 \dots \typeinst_{i-1}` of preceding type instances. - -* Each :ref:`function instance ` :math:`\funcinst_i` in :math:`S.\SFUNCS` must be :ref:`valid ` with some :ref:`type address ` :math:`\typeaddr_i`. +* Each :ref:`function instance ` :math:`\funcinst_i` in :math:`S.\SFUNCS` must be :ref:`valid ` with some :ref:`function type ` :math:`\functype_i`. * Each :ref:`table instance ` :math:`\tableinst_i` in :math:`S.\STABLES` must be :ref:`valid ` with some :ref:`table type ` :math:`\tabletype_i`. @@ -100,11 +98,7 @@ Module instances are classified by *module contexts*, which are regular :ref:`co ~\\[-1ex] \frac{ \begin{array}{@{}c@{}} - a^n = 0 \dots (n-1) - \qquad - (\{\STYPES~\typeinst^n[0 \slice a]\} \vdashtypeinst \typeinst \ok)^n - \\ - (S \vdashfuncinst \funcinst : \typeaddr)^\ast + (S \vdashfuncinst \funcinst : \functype)^\ast \qquad (S \vdashtableinst \tableinst : \tabletype)^\ast \\ @@ -118,7 +112,6 @@ Module instances are classified by *module contexts*, which are regular :ref:`co \\ S = \{ \begin{array}[t]{@{}l@{}} - \STYPES~\typeinst^n, \SFUNCS~\funcinst^\ast, \SGLOBALS~\globalinst^\ast, \\ \STABLES~\tableinst^\ast, @@ -135,63 +128,49 @@ Module instances are classified by *module contexts*, which are regular :ref:`co The validity condition on type instances ensures the absence of cyclic types. -.. index:: function type, type instance -.. _valid-typeinst: - -:ref:`Type Instances ` :math:`\functype` -......................................................... - -* The :ref:`dynamic ` :ref:`function type ` :math:`\functype` must be :ref:`valid `. - -* Then it is valid as a type instance. - -.. math:: - \frac{ - S \vdashfunctype \functype \ok - }{ - S \vdashtypeinst \functype \ok - } - - .. index:: function type, function instance .. _valid-funcinst: -:ref:`Function Instances ` :math:`\{\FITYPE~\typeaddr, \FIMODULE~\moduleinst, \FICODE~\func\}` +:ref:`Function Instances ` :math:`\{\FITYPE~\functype, \FIMODULE~\moduleinst, \FICODE~\func\}` ....................................................................................................................... +* The :ref:`function type ` :math:`\functype` must be :ref:`valid ` under an empty :ref:`context `. + * The :ref:`module instance ` :math:`\moduleinst` must be :ref:`valid ` with some :ref:`context ` :math:`C`. * Under :ref:`context ` :math:`C`: - * The :ref:`function ` :math:`\func` must be :ref:`valid ` with :ref:`static ` :ref:`type identifier ` :math:`\typeidx`. + * The :ref:`function ` :math:`\func` must be :ref:`valid ` with some :ref:`function type ` :math:`\functype'`. - * The :ref:`static ` :ref:`heap type ` :math:`\typeidx` must :ref:`match ` the :ref:`dynamic ` :ref:`heap type ` :math:`\typeaddr`. + * The :ref:`function type ` :math:`\functype'` must :ref:`match ` :math:`\functype`. -* Then the function instance is valid with :ref:`type address ` :math:`\typeaddr`. +* Then the function instance is valid with :ref:`function type ` :math:`\functype`. .. math:: \frac{ \begin{array}{@{}c@{}} + \vdashfunctype \functype \ok + \qquad S \vdashmoduleinst \moduleinst : C \\ - C \vdashfunc \func : \typeidx + C \vdashfunc \func : \functype' \qquad - C; S \vdashheaptypematch \typeidx \matchesheaptype \typeaddr + C \vdashfunctypematch \functype' \matchesfunctype \functype \end{array} }{ - S \vdashfuncinst \{\FITYPE~\typeaddr, \FIMODULE~\moduleinst, \FICODE~\func\} : \typeaddr + S \vdashfuncinst \{\FITYPE~\functype, \FIMODULE~\moduleinst, \FICODE~\func\} : \functype } .. index:: function type, function instance, host function .. _valid-hostfuncinst: -:ref:`Host Function Instances ` :math:`\{\FITYPE~\typeaddr, \FIHOSTCODE~\X{hf}\}` +:ref:`Host Function Instances ` :math:`\{\FITYPE~\functype, \FIHOSTCODE~\X{hf}\}` .................................................................................................. -* The :ref:`type instance ` :math:`S.\STYPES[\typeaddr]` must exist. +* The :ref:`function type ` :math:`\functype` must be :ref:`valid ` under an empty :ref:`context `. -* Let the :ref:`dynamic ` :ref:`function type ` :math:`[t_1^\ast] \toF [t_2^\ast]` be the :ref:`type instance ` :math:`S.\STYPES[\typeaddr]`. +* Let :math:`[t_1^\ast] \toF [t_2^\ast]` be the :ref:`function type ` :math:`\functype`. * For every :ref:`valid ` :ref:`store ` :math:`S_1` :ref:`extending ` :math:`S` and every sequence :math:`\val^\ast` of :ref:`values ` whose :ref:`types ` coincide with :math:`t_1^\ast`: @@ -203,12 +182,12 @@ Module instances are classified by *module contexts*, which are regular :ref:`co * Or :math:`R` consists of a :ref:`valid ` :ref:`store ` :math:`S_2` :ref:`extending ` :math:`S_1` and a :ref:`result ` :math:`\result` whose :ref:`type ` coincides with :math:`[t_2^\ast]`. -* Then the function instance is valid with :ref:`type address ` :math:`\typeaddr`. +* Then the function instance is valid with :ref:`function type ` :math:`\functype`. .. math:: \frac{ \begin{array}[b]{@{}l@{}} - S.\STYPES[\typeaddr] = [t_1^\ast] \toF [t_2^\ast] \\ + \vdashfunctype [t_1^\ast] \toF [t_2^\ast] \ok \\ \end{array} \quad \begin{array}[b]{@{}l@{}} @@ -227,7 +206,7 @@ Module instances are classified by *module contexts*, which are regular :ref:`co R = (S_2; \result) \end{array} }{ - S \vdashfuncinst \{\FITYPE~\typeaddr, \FIHOSTCODE~\X{hf}\} : \typeaddr + S \vdashfuncinst \{\FITYPE~[t_1^\ast] \to [t_2^\ast], \FIHOSTCODE~\X{hf}\} : [t_1^\ast] \to [t_2^\ast] } .. note:: @@ -244,7 +223,7 @@ Module instances are classified by *module contexts*, which are regular :ref:`co :ref:`Table Instances ` :math:`\{ \TITYPE~(\limits~t), \TIELEM~\reff^\ast \}` ............................................................................................... -* The :ref:`dynamic ` :ref:`table type ` :math:`\limits~t` must be :ref:`valid `. +* The :ref:`table type ` :math:`\limits~t` must be :ref:`valid ` under the empty :ref:`context `. * The length of :math:`\reff^\ast` must equal :math:`\limits.\LMIN`. @@ -258,13 +237,13 @@ Module instances are classified by *module contexts*, which are regular :ref:`co .. math:: \frac{ - S \vdashtabletype \limits~t \ok + \vdashtabletype \limits~t \ok \qquad n = \limits.\LMIN \qquad (S \vdash \reff : t')^n \qquad - (S \vdashreftypematch t' \matchesvaltype t)^n + (\vdashreftypematch t' \matchesvaltype t)^n }{ S \vdashtableinst \{ \TITYPE~(\limits~t), \TIELEM~\reff^n \} : \limits~t } @@ -276,7 +255,7 @@ Module instances are classified by *module contexts*, which are regular :ref:`co :ref:`Memory Instances ` :math:`\{ \MITYPE~\limits, \MIDATA~b^\ast \}` ...................................................................................... -* The :ref:`dynamic ` :ref:`memory type ` :math:`\limits` must be :ref:`valid `. +* The :ref:`memory type ` :math:`\limits` must be :ref:`valid ` under the empty :ref:`context `. * The length of :math:`b^\ast` must equal :math:`\limits.\LMIN` multiplied by the :ref:`page size ` :math:`64\,\F{Ki}`. @@ -284,7 +263,7 @@ Module instances are classified by *module contexts*, which are regular :ref:`co .. math:: \frac{ - S \vdashmemtype \limits \ok + \vdashmemtype \limits \ok \qquad n = \limits.\LMIN \cdot 64\,\F{Ki} }{ @@ -298,7 +277,7 @@ Module instances are classified by *module contexts*, which are regular :ref:`co :ref:`Global Instances ` :math:`\{ \GITYPE~(\mut~t), \GIVALUE~\val \}` ......................................................................................... -* The :ref:`dynamic ` :ref:`global type ` :math:`\mut~t` must be :ref:`valid `. +* The :ref:`global type ` :math:`\mut~t` must be :ref:`valid ` under the empty :ref:`context `. * The :ref:`value ` :math:`\val` must be :ref:`valid ` with some :ref:`value type ` :math:`t'`. @@ -308,11 +287,11 @@ Module instances are classified by *module contexts*, which are regular :ref:`co .. math:: \frac{ - S \vdashglobaltype \mut~t \ok + \vdashglobaltype \mut~t \ok \qquad S \vdashval \val : t' \qquad - S \vdashvaltypematch t' \matchesvaltype t + \vdashvaltypematch t' \matchesvaltype t }{ S \vdashglobalinst \{ \GITYPE~(\mut~t), \GIVALUE~\val \} : \mut~t } @@ -324,7 +303,7 @@ Module instances are classified by *module contexts*, which are regular :ref:`co :ref:`Element Instances ` :math:`\{ \EITYPE~t, \EIELEM~\reff^\ast \}` ...................................................................................... -* The :ref:`dynamic ` :ref:`reference type ` :math:`t` must be :ref:`valid `. +* The :ref:`reference type ` :math:`t` must be :ref:`valid ` under the empty :ref:`context `. * For each :ref:`reference ` :math:`\reff_i` in the elements :math:`\reff^n`: @@ -336,11 +315,11 @@ Module instances are classified by *module contexts*, which are regular :ref:`co .. math:: \frac{ - S \vdashreftype t \ok + \vdashreftype t \ok \qquad (S \vdash \reff : t')^\ast \qquad - (S \vdashreftypematch t' \matchesvaltype t)^\ast + (\vdashreftypematch t' \matchesvaltype t)^\ast }{ S \vdasheleminst \{ \EITYPE~t, \EIELEM~\reff^\ast \} : t } @@ -385,9 +364,9 @@ Module instances are classified by *module contexts*, which are regular :ref:`co :ref:`Module Instances ` :math:`\moduleinst` ............................................................... -* For each :ref:`type address ` :math:`\typeaddr_i` in :math:`\moduleinst.\MITYPES`, the :ref:`type instance ` :math:`\typeinst_i` at :math:`S.\STYPES[\typeaddr_i]` must be :ref:`valid `. +* Each :ref:`defined type ` :math:`\deftype_i` in :math:`\moduleinst.\MITYPES` must be :ref:`valid `. -* For each :ref:`function address ` :math:`\funcaddr_i` in :math:`\moduleinst.\MIFUNCS`, the :ref:`external value ` :math:`\EVFUNC~\funcaddr_i` must be :ref:`valid ` with some :ref:`external type ` :math:`\ETFUNC~\typeaddr'_i`. +* For each :ref:`function address ` :math:`\funcaddr_i` in :math:`\moduleinst.\MIFUNCS`, the :ref:`external value ` :math:`\EVFUNC~\funcaddr_i` must be :ref:`valid ` with some :ref:`external type ` :math:`\ETFUNC~\functype_i`. * For each :ref:`table address ` :math:`\tableaddr_i` in :math:`\moduleinst.\MITABLES`, the :ref:`external value ` :math:`\EVTABLE~\tableaddr_i` must be :ref:`valid ` with some :ref:`external type ` :math:`\ETTABLE~\tabletype_i`. @@ -403,9 +382,9 @@ Module instances are classified by *module contexts*, which are regular :ref:`co * For each :ref:`export instance ` :math:`\exportinst_i` in :math:`\moduleinst.\MIEXPORTS`, the :ref:`name ` :math:`\exportinst_i.\EINAME` must be different from any other name occurring in :math:`\moduleinst.\MIEXPORTS`. -* Let :math:`\typeinst^\ast` be the concatenation of all :math:`\typeinst_i` in order. +* Let :math:`\deftype^\ast` be the concatenation of all :math:`\deftype_i` in order. -* Let :math:`\typeaddr'^\ast` be the concatenation of all :math:`\typeaddr'_i` in order. +* Let :math:`\functype^\ast` be the concatenation of all :math:`\functype_i` in order. * Let :math:`\tabletype^\ast` be the concatenation of all :math:`\tabletype_i` in order. @@ -418,15 +397,15 @@ Module instances are classified by *module contexts*, which are regular :ref:`co * Let :math:`n` be the length of :math:`\moduleinst.\MIDATAS`. * Then the module instance is valid with :ref:`context ` - :math:`\{\CTYPES~\typeinst^\ast,` :math:`\CFUNCS~{\typeaddr'}^\ast,` :math:`\CTABLES~\tabletype^\ast,` :math:`\CMEMS~\memtype^\ast,` :math:`\CGLOBALS~\globaltype^\ast,` :math:`\CELEMS~\reftype^\ast,` :math:`\CDATAS~{\ok}^n\}`. + :math:`\{\CTYPES~\deftype^\ast,` :math:`\CFUNCS~\functype^\ast,` :math:`\CTABLES~\tabletype^\ast,` :math:`\CMEMS~\memtype^\ast,` :math:`\CGLOBALS~\globaltype^\ast,` :math:`\CELEMS~\reftype^\ast,` :math:`\CDATAS~{\ok}^n\}`. .. math:: ~\\[-1ex] \frac{ \begin{array}{@{}c@{}} - (S \vdashtypeinst S.\STYPES[\typeaddr] \ok)^\ast + (\vdashdeftype \deftype \ok)^\ast \\ - (S \vdashexternval \EVFUNC~\funcaddr : \ETFUNC~\typeaddr')^\ast + (S \vdashexternval \EVFUNC~\funcaddr : \ETFUNC~\functype)^\ast \qquad (S \vdashexternval \EVTABLE~\tableaddr : \ETTABLE~\tabletype)^\ast \\ @@ -445,7 +424,7 @@ Module instances are classified by *module contexts*, which are regular :ref:`co }{ S \vdashmoduleinst \{ \begin{array}[t]{@{}l@{~}l@{}} - \MITYPES & \typeaddr^\ast, \\ + \MITYPES & \deftype^\ast, \\ \MIFUNCS & \funcaddr^\ast, \\ \MITABLES & \tableaddr^\ast, \\ \MIMEMS & \memaddr^\ast, \\ @@ -454,8 +433,8 @@ Module instances are classified by *module contexts*, which are regular :ref:`co \MIDATAS & \dataaddr^n, \\ \MIEXPORTS & \exportinst^\ast ~\} : \{ \begin{array}[t]{@{}l@{~}l@{}} - \CTYPES & S.\STYPES[\typeaddr]^\ast, \\ - \CFUNCS & {\typeaddr'}^\ast, \\ + \CTYPES & \deftype^\ast, \\ + \CFUNCS & \functype^\ast, \\ \CTABLES & \tabletype^\ast, \\ \CMEMS & \memtype^\ast, \\ \CGLOBALS & \globaltype^\ast, \\ @@ -465,9 +444,6 @@ Module instances are classified by *module contexts*, which are regular :ref:`co \end{array} } -.. note:: - The context derived for a module instance consists of :ref:`dynamic types `. - .. scratch .. index:: context, store, frame @@ -586,7 +562,7 @@ Finally, :ref:`frames ` are classified with *frame contexts*, whic :ref:`Frames ` :math:`\{\ALOCALS~\val^\ast, \AMODULE~\moduleinst\}` ................................................................................. -* The :ref:`module instance ` :math:`\moduleinst` must be :ref:`valid ` with some :ref:`dynamic ` :ref:`module context ` :math:`C`. +* The :ref:`module instance ` :math:`\moduleinst` must be :ref:`valid ` with some :ref:`module context ` :math:`C`. * Each :ref:`value ` :math:`\val_i` in :math:`\val^\ast` must be :ref:`valid ` with some :ref:`value type ` :math:`t_i`. @@ -623,11 +599,11 @@ To that end, all previous typing judgements :math:`C \vdash \X{prop}` are genera :math:`\TRAP` ............. -* The instruction is valid with any :ref:`valid ` :ref:`dynamic ` :ref:`instruction type ` of the form :math:`[t_1^\ast] \to [t_2^\ast]`. +* The instruction is valid with any :ref:`valid ` :ref:`instruction type ` of the form :math:`[t_1^\ast] \to [t_2^\ast]`. .. math:: \frac{ - S; C \vdashinstrtype [t_1^\ast] \to [t_2^\ast] \ok + C \vdashinstrtype [t_1^\ast] \to [t_2^\ast] \ok }{ S; C \vdashadmininstr \TRAP : [t_1^\ast] \to [t_2^\ast] } @@ -652,41 +628,32 @@ To that end, all previous typing judgements :math:`C \vdash \X{prop}` are genera :math:`\REFFUNCADDR~\funcaddr` .............................. -* The :ref:`external function value ` :math:`\EVFUNC~\funcaddr` must be :ref:`valid ` with :ref:`dynamic ` :ref:`external function type ` :math:`\ETFUNC~a'`. +* The :ref:`external function value ` :math:`\EVFUNC~\funcaddr` must be :ref:`valid ` with :ref:`external function type ` :math:`\ETFUNC~\functype`. -* Then the instruction is valid with type :math:`[] \to [(\REF~a')]`. +* Then the instruction is valid with type :math:`[] \to [(\REF~\functype)]`. .. math:: \frac{ - S \vdashexternval \EVFUNC~a : \ETFUNC~a' + S \vdashexternval \EVFUNC~a : \ETFUNC~\functype }{ - S; C \vdashadmininstr \REFFUNCADDR~a : [] \to [(\REF~a')] + S; C \vdashadmininstr \REFFUNCADDR~a : [] \to [(\REF~\functype)] } -.. note:: - This typing rule yields a :ref:`dynamic ` type. - The function may originate from outside the current module, - so that a definition for its type may not exist in context :math:`C`. - .. index:: function address, extern value, extern type, function type :math:`\INVOKE~\funcaddr` ......................... -* The :ref:`external function value ` :math:`\EVFUNC~\funcaddr` must be :ref:`valid ` with :ref:`external function type ` :math:`\ETFUNC a'`. - -* Assert: The :ref:`type address ` :math:`S.\STYPES[a']` is defined in the store. +* The :ref:`external function value ` :math:`\EVFUNC~\funcaddr` must be :ref:`valid ` with :ref:`external function type ` :math:`\ETFUNC \functype'`. -* Let :math:`[t_1^\ast] \toF [t_2^\ast])` be the :ref:`function type ` :math:`S.\STYPES[a']`. +* Let :math:`[t_1^\ast] \toF [t_2^\ast])` be the :ref:`function type ` :math:`\functype`. * Then the instruction is valid with type :math:`[t_1^\ast] \to [t_2^\ast]`. .. math:: \frac{ - S \vdashexternval \EVFUNC~\funcaddr : \ETFUNC~a' - \qquad - S.\STYPES[a'] = [t_1^\ast] \toF [t_2^\ast] + S \vdashexternval \EVFUNC~\funcaddr : \ETFUNC~[t_1^\ast] \toF [t_2^\ast] }{ S; C \vdashadmininstr \INVOKE~\funcaddr : [t_1^\ast] \to [t_2^\ast] } @@ -721,25 +688,20 @@ To that end, all previous typing judgements :math:`C \vdash \X{prop}` are genera :math:`\FRAME_n\{F\}~\instr^\ast~\END` ........................................... -* Under the :ref:`valid ` :ref:`dynamic ` return type :math:`[t^n]`, +* Under the :ref:`valid ` return type :math:`[t^n]`, the :ref:`thread ` :math:`F; \instr^\ast` must be :ref:`valid ` with :ref:`result type ` :math:`[t^n]`. * Then the compound instruction is valid with type :math:`[] \to [t^n]`. .. math:: \frac{ - S \vdashresulttype [t^n] \ok + C \vdashresulttype [t^n] \ok \qquad S; [t^n] \vdashinstrseq F; \instr^\ast : [t^n] }{ S; C \vdashadmininstr \FRAME_n\{F\}~\instr^\ast~\END : [] \to [t^n] } -.. note:: - This typing rule yields a :ref:`dynamic ` type. - The frame's function may originate from outside the current module, - so that the :math:`t^n` may reference type definitions that do not exist in context :math:`C`. - .. index:: ! store extension, store .. _extend: @@ -766,8 +728,6 @@ a store state :math:`S'` extends state :math:`S`, written :math:`S \extendsto S' :ref:`Store ` :math:`S` ..................................... -* The length of :math:`S.\STYPES` must not shrink. - * The length of :math:`S.\SFUNCS` must not shrink. * The length of :math:`S.\STABLES` must not shrink. @@ -780,8 +740,6 @@ a store state :math:`S'` extends state :math:`S`, written :math:`S \extendsto S' * The length of :math:`S.\SDATAS` must not shrink. -* For each :ref:`type instance ` :math:`\typeinst_i` in the original :math:`S.\STYPES`, the new type instance must be an :ref:`extension ` of the old. - * For each :ref:`function instance ` :math:`\funcinst_i` in the original :math:`S.\SFUNCS`, the new function instance must be an :ref:`extension ` of the old. * For each :ref:`table instance ` :math:`\tableinst_i` in the original :math:`S.\STABLES`, the new table instance must be an :ref:`extension ` of the old. @@ -797,9 +755,6 @@ a store state :math:`S'` extends state :math:`S`, written :math:`S \extendsto S' .. math:: \frac{ \begin{array}{@{}ccc@{}} - S_1.\STYPES = \typeinst_1^\ast & - S_2.\STYPES = {\typeinst'_1}^\ast~\typeinst_2^\ast & - (\vdashtypeinstextends \typeinst_1 \extendsto \typeinst'_1)^\ast \\ S_1.\SFUNCS = \funcinst_1^\ast & S_2.\SFUNCS = {\funcinst'_1}^\ast~\funcinst_2^\ast & (\vdashfuncinstextends \funcinst_1 \extendsto \funcinst'_1)^\ast \\ @@ -824,21 +779,6 @@ a store state :math:`S'` extends state :math:`S`, written :math:`S \extendsto S' } -.. index:: type instance -.. _extend-typeinst: - -:ref:`Type Instance ` :math:`\typeinst` -........................................................ - -* A type instance must remain unchanged. - -.. math:: - \frac{ - }{ - \vdashtypeinstextends \typeinst \extendsto \typeinst - } - - .. index:: function instance .. _extend-funcinst: diff --git a/document/core/binary/instructions.rst b/document/core/binary/instructions.rst index 175526bb8..80ac806cf 100644 --- a/document/core/binary/instructions.rst +++ b/document/core/binary/instructions.rst @@ -72,7 +72,7 @@ Control Instructions \hex{13}~~y{:}\Btypeidx~~x{:}\Btableidx &\Rightarrow& \RETURNCALLINDIRECT~x~y \\ &&|& \hex{14}~~x{:}\Btypeidx &\Rightarrow& \CALLREF~x \\ &&|& \hex{15}~~x{:}\Btypeidx &\Rightarrow& \RETURNCALLREF~x \\ &&|& - \hex{D4}~~l{:}\Blabelidx &\Rightarrow& \BRONNULL~l \\ &&|& + \hex{D5}~~l{:}\Blabelidx &\Rightarrow& \BRONNULL~l \\ &&|& \hex{D6}~~l{:}\Blabelidx &\Rightarrow& \BRONNONNULL~l \\ \end{array} @@ -103,7 +103,7 @@ Reference Instructions \hex{D0}~~t{:}\Bheaptype &\Rightarrow& \REFNULL~t \\ &&|& \hex{D1} &\Rightarrow& \REFISNULL \\ &&|& \hex{D2}~~x{:}\Bfuncidx &\Rightarrow& \REFFUNC~x \\ &&|& - \hex{D3} &\Rightarrow& \REFASNONNULL \\ + \hex{D4} &\Rightarrow& \REFASNONNULL \\ \end{array} diff --git a/document/core/binary/types.rst b/document/core/binary/types.rst index 08a30d521..9c05d7840 100644 --- a/document/core/binary/types.rst +++ b/document/core/binary/types.rst @@ -75,8 +75,8 @@ Reference Types .. math:: \begin{array}{llclll@{\qquad\qquad}l} \production{reference type} & \Breftype &::=& - \hex{6B}~~\X{ht}{:}\Bheaptype &\Rightarrow& \REF~\X{ht} \\ &&|& - \hex{6C}~~\X{ht}{:}\Bheaptype &\Rightarrow& \REF~\NULL~\X{ht} \\ &&|& + \hex{63}~~\X{ht}{:}\Bheaptype &\Rightarrow& \REF~\NULL~\X{ht} \\ &&|& + \hex{64}~~\X{ht}{:}\Bheaptype &\Rightarrow& \REF~\X{ht} \\ &&|& \hex{6F} &\Rightarrow& \EXTERNREF \\ &&|& \hex{70} &\Rightarrow& \FUNCREF \\ \end{array} diff --git a/document/core/exec/instructions.rst b/document/core/exec/instructions.rst index 0034071ab..69c36cc3d 100644 --- a/document/core/exec/instructions.rst +++ b/document/core/exec/instructions.rst @@ -2628,11 +2628,11 @@ Control Instructions :math:`\BLOCK~\blocktype~\instr^\ast~\END` .......................................... -1. Assert: due to :ref:`validation `, :math:`\expand_{S;F}(\blocktype)` is defined. +1. Let :math:`F` be the :ref:`current ` :ref:`frame `. -2. Let :math:`[t_1^m] \to [t_2^n]` be the :ref:`instruction type ` :math:`\expand_{S;F}(\blocktype)`. +2. Assert: due to :ref:`validation `, :math:`\expand_{S;F}(\blocktype)` is defined. -3. Let :math:`[t_1^m] \to [t_2^n]` be the :ref:`function type ` :math:`\expand_F(\blocktype)`. +3. Let :math:`[t_1^m] \to [t_2^n]` be the :ref:`instruction type ` :math:`\expand_{S;F}(\blocktype)`. 4. Let :math:`L` be the label whose arity is :math:`n` and whose continuation is the end of the block. @@ -2656,11 +2656,11 @@ Control Instructions :math:`\LOOP~\blocktype~\instr^\ast~\END` ......................................... -1. Assert: due to :ref:`validation `, :math:`\expand_{S;F}(\blocktype)` is defined. +1. Let :math:`F` be the :ref:`current ` :ref:`frame `. -2. Let :math:`[t_1^m] \to [t_2^n]` be the :ref:`instruction type ` :math:`\expand_{S;F}(\blocktype)`. +2. Assert: due to :ref:`validation `, :math:`\expand_{S;F}(\blocktype)` is defined. -3. Let :math:`[t_1^m] \to [t_2^n]` be the :ref:`function type ` :math:`\expand_F(\blocktype)`. +3. Let :math:`[t_1^m] \to [t_2^n]` be the :ref:`instruction type ` :math:`\expand_{S;F}(\blocktype)`. 4. Let :math:`L` be the label whose arity is :math:`m` and whose continuation is the start of the loop. @@ -2951,41 +2951,37 @@ Control Instructions 6. Assert: due to :ref:`validation `, :math:`F.\AMODULE.\MITYPES[y]` exists. -7. Let :math:`\X{ta}_{\F{expect}}` be the :ref:`type address ` :math:`F.\AMODULE.\MITYPES[y]`. - -8. Let :math:`\X{ft}_{\F{expect}}` be the :ref:`function type ` :math:`S.\STYPES[\X{ta}_{\F{expect}}]`. +7. Let :math:`\X{ft}_{\F{expect}}` be the :ref:`function type ` :math:`F.\AMODULE.\MITYPES[y]`. -9. Assert: due to :ref:`validation `, a value with :ref:`value type ` |I32| is on the top of the stack. +8. Assert: due to :ref:`validation `, a value with :ref:`value type ` |I32| is on the top of the stack. -10. Pop the value :math:`\I32.\CONST~i` from the stack. +9. Pop the value :math:`\I32.\CONST~i` from the stack. -11. If :math:`i` is not smaller than the length of :math:`\X{tab}.\TIELEM`, then: +10. If :math:`i` is not smaller than the length of :math:`\X{tab}.\TIELEM`, then: a. Trap. -12. Let :math:`r` be the :ref:`reference ` :math:`\X{tab}.\TIELEM[i]`. +11. Let :math:`r` be the :ref:`reference ` :math:`\X{tab}.\TIELEM[i]`. -13. If :math:`r` is :math:`\REFNULL~\X{ht}`, then: +12. If :math:`r` is :math:`\REFNULL~\X{ht}`, then: a. Trap. -14. Assert: due to :ref:`validation of table mutation `, :math:`r` is a :ref:`function reference `. - -15. Let :math:`\REFFUNCADDR~a` be the :ref:`function reference ` :math:`r`. +13. Assert: due to :ref:`validation of table mutation `, :math:`r` is a :ref:`function reference `. -16. Assert: due to :ref:`validation of table mutation `, :math:`S.\SFUNCS[a]` exists. +14. Let :math:`\REFFUNCADDR~a` be the :ref:`function reference ` :math:`r`. -17. Let :math:`\X{f}` be the :ref:`function instance ` :math:`S.\SFUNCS[a]`. +15. Assert: due to :ref:`validation of table mutation `, :math:`S.\SFUNCS[a]` exists. -18. Let :math:`\X{ta}_{\F{actual}}` be the :ref:`type address ` :math:`\X{f}.\FITYPE`. +16. Let :math:`\X{f}` be the :ref:`function instance ` :math:`S.\SFUNCS[a]`. -19. Let :math:`\X{ft}_{\F{actual}}` be the :ref:`function type ` :math:`S.\STYPES[\X{ta}_{\F{actual}}]`. +17. Let :math:`\X{ft}_{\F{actual}}` be the :ref:`function type ` :math:`\X{f}.\FITYPE`. -20. If :math:`\X{ft}_{\F{actual}}` and :math:`\X{ft}_{\F{expect}}` differ, then: +18. If :math:`\X{ft}_{\F{actual}}` and :math:`\X{ft}_{\F{expect}}` differ, then: a. Trap. -21. :ref:`Invoke ` the function instance at address :math:`a`. +19. :ref:`Invoke ` the function instance at address :math:`a`. .. math:: ~\\[-1ex] @@ -2997,7 +2993,7 @@ Control Instructions \begin{array}[t]{@{}r@{~}l@{}} (\iff & S.\STABLES[F.\AMODULE.\MITABLES[x]].\TIELEM[i] = \REFFUNCADDR~a \\ \wedge & S.\SFUNCS[a] = f \\ - \wedge & S \vdashfunctypematch S.\STYPES[F.\AMODULE.\MITYPES[y]] \matchesfunctype S.\STYPES[f.\FITYPE]) + \wedge & S \vdashfunctypematch F.\AMODULE.\MITYPES[y] \matchesfunctype f.\FITYPE) \end{array} \\[1ex] \begin{array}{lcl@{\qquad}l} @@ -3185,25 +3181,23 @@ Invocation of :ref:`function address ` :math:`a` 2. Let :math:`f` be the :ref:`function instance `, :math:`S.\SFUNCS[a]`. -3. Let :math:`\X{ta}` be the :ref:`type address ` :math:`\X{f}.\FITYPE`. +3. Let :math:`[t_1^n] \toF [t_2^m]` be the :ref:`function type ` :math:`\X{f}.\FITYPE`. -4. Let :math:`[t_1^n] \toF [t_2^m]` be the :ref:`function type ` :math:`S.\STYPES[\X{ta}]`. +4. Let :math:`\local^\ast` be the list of :ref:`locals ` :math:`f.\FICODE.\FLOCALS`. -5. Let :math:`\local^\ast` be the list of :ref:`locals ` :math:`f.\FICODE.\FLOCALS`. +5. Let :math:`\instr^\ast~\END` be the :ref:`expression ` :math:`f.\FICODE.\FBODY`. -6. Let :math:`\instr^\ast~\END` be the :ref:`expression ` :math:`f.\FICODE.\FBODY`. +6. Assert: due to :ref:`validation `, :math:`n` values are on the top of the stack. -7. Assert: due to :ref:`validation `, :math:`n` values are on the top of the stack. +7. Pop the values :math:`\val^n` from the stack. -8. Pop the values :math:`\val^n` from the stack. +8. Let :math:`F` be the :ref:`frame ` :math:`\{ \AMODULE~f.\FIMODULE, \ALOCALS~\val^n~(\default_t)^\ast \}`. -9. Let :math:`F` be the :ref:`frame ` :math:`\{ \AMODULE~f.\FIMODULE, \ALOCALS~\val^n~(\default_t)^\ast \}`. +9. Push the activation of :math:`F` with arity :math:`m` to the stack. -10. Push the activation of :math:`F` with arity :math:`m` to the stack. +10. Let :math:`L` be the :ref:`label ` whose arity is :math:`m` and whose continuation is the end of the function. -11. Let :math:`L` be the :ref:`label ` whose arity is :math:`m` and whose continuation is the end of the function. - -12. :ref:`Enter ` the instruction sequence :math:`\instr^\ast` with label :math:`L`. +11. :ref:`Enter ` the instruction sequence :math:`\instr^\ast` with label :math:`L`. .. math:: ~\\[-1ex] @@ -3214,7 +3208,7 @@ Invocation of :ref:`function address ` :math:`a` \\ \qquad \begin{array}[t]{@{}r@{~}l@{}} (\iff & S.\SFUNCS[a] = f \\ - \wedge & S.\STYPES[f.\FITYPE] = [t_1^n] \toF [t_2^m] \\ + \wedge & S.f.\FITYPE = [t_1^n] \toF [t_2^m] \\ \wedge & f.\FICODE = \{ \FTYPE~x, \FLOCALS~\{\LTYPE~t\}^k, \FBODY~\instr^\ast~\END \} \\ \wedge & F = \{ \AMODULE~f.\FIMODULE, ~\ALOCALS~\val^n~(\default_t)^k \}) \end{array} \\ @@ -3313,8 +3307,7 @@ Furthermore, the resulting store must be :ref:`valid `, i.e., all d \end{array} \\ \qquad \begin{array}[t]{@{}r@{~}l@{}} - (\iff & S.\SFUNCS[a] = \{ \FITYPE~\X{ta}, \FIHOSTCODE~\X{hf} \} \\ - \wedge & S.\STYPES[\X{ta}] = [t_1^n] \toF [t_2^m] \\ + (\iff & S.\SFUNCS[a] = \{ \FITYPE~[t_1^n] \toF [t_2^m], \FIHOSTCODE~\X{hf} \} \\ \wedge & (S'; \result) \in \X{hf}(S; \val^n)) \\ \end{array} \\ \begin{array}{lcl@{\qquad}l} diff --git a/document/core/exec/modules.rst b/document/core/exec/modules.rst index 9d8ae5a4d..6b20540e1 100644 --- a/document/core/exec/modules.rst +++ b/document/core/exec/modules.rst @@ -10,34 +10,10 @@ For modules, the execution semantics primarily defines :ref:`instantiation `, :ref:`functions `, :ref:`tables `, :ref:`memories `, and :ref:`globals ` are *allocated* in a :ref:`store ` :math:`S`, as defined by the following auxiliary functions. +New instances of :ref:`functions `, :ref:`tables `, :ref:`memories `, and :ref:`globals ` are *allocated* in a :ref:`store ` :math:`S`, as defined by the following auxiliary functions. -.. index:: type, type instance, type address, function type -.. _alloc-type: - -:ref:`Types ` -.............................. - -1. Let :math:`\functype` be the :ref:`dynamic type `. - -2. Let :math:`a` be the first free :ref:`type address ` in :math:`S`. - -3. Append :math:`\typeinst` to the |STYPES| of :math:`S`. - -4. Return :math:`a`. - -.. math:: - ~\\[-1ex] - \begin{array}{rlll} - \alloctype(S, \functype) &=& S', \typeaddr \\[1ex] - \mbox{where:} \hfill \\ - \typeaddr &=& |S.\STYPES| \\ - S' &=& S \compose \{\STYPES~\typeinst\} \\ - \end{array} - - -.. index:: function, function instance, function address, module instance, function type, type instance +.. index:: function, function instance, function address, module instance, function type .. _alloc-func: :ref:`Functions ` @@ -45,11 +21,11 @@ New instances of :ref:`types `, :ref:`functions ` to allocate and :math:`\moduleinst` its :ref:`module instance `. -2. Let :math:`\typeaddr` be the :ref:`type address ` :math:`\moduleinst.\MITYPES[\func.\FTYPE]`. +2. Let :math:`\functype` be the :ref:`function type ` :math:`\moduleinst.\MITYPES[\func.\FTYPE]`. 3. Let :math:`a` be the first free :ref:`function address ` in :math:`S`. -4. Let :math:`\funcinst` be the :ref:`function instance ` :math:`\{ \FITYPE~\typeaddr', \FIMODULE~\moduleinst, \FICODE~\func \}`. +4. Let :math:`\funcinst` be the :ref:`function instance ` :math:`\{ \FITYPE~\functype, \FIMODULE~\moduleinst, \FICODE~\func \}`. 6. Append :math:`\funcinst` to the |SFUNCS| of :math:`S`. @@ -60,9 +36,9 @@ New instances of :ref:`types `, :ref:`functions `, :ref:`functions ` ....................................... -1. Let :math:`\hostfunc` be the :ref:`host function ` to allocate and :math:`\typeaddr` its :ref:`dynamic ` :ref:`function type `. +1. Let :math:`\hostfunc` be the :ref:`host function ` to allocate and :math:`\functype` its :ref:`function type `. 2. Let :math:`a` be the first free :ref:`function address ` in :math:`S`. -3. Let :math:`\funcinst` be the :ref:`function instance ` :math:`\{ \FITYPE~\typeaddr, \FIHOSTCODE~\hostfunc \}`. +3. Let :math:`\funcinst` be the :ref:`function instance ` :math:`\{ \FITYPE~\functype, \FIHOSTCODE~\hostfunc \}`. 4. Append :math:`\funcinst` to the |SFUNCS| of :math:`S`. @@ -86,10 +62,10 @@ New instances of :ref:`types `, :ref:`functions `, :ref:`functions ` ................................ -1. Let :math:`\tabletype` be the :ref:`dynamic ` :ref:`table type ` of the table to allocate and :math:`\reff` the initialization value. +1. Let :math:`\tabletype` be the :ref:`table type ` of the table to allocate and :math:`\reff` the initialization value. 2. Let :math:`(\{\LMIN~n, \LMAX~m^?\}~\reftype)` be the structure of :ref:`table type ` :math:`\tabletype`. -3. Let :math:`\tabletype'` be the :ref:`table type ` obtained from :math:`\tabletype` by substituting each :ref:`type index ` :math:`x` occurring in it with the :ref:`type address ` :math:`\moduleinst.\MITYPES[x]`. +3. Let :math:`a` be the first free :ref:`table address ` in :math:`S`. -4. Let :math:`a` be the first free :ref:`table address ` in :math:`S`. +4. Let :math:`\tableinst` be the :ref:`table instance ` :math:`\{ \TITYPE~\tabletype', \TIELEM~\reff^n \}` with :math:`n` elements set to :math:`\reff`. -5. Let :math:`\tableinst` be the :ref:`table instance ` :math:`\{ \TITYPE~\tabletype', \TIELEM~\reff^n \}` with :math:`n` elements set to :math:`\reff`. +5. Append :math:`\tableinst` to the |STABLES| of :math:`S`. -6. Append :math:`\tableinst` to the |STABLES| of :math:`S`. - -7. Return :math:`a`. +6. Return :math:`a`. .. math:: \begin{array}{rlll} @@ -135,7 +109,7 @@ New instances of :ref:`types `, :ref:`functions ` ................................ -1. Let :math:`\memtype` be the :ref:`dynamic ` :ref:`memory type ` of the memory to allocate. +1. Let :math:`\memtype` be the :ref:`memory type ` of the memory to allocate. 2. Let :math:`\{\LMIN~n, \LMAX~m^?\}` be the structure of :ref:`memory type ` :math:`\memtype`. @@ -164,7 +138,7 @@ New instances of :ref:`types `, :ref:`functions ` .................................. -1. Let :math:`\globaltype` be the :ref:`dynamic ` :ref:`global type ` of the global to allocate and :math:`\val` its initialization :ref:`value `. +1. Let :math:`\globaltype` be the :ref:`global type ` of the global to allocate and :math:`\val` its initialization :ref:`value `. 2. Let :math:`a` be the first free :ref:`global address ` in :math:`S`. @@ -190,7 +164,7 @@ New instances of :ref:`types `, :ref:`functions ` ......................................... -1. Let :math:`\reftype` be the elements' :ref:`dynamic ` type and :math:`\reff^\ast` the vector of :ref:`references ` to allocate. +1. Let :math:`\reftype` be the elements' type and :math:`\reff^\ast` the vector of :ref:`references ` to allocate. 2. Let :math:`a` be the first free :ref:`element address ` in :math:`S`. @@ -322,11 +296,9 @@ and list of :ref:`reference ` vectors for the module's :ref:`element 1. Let :math:`\module` be the :ref:`module ` to allocate and :math:`\externval_{\F{im}}^\ast` the vector of :ref:`external values ` providing the module's imports, :math:`\val_{\F{g}}^\ast` the initialization :ref:`values ` of the module's :ref:`globals `, :math:`\reff_{\F{t}}^\ast` the initializer :ref:`reference ` of the module's :ref:`tables `, and :math:`(\reff_{\F{e}}^\ast)^\ast` the :ref:`reference ` vectors of the module's :ref:`element segments `. -2. For each :ref:`function type ` :math:`\functype_i` in :math:`\module.\MTYPES`, do: - - a. Let :math:`\functype'_i` be the :ref:`dynamic ` :ref:`function type ` obtained from :math:`\functype_i` in :math:`\moduleinst` defined below. +2. For each :ref:`defined type ` :math:`\deftype'_i` in :math:`\module.\MTYPES`, do: - b. Let :math:`\typeaddr_i` be the :ref:`type address ` resulting from :ref:`allocating ` :math:`\functype'_i`. + a. Let :math:`\deftype_i` be the :ref:`instantiation ` :math:`\deftype'_i` in :math:`\moduleinst` defined below. 3. For each :ref:`function ` :math:`\func_i` in :math:`\module.\MFUNCS`, do: @@ -334,25 +306,25 @@ and list of :ref:`reference ` vectors for the module's :ref:`element 4. For each :ref:`table ` :math:`\table_i` in :math:`\module.\MTABLES`, do: - a. Let :math:`\limits_i~t_i` be the :ref:`dynamic ` :ref:`table type ` obtained from :math:`\table_i.\TTYPE` in :math:`\moduleinst` defined below. + a. Let :math:`\limits_i~t_i` be the :ref:`table type ` obtained by :ref:`instantiating ` :math:`\table_i.\TTYPE` in :math:`\moduleinst` defined below. b. Let :math:`\tableaddr_i` be the :ref:`table address ` resulting from :ref:`allocating ` :math:`\table_i.\TTYPE` with initialization value :math:`\reff_{\F{t}}^\ast[i]`. 5. For each :ref:`memory ` :math:`\mem_i` in :math:`\module.\MMEMS`, do: - a. Let :math:`\memtype_i` be the :ref:`dynamic ` :ref:`memory type ` obtained from :math:`\mem_i.\MTYPE` in :math:`\moduleinst` defined below. + a. Let :math:`\memtype_i` be the :ref:`memory type ` obtained by :ref:`insantiating ` :math:`\mem_i.\MTYPE` in :math:`\moduleinst` defined below. b. Let :math:`\memaddr_i` be the :ref:`memory address ` resulting from :ref:`allocating ` :math:`\memtype_i`. 6. For each :ref:`global ` :math:`\global_i` in :math:`\module.\MGLOBALS`, do: - a. Let :math:`\globaltype_i` be the :ref:`dynamic ` :ref:`global type ` obtained from :math:`\global_i.\GTYPE` in :math:`\moduleinst` defined below. + a. Let :math:`\globaltype_i` be the :ref:`global type ` obtained by :ref:`instantiating ` :math:`\global_i.\GTYPE` in :math:`\moduleinst` defined below. b. Let :math:`\globaladdr_i` be the :ref:`global address ` resulting from :ref:`allocating ` :math:`\globaltype_i` with initializer value :math:`\val_{\F{g}}^\ast[i]`. 7. For each :ref:`element segment ` :math:`\elem_i` in :math:`\module.\MELEMS`, do: - a. Let :math:`\reftype_i` be the :ref:`dynamic ` element :ref:`reference type ` obtained from :math:`\elem_i.\ETYPE` in :math:`\moduleinst` defined below. + a. Let :math:`\reftype_i` be the element :ref:`reference type ` obtained by `instantiating ` :math:`\elem_i.\ETYPE` in :math:`\moduleinst` defined below. b. Let :math:`\elemaddr_i` be the :ref:`element address ` resulting from :ref:`allocating ` a :ref:`element instance ` of :ref:`reference type ` :math:`\reftype_i` with contents :math:`(\reff_{\F{e}}^\ast)^\ast[i]`. @@ -360,7 +332,7 @@ and list of :ref:`reference ` vectors for the module's :ref:`element a. Let :math:`\dataaddr_i` be the :ref:`data address ` resulting from :ref:`allocating ` a :ref:`data instance ` with contents :math:`\data_i.\DINIT`. -9. Let :math:`\typeaddr^\ast` be the concatenation of the :ref:`function addresses ` :math:`\typeaddr_i` in index order. +9. Let :math:`\deftype^\ast` be the concatenation of the :ref:`defined types ` :math:`\deftype_i` in index order. 10. Let :math:`\funcaddr^\ast` be the concatenation of the :ref:`function addresses ` :math:`\funcaddr_i` in index order. @@ -396,7 +368,7 @@ and list of :ref:`reference ` vectors for the module's :ref:`element 21. Let :math:`\exportinst^\ast` be the concatenation of the :ref:`export instances ` :math:`\exportinst_i` in index order. -22. Let :math:`\moduleinst` be the :ref:`module instance ` :math:`\{\MITYPES~\typeaddr^\ast,` :math:`\MIFUNCS~\funcaddr_{\F{mod}}^\ast,` :math:`\MITABLES~\tableaddr_{\F{mod}}^\ast,` :math:`\MIMEMS~\memaddr_{\F{mod}}^\ast,` :math:`\MIGLOBALS~\globaladdr_{\F{mod}}^\ast,` :math:`\MIEXPORTS~\exportinst^\ast\}`. +22. Let :math:`\moduleinst` be the :ref:`module instance ` :math:`\{\MITYPES~\deftype^\ast,` :math:`\MIFUNCS~\funcaddr_{\F{mod}}^\ast,` :math:`\MITABLES~\tableaddr_{\F{mod}}^\ast,` :math:`\MIMEMS~\memaddr_{\F{mod}}^\ast,` :math:`\MIGLOBALS~\globaladdr_{\F{mod}}^\ast,` :math:`\MIEXPORTS~\exportinst^\ast\}`. 23. Return :math:`\moduleinst`. @@ -419,7 +391,7 @@ where: \export^\ast &=& \module.\MEXPORTS \\[1ex] \moduleinst &=& \{~ \begin{array}[t]{@{}l@{}} - \MITYPES~\typeaddr^\ast, \\ + \MITYPES~\deftype^\ast, \\ \MIFUNCS~\evfuncs(\externval_{\F{im}}^\ast)~\funcaddr^\ast, \\ \MITABLES~\evtables(\externval_{\F{im}}^\ast)~\tableaddr^\ast, \\ \MIMEMS~\evmems(\externval_{\F{im}}^\ast)~\memaddr^\ast, \\ @@ -428,21 +400,21 @@ where: \MIDATAS~\dataaddr^\ast, \\ \MIEXPORTS~\exportinst^\ast ~\} \end{array} \\[1ex] - S_1, \typeaddr^\ast &=& - \alloctype^\ast(S, \dyn_{\moduleinst}(\module.\MTYPES)) \\ - S_2, \funcaddr^\ast &=& - \allocfunc^\ast(S_1, \module.\MFUNCS, \moduleinst) \\ - S_3, \tableaddr^\ast &=& - \alloctable^\ast(S_2, \dyn_{\moduleinst}(\table.\TTYPE)^\ast, \reff_{\F{t}}^\ast) + \deftype^\ast &=& + \insttype_{\moduleinst}(\module.\MTYPES) \\ + S_1, \funcaddr^\ast &=& + \allocfunc^\ast(S, \module.\MFUNCS, \moduleinst) \\ + S_2, \tableaddr^\ast &=& + \alloctable^\ast(S_1, \insttype_{\moduleinst}(\table.\TTYPE)^\ast, \reff_{\F{t}}^\ast) \quad (\where (\table.\TTYPE)^\ast = (\limits~t)^\ast) \\ - S_4, \memaddr^\ast &=& - \allocmem^\ast(S_3, \dyn_{\moduleinst}(\mem.\MTYPE)^\ast) \\ - S_5, \globaladdr^\ast &=& - \allocglobal^\ast(S_3, \dyn_{\moduleinst}(\global.\GTYPE)^\ast, \val_{\F{g}}^\ast) \\ - S_6, \elemaddr^\ast &=& - \allocelem^\ast(S_5, \dyn_{\moduleinst}(\elem.\ETYPE)^\ast, (\reff_{\F{e}}^\ast)^\ast) \\ + S_3, \memaddr^\ast &=& + \allocmem^\ast(S_2, \insttype_{\moduleinst}(\mem.\MTYPE)^\ast) \\ + S_4, \globaladdr^\ast &=& + \allocglobal^\ast(S_3, \insttype_{\moduleinst}(\global.\GTYPE)^\ast, \val_{\F{g}}^\ast) \\ + S_5, \elemaddr^\ast &=& + \allocelem^\ast(S_4, \insttype_{\moduleinst}(\elem.\ETYPE)^\ast, (\reff_{\F{e}}^\ast)^\ast) \\ S', \dataaddr^\ast &=& - \allocdata^\ast(S_6, \dyn_{\moduleinst}(\data.\DINIT)^\ast) \\ + \allocdata^\ast(S_5, \data.\DINIT^\ast) \\ \exportinst^\ast &=& \{ \EINAME~(\export.\ENAME), \EIVALUE~\externval_{\F{ex}} \}^\ast \\[1ex] \evfuncs(\externval_{\F{ex}}^\ast) &=& (\moduleinst.\MIFUNCS[x])^\ast @@ -511,7 +483,7 @@ It is up to the :ref:`embedder ` to define how such conditions are rep i. Fail. - b. Let :math:`\externtype''_i` be the :ref:`dynamic ` :ref:`external type ` obtained by :ref:`instantiating ` :math:`\externtype'_i` in :math:`\moduleinst` defined below. + b. Let :math:`\externtype''_i` be the :ref:`external type ` obtained by :ref:`instantiating ` :math:`\externtype'_i` in :math:`\moduleinst` defined below. c. If :math:`\externtype_i` does not :ref:`match ` :math:`\externtype''_i`, then: @@ -624,7 +596,7 @@ It is up to the :ref:`embedder ` to define how such conditions are rep &(\iff & \vdashmodule \module : \externtype_{\F{im}}^k \rightarrow \externtype_{\F{ex}}^\ast \\ &\wedge& (S' \vdashexternval \externval : \externtype)^k \\ - &\wedge& (S' \vdashexterntypematch \externtype \matchesexterntype \dyn_{\moduleinst}(\externtype_{\F{im}}))^k \\[1ex] + &\wedge& (S' \vdashexterntypematch \externtype \matchesexterntype \insttype_{\moduleinst}(\externtype_{\F{im}}))^k \\[1ex] &\wedge& \module.\MGLOBALS = \global^\ast \\ &\wedge& \module.\MELEMS = \elem^n \\ &\wedge& \module.\MDATAS = \data^m \\ @@ -636,18 +608,15 @@ It is up to the :ref:`embedder ` to define how such conditions are rep &\wedge& F = \{ \AMODULE~\moduleinst, \ALOCALS~\epsilon \} \\[1ex] &\wedge& (S'; F; \expr_{\F{g}} \stepto^\ast S'; F; \val_{\F{g}}~\END)^\ast \\ &\wedge& (S'; F; \expr_{\F{t}} \stepto^\ast S'; F; \reff_{\F{t}}~\END)^\ast \\ - &\wedge& ((S'; F; \expr_{\F{e}} \stepto^\ast S'; F; \reff_{\F{e}}~\END)^\ast)^n \\ - &\wedge& (\tableaddr = \moduleinst.\MITABLES[\elem.\ETABLE])^\ast \\ - &\wedge& (\memaddr = \moduleinst.\MIMEMS[\data.\DMEM])^\ast \\ - &\wedge& (\funcaddr = \moduleinst.\MIFUNCS[\start.\SFUNC])^?) + &\wedge& ((S'; F; \expr_{\F{e}} \stepto^\ast S'; F; \reff_{\F{e}}~\END)^\ast)^n) \\ \end{array} where: .. math:: \begin{array}{@{}l} - \F{runelem}_i(\{\ETYPE~\X{et}, \EINIT~\reff^n, \EMODE~\EPASSIVE\}) \quad=\\ \qquad \epsilon \\ - \F{runelem}_i(\{\ETYPE~\X{et}, \EINIT~\reff^n, \EMODE~\EACTIVE \{\ETABLE~x, \EOFFSET~\instr^\ast~\END\}\}) \quad=\\ \qquad + \F{runelem}_i(\{\ETYPE~\X{et}, \EINIT~\expr^n, \EMODE~\EPASSIVE\}) \quad=\quad \epsilon \\ + \F{runelem}_i(\{\ETYPE~\X{et}, \EINIT~\expr^n, \EMODE~\EACTIVE \{\ETABLE~x, \EOFFSET~\instr^\ast~\END\}\}) \quad=\\ \qquad \instr^\ast~(\I32.\CONST~0)~(\I32.\CONST~n)~(\TABLEINIT~x~i)~(\ELEMDROP~i) \\ \F{runelem}_i(\{\ETYPE~\X{et}, \EINIT~\expr^n, \EMODE~\EDECLARATIVE\}) \quad=\\ \qquad (\ELEMDROP~i) \\[1ex] @@ -657,7 +626,7 @@ where: \end{array} .. note:: - Checking import types assumes that the :ref:`module instance ` has already been :ref:`allocated ` and the resulting :ref:`type addresses ` are available, in order to :ref:`instantiate ` all relevant types. + Checking import types assumes that the :ref:`module instance ` has already been :ref:`allocated ` to compute the respective :ref:`closed ` :ref:`defined types `. However, this forward reference merely is a way to simplify the specification. In practice, implementations will likely allocate or canonicalize types beforehand, when *compiling* a module, in a stage before instantiation and before imports are checked. @@ -694,29 +663,25 @@ The following steps are performed: 2. Let :math:`\funcinst` be the :ref:`function instance ` :math:`S.\SFUNCS[\funcaddr]`. -3. Let :math:`\typeaddr` be the :ref:`type address ` :math:`\funcinst.\FITYPE`. - -4. Assert: :math:`S.\STYPES[\typeaddr]` exists. - -5. Let :math:`[t_1^n] \toF [t_2^m]` be the :ref:`dynamic ` :ref:`function type ` :math:`S.\STYPES[\typeaddr]`. +3. Let :math:`[t_1^n] \toF [t_2^m]` be the :ref:`function type ` :math:`\funcinst.\FITYPE`. -6. If the length :math:`|\val^\ast|` of the provided argument values is different from the number :math:`n` of expected arguments, then: +4. If the length :math:`|\val^\ast|` of the provided argument values is different from the number :math:`n` of expected arguments, then: a. Fail. -7. For each :ref:`value type ` :math:`t_i` in :math:`t_1^n` and corresponding :ref:`value ` :math:`val_i` in :math:`\val^\ast`, do: +5. For each :ref:`value type ` :math:`t_i` in :math:`t_1^n` and corresponding :ref:`value ` :math:`val_i` in :math:`\val^\ast`, do: a. If :math:`\val_i` is not :ref:`valid ` with value type :math:`t_i`, then: i. Fail. -8. Let :math:`F` be the dummy :ref:`frame ` :math:`\{ \AMODULE~\{\}, \ALOCALS~\epsilon \}`. +6. Let :math:`F` be the dummy :ref:`frame ` :math:`\{ \AMODULE~\{\}, \ALOCALS~\epsilon \}`. -9. Push the frame :math:`F` to the stack. +7. Push the frame :math:`F` to the stack. -10. Push the values :math:`\val^\ast` to the stack. +8. Push the values :math:`\val^\ast` to the stack. -11. :ref:`Invoke ` the function instance at address :math:`\funcaddr`. +9. :ref:`Invoke ` the function instance at address :math:`\funcaddr`. Once the function has returned, the following steps are executed: @@ -730,7 +695,7 @@ The values :math:`\val_{\F{res}}^m` are returned as the results of the invocatio ~\\[-1ex] \begin{array}{@{}lcl} \invoke(S, \funcaddr, \val^n) &=& S; F; \val^n~(\INVOKE~\funcaddr) \\ - &(\iff & S.\STYPES[S.\SFUNCS[\funcaddr].\FITYPE] = [t_1^n] \toF [t_2^m] \\ + &(\iff & S.\SFUNCS[\funcaddr].\FITYPE = [t_1^n] \toF [t_2^m] \\ &\wedge& (S \vdashval \val : t_1)^n \\ &\wedge& F = \{ \AMODULE~\{\}, \ALOCALS~\epsilon \}) \\ \end{array} diff --git a/document/core/exec/runtime.rst b/document/core/exec/runtime.rst index 01655984b..23464eae0 100644 --- a/document/core/exec/runtime.rst +++ b/document/core/exec/runtime.rst @@ -97,7 +97,7 @@ Store ~~~~~ The *store* represents all global state that can be manipulated by WebAssembly programs. -It consists of the runtime representation of all *instances* of :ref:`types `, :ref:`functions `, :ref:`tables `, :ref:`memories `, and :ref:`globals `, :ref:`element segments `, and :ref:`data segments ` that have been :ref:`allocated ` during the life time of the abstract machine. [#gc]_ +It consists of the runtime representation of all *instances* of :ref:`functions `, :ref:`tables `, :ref:`memories `, and :ref:`globals `, :ref:`element segments `, and :ref:`data segments ` that have been :ref:`allocated ` during the life time of the abstract machine. [#gc]_ It is an invariant of the semantics that no element or data instance is :ref:`addressed ` from anywhere else but the owning module instances. @@ -107,7 +107,6 @@ Syntactically, the store is defined as a :ref:`record ` listing \begin{array}{llll} \production{store} & \store &::=& \{~ \begin{array}[t]{l@{~}ll} - \STYPES & \typeinst^\ast, \\ \SFUNCS & \funcinst^\ast, \\ \STABLES & \tableinst^\ast, \\ \SMEMS & \meminst^\ast, \\ @@ -130,7 +129,6 @@ Convention .. index:: ! address, store, function instance, table instance, memory instance, global instance, element instance, data instance, embedder - pair: abstract syntax; type address pair: abstract syntax; function address pair: abstract syntax; table address pair: abstract syntax; memory address @@ -138,7 +136,6 @@ Convention pair: abstract syntax; element address pair: abstract syntax; data address pair: abstract syntax; host address - pair: type; address pair: function; address pair: table; address pair: memory; address @@ -146,7 +143,6 @@ Convention pair: element; address pair: data; address pair: host; address -.. _syntax-typeaddr: .. _syntax-funcaddr: .. _syntax-tableaddr: .. _syntax-memaddr: @@ -159,7 +155,7 @@ Convention Addresses ~~~~~~~~~ -:ref:`Type instances `, :ref:`function instances `, :ref:`table instances `, :ref:`memory instances `, and :ref:`global instances `, :ref:`element instances `, and :ref:`data instances ` in the :ref:`store ` are referenced with abstract *addresses*. +:ref:`Function instances `, :ref:`table instances `, :ref:`memory instances `, and :ref:`global instances `, :ref:`element instances `, and :ref:`data instances ` in the :ref:`store ` are referenced with abstract *addresses*. These are simply indices into the respective store component. In addition, an :ref:`embedder ` may supply an uninterpreted set of *host addresses*. @@ -167,8 +163,6 @@ In addition, an :ref:`embedder ` may supply an uninterpreted set of *h \begin{array}{llll} \production{address} & \addr &::=& 0 ~|~ 1 ~|~ 2 ~|~ \dots \\ - \production{type address} & \typeaddr &::=& - \addr \\ \production{function address} & \funcaddr &::=& \addr \\ \production{table address} & \tableaddr &::=& @@ -200,7 +194,6 @@ even where this identity is not observable from within WebAssembly code itself hence logical addresses can be arbitrarily large natural numbers. -.. _free-typeaddr: .. _free-funcaddr: .. _free-tableaddr: .. _free-memaddr: @@ -234,7 +227,7 @@ and collects runtime representations of all entities that are imported, defined, \begin{array}{llll} \production{module instance} & \moduleinst &::=& \{ \begin{array}[t]{l@{~}ll} - \MITYPES & \typeaddr^\ast, \\ + \MITYPES & \deftype^\ast, \\ \MIFUNCS & \funcaddr^\ast, \\ \MITABLES & \tableaddr^\ast, \\ \MIMEMS & \memaddr^\ast, \\ @@ -246,29 +239,11 @@ and collects runtime representations of all entities that are imported, defined, \end{array} Each component references runtime instances corresponding to respective declarations from the original module -- whether imported or defined -- in the order of their static :ref:`indices `. -:ref:`Type instances `, :ref:`function instances `, :ref:`table instances `, :ref:`memory instances `, and :ref:`global instances ` are referenced with an indirection through their respective :ref:`addresses ` in the :ref:`store `. +:ref:`Function instances `, :ref:`table instances `, :ref:`memory instances `, and :ref:`global instances ` are referenced with an indirection through their respective :ref:`addresses ` in the :ref:`store `. It is an invariant of the semantics that all :ref:`export instances ` in a given module instance have different :ref:`names `. -.. index:: ! type instance, function type, module - pair: abstract syntax; function instance - pair: function; instance -.. _syntax-typeinst: - -Type Instances -~~~~~~~~~~~~~~ - -A *type instance* is the runtime representation of a :ref:`function type `. -It is a :ref:`dynamic type ` equivalent to the respective :ref:`static type ` that appeared in the module. - -.. math:: - \begin{array}{llll} - \production{type instance} & \typeinst &::=& - \functype - \end{array} - - .. index:: ! function instance, module instance, function, closure, module, ! host function, invocation pair: abstract syntax; function instance pair: function; instance @@ -285,8 +260,8 @@ The module instance is used to resolve references to other definitions during ex .. math:: \begin{array}{llll} \production{function instance} & \funcinst &::=& - \{ \FITYPE~\typeaddr, \FIMODULE~\moduleinst, \FICODE~\func \} \\ &&|& - \{ \FITYPE~\typeaddr, \FIHOSTCODE~\hostfunc \} \\ + \{ \FITYPE~\functype, \FIMODULE~\moduleinst, \FICODE~\func \} \\ &&|& + \{ \FITYPE~\functype, \FIHOSTCODE~\hostfunc \} \\ \production{host function} & \hostfunc &::=& \dots \\ \end{array} @@ -552,7 +527,7 @@ Conventions .. math:: \begin{array}{lll} - \expand_{S;F}(\typeidx) &=& S.\STYPES[F.\AMODULE.\MITYPES[\typeidx]] \\ + \expand_{S;F}(\typeidx) &=& F.\AMODULE.\MITYPES[\typeidx] \\ \expand_{S;F}([\valtype^?]) &=& [] \to [\valtype^?] \\ \end{array} diff --git a/document/core/exec/types.rst b/document/core/exec/types.rst index 19175460c..6742ba1aa 100644 --- a/document/core/exec/types.rst +++ b/document/core/exec/types.rst @@ -4,69 +4,23 @@ Types ----- -Execution has to check and compare :ref:`types ` and :ref:`type instances ` in a few places, such as :ref:`executing ` |CALLINDIRECT| or :ref:`instantiating ` :ref:`modules `. -During execution, types of all forms are represented as :ref:`dynamic ` types, where all occurring :ref:`type identifiers ` are interpreted as :ref:`type addresses `. -Relevant type relations need to be redefined accordingly. +Execution has to check and compare :ref:`types ` in a few places, such as :ref:`executing ` |CALLINDIRECT| or :ref:`instantiating ` :ref:`modules `. + +It is an invariant of the semantics that all types occurring during execution are :ref:`closed `. .. note:: Runtime type checks generally involve types from multiple modules or types not defined by a module at all, such that module-local :ref:`type indices ` are not meaningful. - Type addresses are global to a :ref:`store ` and can hence be interpreted independent of module boundaries. - - -.. index:: type identifier, type address, store - pair: validation; type identifier - single: abstract syntax; type identifier -.. _valid-typeaddr: - -Type Identifiers -~~~~~~~~~~~~~~~~ - -During execution, :ref:`type identifiers ` are represented as :ref:`type addresses `, which are looked up as :ref:`function types ` in the :ref:`store ` by the following rule. - -:math:`\typeaddr` -................. - -* The type :math:`S.\STYPES[\typeaddr]` must be defined in the store. - -* Then the type address is valid as :ref:`function type ` :math:`S.\STYPES[\typeaddr]`. - -.. math:: - \frac{ - S.\STYPES[\typeaddr] = \functype - }{ - S; C \vdashtypeid \typeaddr : \functype - } -.. note:: - Unlike :ref:`type indices ` recorded in a context, the number of type addresses in a store is not bounded by :math:`2^{32}`. -.. index:: type identifier, type index, type address, type instantiation, module instance, dynamic type +.. index:: type index, defined type, type instantiation, module instance, dynamic type -.. _dyn: +.. _type-inst: Instantiation ~~~~~~~~~~~~~ -Any form of :ref:`static ` :ref:`type ` can be *instantiated* into a :ref:`dynamic ` type inside a :ref:`module instance ` by :ref:`substituting ` each :ref:`type index ` :math:`x` occurring in it with the corresponding :ref:`type address ` :math:`\moduleinst.\MITYPES[x]`. +Any form of :ref:`type ` can be *instantiated* into a :ref:`closed ` type inside a :ref:`module instance ` by :ref:`substituting ` each :ref:`type index ` :math:`x` occurring in it with the corresponding :ref:`defined type ` :math:`\moduleinst.\MITYPES[x]`. .. math:: - \dyn_{\moduleinst}(t) = t[\subst \moduleinst.\MITYPES] - - -.. index:: type, matching, store, dynamic types, validity -.. _exec-valid-type: -.. _exec-match: - -Dynamic Typing -~~~~~~~~~~~~~~ - -To handle :ref:`dynamic ` types, all static judgements :math:`C \vdash \X{prop}` on types (such as :ref:`validity ` and :ref:`matching `) are generalized to include the store, as in :math:`S; C \vdash \X{prop}`, by implicitly adding a :ref:`store ` :math:`S` to all rules -- :math:`S` is never modified by the pre-existing rules, but it is accessed in the extra rule for :ref:`type addresses ` given :ref:`above `. - -It is an invariant of the semantics that all types inspected by execution rules are dynamic, i.e., the :ref:`context ` is always empty and never used. -To avoid unnecessary clutter, empty contexts are omitted from the rules, writing just :math:`S \vdash \X{prop}`. - -.. note:: - Only matching rules are invoked during execution. - Dynamic validity is only needed to prove :ref:`type soundness ` - and for specifying parts of the :ref:`embedder ` interface. + \insttype_{\moduleinst}(t) = t[\subst \moduleinst.\MITYPES] diff --git a/document/core/exec/values.rst b/document/core/exec/values.rst index f5a873495..e0fd90e24 100644 --- a/document/core/exec/values.rst +++ b/document/core/exec/values.rst @@ -11,7 +11,7 @@ Value Typing ~~~~~~~~~~~~ For the purpose of checking argument :ref:`values ` against the parameter types of exported :ref:`functions `, -values are classified by :ref:`dynamic ` :ref:`value types `. +values are classified by :ref:`value types `. The following auxiliary typing rules specify this typing relation relative to a :ref:`store ` :math:`S` in which possibly referenced addresses live. .. _valid-num: @@ -45,13 +45,13 @@ The following auxiliary typing rules specify this typing relation relative to a :ref:`Null References ` :math:`\REFNULL~t` ...................................................... -* The :ref:`dynamic ` :ref:`heap type ` must be :ref:`valid `. +* The :ref:`heap type ` must be :ref:`valid ` under the empty :ref:`context `. * Then value is valid with :ref:`reference type ` :math:`(\REF~\NULL~t)`. .. math:: \frac{ - S \vdashheaptype t \ok + \vdashheaptype t \ok }{ S \vdashval \REFNULL~t : (\REF~\NULL~t) } @@ -60,15 +60,15 @@ The following auxiliary typing rules specify this typing relation relative to a :ref:`Function References ` :math:`\REFFUNCADDR~a` .............................................................. -* The :ref:`external value ` :math:`\EVFUNC~a` must be :ref:`valid ` with :ref:`dynamic ` :ref:`external type ` :math:`\ETFUNC~a'`. +* The :ref:`external value ` :math:`\EVFUNC~a` must be :ref:`valid ` with :ref:`external type ` :math:`\ETFUNC~\functype`. -* Then the value is valid with :ref:`dynamic ` :ref:`reference type ` :math:`(\REF~a')`. +* Then the value is valid with :ref:`reference type ` :math:`(\REF~\functype)`. .. math:: \frac{ - S \vdashexternval \EVFUNC~a : \ETFUNC~a' + S \vdashexternval \EVFUNC~a : \ETFUNC~\functype }{ - S \vdashval \REFFUNCADDR~a : \REF~a' + S \vdashval \REFFUNCADDR~a : \REF~\functype } @@ -92,7 +92,7 @@ External Typing ~~~~~~~~~~~~~~~ For the purpose of checking :ref:`external values ` against :ref:`imports `, -such values are classified by :ref:`dynamic ` :ref:`external types `. +such values are classified by :ref:`external types `. The following auxiliary typing rules specify this typing relation relative to a :ref:`store ` :math:`S` in which the referenced instances live. diff --git a/document/core/syntax/types.rst b/document/core/syntax/types.rst index 15a57fb10..5d1b355c7 100644 --- a/document/core/syntax/types.rst +++ b/document/core/syntax/types.rst @@ -9,51 +9,6 @@ Various entities in WebAssembly are classified by types. Types are checked during :ref:`validation `, :ref:`instantiation `, and possibly :ref:`execution `. - -.. index:: ! type identifier, type index, type address, ! static type, ! dynamic type - pair: abstract syntax; type identifier -.. _syntax-typeid: -.. _syntax-type-stat: -.. _syntax-type-dyn: - -Type Identifiers -~~~~~~~~~~~~~~~~ - -Defined types like :ref:`function types ` are not embedded directly into other types, such as :ref:`reference types `. -Instead, they are referred to indirectly. - -In a :ref:`module ` and during :ref:`validation `, this indirection is expressed through a :ref:`type index `, whose meaning is confined to one module. - -During :ref:`execution `, where types from multiple modules may interact, it is expressed through :ref:`type addresses ` that refer to the global :ref:`store `. - -The type grammar hence allows multiple representations of type identifiers: - -.. math:: - \begin{array}{llll} - \production{type identifier} & \typeid &::=& - \typeidx ~|~ \typeaddr - \end{array} - -Types represented with type indices are referred to as *static types*, -whereas types represented with type addresses are referred to as *dynamic types*. - -Static types are transformed into dynamic types during module :ref:`instantiation `. - -It is an invariant of the semantics that only static types arise during :ref:`validation `, while only dynamic types are used during :ref:`execution `. -However, for the proof of :ref:`type soundness `, both forms of types must be considered together, and static types may refer to dynamic types. - -.. _notation-subst: - -Convention -.......... - -The following notation expresses conversion between static and dynamic types: - -* :math:`t[x^\ast \subst a^\ast]` denotes the parallel substitution of :ref:`type indices ` :math:`x^\ast` with :ref:`type addresses ` :math:`a^\ast`, provided :math:`|x^\ast| = |a^\ast|`. - -* :math:`t[\subst a^\ast]` is shorthand for the substitution :math:`t[x^\ast \subst a^\ast]` where :math:`x^\ast = 0 \cdots (|a^\ast| - 1)`. - - .. index:: ! number type, integer, floating-point, IEEE 754, bit width, memory pair: abstract syntax; number type pair: number; type @@ -117,8 +72,11 @@ Conventions * The notation :math:`|t|` for :ref:`bit width ` extends to vector types as well, that is, :math:`|\V128| = 128`. -.. index:: ! heap type, store, type identifier + +.. index:: ! heap type, store, type identifier, ! substitution, ! closed type pair: abstract syntax; heap type +.. _type-subst: +.. _type-closed: .. _syntax-heaptype: Heap Types @@ -129,19 +87,35 @@ Heap Types .. math:: \begin{array}{llll} \production{heap type} & \heaptype &::=& - \FUNC ~|~ \EXTERN ~|~ \typeid ~|~ \BOT \\ + \FUNC ~|~ \EXTERN ~|~ \typeidx ~|~ \functype ~|~ \BOT \\ \end{array} The type |FUNC| denotes the infinite union of all types of :ref:`functions `, regardless of their concrete :ref:`function types `. The type |EXTERN| denotes the infinite union of all objects owned by the :ref:`embedder ` and that can be passed into WebAssembly under this type. -A *concrete* heap type consists of a :ref:`type identifier ` and classifies an object of the respective :ref:`type ` defined in some module. +A *concrete* heap type consists of a :ref:`type index ` and classifies an object of the respective :ref:`type ` defined in some module. + +A concrete heap type can also consist of a :ref:`function type ` directly. +However, this form is representable in neither the :ref:`binary format ` nor the :ref:`text format `, such that it cannot be used in a program; +it only occurs during :ref:`validation ` or :ref:`execution `, as the result of *substituting* a :ref:`type index ` with its definition. The type :math:`\BOT` is a :ref:`subtype ` of all other heap types. By virtue of being representable in neither the :ref:`binary format ` nor the :ref:`text format `, it cannot be used in a program; it only occurs during :ref:`validation `, as a part of a possible operand type for instructions. +A type of any form is *closed* when it does not contain a heap type that is a :ref:`type index `, +i.e., all :ref:`type indices ` have been :ref:`substituted ` with their :ref:`defined type `. + +.. _notation-subst: + +Convention +.......... + +* :math:`t[x^\ast \subst \X{ft}^\ast]` denotes the parallel *substitution* of :ref:`type indices ` :math:`x^\ast` with :ref:`function types ` :math:`\X{ft}^\ast`, provided :math:`|x^\ast| = |\X{ft}^\ast|` in type :math:`t`. + +* :math:`t[\subst \X{ft}^\ast]` is shorthand for the substitution :math:`t[x^\ast \subst \X{ft}^\ast]` where :math:`x^\ast = 0 \cdots (|\X{ft}^\ast| - 1)` in type :math:`t`. + .. index:: ! reference type, heap type, reference, table, function, function type, null pair: abstract syntax; reference type @@ -283,6 +257,25 @@ They are also used to classify the inputs and outputs of :ref:`instructions `, assigning them a :ref:`type index `. + +.. math:: + \begin{array}{llll} + \production{defined type} & \deftype &::=& + \functype \\ + \end{array} + +.. note:: + Future versions of WebAssembly may introduce additional forms of defined types. + + .. index:: ! limits, memory type, table type pair: abstract syntax; limits single: memory; limits @@ -384,7 +377,7 @@ External Types .. math:: \begin{array}{llll} \production{external types} & \externtype &::=& - \ETFUNC~\typeid ~|~ + \ETFUNC~\functype ~|~ \ETTABLE~\tabletype ~|~ \ETMEM~\memtype ~|~ \ETGLOBAL~\globaltype \\ @@ -397,7 +390,7 @@ Conventions The following auxiliary notation is defined for sequences of external types. It filters out entries of a specific kind in an order-preserving fashion: -* :math:`\etfuncs(\externtype^\ast) = [\typeid ~|~ (\ETFUNC~\typeid) \in \externtype^\ast]` +* :math:`\etfuncs(\externtype^\ast) = [\functype ~|~ (\ETFUNC~\functype) \in \externtype^\ast]` * :math:`\ettables(\externtype^\ast) = [\tabletype ~|~ (\ETTABLE~\tabletype) \in \externtype^\ast]` diff --git a/document/core/text/modules.rst b/document/core/text/modules.rst index f095ba2e2..226dc8299 100644 --- a/document/core/text/modules.rst +++ b/document/core/text/modules.rst @@ -544,7 +544,7 @@ Also, the element list may be written as just a sequence of :ref:`function indic \begin{array}{llcll} \production{element list} & \text{func}~~\Tvec(\Tfuncidx_I) &\equiv& - \text{funcref}~~\Tvec(\text{(}~\text{ref.func}~~\Tfuncidx_I~\text{)}) + \text{(ref}~\text{func)}~~\Tvec(\text{(}~\text{ref.func}~~\Tfuncidx_I~\text{)}) \end{array} A table use can be omitted, defaulting to :math:`\T{0}`. diff --git a/document/core/util/macros.def b/document/core/util/macros.def index cc1793e1b..81dc94de2 100644 --- a/document/core/util/macros.def +++ b/document/core/util/macros.def @@ -178,7 +178,10 @@ .. |toF| mathdef:: \xref{syntax/types}{syntax-functype}{\rightarrow} .. |to| mathdef:: \xref{syntax/types}{syntax-instrtype}{\rightarrow} -.. |toX#1| mathdef:: \xref{syntax/types}{syntax-instrtype}{\rightarrow_{#1}} +.. Unfortunately, MathJax somehow barfs on the use of xref in the expansion + of a macro with parameters, so we cannot hyperlink the arrow + .. |toX#1| mathdef:: \xref{syntax/types}{syntax-instrtype}{\rightarrow_{#1}} +.. |toX#1| mathdef:: \rightarrow_{#1} .. |BOT| mathdef:: \xref{syntax/types}{syntax-valtype}{\K{bot}} @@ -223,7 +226,6 @@ .. Types, non-terminals -.. |typeid| mathdef:: \xref{syntax/types}{syntax-typeid}{\X{typeid}} .. |numtype| mathdef:: \xref{syntax/types}{syntax-numtype}{\X{numtype}} .. |vectype| mathdef:: \xref{syntax/types}{syntax-vectype}{\X{vectype}} .. |heaptype| mathdef:: \xref{syntax/types}{syntax-heaptype}{\X{heaptype}} @@ -231,6 +233,7 @@ .. |valtype| mathdef:: \xref{syntax/types}{syntax-valtype}{\X{valtype}} .. |resulttype| mathdef:: \xref{syntax/types}{syntax-resulttype}{\X{resulttype}} .. |functype| mathdef:: \xref{syntax/types}{syntax-functype}{\X{functype}} +.. |deftype| mathdef:: \xref{syntax/types}{syntax-deftype}{\X{deftype}} .. |globaltype| mathdef:: \xref{syntax/types}{syntax-globaltype}{\X{globaltype}} .. |tabletype| mathdef:: \xref{syntax/types}{syntax-tabletype}{\X{tabletype}} @@ -343,7 +346,7 @@ .. Modules, non-terminals .. |module| mathdef:: \xref{syntax/modules}{syntax-module}{\X{module}} -.. |type| mathdef:: \xref{syntax/types}{syntax-functype}{\X{type}} +.. |type| mathdef:: \xref{syntax/types}{syntax-deftype}{\X{type}} .. |func| mathdef:: \xref{syntax/modules}{syntax-func}{\X{func}} .. |local| mathdef:: \xref{syntax/modules}{syntax-local}{\X{local}} .. |table| mathdef:: \xref{syntax/modules}{syntax-table}{\X{table}} @@ -629,6 +632,7 @@ .. |Bvaltype| mathdef:: \xref{binary/types}{binary-valtype}{\B{valtype}} .. |Bresulttype| mathdef:: \xref{binary/types}{binary-resulttype}{\B{resulttype}} .. |Bfunctype| mathdef:: \xref{binary/types}{binary-functype}{\B{functype}} +.. |Bdeftype| mathdef:: \xref{binary/types}{binary-deftype}{\B{deftype}} .. |Bglobaltype| mathdef:: \xref{binary/types}{binary-globaltype}{\B{globaltype}} .. |Btabletype| mathdef:: \xref{binary/types}{binary-tabletype}{\B{tabletype}} .. |Bmemtype| mathdef:: \xref{binary/types}{binary-memtype}{\B{memtype}} @@ -794,6 +798,7 @@ .. |Treftype| mathdef:: \xref{text/types}{text-reftype}{\T{reftype}} .. |Tvaltype| mathdef:: \xref{text/types}{text-valtype}{\T{valtype}} .. |Tfunctype| mathdef:: \xref{text/types}{text-functype}{\T{functype}} +.. |Tdeftype| mathdef:: \xref{text/types}{text-deftype}{\T{deftype}} .. |Tglobaltype| mathdef:: \xref{text/types}{text-globaltype}{\T{globaltype}} .. |Ttabletype| mathdef:: \xref{text/types}{text-tabletype}{\T{tabletype}} @@ -936,7 +941,6 @@ .. Judgments -.. |vdashtypeid| mathdef:: \xref{valid/types}{valid-typeid}{\vdash} .. |vdashnumtype| mathdef:: \xref{valid/types}{valid-numtype}{\vdash} .. |vdashvectype| mathdef:: \xref{valid/types}{valid-vectype}{\vdash} .. |vdashheaptype| mathdef:: \xref{valid/types}{valid-heaptype}{\vdash} @@ -950,6 +954,7 @@ .. |vdashmemtype| mathdef:: \xref{valid/types}{valid-memtype}{\vdash} .. |vdashglobaltype| mathdef:: \xref{valid/types}{valid-globaltype}{\vdash} .. |vdashexterntype| mathdef:: \xref{valid/types}{valid-externtype}{\vdash} +.. |vdashdeftype| mathdef:: \xref{valid/types}{valid-deftype}{\vdash} .. |vdashinstrtype| mathdef:: \xref{valid/types}{valid-instrtype}{\vdash} @@ -1007,9 +1012,8 @@ .. Allocation -.. |dyn| mathdef:: \xref{exec/types}{dyn}{\F{dyn}} +.. |insttype| mathdef:: \xref{exec/types}{type-inst}{\F{clos}} -.. |alloctype| mathdef:: \xref{exec/modules}{alloc-type}{\F{alloctype}} .. |allocfunc| mathdef:: \xref{exec/modules}{alloc-func}{\F{allocfunc}} .. |allochostfunc| mathdef:: \xref{exec/modules}{alloc-hostfunc}{\F{allochostfunc}} .. |alloctable| mathdef:: \xref{exec/modules}{alloc-table}{\F{alloctable}} @@ -1026,7 +1030,6 @@ .. Addresses, non-terminals .. |addr| mathdef:: \xref{exec/runtime}{syntax-addr}{\X{addr}} -.. |typeaddr| mathdef:: \xref{exec/runtime}{syntax-typeaddr}{\X{typeaddr}} .. |funcaddr| mathdef:: \xref{exec/runtime}{syntax-funcaddr}{\X{funcaddr}} .. |tableaddr| mathdef:: \xref{exec/runtime}{syntax-tableaddr}{\X{tableaddr}} .. |memaddr| mathdef:: \xref{exec/runtime}{syntax-memaddr}{\X{memaddr}} @@ -1038,7 +1041,6 @@ .. Address, meta functions -.. |freetypeaddr| mathdef:: \xref{syntax/modules}{syntax-typeaddr}{\F{typeaddr}} .. |freefuncaddr| mathdef:: \xref{syntax/modules}{syntax-funcaddr}{\F{funcaddr}} .. |freetableaddr| mathdef:: \xref{syntax/modules}{syntax-tableaddr}{\F{tableaddr}} .. |freememaddr| mathdef:: \xref{syntax/modules}{syntax-memaddr}{\F{memaddr}} @@ -1091,7 +1093,6 @@ .. |externval| mathdef:: \xref{exec/runtime}{syntax-externval}{\X{externval}} .. |moduleinst| mathdef:: \xref{exec/runtime}{syntax-moduleinst}{\X{moduleinst}} -.. |typeinst| mathdef:: \xref{exec/runtime}{syntax-typeinst}{\X{typeinst}} .. |funcinst| mathdef:: \xref{exec/runtime}{syntax-funcinst}{\X{funcinst}} .. |tableinst| mathdef:: \xref{exec/runtime}{syntax-tableinst}{\X{tableinst}} .. |meminst| mathdef:: \xref{exec/runtime}{syntax-meminst}{\X{meminst}} @@ -1113,7 +1114,6 @@ .. Store, terminals -.. |STYPES| mathdef:: \xref{exec/runtime}{syntax-store}{\K{types}} .. |SFUNCS| mathdef:: \xref{exec/runtime}{syntax-store}{\K{funcs}} .. |STABLES| mathdef:: \xref{exec/runtime}{syntax-store}{\K{tables}} .. |SMEMS| mathdef:: \xref{exec/runtime}{syntax-store}{\K{mems}} @@ -1311,7 +1311,6 @@ .. |vdashval| mathdef:: \xref{appendix/properties}{valid-val}{\vdash} .. |vdashresult| mathdef:: \xref{appendix/properties}{valid-result}{\vdash} -.. |vdashtypeinst| mathdef:: \xref{appendix/properties}{valid-typeinst}{\vdash} .. |vdashfuncinst| mathdef:: \xref{appendix/properties}{valid-funcinst}{\vdash} .. |vdashtableinst| mathdef:: \xref{appendix/properties}{valid-tableinst}{\vdash} .. |vdashmeminst| mathdef:: \xref{appendix/properties}{valid-meminst}{\vdash} @@ -1327,7 +1326,6 @@ .. |vdashthread| mathdef:: \xref{appendix/properties}{valid-thread}{\vdash} .. |vdashframe| mathdef:: \xref{appendix/properties}{valid-frame}{\vdash} -.. |vdashtypeinstextends| mathdef:: \xref{appendix/properties}{extend-typeinst}{\vdash} .. |vdashfuncinstextends| mathdef:: \xref{appendix/properties}{extend-funcinst}{\vdash} .. |vdashtableinstextends| mathdef:: \xref{appendix/properties}{extend-tableinst}{\vdash} .. |vdashmeminstextends| mathdef:: \xref{appendix/properties}{extend-meminst}{\vdash} diff --git a/document/core/valid/conventions.rst b/document/core/valid/conventions.rst index 00e517dc7..5d1767e53 100644 --- a/document/core/valid/conventions.rst +++ b/document/core/valid/conventions.rst @@ -34,7 +34,7 @@ Validity of an individual definition is specified relative to a *context*, which collects relevant information about the surrounding :ref:`module ` and the definitions in scope: * *Types*: the list of :ref:`types ` defined in the current module. -* *Functions*: the list of :ref:`functions ` declared in the current module, represented by a :ref:`type identifier ` for their :ref:`function type `. +* *Functions*: the list of :ref:`functions ` declared in the current module, represented by their :ref:`function type `. * *Tables*: the list of :ref:`tables ` declared in the current module, represented by their :ref:`table type `. * *Memories*: the list of :ref:`memories ` declared in the current module, represented by their :ref:`memory type `. * *Globals*: the list of :ref:`globals ` declared in the current module, represented by their :ref:`global type `. @@ -56,8 +56,8 @@ More concretely, contexts are defined as :ref:`records ` :math: \begin{array}{llll} \production{context} & C &::=& \begin{array}[t]{l@{~}ll} - \{ & \CTYPES & \functype^\ast, \\ - & \CFUNCS & \typeid^\ast, \\ + \{ & \CTYPES & \deftype^\ast, \\ + & \CFUNCS & \functype^\ast, \\ & \CTABLES & \tabletype^\ast, \\ & \CMEMS & \memtype^\ast, \\ & \CGLOBALS & \globaltype^\ast, \\ diff --git a/document/core/valid/instructions.rst b/document/core/valid/instructions.rst index d8539c0b9..05581d4eb 100644 --- a/document/core/valid/instructions.rst +++ b/document/core/valid/instructions.rst @@ -1603,13 +1603,11 @@ Control Instructions * The :ref:`result type ` :math:`[t_2^\ast]` must be the same as :math:`C.\CRETURN`. -* Then the instruction is valid with type :math:`[t_3^\ast~t_1^\ast] \to [t_4^\ast]`, for any sequences of :ref:`value types ` :math:`t_3^\ast` and :math:`t_4^\ast`. +* Then the instruction is valid with any :ref:`valid ` type :math:`[t_3^\ast~t_1^\ast] \to [t_4^\ast]`. .. math:: \frac{ - C.\CFUNCS[x] = [t_1^\ast] \toF [t_2^\ast] - \qquad - C.\CRETURN = [t_2^\ast] + C.\CFUNCS[x] = [t_1^\ast] \toF C.\CRETURN }{ C \vdashinstr \RETURNCALL~x : [t_3^\ast~t_1^\ast] \to [t_4^\ast] } @@ -1629,17 +1627,18 @@ Control Instructions * The :ref:`result type ` :math:`[t_2^\ast]` must be the same as :math:`C.\CRETURN`. -* Then the instruction is valid with type :math:`[t_1^\ast~(\REF~\NULL~x)] \to [t_2^\ast]`. +* Then the instruction is valid with any :ref:`valid ` type :math:`[t_3^\ast~t_1^\ast~(\REF~\NULL~x)] \to [t_4^\ast]`. .. math:: \frac{ - C.\CTYPES[x] = [t_1^\ast] \toF [t_2^\ast] - \qquad - C.\CRETURN = [t_2^\ast] + C.\CTYPES[x] = [t_1^\ast] \toF C.\CRETURN }{ - C \vdashinstr \CALLREF~x : [t_1^\ast~(\REF~\NULL~x)] \to [t_2^\ast] + C \vdashinstr \CALLREF~x : [t_3^\ast~t_1^\ast~(\REF~\NULL~x)] \to [t_4^\ast] } +.. note:: + The |RETURNCALLREF| instruction is :ref:`stack-polymorphic `. + .. _valid-return_call_indirect: @@ -1662,14 +1661,11 @@ Control Instructions * Then the instruction is valid with type :math:`[t_3^\ast~t_1^\ast~\I32] \to [t_4^\ast]`, for any sequences of :ref:`value types ` :math:`t_3^\ast` and :math:`t_4^\ast`. - .. math:: \frac{ C.\CTABLES[x] = \limits~\FUNCREF \qquad - C.\CTYPES[y] = [t_1^\ast] \toF [t_2^\ast] - \qquad - C.\CRETURN = [t_2^\ast] + C.\CTYPES[y] = [t_1^\ast] \toF C.\CRETURN }{ C \vdashinstr \RETURNCALLINDIRECT~x~y : [t_3^\ast~t_1^\ast~\I32] \to [t_4^\ast] } diff --git a/document/core/valid/matching.rst b/document/core/valid/matching.rst index ac9229559..e6fededdb 100644 --- a/document/core/valid/matching.rst +++ b/document/core/valid/matching.rst @@ -54,9 +54,13 @@ A :ref:`heap type ` :math:`\heaptype_1` matches a :ref:`heap ty * Either both :math:`\heaptype_1` and :math:`\heaptype_2` are the same. -* Or :math:`\heaptype_1` is a :ref:`type identifier ` that defines a function type and :math:`\heaptype_2` is :math:`FUNC`. +* Or :math:`\heaptype_1` is a :ref:`function type ` and :math:`\heaptype_2` is :math:`FUNC`. -* Or :math:`\heaptype_1` is a :ref:`type identifier ` that defines a function type :math:`\functype_1`, and :math:`\heaptype_2` is a :ref:`type identifier ` that defines a function type :math:`\functype_2`, and :math:`\functype_1` :ref:`matches ` :math:`\functype_2`. +* Or :math:`\heaptype_1` is a :ref:`function type ` :math:`\functype_1` and :math:`\heaptype_2` is a :ref:`function type ` :math:`\functype_2`, and :math:`\functype_1` :ref:`matches ` :math:`\functype_2`. + +* Or :math:`\heaptype_1` is a :ref:`type index ` :math:`x_1`, and :math:`C.\CTYPES[x_1]` :ref:`matches ` :math:`\heaptype_2`. + +* Or :math:`\heaptype_2` is a :ref:`type index ` :math:`x_2`, and :math:`\heaptype_1` :ref:`matches ` :math:`C.\CTYPES[x_2]`. .. math:: ~\\[-1ex] @@ -66,24 +70,34 @@ A :ref:`heap type ` :math:`\heaptype_1` matches a :ref:`heap ty } \qquad \frac{ - C \vdashtypeid \typeid : \functype }{ - C \vdashheaptypematch \typeid \matchesheaptype \FUNC + C \vdashheaptypematch \functype \matchesheaptype \FUNC } .. math:: ~\\[-1ex] \frac{ - C \vdashtypeid \typeid_1 : \functype_1 - \qquad - C \vdashtypeid \typeid_2 : \functype_2 - \qquad C \vdashfunctypematch \functype_1 \matchesfunctype \functype_2 }{ - C \vdashheaptypematch \typeid_1 \matchesheaptype \typeid_2 + C \vdashheaptypematch \functype_1 \matchesheaptype \functype_2 + } + +.. math:: + ~\\[-1ex] + \frac{ + C \vdashheaptypematch C.\CTYPES[\typeidx_1] \matchesheaptype \heaptype_2 + }{ + C \vdashheaptypematch \typeidx_1 \matchesheaptype \heaptype_2 + } + \qquad + \frac{ + C \vdashheaptypematch \heaptype_1 \matchesheaptype C.\CTYPES[\typeidx_2] + }{ + C \vdashheaptypematch \heaptype_1 \matchesheaptype \typeidx_2 } + .. index:: reference type .. _match-reftype: @@ -348,16 +362,16 @@ External Types Functions ......... -An :ref:`external type ` :math:`\ETFUNC~\typeid_1` matches :math:`\ETFUNC~\typeid_2` if and only if: +An :ref:`external type ` :math:`\ETFUNC~\functype_1` matches :math:`\ETFUNC~\functype_2` if and only if: -* The :ref:`heap type ` :math:`\typeid_1` :ref:`matches ` :math:`\typeid_2`. +* The :ref:`function type ` :math:`\functype_1` :ref:`matches ` :math:`\functype_2`. .. math:: ~\\[-1ex] \frac{ - C \vdashheaptypematch \typeid_1 \matchesheaptype \typeid_2 + C \vdashfunctypematch \functype_1 \matchesfunctype \functype_2 }{ - C \vdashexterntypematch \ETFUNC~\typeid_1 \matchesexterntype \ETFUNC~\typeid_2 + C \vdashexterntypematch \ETFUNC~\functype_1 \matchesexterntype \ETFUNC~\functype_2 } diff --git a/document/core/valid/modules.rst b/document/core/valid/modules.rst index 1c5fde95a..550d89577 100644 --- a/document/core/valid/modules.rst +++ b/document/core/valid/modules.rst @@ -428,9 +428,9 @@ Exports :math:`\export` and export descriptions :math:`\exportdesc` are classifi .. math:: \frac{ - C.\CFUNCS[x] = \typeid + C.\CFUNCS[x] = \functype }{ - C \vdashexportdesc \EDFUNC~x : \ETFUNC~\typeid + C \vdashexportdesc \EDFUNC~x : \ETFUNC~\functype } diff --git a/document/core/valid/types.rst b/document/core/valid/types.rst index d281885b3..dc21aa29e 100644 --- a/document/core/valid/types.rst +++ b/document/core/valid/types.rst @@ -9,36 +9,6 @@ However, restrictions apply to most other types, such as :ref:`reference types < Moreover, :ref:`block types ` are converted to plain :ref:`function types ` for ease of processing. -.. index:: type identifier, type index - pair: validation; type identifier - single: abstract syntax; type identifier -.. _valid-typeid: -.. _valid-typeidx: - -Type Identifiers -~~~~~~~~~~~~~~~~ - -During validation, :ref:`type identifiers ` are represented as :ref:`type indices `, which are lookued up as :ref:`function types ` by the following rule. - -:math:`\typeidx` -................ - -* The type :math:`C.\CTYPES[\typeidx]` must be defined in the context. - -* Then the type identifier is valid as :ref:`function type ` :math:`C.\CTYPES[\typeidx]`. - -.. math:: - \frac{ - C.\CTYPES[\typeidx] = \functype - }{ - C \vdashtypeid \typeidx : \functype - } - -.. note:: - :ref:`Dynamic types ` do not arise during validation. - They only need to be :ref:`looked up ` during :ref:`execution `. - - .. index:: number type pair: validation; number type single: abstract syntax; number type @@ -81,7 +51,7 @@ Vector Types Heap Types ~~~~~~~~~~ -Concrete :ref:`Heap types ` are only valid when the :ref:`type identifier ` is. +Concrete :ref:`Heap types ` are only valid when the :ref:`type index ` is. :math:`\FUNC` ............. @@ -105,18 +75,18 @@ Concrete :ref:`Heap types ` are only valid when the :ref:`type C \vdashheaptype \EXTERN \ok } -:math:`\typeid` -............... +:math:`\typeidx` +................ -* The type identifier :math:`\typeid` must be valid. +* The type :math:`C.\CTYPES[\typeidx]` must be defined in the context. * Then the heap type is valid. .. math:: \frac{ - C \vdashtypeid \typeid : \functype + C.\CTYPES[\typeidx] = \deftype }{ - C \vdashheaptype \typeid \ok + C \vdashheaptype \typeidx \ok } :math:`\BOT` @@ -278,6 +248,7 @@ Instruction Types pair: validation; function type single: abstract syntax; function type .. _valid-functype: +.. _valid-deftype: Function Types ~~~~~~~~~~~~~~ diff --git a/interpreter/README.md b/interpreter/README.md index 1bba5681b..6195e9773 100644 --- a/interpreter/README.md +++ b/interpreter/README.md @@ -240,14 +240,15 @@ op: br br_if br_table + - br_on_null + br_on_null + br_on_non_null call call_ref - call_indirect ? + call_indirect ? (type )? return return_call return_call_ref - return_call_indirect ? + return_call_indirect ? (type )? local.get local.set local.tee @@ -274,8 +275,8 @@ op: memory.init data.drop ref.null - ref.is_null - ref_as_non_null + ref.is_null + ref_as_non_null ref.func .const . diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index c64a757d8..72bf681ec 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -168,7 +168,7 @@ let var_type s = let heap_type s = let pos = pos s in either [ - (fun s -> DefHT (Stat (var_type s))); + (fun s -> VarHT (StatX (var_type s))); (fun s -> match s7 s with | -0x10 -> FuncHT @@ -182,8 +182,8 @@ let ref_type s = match s7 s with | -0x10 -> (Null, FuncHT) | -0x11 -> (Null, ExternHT) - | -0x14 -> (Null, heap_type s) - | -0x15 -> (NoNull, heap_type s) + | -0x1c -> (NoNull, heap_type s) + | -0x1d -> (Null, heap_type s) | _ -> error s pos "malformed reference type" let val_type s = @@ -201,7 +201,7 @@ let func_type s = FuncT (ts1, ts2) let cont_type s = - ContT (Stat (var_type s)) + ContT (heap_type s) let def_type s = match s7 s with @@ -227,8 +227,8 @@ let memory_type s = let tag_type s = zero s; - let x = Stat (var_type s) in - TagT x + let et = heap_type s in + TagT et let mutability s = match byte s with @@ -564,9 +564,9 @@ let rec instr s = | 0xd0 -> ref_null (heap_type s) | 0xd1 -> ref_is_null | 0xd2 -> ref_func (at var s) - | 0xd3 -> ref_as_non_null - | 0xd4 -> br_on_null (at var s) - | 0xd5 as b -> illegal s pos b + | 0xd3 as b -> illegal s pos b + | 0xd4 -> ref_as_non_null + | 0xd5 -> br_on_null (at var s) | 0xd6 -> br_on_non_null (at var s) | 0xe0 -> cont_new (at var s) @@ -962,7 +962,7 @@ let import_desc s = | 0x01 -> TableImport (table_type s) | 0x02 -> MemoryImport (memory_type s) | 0x03 -> GlobalImport (global_type s) - | 0x04 -> TagImport (tag_type s) + | 0x04 -> TagImport (at var s) | _ -> error s (pos s - 1) "malformed import kind" let import s = diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 0c65cdbdf..87e6dab91 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -96,8 +96,7 @@ struct open Types let var_type = function - | Stat x -> s33 x - | Dyn _ -> assert false + | StatX x -> s33 x let num_type = function | I32T -> s7 (-0x01) @@ -111,14 +110,14 @@ struct let heap_type = function | FuncHT -> s7 (-0x10) | ExternHT -> s7 (-0x11) - | DefHT x -> var_type x - | BotHT -> assert false + | VarHT x -> var_type x + | DefHT _ | BotHT -> assert false let ref_type = function | (Null, FuncHT) -> s7 (-0x10) | (Null, ExternHT) -> s7 (-0x11) - | (Null, t) -> s7 (-0x14); heap_type t - | (NoNull, t) -> s7 (-0x15); heap_type t + | (NoNull, t) -> s7 (-0x1c); heap_type t + | (Null, t) -> s7 (-0x1d); heap_type t let val_type = function | NumT t -> num_type t @@ -130,7 +129,7 @@ struct | FuncT (ts1, ts2) -> vec val_type ts1; vec val_type ts2 let cont_type = function - | ContT x -> var_type x + | ContT ht -> heap_type ht let def_type = function | DefFuncT ft -> s7 (-0x20); func_type ft @@ -155,8 +154,8 @@ struct let global_type = function | GlobalT (mut, t) -> val_type t; mutability mut - let tag_type (TagT x) = - u32 0x00l; var_type x + let tag_type = function + | TagT ht -> byte 0x00; heap_type ht (* Instructions *) @@ -221,7 +220,7 @@ struct | Br x -> op 0x0c; var x | BrIf x -> op 0x0d; var x | BrTable (xs, x) -> op 0x0e; vec var xs; var x - | BrOnNull x -> op 0xd4; var x + | BrOnNull x -> op 0xd5; var x | BrOnNonNull x -> op 0xd6; var x | Return -> op 0x0f | Call x -> op 0x10; var x @@ -354,7 +353,7 @@ struct | RefNull t -> op 0xd0; heap_type t | RefFunc x -> op 0xd2; var x | RefIsNull -> op 0xd1 - | RefAsNonNull -> op 0xd3 + | RefAsNonNull -> op 0xd4 | Const {it = I32 c; _} -> op 0x41; s32 c | Const {it = I64 c; _} -> op 0x42; s64 c @@ -816,7 +815,7 @@ struct | TableImport t -> byte 0x01; table_type t | MemoryImport t -> byte 0x02; memory_type t | GlobalImport t -> byte 0x03; global_type t - | TagImport t -> byte 0x04; tag_type t + | TagImport t -> byte 0x04; var t let import im = let {module_name; item_name; idesc} = im.it in diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 22742cd53..fb72925c9 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -135,8 +135,11 @@ let elem (inst : module_inst) x = lookup "element segment" inst.elems x let data (inst : module_inst) x = lookup "data segment" inst.datas x let local (frame : frame) x = lookup "local" frame.locals x -let func_type (inst : module_inst) x = as_func_def_type (def_of (type_ inst x)) -let cont_type (inst : module_inst) x = as_cont_def_type (def_of (type_ inst x)) +let subst_of (inst : module_inst) (StatX x) = + DefHT (type_ inst (x @@ Source.no_region)) + +let func_type (inst : module_inst) x = as_func_def_type (type_ inst x) +let cont_type (inst : module_inst) x = as_cont_def_type (type_ inst x) let any_ref (inst : module_inst) x i at = try Table.load (table inst x) i with Table.Bounds -> @@ -151,7 +154,7 @@ let func_ref (inst : module_inst) x i at = let block_type (inst : module_inst) bt at = match bt with | ValBlockType None -> InstrT ([], [], []) - | ValBlockType (Some t) -> InstrT ([], [dyn_val_type inst.types t], []) + | ValBlockType (Some t) -> InstrT ([], [subst_val_type (subst_of inst) t], []) | VarBlockType x -> let FuncT (ts1, ts2) = func_type inst x in InstrT (ts1, ts2, []) @@ -225,8 +228,7 @@ let rec step (c : config) : config = | Throw x, vs -> let tagt = tag c.frame.inst x in - let TagT x' = Tag.type_of tagt in - let FuncT (ts, _) = as_func_def_type (def_of (as_dyn_var x')) in + let FuncT (ts, _) = as_func_tag_type (Tag.type_of tagt) in let vs0, vs' = split (Lib.List32.length ts) vs e.at in vs', [Throwing (tagt, vs0) @@ e.at] @@ -294,7 +296,7 @@ let rec step (c : config) : config = | CallIndirect (x, y), Num (I32 i) :: vs -> let f = func_ref c.frame.inst x i e.at in if - Match.eq_func_type [] (func_type c.frame.inst y) (Func.type_of f) + Match.eq_func_type (func_type c.frame.inst y) (Func.type_of f) then vs, [Invoke f @@ e.at] else @@ -325,8 +327,9 @@ let rec step (c : config) : config = vs, [Trapping "continuation already consumed" @@ e.at] | ContBind (x, y), Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> - let ContT z = cont_type c.frame.inst y in - let FuncT (ts', _) = as_func_def_type (def_of (as_dyn_var z)) in + let ct = cont_type c.frame.inst y in + let ct = subst_cont_type (subst_of c.frame.inst) ct in + let FuncT (ts', _) = as_func_cont_type ct in let args, vs' = try split (Int32.sub n (Lib.List32.length ts')) vs e.at with Failure _ -> Crash.error e.at "type mismatch at continuation bind" @@ -337,8 +340,7 @@ let rec step (c : config) : config = | Suspend x, vs -> let tagt = tag c.frame.inst x in - let TagT x' = Tag.type_of tagt in - let FuncT (ts, _) = as_func_def_type (def_of (as_dyn_var x')) in + let FuncT (ts, _) = as_func_tag_type (Tag.type_of tagt) in let args, vs' = split (Lib.List32.length ts) vs e.at in vs', [Suspending (tagt, args, fun code -> code) @@ e.at] @@ -362,8 +364,7 @@ let rec step (c : config) : config = | ResumeThrow (x, y, xls), Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> let tagt = tag c.frame.inst y in - let TagT x' = Tag.type_of tagt in - let FuncT (ts, _) = as_func_def_type (def_of (as_dyn_var x')) in + let FuncT (ts, _) = as_func_tag_type (Tag.type_of tagt) in let hs = List.map (fun (x, l) -> tag c.frame.inst x, l) xls in let args, vs' = split (Lib.List32.length ts) vs e.at in cont := None; @@ -515,11 +516,11 @@ let rec step (c : config) : config = | Load {offset; ty; pack; _}, Num (I32 i) :: vs' -> let mem = memory c.frame.inst (0l @@ e.at) in let a = I64_convert.extend_i32_u i in - let t = dyn_num_type [] ty in + let t = subst_num_type (subst_of c.frame.inst) ty in (try let n = match pack with - | None -> Memory.load_num mem a offset t + | None -> Memory.load_num mem a offset ty | Some (sz, ext) -> Memory.load_num_packed sz ext mem a offset t in Num n :: vs', [] with exn -> vs', [Trapping (memory_error e.at exn) @@ e.at]) @@ -538,7 +539,7 @@ let rec step (c : config) : config = | VecLoad {offset; ty; pack; _}, Num (I32 i) :: vs' -> let mem = memory c.frame.inst (0l @@ e.at) in let a = I64_convert.extend_i32_u i in - let t = dyn_vec_type [] ty in + let t = subst_vec_type (subst_of c.frame.inst) ty in (try let v = match pack with @@ -680,7 +681,7 @@ let rec step (c : config) : config = vs, [] | RefNull t, vs' -> - Ref (NullRef (dyn_heap_type c.frame.inst.types t)) :: vs', [] + Ref (NullRef (subst_heap_type (subst_of c.frame.inst) t)) :: vs', [] | RefIsNull, Ref r :: vs' -> (match r with @@ -906,7 +907,8 @@ let rec step (c : config) : config = | Func.AstFunc (_, inst', func) -> let {locals; body; _} = func.it in let m = Lib.Promise.value inst' in - let ts = List.map (fun loc -> Types.dyn_val_type m.types loc.it.ltype) locals in + let s = subst_of m in + let ts = List.map (fun loc -> subst_val_type s loc.it.ltype) locals in let locs' = List.(rev (map Option.some args) @ map default_value ts) in let frame' = {inst = m; locals = List.map ref locs'} in let instr' = [Label (n2, [], ([], List.map plain body)) @@ func.at] in @@ -925,8 +927,7 @@ let rec step (c : config) : config = | Handle (Some hs, (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs when List.mem_assq tagt hs -> - let TagT x' = Tag.type_of tagt in - let FuncT (_, ts) = as_func_def_type (def_of (as_dyn_var x')) in + let FuncT (_, ts) = as_func_tag_type (Tag.type_of tagt) in let ctxt' code = compose (ctxt code) (vs', es') in [Ref (ContRef (ref (Some (Lib.List32.length ts, ctxt'))))] @ vs1 @ vs, [Plain (Br (List.assq tagt hs)) @@ e.at] @@ -988,7 +989,7 @@ let invoke (func : func_inst) (vs : value list) : value list = let FuncT (ts1, _ts2) = Func.type_of func in if List.length vs <> List.length ts1 then Crash.error at "wrong number of arguments"; - if not (List.for_all2 (fun v -> Match.match_val_type [] (type_of_value v)) vs ts1) then + if not (List.for_all2 (fun v -> Match.match_val_type (type_of_value v)) vs ts1) then Crash.error at "wrong types of arguments"; let c = config empty_module_inst (List.rev vs) [Invoke func @@ at] in try List.rev (eval c) with Stack_overflow -> @@ -1003,36 +1004,79 @@ let eval_const (inst : module_inst) (const : const) : value = (* Modules *) -let create_type (_ : type_) : type_inst = - Types.alloc_uninit () - -let create_func (inst : module_inst) (f : func) : func_inst = - Func.alloc (type_ inst f.it.ftype) (Lib.Promise.make ()) f +let init_type (inst : module_inst) (ty : type_) : module_inst = + let dt = subst_def_type (subst_of inst) ty.it in + {inst with types = inst.types @ [dt]} + +let init_import (inst : module_inst) (ex : extern) (im : import) : module_inst = + let {idesc; _} = im.it in + let it = + match idesc.it with + | FuncImport x -> ExternFuncT (func_type inst x) + | TableImport tt -> ExternTableT tt + | MemoryImport mt -> ExternMemoryT mt + | GlobalImport gt -> ExternGlobalT gt + | TagImport x -> ExternTagT (TagT (VarHT (StatX x.it))) + in + let et = subst_extern_type (subst_of inst) it in + let et' = extern_type_of inst.types ex in + if not (Match.match_extern_type et' et) then + Link.error im.at ("incompatible import type for " ^ + "\"" ^ Utf8.encode im.it.module_name ^ "\" " ^ + "\"" ^ Utf8.encode im.it.item_name ^ "\": " ^ + "expected " ^ Types.string_of_extern_type et ^ + ", got " ^ Types.string_of_extern_type et'); + match ex with + | ExternFunc func -> {inst with funcs = inst.funcs @ [func]} + | ExternTable tab -> {inst with tables = inst.tables @ [tab]} + | ExternMemory mem -> {inst with memories = inst.memories @ [mem]} + | ExternGlobal glob -> {inst with globals = inst.globals @ [glob]} + | ExternTag tag -> {inst with tags = inst.tags @ [tag]} + +let init_func (inst : module_inst) (f : func) : module_inst = + let func = Func.alloc (func_type inst f.it.ftype) (Lib.Promise.make ()) f in + {inst with funcs = inst.funcs @ [func]} + +let init_global (inst : module_inst) (glob : global) : module_inst = + let {gtype; ginit} = glob.it in + let gt = subst_global_type (subst_of inst) gtype in + let v = eval_const inst ginit in + let glob = Global.alloc gt v in + {inst with globals = inst.globals @ [glob]} -let create_table (inst : module_inst) (tab : table) : table_inst = +let init_table (inst : module_inst) (tab : table) : module_inst = let {ttype; tinit} = tab.it in - let tt = Types.dyn_table_type inst.types ttype in + let tt = subst_table_type (subst_of inst) ttype in let r = match eval_const inst tinit with | Ref r -> r | _ -> Crash.error tinit.at "non-reference table initializer" in - Table.alloc tt r + let tab = Table.alloc tt r in + {inst with tables = inst.tables @ [tab]} -let create_memory (inst : module_inst) (mem : memory) : memory_inst = +let init_memory (inst : module_inst) (mem : memory) : module_inst = let {mtype} = mem.it in - Memory.alloc (Types.dyn_memory_type inst.types mtype) + let mt = subst_memory_type (subst_of inst) mtype in + let mem = Memory.alloc mt in + {inst with memories = inst.memories @ [mem]} -let create_global (inst : module_inst) (glob : global) : global_inst = - let {gtype; ginit} = glob.it in - let v = eval_const inst ginit in - Global.alloc (Types.dyn_global_type inst.types gtype) v +let init_elem (inst : module_inst) (seg : elem_segment) : module_inst = + let {etype; einit; _} = seg.it in + let elem = Elem.alloc (List.map (fun c -> as_ref (eval_const inst c)) einit) in + {inst with elems = inst.elems @ [elem]} -let create_tag (inst : module_inst) (tag : tag) : tag_inst = +let init_tag (inst : module_inst) (tag : tag) : module_inst = let {tagtype} = tag.it in - Tag.alloc (Types.dyn_tag_type inst.types tagtype) + let tag = Tag.alloc (subst_tag_type (subst_of inst) tagtype) in + {inst with tags = inst.tags @ [tag]} -let create_export (inst : module_inst) (ex : export) : export_inst = +let init_data (inst : module_inst) (seg : data_segment) : module_inst = + let {dinit; _} = seg.it in + let data = Data.alloc dinit in + {inst with datas = inst.datas @ [data]} + +let init_export (inst : module_inst) (ex : export) : module_inst = let {name; edesc} = ex.it in let ext = match edesc.it with @@ -1041,43 +1085,14 @@ let create_export (inst : module_inst) (ex : export) : export_inst = | MemoryExport x -> ExternMemory (memory inst x) | GlobalExport x -> ExternGlobal (global inst x) | TagExport x -> ExternTag (tag inst x) - in (name, ext) - -let create_elem (inst : module_inst) (seg : elem_segment) : elem_inst = - let {etype; einit; _} = seg.it in - Elem.alloc (List.map (fun c -> as_ref (eval_const inst c)) einit) - -let create_data (inst : module_inst) (seg : data_segment) : data_inst = - let {dinit; _} = seg.it in - Data.alloc dinit - - -let add_import (m : module_) (ext : extern) (im : import) (inst : module_inst) - : module_inst = - let it = Types.extern_type_of_import_type (import_type_of m im) in - let et = Types.dyn_extern_type inst.types it in - let et' = extern_type_of inst.types ext in - if not (Match.match_extern_type [] et' et) then - Link.error im.at ("incompatible import type for " ^ - "\"" ^ Utf8.encode im.it.module_name ^ "\" " ^ - "\"" ^ Utf8.encode im.it.item_name ^ "\": " ^ - "expected " ^ Types.string_of_extern_type et ^ - ", got " ^ Types.string_of_extern_type et'); - match ext with - | ExternFunc func -> {inst with funcs = func :: inst.funcs} - | ExternTable tab -> {inst with tables = tab :: inst.tables} - | ExternMemory mem -> {inst with memories = mem :: inst.memories} - | ExternGlobal glob -> {inst with globals = glob :: inst.globals} - | ExternTag tag -> {inst with tags = tag :: inst.tags} - - -let init_type (inst : module_inst) (type_ : type_) (x : type_inst) = - Types.init x (Types.dyn_def_type inst.types type_.it) + in + {inst with exports = inst.exports @ [(name, ext)]} -let init_func (inst : module_inst) (func : func_inst) = +let init_func_inst (inst : module_inst) (func : func_inst) = match func with - | Func.AstFunc (_, inst_prom, _) -> Lib.Promise.fulfill inst_prom inst - | _ -> assert false + | Func.AstFunc (_, prom, _) when Lib.Promise.value_opt prom = None -> + Lib.Promise.fulfill prom inst + | _ -> () let run_elem i elem = let at = elem.it.emode.at in @@ -1112,37 +1127,32 @@ let run_data i data = let run_start start = [Call start.it.sfunc @@ start.at] + +let init_list f xs (inst : module_inst) : module_inst = + List.fold_left f inst xs + +let init_list2 f xs ys (inst : module_inst) : module_inst = + List.fold_left2 f inst xs ys + let init (m : module_) (exts : extern list) : module_inst = - let - { types; imports; tables; memories; globals; funcs; tags; - exports; elems; datas; start - } = m.it - in - if List.length exts <> List.length imports then + if List.length exts <> List.length m.it.imports then Link.error m.at "wrong number of imports provided for initialisation"; - let inst0 = {empty_module_inst with types = List.map create_type types} in - List.iter2 (init_type inst0) types inst0.types; - let inst1 = List.fold_right2 (add_import m) exts imports inst0 in - let fs = List.map (create_func inst1) funcs in - let inst2 = {inst1 with funcs = inst1.funcs @ fs} in - let inst3 = - { inst2 with - tables = inst2.tables @ List.map (create_table inst2) tables; - memories = inst2.memories @ List.map (create_memory inst2) memories; - globals = inst2.globals @ List.map (create_global inst2) globals; - tags = inst2.tags @ List.map (create_tag inst2) tags; - } - in let inst = - { inst3 with - exports = List.map (create_export inst3) exports; - elems = List.map (create_elem inst3) elems; - datas = List.map (create_data inst3) datas; - } + empty_module_inst + |> init_list init_type m.it.types + |> init_list2 init_import exts m.it.imports + |> init_list init_func m.it.funcs + |> init_list init_global m.it.globals + |> init_list init_tag m.it.tags + |> init_list init_table m.it.tables + |> init_list init_memory m.it.memories + |> init_list init_elem m.it.elems + |> init_list init_data m.it.datas + |> init_list init_export m.it.exports in - List.iter (init_func inst) fs; - let es_elem = List.concat (Lib.List32.mapi run_elem elems) in - let es_data = List.concat (Lib.List32.mapi run_data datas) in - let es_start = Lib.Option.get (Lib.Option.map run_start start) [] in + List.iter (init_func_inst inst) inst.funcs; + let es_elem = List.concat (Lib.List32.mapi run_elem m.it.elems) in + let es_data = List.concat (Lib.List32.mapi run_data m.it.datas) in + let es_start = Lib.Option.get (Lib.Option.map run_start m.it.start) [] in ignore (eval (config inst [] (List.map plain (es_elem @ es_data @ es_start)))); inst diff --git a/interpreter/host/env.ml b/interpreter/host/env.ml index 637b2f30b..1bcd97c6f 100644 --- a/interpreter/host/env.ml +++ b/interpreter/host/env.ml @@ -41,8 +41,6 @@ let exit vs = let lookup name et = match Utf8.encode name, et with - | "abort", ExternFuncT ft -> - ExternFunc (Func.alloc_host (Types.alloc (DefFuncT ft)) abort) - | "exit", ExternFuncT ft -> - ExternFunc (Func.alloc_host (Types.alloc (DefFuncT ft)) exit) + | "abort", ExternFuncT ft -> ExternFunc (Func.alloc_host ft abort) + | "exit", ExternFuncT ft -> ExternFunc (Func.alloc_host ft exit) | _ -> raise Not_found diff --git a/interpreter/host/spectest.ml b/interpreter/host/spectest.ml index 598ec05e9..1568ffc27 100644 --- a/interpreter/host/spectest.ml +++ b/interpreter/host/spectest.ml @@ -19,18 +19,9 @@ let global (GlobalT (_, t) as gt) = | BotT -> assert false in Global.alloc gt v -let table = - Table.alloc (TableT ({min = 10l; max = Some 20l}, (Null, FuncHT))) - (NullRef FuncHT) -let memory = Memory.alloc (MemoryT {min = 1l; max = Some 2l}) -let func f ft = Func.alloc_host (Types.alloc (DefFuncT ft)) (f ft) - -let tag = - let p = Types.alloc (DefFuncT (FuncT ([NumT I32T], [NumT I32T]))) in - Tag.alloc (TagT (Dyn p)) -let except = - let p = Types.alloc (DefFuncT (FuncT ([NumT I32T], []))) in - Tag.alloc (TagT (Dyn p)) +let table tt = Table.alloc tt (NullRef BotHT) +let memory mt = Memory.alloc mt +let func f ft = Func.alloc_host ft (f ft) let print_value v = Printf.printf "%s : %s\n" @@ -55,8 +46,6 @@ let lookup name t = | "global_i64", _ -> ExternGlobal (global (GlobalT (Cons, NumT I64T))) | "global_f32", _ -> ExternGlobal (global (GlobalT (Cons, NumT F32T))) | "global_f64", _ -> ExternGlobal (global (GlobalT (Cons, NumT F64T))) - | "table", _ -> ExternTable table - | "memory", _ -> ExternMemory memory - | "tag", _ -> ExternTag tag - | "exception", _ -> ExternTag except + | "table", _ -> ExternTable (table (TableT ({min = 10l; max = Some 20l}, (Null, FuncHT)))) + | "memory", _ -> ExternMemory (memory (MemoryT {min = 1l; max = Some 2l})) | _ -> raise Not_found diff --git a/interpreter/runtime/func.ml b/interpreter/runtime/func.ml index e4828dd45..18c1b68c2 100644 --- a/interpreter/runtime/func.ml +++ b/interpreter/runtime/func.ml @@ -3,14 +3,12 @@ open Value type 'inst t = 'inst func and 'inst func = - | AstFunc of type_addr * 'inst * Ast.func - | HostFunc of type_addr * (value list -> value list) + | AstFunc of func_type * 'inst * Ast.func + | HostFunc of func_type * (value list -> value list) -let alloc x inst f = AstFunc (x, inst, f) -let alloc_host x f = HostFunc (x, f) +let alloc ft inst f = AstFunc (ft, inst, f) +let alloc_host ft f = HostFunc (ft, f) -let type_inst_of = function - | AstFunc (x, _, _) -> x - | HostFunc (x, _) -> x - -let type_of f = as_func_def_type (def_of (type_inst_of f)) +let type_of = function + | AstFunc (ft, _, _) -> ft + | HostFunc (ft, _) -> ft diff --git a/interpreter/runtime/func.mli b/interpreter/runtime/func.mli index 880ddc5c7..e072c735b 100644 --- a/interpreter/runtime/func.mli +++ b/interpreter/runtime/func.mli @@ -3,11 +3,10 @@ open Value type 'inst t = 'inst func and 'inst func = - | AstFunc of type_addr * 'inst * Ast.func - | HostFunc of type_addr * (value list -> value list) + | AstFunc of func_type * 'inst * Ast.func + | HostFunc of func_type * (value list -> value list) -val alloc : type_addr -> 'inst -> Ast.func -> 'inst func -val alloc_host : type_addr -> (value list -> value list) -> 'inst func +val alloc : func_type -> 'inst -> Ast.func -> 'inst func +val alloc_host : func_type -> (value list -> value list) -> 'inst func val type_of : 'inst func -> func_type -val type_inst_of : 'inst func -> type_addr diff --git a/interpreter/runtime/global.ml b/interpreter/runtime/global.ml index a7df8e692..fc76a9c19 100644 --- a/interpreter/runtime/global.ml +++ b/interpreter/runtime/global.ml @@ -8,7 +8,7 @@ exception Type exception NotMutable let alloc (GlobalT (_mut, t) as ty) v = - if not (Match.match_val_type [] (type_of_value v) t) then raise Type; + if not (Match.match_val_type (type_of_value v) t) then raise Type; {ty; content = v} let type_of glob = @@ -20,5 +20,5 @@ let load glob = let store glob v = let GlobalT (mut, t) = glob.ty in if mut <> Var then raise NotMutable; - if not (Match.match_val_type [] (type_of_value v) t) then raise Type; + if not (Match.match_val_type (type_of_value v) t) then raise Type; glob.content <- v diff --git a/interpreter/runtime/instance.ml b/interpreter/runtime/instance.ml index 8ab5fffc0..155b3903e 100644 --- a/interpreter/runtime/instance.ml +++ b/interpreter/runtime/instance.ml @@ -13,7 +13,7 @@ type module_inst = exports : export_inst list; } -and type_inst = type_addr +and type_inst = def_type and func_inst = module_inst Lib.Promise.t Func.t and table_inst = Table.t and memory_inst = Memory.t @@ -38,7 +38,7 @@ type Value.ref_ += FuncRef of func_inst let () = let type_of_ref' = !Value.type_of_ref' in Value.type_of_ref' := function - | FuncRef f -> DefHT (Dyn (Func.type_inst_of f)) + | FuncRef f -> DefHT (DefFuncT (Func.type_of f)) | r -> type_of_ref' r let () = @@ -55,6 +55,14 @@ let () = | _, _ -> eq_ref' r1 r2 +(* Projections *) + +let func_inst_of_extern = function ExternFunc f -> f | _ -> failwith "func_inst_of_extern" +let table_inst_of_extern = function ExternTable f -> f | _ -> failwith "table_inst_of_extern" +let memory_inst_of_extern = function ExternMemory f -> f | _ -> failwith "memory_inst_of_extern" +let global_inst_of_extern = function ExternGlobal f -> f | _ -> failwith "global_inst_of_extern" + + (* Auxiliary functions *) let empty_module_inst = diff --git a/interpreter/runtime/table.ml b/interpreter/runtime/table.ml index fe6ed3c8a..d309eefac 100644 --- a/interpreter/runtime/table.ml +++ b/interpreter/runtime/table.ml @@ -52,7 +52,7 @@ let load tab i = let store tab i r = let TableT (lim, t) = tab.ty in - if not (Match.match_ref_type [] (type_of_ref r) t) then raise Type; + if not (Match.match_ref_type (type_of_ref r) t) then raise Type; try Lib.Array32.set tab.content i r with Invalid_argument _ -> raise Bounds let blit tab offset rs = diff --git a/interpreter/script/import.ml b/interpreter/script/import.ml index cac9a8d83..1040aaa79 100644 --- a/interpreter/script/import.ml +++ b/interpreter/script/import.ml @@ -17,5 +17,5 @@ let lookup (ImportT (et, module_name, item_name)) at : Instance.extern = "\".\"" ^ Types.string_of_name item_name ^ "\"") let link m = - let ModuleT (_, its, _) = Types.dyn_module_type (module_type_of m) in + let ModuleT (its, _) = module_type_of m in List.map2 lookup its (List.map Source.at m.it.imports) diff --git a/interpreter/script/js.ml b/interpreter/script/js.ml index 7f660b74d..bfed6828b 100644 --- a/interpreter/script/js.ml +++ b/interpreter/script/js.ml @@ -195,8 +195,8 @@ function assert_return(action, ...expected) { }; return; case "ref.null": - if (actual !== null) { - throw new Error("Wasm null return value expected, got " + actual); + if (actual[i] !== null) { + throw new Error("Wasm null return value expected, got " + actual[i]); }; return; default: @@ -218,7 +218,7 @@ type exports = extern_type NameMap.t type modules = {mutable env : exports Map.t; mutable current : int} let exports m : exports = - let ets = List.map (export_type_of m) m.it.exports in + let ModuleT (_, ets) = module_type_of m in List.fold_left (fun map (ExportT (et, name)) -> NameMap.add name et map) NameMap.empty ets @@ -283,12 +283,8 @@ let abs_mask_of = function let null_heap_type_of = function | Types.FuncHT -> FuncHT | Types.ExternHT -> ExternHT - | Types.BotHT -> assert false - | Types.DefHT (Stat _) -> assert false - | Types.DefHT (Dyn a) -> - match Types.def_of a with - | Types.DefFuncT _ -> FuncHT - | Types.DefContT _ -> assert false + | Types.DefHT (Types.DefFuncT _) -> FuncHT + | Types.DefHT (Types.DefContT _) | Types.VarHT _ | Types.BotHT -> assert false let value v = match v.it with @@ -398,8 +394,7 @@ let assert_return ress ts at = match t with | FuncHT -> is_funcref_idx | ExternHT -> is_externref_idx - | DefHT _ -> is_funcref_idx - | BotHT -> assert false + | DefHT _ | VarHT _ | BotHT -> assert false in [ Call (is_ref_idx @@ at) @@ at; Test (I32 I32Op.Eqz) @@ at; diff --git a/interpreter/script/run.ml b/interpreter/script/run.ml index 2c3f19897..9371270be 100644 --- a/interpreter/script/run.ml +++ b/interpreter/script/run.ml @@ -234,7 +234,7 @@ let type_of_result r = | NumResult (NanPat n) -> NumT (Value.type_of_num n.it) | VecResult (VecPat v) -> VecT (Value.type_of_vec v) | RefResult (RefPat r) -> RefT (Value.type_of_ref r.it) - | RefResult (RefTypePat t) -> RefT (NoNull, dyn_heap_type [] t) + | RefResult (RefTypePat t) -> RefT (NoNull, t) (* assume closed *) | RefResult (NullPat) -> RefT (Null, ExternHT) let string_of_num_pat (p : num_pat) = @@ -330,7 +330,7 @@ let run_action act : Value.t list = if List.length vs <> List.length ts1 then Script.error act.at "wrong number of arguments"; List.iter2 (fun v t -> - if not (Match.match_val_type [] (Value.type_of_value v.it) t) then + if not (Match.match_val_type (Value.type_of_value v.it) t) then Script.error v.at "wrong type of argument" ) vs ts1; Eval.invoke f (List.map (fun v -> v.it) vs) diff --git a/interpreter/syntax/ast.ml b/interpreter/syntax/ast.ml index 4b605fa40..61ec8d1cc 100644 --- a/interpreter/syntax/ast.ml +++ b/interpreter/syntax/ast.ml @@ -320,7 +320,7 @@ and import_desc' = | TableImport of table_type | MemoryImport of memory_type | GlobalImport of global_type - | TagImport of tag_type + | TagImport of idx type import = import' Source.phrase and import' = @@ -372,47 +372,50 @@ let empty_module = open Source -let func_type_of (m : module_) (x : idx) : func_type = +let ft (m : module_) (x : idx) : func_type = as_func_def_type (Lib.List32.nth m.it.types x.it).it +let ht (m : module_) (x : idx) : heap_type = + DefHT ((Lib.List32.nth m.it.types x.it).it) + let import_type_of (m : module_) (im : import) : import_type = let {idesc; module_name; item_name} = im.it in let et = match idesc.it with - | FuncImport x -> ExternFuncT (func_type_of m x) - | TableImport t -> ExternTableT t - | MemoryImport t -> ExternMemoryT t - | GlobalImport t -> ExternGlobalT t - | TagImport t -> ExternTagT t + | FuncImport x -> ExternFuncT (ft m x) + | TableImport tt -> ExternTableT tt + | MemoryImport mt -> ExternMemoryT mt + | GlobalImport gt -> ExternGlobalT gt + | TagImport et -> ExternTagT (TagT (ht m et)) in ImportT (et, module_name, item_name) let export_type_of (m : module_) (ex : export) : export_type = let {edesc; name} = ex.it in let its = List.map (import_type_of m) m.it.imports in let ets = List.map extern_type_of_import_type its in - let open Lib.List32 in let et = match edesc.it with | FuncExport x -> - let fts = - funcs ets @ List.map (fun f -> func_type_of m f.it.ftype) m.it.funcs - in ExternFuncT (nth fts x.it) + let fts = funcs ets @ List.map (fun f -> ft m f.it.ftype) m.it.funcs in + ExternFuncT (Lib.List32.nth fts x.it) | TableExport x -> let tts = tables ets @ List.map (fun t -> t.it.ttype) m.it.tables in - ExternTableT (nth tts x.it) + ExternTableT (Lib.List32.nth tts x.it) | MemoryExport x -> let mts = memories ets @ List.map (fun m -> m.it.mtype) m.it.memories in - ExternMemoryT (nth mts x.it) + ExternMemoryT (Lib.List32.nth mts x.it) | GlobalExport x -> let gts = globals ets @ List.map (fun g -> g.it.gtype) m.it.globals in - ExternGlobalT (nth gts x.it) + ExternGlobalT (Lib.List32.nth gts x.it) | TagExport x -> let tagts = tags ets @ List.map (fun t -> t.it.tagtype) m.it.tags in - ExternTagT (nth tagts x.it) + ExternTagT (Lib.List32.nth tagts x.it) in ExportT (et, name) let module_type_of (m : module_) : module_type = - let dts = List.map Source.it m.it.types in let its = List.map (import_type_of m) m.it.imports in let ets = List.map (export_type_of m) m.it.exports in - ModuleT (dts, its, ets) + let a = Array.make (List.length m.it.types) BotHT in + let s = fun (StatX x) -> a.(Int32.to_int x) in + List.iteri (fun i dt -> a.(i) <- DefHT (subst_def_type s dt.it)) m.it.types; + subst_module_type s (ModuleT (its, ets)) diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml index e797da6d2..0403e2f56 100644 --- a/interpreter/syntax/free.ml +++ b/interpreter/syntax/free.ml @@ -67,8 +67,7 @@ let opt free xo = Lib.Option.get (Option.map free xo) empty let list free xs = List.fold_left union empty (List.map free xs) let var_type = function - | Stat x -> types (idx' x) - | Dyn x -> empty + | StatX x -> types (idx' x) let num_type = function | I32T | I64T | F32T | F64T -> empty @@ -78,7 +77,8 @@ let vec_type = function let heap_type = function | FuncHT | ExternHT | BotHT -> empty - | DefHT x -> var_type x + | VarHT x -> var_type x + | DefHT dt -> empty (* assume closed *) let ref_type = function | (_, t) -> heap_type t @@ -90,15 +90,15 @@ let val_type = function | BotT -> empty let func_type (FuncT (ins, out)) = list val_type ins ++ list val_type out -let cont_type (ContT x) = var_type x +let cont_type (ContT ht) = heap_type ht let global_type (GlobalT (_mut, t)) = val_type t let table_type (TableT (_lim, t)) = ref_type t let memory_type (MemoryT (_lim)) = empty -let tag_type (TagT x) = var_type x +let tag_type (TagT ht) = heap_type ht let def_type = function | DefFuncT ft -> func_type ft - | DefContT ct -> cont_type ct + | DefContT x -> cont_type x let block_type = function | VarBlockType x -> types (idx x) @@ -192,7 +192,7 @@ let import_desc (d : import_desc) = | TableImport tt -> table_type tt | MemoryImport mt -> memory_type mt | GlobalImport gt -> global_type gt - | TagImport et -> tag_type et + | TagImport et -> types (idx et) let export (e : export) = export_desc e.it.edesc let import (i : import) = import_desc i.it.idesc diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml index c93089d1b..1bdbe7b6c 100644 --- a/interpreter/syntax/types.ml +++ b/interpreter/syntax/types.ml @@ -9,26 +9,25 @@ type mut = Cons | Var type init = Set | Unset type 'a limits = {min : 'a; max : 'a option} -type type_addr = .. -type var = Stat of type_idx | Dyn of type_addr +type var = StatX of type_idx type num_type = I32T | I64T | F32T | F64T type vec_type = V128T -type heap_type = FuncHT | ExternHT | DefHT of var | BotHT -type ref_type = null * heap_type -type val_type = NumT of num_type | VecT of vec_type | RefT of ref_type | BotT +type heap_type = FuncHT | ExternHT | VarHT of var | DefHT of def_type | BotHT +and ref_type = null * heap_type +and val_type = NumT of num_type | VecT of vec_type | RefT of ref_type | BotT -type result_type = val_type list -type instr_type = InstrT of result_type * result_type * local_idx list -type func_type = FuncT of result_type * result_type -type cont_type = ContT of var -type def_type = DefFuncT of func_type | DefContT of cont_type +and result_type = val_type list +and instr_type = InstrT of result_type * result_type * local_idx list +and func_type = FuncT of result_type * result_type +and cont_type = ContT of heap_type +and def_type = DefFuncT of func_type | DefContT of cont_type type table_type = TableT of Int32.t limits * ref_type type memory_type = MemoryT of Int32.t limits type global_type = GlobalT of mut * val_type type local_type = LocalT of init * val_type -type tag_type = TagT of var +type tag_type = TagT of heap_type type extern_type = | ExternFuncT of func_type | ExternTableT of table_type @@ -38,38 +37,64 @@ type extern_type = type export_type = ExportT of extern_type * name type import_type = ImportT of extern_type * name * name -type module_type = - | ModuleT of def_type list * import_type list * export_type list +type module_type = ModuleT of import_type list * export_type list (* Attributes *) -let num_size : num_type -> int = function +let num_size = function | I32T | F32T -> 4 | I64T | F64T -> 8 -let vec_size : vec_type -> int = function +let vec_size = function | V128T -> 16 -let is_num_type : val_type -> bool = function +let is_num_type = function | NumT _ | BotT -> true | _ -> false -let is_vec_type : val_type -> bool = function +let is_vec_type = function | VecT _ | BotT -> true | _ -> false -let is_ref_type : val_type -> bool = function +let is_ref_type = function | RefT _ | BotT -> true | _ -> false -let defaultable : val_type -> bool = function +let defaultable = function | NumT _ -> true | VecT _ -> true | RefT (nul, _) -> nul = Null | BotT -> assert false +(* Projections *) + +let as_func_def_type (dt : def_type) : func_type = + match dt with + | DefFuncT ft -> ft + | _ -> assert false + +let as_cont_def_type (dt : def_type) : cont_type = + match dt with + | DefContT ct -> ct + | _ -> assert false + +let as_func_heap_type (ht : heap_type) : func_type = + match ht with + | DefHT dt -> as_func_def_type dt + | _ -> assert false + +let as_func_cont_type (ContT ct) : func_type = + as_func_heap_type ct + +let as_func_tag_type (TagT et) : func_type = + as_func_heap_type et + +let extern_type_of_import_type (ImportT (et, _, _)) = et +let extern_type_of_export_type (ExportT (et, _)) = et + + (* Filters *) let funcs (ets : extern_type list) : func_type list = @@ -102,78 +127,77 @@ let string_of_name n = List.iter escape n; Buffer.contents b -let string_of_null : null -> string = function +let string_of_var = function + | StatX x -> I32.to_string_u x + +let string_of_null = function | NoNull -> "" | Null -> "null " -let string_of_addr' = ref (fun (a : type_addr) -> assert false) -let string_of_addr a = !string_of_addr' a +let string_of_limits = function + | {min; max} -> + I32.to_string_u min ^ + (match max with None -> "" | Some n -> " " ^ I32.to_string_u n) -let string_of_var : var -> string = function - | Stat x -> I32.to_string_u x - | Dyn a -> string_of_addr a -let string_of_num_type : num_type -> string = function +let string_of_num_type = function | I32T -> "i32" | I64T -> "i64" | F32T -> "f32" | F64T -> "f64" -let string_of_vec_type : vec_type -> string = function +let string_of_vec_type = function | V128T -> "v128" -let string_of_heap_type : heap_type -> string = function +let rec string_of_heap_type = function | FuncHT -> "func" | ExternHT -> "extern" - | DefHT x -> string_of_var x - | BotHT -> "something" + | VarHT x -> string_of_var x + | DefHT dt -> string_of_def_type dt + | BotHT -> "none" -let string_of_ref_type : ref_type -> string = function +and string_of_ref_type = function | (nul, t) -> "(ref " ^ string_of_null nul ^ string_of_heap_type t ^ ")" -let string_of_val_type : val_type -> string = function +and string_of_val_type = function | NumT t -> string_of_num_type t | VecT t -> string_of_vec_type t | RefT t -> string_of_ref_type t - | BotT -> "(something)" + | BotT -> "bot" -let string_of_result_type : result_type -> string = function +and string_of_result_type = function | ts -> "[" ^ String.concat " " (List.map string_of_val_type ts) ^ "]" -let string_of_func_type : func_type -> string = function +and string_of_func_type = function | FuncT (ts1, ts2) -> string_of_result_type ts1 ^ " -> " ^ string_of_result_type ts2 -let string_of_cont_type = function - | ContT x -> string_of_var x +and string_of_cont_type = function + | ContT ht -> string_of_heap_type ht -let string_of_def_type : def_type -> string = function +and string_of_def_type = function | DefFuncT ft -> "func " ^ string_of_func_type ft | DefContT ct -> "cont " ^ string_of_cont_type ct -let string_of_tag_type (TagT x) = string_of_var x +let string_of_tag_type = function + | TagT ht -> string_of_heap_type ht -let string_of_limits : I32.t limits -> string = function - | {min; max} -> - I32.to_string_u min ^ - (match max with None -> "" | Some n -> " " ^ I32.to_string_u n) - -let string_of_memory_type : memory_type -> string = function +let string_of_memory_type = function | MemoryT lim -> string_of_limits lim -let string_of_table_type : table_type -> string = function +let string_of_table_type = function | TableT (lim, t) -> string_of_limits lim ^ " " ^ string_of_ref_type t -let string_of_global_type : global_type -> string = function +let string_of_global_type = function | GlobalT (Cons, t) -> string_of_val_type t | GlobalT (Var, t) -> "(mut " ^ string_of_val_type t ^ ")" -let string_of_local_type : local_type -> string = function +let string_of_local_type = function | LocalT (Set, t) -> string_of_val_type t | LocalT (Unset, t) -> "(unset " ^ string_of_val_type t ^ ")" -let string_of_extern_type : extern_type -> string = function +let string_of_extern_type = function | ExternFuncT ft -> "func " ^ string_of_func_type ft | ExternTableT tt -> "table " ^ string_of_table_type tt | ExternMemoryT mt -> "memory " ^ string_of_memory_type mt @@ -181,143 +205,88 @@ let string_of_extern_type : extern_type -> string = function | ExternTagT t -> "tag " ^ string_of_tag_type t -let string_of_export_type : export_type -> string = function +let string_of_export_type = function | ExportT (et, name) -> "\"" ^ string_of_name name ^ "\" : " ^ string_of_extern_type et -let string_of_import_type : import_type -> string = function +let string_of_import_type = function | ImportT (et, module_name, name) -> "\"" ^ string_of_name module_name ^ "\" \"" ^ string_of_name name ^ "\" : " ^ string_of_extern_type et -let string_of_module_type : module_type -> string = function - | ModuleT (dts, its, ets) -> +let string_of_module_type = function + | ModuleT (its, ets) -> String.concat "" ( - List.mapi (fun i dt -> "type " ^ string_of_int i ^ " = " ^ string_of_def_type dt ^ "\n") dts @ List.map (fun it -> "import " ^ string_of_import_type it ^ "\n") its @ List.map (fun et -> "export " ^ string_of_export_type et ^ "\n") ets ) -(* Dynamic Types *) - -type type_addr += Addr of def_type Lib.Promise.t - -let unwrap = function - | Addr p -> p - | _ -> assert false - -let alloc_uninit () = Addr (Lib.Promise.make ()) -let init x dt = Lib.Promise.fulfill (unwrap x) dt -let alloc dt = let x = alloc_uninit () in init x dt; x -let def_of x = Lib.Promise.value (unwrap x) - -let () = string_of_addr' := - let inner = ref false in - fun x -> - if !inner then "..." else - ( inner := true; - try - let s = string_of_def_type (def_of x) in - inner := false; "(" ^ s ^ ")" - with exn -> inner := false; raise exn - ) - +(* Substitution *) -(* Instantiation *) +type subst = var -> heap_type -let dyn_var_type c = function - | Stat x -> Dyn (Lib.List32.nth c x) - | Dyn a -> assert false +let subst_num_type s t = t -let dyn_num_type c = function - | t -> t +let subst_vec_type s t = t -let dyn_vec_type c = function - | t -> t - -let dyn_heap_type c = function +let subst_heap_type s = function | FuncHT -> FuncHT | ExternHT -> ExternHT - | DefHT x -> DefHT (dyn_var_type c x) + | VarHT x -> s x + | DefHT ht -> DefHT ht (* assume closed *) | BotHT -> BotHT -let dyn_ref_type c = function - | (nul, t) -> (nul, dyn_heap_type c t) +let subst_ref_type s = function + | (nul, t) -> (nul, subst_heap_type s t) -let dyn_val_type c = function - | NumT t -> NumT (dyn_num_type c t) - | VecT t -> VecT (dyn_vec_type c t) - | RefT t -> RefT (dyn_ref_type c t) +let subst_val_type s = function + | NumT t -> NumT (subst_num_type s t) + | VecT t -> VecT (subst_vec_type s t) + | RefT t -> RefT (subst_ref_type s t) | BotT -> BotT -let dyn_result_type c = function - | ts -> List.map (dyn_val_type c) ts - -let dyn_func_type c = function - | FuncT (ts1, ts2) -> FuncT (dyn_result_type c ts1, dyn_result_type c ts2) +let subst_result_type s = function + | ts -> List.map (subst_val_type s) ts -let dyn_cont_type c = function - | ContT x -> ContT (dyn_var_type c x) +let subst_func_type s = function + | FuncT (ts1, ts2) -> FuncT (subst_result_type s ts1, subst_result_type s ts2) -let dyn_def_type c = function - | DefFuncT ft -> DefFuncT (dyn_func_type c ft) - | DefContT x -> DefContT (dyn_cont_type c x) +let subst_cont_type s = function + | ContT ft -> ContT (subst_heap_type s ft) -let dyn_local_type c = function - | LocalT (init, t) -> LocalT (init, dyn_val_type c t) +let subst_def_type s = function + | DefFuncT ft -> DefFuncT (subst_func_type s ft) + | DefContT ct -> DefContT (subst_cont_type s ct) -let dyn_memory_type c = function +let subst_memory_type s = function | MemoryT lim -> MemoryT lim -let dyn_table_type c = function - | TableT (lim, t) -> TableT (lim, dyn_ref_type c t) +let subst_table_type s = function + | TableT (lim, t) -> TableT (lim, subst_ref_type s t) -let dyn_global_type c = function - | GlobalT (mut, t) -> GlobalT (mut, dyn_val_type c t) +let subst_global_type s = function + | GlobalT (mut, t) -> GlobalT (mut, subst_val_type s t) -let dyn_tag_type c = function - | TagT t -> TagT (dyn_var_type c t) +let subst_tag_type s = function + | TagT ht -> TagT (subst_heap_type s ht) -let dyn_extern_type c = function - | ExternFuncT ft -> ExternFuncT (dyn_func_type c ft) - | ExternTableT tt -> ExternTableT (dyn_table_type c tt) - | ExternMemoryT mt -> ExternMemoryT (dyn_memory_type c mt) - | ExternGlobalT gt -> ExternGlobalT (dyn_global_type c gt) - | ExternTagT t -> ExternTagT (dyn_tag_type c t) +let subst_extern_type s = function + | ExternFuncT ft -> ExternFuncT (subst_func_type s ft) + | ExternTableT tt -> ExternTableT (subst_table_type s tt) + | ExternMemoryT mt -> ExternMemoryT (subst_memory_type s mt) + | ExternGlobalT gt -> ExternGlobalT (subst_global_type s gt) + | ExternTagT et -> ExternTagT (subst_tag_type s et) -let dyn_export_type c = function - | ExportT (et, name) -> ExportT (dyn_extern_type c et, name) +let subst_export_type s = function + | ExportT (et, name) -> ExportT (subst_extern_type s et, name) -let dyn_import_type c = function +let subst_import_type s = function | ImportT (et, module_name, name) -> - ImportT (dyn_extern_type c et, module_name, name) - -let dyn_module_type = function - | ModuleT (dts, its, ets) -> - let c = List.map (fun _ -> alloc_uninit ()) dts in - List.iter2 (fun a dt -> init a (dyn_def_type c dt)) c dts; - let its = List.map (dyn_import_type c) its in - let ets = List.map (dyn_export_type c) ets in - ModuleT ([], its, ets) - -(* Projections *) -let as_stat_var = function - | Stat x -> x - | Dyn _ -> assert false - -let as_dyn_var = function - | Dyn a -> a - | Stat _ -> assert false + ImportT (subst_extern_type s et, module_name, name) -let as_func_def_type (dt : def_type) : func_type = - match dt with - | DefFuncT ft -> ft - | _ -> assert false - -let as_cont_def_type (dt : def_type) : cont_type = - match dt with - | DefContT ct -> ct - | _ -> assert false - -let extern_type_of_import_type (ImportT (et, _, _)) = et -let extern_type_of_export_type (ExportT (et, _)) = et +let subst_module_type s = function + | ModuleT (its, ets) -> + ModuleT ( + List.map (subst_import_type s) its, + List.map (subst_export_type s) ets + ) diff --git a/interpreter/text/arrange.ml b/interpreter/text/arrange.ml index 78c54e273..386643c8a 100644 --- a/interpreter/text/arrange.ml +++ b/interpreter/text/arrange.ml @@ -56,7 +56,7 @@ let break_string s = (* Types *) -let var_type t = string_of_var t +(* let var_type t = string_of_var t *) let num_type t = string_of_num_type t let vec_type t = string_of_vec_type t let ref_type t = string_of_ref_type t @@ -68,8 +68,8 @@ let decls kind ts = tab kind (atom val_type) ts let func_type (FuncT (ts1, ts2)) = Node ("func", decls "param" ts1 @ decls "result" ts2) -let cont_type (ContT x) = - Node ("cont", [Atom (var_type x)]) +let cont_type (ContT ct) = + Node ("cont", [atom heap_type ct]) let def_type dt = match dt with @@ -578,9 +578,9 @@ let memory off i mem = Node ("memory $" ^ nat (off + i) ^ " " ^ limits nat32 lim, []) let tag off i tag = - let {tagtype = TagT x} = tag.it in + let {tagtype = TagT et} = tag.it in Node ("tag $" ^ nat (off + i), - [Node ("type", [atom var_type x])] + [Node ("type", [atom heap_type et])] ) let is_elem_kind = function @@ -637,8 +637,8 @@ let import_desc fx tx mx ex gx d = incr tx; table 0 (!tx - 1) ({ttype = t; tinit = [] @@ d.at} @@ d.at) | MemoryImport t -> incr mx; memory 0 (!mx - 1) ({mtype = t} @@ d.at) - | TagImport t -> - incr ex; tag 0 (!ex - 1) ({tagtype = t} @@ d.at) + | TagImport x -> + incr ex; Node ("tag $" ^ nat (!ex - 1), [Node ("type", [atom var x])]) | GlobalImport t -> incr gx; Node ("global $" ^ nat (!gx - 1), [global_type t]) diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index fc6ae4b62..7d4e54329 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -209,15 +209,17 @@ let anon_elem (c : context) at = bind "elem segment" c.elems 1l at let anon_data (c : context) at = bind "data segment" c.datas 1l at let anon_label (c : context) at = bind "label" c.labels 1l at - -let inline_func_type (c : context) ft at = - let dt = DefFuncT ft in +let find_type_index (c : context) dt at = match Lib.List.index_where (fun ty -> ty.it = dt) c.types.list with | Some i -> Int32.of_int i @@ at | None -> let i = anon_type c at in define_type c (dt @@ at); i @@ at +let inline_func_type (c : context) ft at = + let dt = DefFuncT ft in + find_type_index c dt at + let inline_func_type_explicit (c : context) x ft at = if ft = FuncT ([], []) then (* Deferring ensures that type lookup is only triggered when @@ -230,6 +232,11 @@ let inline_func_type_explicit (c : context) x ft at = error at "inline function type does not match explicit type"; x +let inline_tag_type (c : context) (TagT ht) at = + match ht with + | VarHT (StatX x) -> x @@ at + | DefHT dt -> find_type_index c dt at + | _ -> assert false %} @@ -299,7 +306,7 @@ null_opt : heap_type : | FUNC { fun c -> FuncHT } | EXTERN { fun c -> ExternHT } - | var { fun c -> DefHT (Stat ($1 c type_).it) } + | var { fun c -> VarHT (StatX ($1 c type_).it) } ref_type : | LPAR REF null_opt heap_type RPAR { fun c -> ($3, $4 c) } @@ -321,20 +328,22 @@ global_type : def_type : | LPAR FUNC func_type RPAR { fun c -> DefFuncT ($3 c) } - | LPAR CONT cont_type RPAR { fun c -> DefContT (ContT (Stat ($3 c).it)) } + | LPAR CONT cont_type RPAR { fun c -> DefContT ($3 c) } cont_type : | type_use cont_type_params { let at1 = ati 1 in fun c -> match $2 c with - | FuncT ([], []) -> $1 c - | ft -> inline_func_type_explicit c ($1 c) ft at1 } + | FuncT ([], []) -> ContT (VarHT (StatX ($1 c).it)) + | ft -> + let x = inline_func_type_explicit c ($1 c) ft at1 in + ContT (VarHT (StatX x.it)) } | cont_type_params /* TODO: the inline type is broken for now */ - { let at = at () in fun c -> inline_func_type c ($1 c) at } + { let at = at () in fun c -> ContT (VarHT (StatX (inline_func_type c ($1 c) at).it)) } | var /* Sugar */ - { fun c -> $1 c type_ } + { fun c -> ContT (VarHT (StatX ($1 c type_).it)) } cont_type_params : | LPAR PARAM val_type_list RPAR cont_type_params @@ -367,9 +376,9 @@ func_type_result : tag_type : | type_use - { fun c -> TagT (Stat ($1 c).it) } + { fun c -> TagT (VarHT (StatX ($1 c).it)) } | func_type - { let at = at () in fun c -> TagT (Stat (inline_func_type c ($1 c) at).it) } + { let at1 = at () in fun c -> TagT (VarHT (StatX (inline_func_type c ($1 c) at1).it)) } table_type : | limits ref_type { fun c -> TableT ($1, $2 c) } @@ -1028,10 +1037,10 @@ table_fields : | inline_export table_fields /* Sugar */ { fun c x at -> let tabs, elems, ims, exs = $2 c x at in tabs, elems, ims, $1 (TableExport x) c :: exs } - | ref_type LPAR ELEM elem_var_list RPAR /* Sugar */ + | ref_type LPAR ELEM elem_expr elem_expr_list RPAR /* Sugar */ { fun c x at -> let offset = [i32_const (0l @@ at) @@ at] @@ at in - let einit = $4 c in + let einit = $4 c :: $5 c in let size = Lib.List32.length einit in let emode = Active {index = x; offset} @@ at in let (_, ht) as etype = $1 c in @@ -1039,15 +1048,15 @@ table_fields : [{ttype = TableT ({min = size; max = Some size}, etype); tinit} @@ at], [{etype; einit; emode} @@ at], [], [] } - | ref_type LPAR ELEM elem_expr elem_expr_list RPAR /* Sugar */ + | ref_type LPAR ELEM elem_var_list RPAR /* Sugar */ { fun c x at -> let offset = [i32_const (0l @@ at) @@ at] @@ at in - let einit = $4 c :: $5 c in + let einit = $4 c in let size = Lib.List32.length einit in let emode = Active {index = x; offset} @@ at in let (_, ht) as etype = $1 c in let tinit = [RefNull ht @@ at] @@ at in - [{ttype = TableT ({min = size; max = Some size}, $1 c); tinit} @@ at], + [{ttype = TableT ({min = size; max = Some size}, etype); tinit} @@ at], [{etype; einit; emode} @@ at], [], [] } @@ -1123,7 +1132,7 @@ tag_fields : { fun c x at -> [], [{ module_name = fst $1; item_name = snd $1; - idesc = TagImport ($2 c) @@ at } @@ at], [] } + idesc = TagImport (inline_tag_type c ($2 c) at) @@ at } @@ at], [] } | inline_export tag_fields /* Sugar */ { fun c x at -> let evts, ims, exs = $2 c x at in evts, ims, $1 (TagExport x) c :: exs } @@ -1148,8 +1157,9 @@ import_desc : { fun c -> ignore ($3 c anon_global bind_global); fun () -> GlobalImport ($4 c) } | LPAR TAG bind_var_opt tag_type RPAR - { fun c -> ignore ($3 c anon_tag bind_tag); - fun () -> TagImport ($4 c) } + { let at4 = ati 4 in + fun c -> ignore ($3 c anon_tag bind_tag); + fun () -> TagImport (inline_tag_type c ($4 c) at4) } import : | LPAR IMPORT name name import_desc RPAR @@ -1344,8 +1354,7 @@ literal_vec : | LPAR VEC_CONST VEC_SHAPE num_list RPAR { snd (vec $2 $3 $4 (at ())) } literal_ref : - | LPAR REF_NULL heap_type RPAR - { Value.NullRef (Types.dyn_heap_type [] ($3 (empty_context ()))) } + | LPAR REF_NULL heap_type RPAR { Value.NullRef ($3 (empty_context ())) } | LPAR REF_EXTERN NAT RPAR { Script.ExternRef (nat32 $3 (ati 3)) } literal : diff --git a/interpreter/util/lib.ml b/interpreter/util/lib.ml index be71678f0..f7e5276b5 100644 --- a/interpreter/util/lib.ml +++ b/interpreter/util/lib.ml @@ -64,10 +64,6 @@ struct and make' n x xs = if n = 0 then xs else make' (n - 1) x (x::xs) - let rec table n f = table' n f [] - and table' n f xs = - if n = 0 then xs else table' (n - 1) f (f (n - 1) :: xs) - let rec take n xs = match n, xs with | 0, _ -> [] diff --git a/interpreter/util/lib.mli b/interpreter/util/lib.mli index ebad2f3e5..d0dcc5e94 100644 --- a/interpreter/util/lib.mli +++ b/interpreter/util/lib.mli @@ -15,7 +15,6 @@ end module List : sig val make : int -> 'a -> 'a list - val table : int -> (int -> 'a) -> 'a list val take : int -> 'a list -> 'a list (* raises Failure *) val drop : int -> 'a list -> 'a list (* raises Failure *) val split : int -> 'a list -> 'a list * 'a list (* raises Failure *) diff --git a/interpreter/valid/match.ml b/interpreter/valid/match.ml index 7bc1a0f56..4c5162e86 100644 --- a/interpreter/valid/match.ml +++ b/interpreter/valid/match.ml @@ -1,183 +1,161 @@ open Types -(* Context *) - -type context = def_type list - -let lookup c = function - | Stat x -> Lib.List32.nth c x - | Dyn a -> def_of a - - (* Equivalence *) -let eq_var x1 x2 = - match x1, x2 with - | Stat x1, Stat x2 -> x1 = x2 - | Dyn a1, Dyn a2 -> a1 == a2 - | _, _ -> false - -let eq_nullability c nul1 nul2 = +let eq_nullability nul1 nul2 = nul1 = nul2 -let eq_mutability c mut1 mut2 = +let eq_mutability mut1 mut2 = mut1 = mut2 -let eq_limits c lim1 lim2 = +let eq_limits lim1 lim2 = lim1.min = lim2.min && lim1.max = lim2.max -let eq_num_type c t1 t2 = +let eq_num_type t1 t2 = t1 = t2 -let eq_vec_type c t1 t2 = +let eq_vec_type t1 t2 = t1 = t2 -let rec eq_heap_type c t1 t2 = +let rec eq_heap_type t1 t2 = match t1, t2 with - | DefHT x1, DefHT x2 -> eq_var_type c x1 x2 + | DefHT dt1, DefHT dt2 -> eq_def_type dt1 dt2 | _, _ -> t1 = t2 -and eq_ref_type c t1 t2 = +and eq_ref_type t1 t2 = match t1, t2 with | (nul1, t1'), (nul2, t2') -> - eq_nullability c nul1 nul2 && eq_heap_type c t1' t2' + eq_nullability nul1 nul2 && eq_heap_type t1' t2' -and eq_val_type c t1 t2 = +and eq_val_type t1 t2 = match t1, t2 with - | NumT t1', NumT t2' -> eq_num_type c t1' t2' - | VecT t1', VecT t2' -> eq_vec_type c t1' t2' - | RefT t1', RefT t2' -> eq_ref_type c t1' t2' + | NumT t1', NumT t2' -> eq_num_type t1' t2' + | VecT t1', VecT t2' -> eq_vec_type t1' t2' + | RefT t1', RefT t2' -> eq_ref_type t1' t2' | BotT, BotT -> true | _, _ -> false -and eq_result_type c ts1 ts2 = +(* and eq_var_type t1 t2 = + * t1 = t2 *) + +and eq_result_type ts1 ts2 = List.length ts1 = List.length ts2 && - List.for_all2 (eq_val_type c) ts1 ts2 + List.for_all2 eq_val_type ts1 ts2 -and eq_func_type c (FuncT (ts11, ts12)) (FuncT (ts21, ts22)) = - eq_result_type c ts11 ts21 && eq_result_type c ts12 ts22 +and eq_func_type (FuncT (ts11, ts12)) (FuncT (ts21, ts22)) = + eq_result_type ts11 ts21 && eq_result_type ts12 ts22 -and eq_cont_type c (ContT x1) (ContT x2) = - eq_var_type c x1 x2 +and eq_cont_type (ContT ht1) (ContT ht2) = + eq_heap_type ht1 ht2 -and eq_def_type c dt1 dt2 = +and eq_def_type dt1 dt2 = match dt1, dt2 with - | DefFuncT ft1, DefFuncT ft2 -> eq_func_type c ft1 ft2 - | DefContT ct1, DefContT ct2 -> eq_cont_type c ct1 ct2 + | DefFuncT ft1, DefFuncT ft2 -> eq_func_type ft1 ft2 + | DefContT ct1, DefContT ct2 -> eq_cont_type ct1 ct2 | _, _ -> false -and eq_var_type c x1 x2 = - eq_var x1 x2 || - eq_def_type c (lookup c x1) (lookup c x2) - - -let eq_table_type c (TableT (lim1, t1)) (TableT (lim2, t2)) = - eq_limits c lim1 lim2 && eq_ref_type c t1 t2 +and eq_table_type (TableT (lim1, t1)) (TableT (lim2, t2)) = + eq_limits lim1 lim2 && eq_ref_type t1 t2 -let eq_memory_type c (MemoryT lim1) (MemoryT lim2) = - eq_limits c lim1 lim2 +and eq_memory_type (MemoryT lim1) (MemoryT lim2) = + eq_limits lim1 lim2 -let eq_global_type c (GlobalT (mut1, t1)) (GlobalT (mut2, t2)) = - eq_mutability c mut1 mut2 && eq_val_type c t1 t2 +and eq_global_type (GlobalT (mut1, t1)) (GlobalT (mut2, t2)) = + eq_mutability mut1 mut2 && eq_val_type t1 t2 -let eq_tag_type c (TagT x1) (TagT x2) = - eq_var_type c x1 x2 +and eq_tag_type (TagT ht1) (TagT ht2) = + eq_heap_type ht1 ht2 -let eq_extern_type c et1 et2 = +and eq_extern_type et1 et2 = match et1, et2 with - | ExternFuncT ft1, ExternFuncT ft2 -> eq_func_type c ft1 ft2 - | ExternTableT tt1, ExternTableT tt2 -> eq_table_type c tt1 tt2 - | ExternMemoryT mt1, ExternMemoryT mt2 -> eq_memory_type c mt1 mt2 - | ExternGlobalT gt1, ExternGlobalT gt2 -> eq_global_type c gt1 gt2 - | ExternTagT t1, ExternTagT t2 -> eq_tag_type c t1 t2 + | ExternFuncT ft1, ExternFuncT ft2 -> eq_func_type ft1 ft2 + | ExternTableT tt1, ExternTableT tt2 -> eq_table_type tt1 tt2 + | ExternMemoryT mt1, ExternMemoryT mt2 -> eq_memory_type mt1 mt2 + | ExternGlobalT gt1, ExternGlobalT gt2 -> eq_global_type gt1 gt2 + | ExternTagT t1, ExternTagT t2 -> eq_tag_type t1 t2 | _, _ -> false (* Subtyping *) -let match_nullability c nul1 nul2 = +let match_nullability nul1 nul2 = match nul1, nul2 with | NoNull, Null -> true | _, _ -> nul1 = nul2 -let match_limits c lim1 lim2 = +let match_limits lim1 lim2 = I32.ge_u lim1.min lim2.min && match lim1.max, lim2.max with | _, None -> true | None, Some _ -> false | Some i, Some j -> I32.le_u i j -let match_num_type c t1 t2 = +let match_num_type t1 t2 = t1 = t2 -let match_vec_type c t1 t2 = +let match_vec_type t1 t2 = t1 = t2 -let rec match_heap_type c t1 t2 = +let rec match_heap_type t1 t2 = match t1, t2 with - | DefHT x1, FuncHT -> - (match lookup c x1 with - | DefFuncT _ -> true - | _ -> false - ) - | DefHT x1, DefHT x2 -> match_var_type c x1 x2 + | DefHT (DefFuncT _), FuncHT -> true + | DefHT dt1, DefHT dt2 -> match_def_type dt1 dt2 | BotHT, _ -> true - | _, _ -> eq_heap_type c t1 t2 + | _, _ -> eq_heap_type t1 t2 -and match_ref_type c t1 t2 = +and match_ref_type t1 t2 = match t1, t2 with | (nul1, t1'), (nul2, t2') -> - match_nullability c nul1 nul2 && match_heap_type c t1' t2' + match_nullability nul1 nul2 && match_heap_type t1' t2' -and match_val_type c t1 t2 = +and match_val_type t1 t2 = match t1, t2 with - | NumT t1', NumT t2' -> match_num_type c t1' t2' - | VecT t1', VecT t2' -> match_vec_type c t1' t2' - | RefT t1', RefT t2' -> match_ref_type c t1' t2' + | NumT t1', NumT t2' -> match_num_type t1' t2' + | VecT t1', VecT t2' -> match_vec_type t1' t2' + | RefT t1', RefT t2' -> match_ref_type t1' t2' | BotT, _ -> true | _, _ -> false -and match_result_type c ts1 ts2 = +and match_result_type ts1 ts2 = List.length ts1 = List.length ts2 && - List.for_all2 (match_val_type c) ts1 ts2 + List.for_all2 match_val_type ts1 ts2 -and match_func_type c ft1 ft2 = - eq_func_type c ft1 ft2 +and match_func_type ft1 ft2 = + eq_func_type ft1 ft2 -and match_def_type c dt1 dt2 = +and match_def_type dt1 dt2 = match dt1, dt2 with - | DefFuncT ft1, DefFuncT ft2 -> match_func_type c ft1 ft2 - | DefContT ct1, DefContT ct2 -> match_cont_type c ct1 ct2 + | DefFuncT ft1, DefFuncT ft2 -> match_func_type ft1 ft2 + | DefContT ct1, DefContT ct2 -> match_cont_type ct1 ct2 | _, _ -> false -and match_var_type c x1 x2 = - eq_var x1 x2 || - match_def_type c (lookup c x1) (lookup c x2) +and match_table_type (TableT (lim1, t1)) (TableT (lim2, t2)) = + match_limits lim1 lim2 && eq_ref_type t1 t2 -and match_cont_type c (ContT x1) (ContT x2) = - match_var_type c x1 x2 +and match_cont_type (ContT ht1) (ContT ht2) = + match_heap_type ht1 ht2 -let match_table_type c (TableT (lim1, t1)) (TableT (lim2, t2)) = - match_limits c lim1 lim2 && eq_ref_type c t1 t2 +and match_memory_type (MemoryT lim1) (MemoryT lim2) = + match_limits lim1 lim2 -let match_memory_type c (MemoryT lim1) (MemoryT lim2) = - match_limits c lim1 lim2 - -let match_global_type c (GlobalT (mut1, t1)) (GlobalT (mut2, t2)) = - eq_mutability c mut1 mut2 && +and match_global_type (GlobalT (mut1, t1)) (GlobalT (mut2, t2)) = + eq_mutability mut1 mut2 && match mut1 with - | Cons -> match_val_type c t1 t2 - | Var -> eq_val_type c t1 t2 + | Cons -> match_val_type t1 t2 + | Var -> eq_val_type t1 t2 + +and match_tag_type (TagT ht1) (TagT ht2) = + match_heap_type ht1 ht2 -let match_tag_type c tt1 tt2 = - eq_tag_type c tt1 tt2 +(* and match_var_type t1 t2 = + * eq_var_type t1 t2 *) -let match_extern_type c et1 et2 = +let match_extern_type et1 et2 = match et1, et2 with - | ExternFuncT ft1, ExternFuncT ft2 -> match_func_type c ft1 ft2 - | ExternTableT tt1, ExternTableT tt2 -> match_table_type c tt1 tt2 - | ExternMemoryT mt1, ExternMemoryT mt2 -> match_memory_type c mt1 mt2 - | ExternGlobalT gt1, ExternGlobalT gt2 -> match_global_type c gt1 gt2 - | ExternTagT t1, ExternTagT t2 -> match_tag_type c t1 t2 + | ExternFuncT ft1, ExternFuncT ft2 -> match_func_type ft1 ft2 + | ExternTableT tt1, ExternTableT tt2 -> match_table_type tt1 tt2 + | ExternMemoryT mt1, ExternMemoryT mt2 -> match_memory_type mt1 mt2 + | ExternGlobalT gt1, ExternGlobalT gt2 -> match_global_type gt1 gt2 + | ExternTagT t1, ExternTagT t2 -> match_tag_type t1 t2 | _, _ -> false diff --git a/interpreter/valid/match.mli b/interpreter/valid/match.mli index 201709fb4..91aa572fd 100644 --- a/interpreter/valid/match.mli +++ b/interpreter/valid/match.mli @@ -1,39 +1,35 @@ open Types -(* Context *) - -type context = def_type list - (* Equivalence *) -val eq_num_type : context -> num_type -> num_type -> bool -val eq_ref_type : context -> ref_type -> ref_type -> bool -val eq_val_type : context -> val_type -> val_type -> bool +val eq_num_type : num_type -> num_type -> bool +val eq_ref_type : ref_type -> ref_type -> bool +val eq_val_type : val_type -> val_type -> bool -val eq_result_type : context -> result_type -> result_type -> bool +val eq_result_type : result_type -> result_type -> bool -val eq_func_type : context -> func_type -> func_type -> bool -val eq_table_type : context -> table_type -> table_type -> bool -val eq_memory_type : context -> memory_type -> memory_type -> bool -val eq_global_type : context -> global_type -> global_type -> bool +val eq_func_type : func_type -> func_type -> bool +val eq_table_type : table_type -> table_type -> bool +val eq_memory_type : memory_type -> memory_type -> bool +val eq_global_type : global_type -> global_type -> bool -val eq_extern_type : context -> extern_type -> extern_type -> bool +val eq_extern_type : extern_type -> extern_type -> bool -val eq_def_type : context -> def_type -> def_type -> bool +val eq_def_type : def_type -> def_type -> bool (* Subtyping *) -val match_num_type : context -> num_type -> num_type -> bool -val match_ref_type : context -> ref_type -> ref_type -> bool -val match_val_type : context -> val_type -> val_type -> bool +val match_num_type : num_type -> num_type -> bool +val match_ref_type : ref_type -> ref_type -> bool +val match_val_type : val_type -> val_type -> bool -val match_result_type : context -> result_type -> result_type -> bool +val match_result_type : result_type -> result_type -> bool -val match_func_type : context -> func_type -> func_type -> bool -val match_table_type : context -> table_type -> table_type -> bool -val match_memory_type : context -> memory_type -> memory_type -> bool -val match_global_type : context -> global_type -> global_type -> bool +val match_func_type : func_type -> func_type -> bool +val match_table_type : table_type -> table_type -> bool +val match_memory_type : memory_type -> memory_type -> bool +val match_global_type : global_type -> global_type -> bool -val match_extern_type : context -> extern_type -> extern_type -> bool +val match_extern_type : extern_type -> extern_type -> bool -val match_def_type : context -> def_type -> def_type -> bool +val match_def_type : def_type -> def_type -> bool diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index aae28d03f..6cf8bf9ad 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -96,64 +96,68 @@ let check_limits {min; max} range at msg = "size minimum must not be greater than maximum" let check_num_type (c : context) (t : num_type) at = - () + t let check_vec_type (c : context) (t : vec_type) at = - () + t let check_heap_type (c : context) (t : heap_type) at = match t with - | FuncHT -> () - | ExternHT -> () - | DefHT (Stat x) -> ignore (type_ c (x @@ at)) - | DefHT (Dyn _) -> assert false + | FuncHT -> FuncHT + | ExternHT -> ExternHT + | VarHT (StatX x) -> DefHT (type_ c (x @@ at)) + | DefHT _ -> t | BotHT -> assert false let check_ref_type (c : context) (t : ref_type) at = match t with - | (_nul, ht) -> check_heap_type c ht at + | (nul, ht) -> (nul, check_heap_type c ht at) let check_val_type (c : context) (t : val_type) at = match t with - | NumT t' -> check_num_type c t' at - | VecT t' -> check_vec_type c t' at - | RefT t' -> check_ref_type c t' at + | NumT t' -> NumT (check_num_type c t' at) + | VecT t' -> VecT (check_vec_type c t' at) + | RefT t' -> RefT (check_ref_type c t' at) | BotT -> assert false let check_result_type (c : context) (ts : result_type) at = - List.iter (fun t -> check_val_type c t at) ts + List.map (fun t -> check_val_type c t at) ts let check_func_type (c : context) (ft : func_type) at = let FuncT (ts1, ts2) = ft in - check_result_type c ts1 at; - check_result_type c ts2 at + let ts1' = check_result_type c ts1 at in + let ts2' = check_result_type c ts2 at in + FuncT (ts1', ts2') let check_cont_type (c : context) (ct : cont_type) at = - let ContT x = ct in - ignore (func_type c (as_stat_var x @@ at)) + match ct with + | ContT ft -> ContT (check_heap_type c ft at) let check_table_type (c : context) (tt : table_type) at = let TableT (lim, t) = tt in check_limits lim 0xffff_ffffl at "table size must be at most 2^32-1"; - check_ref_type c t at + let t' = check_ref_type c t at in + TableT (lim, t') let check_memory_type (c : context) (mt : memory_type) at = let MemoryT lim = mt in check_limits lim 0x1_0000l at - "memory size must be at most 65536 pages (4GiB)" + "memory size must be at most 65536 pages (4GiB)"; + MemoryT lim let check_tag_type (c : context) (et : tag_type) at = - let TagT x = et in - ignore (func_type c (as_stat_var x @@ at)) + match et with + | TagT ft -> TagT (check_heap_type c ft at) let check_global_type (c : context) (gt : global_type) at = - let GlobalT (_mut, t) = gt in - check_val_type c t at + let GlobalT (mut, t) = gt in + let t' = check_val_type c t at in + GlobalT (mut, t') let check_def_type (c : context) (dt : def_type) at = match dt with - | DefFuncT ft -> check_func_type c ft at - | DefContT ct -> check_cont_type c ct at + | DefFuncT ft -> DefFuncT (check_func_type c ft at) + | DefContT ct -> DefContT (check_cont_type c ct at) (* Stack typing *) @@ -178,8 +182,8 @@ let (-->...) ts1 ts2 = {ins = Ellipses, ts1; outs = Ellipses, ts2} let check_stack (c : context) ts1 ts2 at = require - (List.length ts1 = List.length ts2 && - List.for_all2 (match_val_type c.types) ts1 ts2) at + ( List.length ts1 = List.length ts2 && + List.for_all2 match_val_type ts1 ts2 ) at ("type mismatch: instruction requires " ^ string_of_result_type ts2 ^ " but stack has " ^ string_of_result_type ts1) @@ -300,7 +304,8 @@ let check_memop (c : context) (memop : ('t, 's) memop) ty_size get_sz at = Pack.packed_size sz in require (1 lsl memop.align <= size) at - "alignment must not be larger than natural" + "alignment must not be larger than natural"; + memop.ty (* @@ -325,16 +330,14 @@ let check_memop (c : context) (memop : ('t, 's) memop) ty_size get_sz at = let check_resume_table (c : context) ts2 (xys : (idx * idx) list) at = List.iter (fun (x1, x2) -> - let TagT x1' = tag c x1 in - let FuncT (ts3, ts4) = func_type c (as_stat_var x1' @@ x1.at) in + let FuncT (ts3, ts4) = as_func_tag_type (tag c x1) in let (_, ts') = label c x2 in match Lib.List.last_opt ts' with - | Some (RefT (nul', DefHT (Stat y'))) -> - let ContT z' = cont_type c (y' @@ x2.at) in - let ft' = func_type c (as_stat_var z' @@ x2.at) in - require (match_func_type c.types (FuncT (ts4, ts2)) ft') x2.at + | Some (RefT (nul', DefHT (DefContT (ContT ht')))) -> + let ft' = as_func_heap_type ht' in + require (match_func_type (FuncT (ts4, ts2)) ft') x2.at "type mismatch in continuation type"; - check_stack c (ts3 @ [RefT (nul', DefHT (Stat y'))]) ts' x2.at + check_stack c (ts3 @ [RefT (nul', DefHT (DefContT (ContT ht')))]) ts' x2.at | _ -> error at ("type mismatch: instruction requires continuation reference type" ^ @@ -344,7 +347,7 @@ let check_resume_table (c : context) ts2 (xys : (idx * idx) list) at = let check_block_type (c : context) (bt : block_type) at : instr_type = match bt with | ValBlockType None -> InstrT ([], [], []) - | ValBlockType (Some t) -> check_val_type c t at; InstrT ([], [t], []) + | ValBlockType (Some t) -> InstrT ([], [check_val_type c t at], []) | VarBlockType x -> let FuncT (ts1, ts2) = func_type c x in InstrT (ts1, ts2, []) @@ -369,8 +372,8 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in | Select (Some ts) -> require (List.length ts = 1) e.at "invalid result arity other than 1 is not (yet) allowed"; - check_result_type c ts e.at; - (ts @ ts @ [NumT I32T]) --> ts, [] + let ts' = check_result_type c ts e.at in + (ts' @ ts' @ [NumT I32T]) --> ts', [] | Block (bt, es) -> let InstrT (ts1, ts2, xs) as it = check_block_type c bt e.at in @@ -389,8 +392,9 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in (ts1 @ [NumT I32T]) --> ts2, List.map (fun x -> x @@ e.at) xs | Throw x -> - let TagT y = tag c x in - let FuncT (ts1, _) = func_type c (as_stat_var y @@ e.at) in + let tag = tag c x in + let tagtype = check_tag_type c tag e.at in + let FuncT (ts1, _) = as_func_tag_type tagtype in ts1 -->... [], [] | Rethrow x -> @@ -423,7 +427,7 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in | BrTable (xs, x) -> let n = List.length (snd (label c x)) in - let ts = Lib.List.table n (fun i -> peek (n - i) s) in + let ts = List.init n (fun i -> peek (n - i) s) in check_stack c ts (snd (label c x)) x.at; List.iter (fun x' -> check_stack c ts (snd (label c x')) x'.at) xs; (ts @ [NumT I32T]) -->... [], [] @@ -439,9 +443,9 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in let (_, ts) = label c x in require (ts <> []) e.at ("type mismatch: instruction requires type " ^ string_of_val_type t' ^ - " but label has " ^ string_of_result_type ts); - let ts0, t1 = Lib.List.split_last ts in - require (match_val_type c.types t' t1) e.at + " but label has " ^ string_of_result_type (snd (label c x))); + let ts0, t1 = Lib.List.split_last (snd (label c x)) in + require (match_val_type t' t1) e.at ("type mismatch: instruction requires type " ^ string_of_val_type t' ^ " but label has " ^ string_of_result_type ts); (ts0 @ [RefT (Null, ht)]) --> ts0, [] @@ -454,78 +458,79 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in ts1 --> ts2, [] | CallRef x -> - let FuncT (ts1, ts2) = func_type c x in - (ts1 @ [RefT (Null, DefHT (Stat x.it))]) --> ts2, [] + let FuncT (ts1, ts2) as ft = func_type c x in + (ts1 @ [RefT (Null, DefHT (DefFuncT ft))]) --> ts2, [] | CallIndirect (x, y) -> let TableT (_lim, t) = table c x in let FuncT (ts1, ts2) = func_type c y in - require (match_ref_type c.types t (Null, FuncHT)) x.at + require (match_ref_type t (Null, FuncHT)) x.at ("type mismatch: instruction requires table of function type" ^ " but table has element type " ^ string_of_ref_type t); (ts1 @ [NumT I32T]) --> ts2, [] | ReturnCall x -> let FuncT (ts1, ts2) = func c x in - require (match_result_type c.types ts2 c.results) e.at + require (match_result_type ts2 c.results) e.at ("type mismatch: current function requires result type " ^ string_of_result_type c.results ^ " but callee returns " ^ string_of_result_type ts2); ts1 -->... [], [] | ReturnCallRef x -> - let FuncT (ts1, ts2) = func_type c x in - require (match_result_type c.types ts2 c.results) e.at + let FuncT (ts1, ts2) as ft = func_type c x in + require (match_result_type ts2 c.results) e.at ("type mismatch: current function requires result type " ^ string_of_result_type c.results ^ " but callee returns " ^ string_of_result_type ts2); - (ts1 @ [RefT (Null, DefHT (Stat x.it))]) -->... [], [] + (ts1 @ [RefT (Null, DefHT (DefFuncT ft))]) -->... [], [] | ReturnCallIndirect (x, y) -> let TableT (_lim, t) = table c x in let FuncT (ts1, ts2) = func_type c y in - require (match_result_type c.types ts2 c.results) e.at + require (match_result_type ts2 c.results) e.at ("type mismatch: current function requires result type " ^ string_of_result_type c.results ^ " but callee returns " ^ string_of_result_type ts2); (ts1 @ [NumT I32T]) -->... [], [] | ContNew x -> - let ContT y = cont_type c x in - [RefT (NoNull, DefHT y)] --> - [RefT (NoNull, DefHT (Stat x.it))], [] + let ct = cont_type c x in + let ft = as_func_cont_type ct in + [RefT (Null, DefHT (DefFuncT ft))] --> + [RefT (NoNull, DefHT (DefContT ct))], [] | ContBind (x, y) -> - let ContT z = cont_type c x in - let FuncT (ts1, ts2) = func_type c (as_stat_var z @@ e.at) in - let ContT z' = cont_type c y in - let FuncT (ts1', _) as ft' = func_type c (as_stat_var z' @@ e.at) in + let ct = cont_type c x in + let FuncT (ts1, ts2) = as_func_cont_type ct in + let ct' = cont_type c y in + let FuncT (ts1', _) as ft' = as_func_cont_type ct' in require (List.length ts1 >= List.length ts1') x.at "type mismatch in continuation arguments"; let ts11, ts12 = Lib.List.split (List.length ts1 - List.length ts1') ts1 in - require (match_func_type c.types (FuncT (ts12, ts2)) ft') e.at + require (match_func_type (FuncT (ts12, ts2)) ft') e.at "type mismatch in continuation types"; - (ts11 @ [RefT (Null, DefHT (Stat x.it))]) --> - [RefT (NoNull, DefHT (Stat y.it))], [] + (ts11 @ [RefT (Null, DefHT (DefContT ct))]) --> + [RefT (NoNull, DefHT (DefContT ct'))], [] | Suspend x -> - let TagT x' = tag c x in - let FuncT (ts1, ts2) = func_type c (as_stat_var x' @@ x.at) in + let tag = tag c x in + let FuncT (ts1, ts2) = as_func_tag_type tag in ts1 --> ts2, [] | Resume (x, xys) -> - let ContT z = cont_type c x in - let FuncT (ts1, ts2) = func_type c (as_stat_var z @@ e.at) in + let ct = cont_type c x in + let FuncT (ts1, ts2) = as_func_cont_type ct in check_resume_table c ts2 xys e.at; - (ts1 @ [RefT (Null, DefHT (Stat x.it))]) --> ts2, [] + (ts1 @ [RefT (Null, DefHT (DefContT ct))]) --> ts2, [] | ResumeThrow (x, y, xys) -> - let ContT z = cont_type c x in - let FuncT (ts1, ts2) = func_type c (as_stat_var z @@ e.at) in - let TagT y' = tag c y in - let FuncT (ts0, _) = func_type c (as_stat_var y' @@ x.at) in + let ct = cont_type c x in + let FuncT (ts1, ts2) = as_func_cont_type ct in + let tag = tag c y in + let FuncT (ts0, _) = as_func_tag_type tag in check_resume_table c ts2 xys e.at; - (ts0 @ [RefT (Null, DefHT (Stat x.it))]) --> ts2, [] + (ts0 @ [RefT (Null, DefHT (DefContT ct))]) --> ts2, [] | Barrier (bt, es) -> let InstrT (ts1, ts2, xs) as ft = check_block_type c bt e.at in @@ -577,7 +582,7 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in | TableCopy (x, y) -> let TableT (_lim1, t1) = table c x in let TableT (_lim2, t2) = table c y in - require (match_ref_type c.types t2 t1) x.at + require (match_ref_type t2 t1) x.at ("type mismatch: source element type " ^ string_of_ref_type t1 ^ " does not match destination element type " ^ string_of_ref_type t2); [NumT I32T; NumT I32T; NumT I32T] --> [], [] @@ -585,7 +590,7 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in | TableInit (x, y) -> let TableT (_lim1, t1) = table c x in let t2 = elem c y in - require (match_ref_type c.types t2 t1) x.at + require (match_ref_type t2 t1) x.at ("type mismatch: element segment's type " ^ string_of_ref_type t1 ^ " does not match table's element type " ^ string_of_ref_type t2); [NumT I32T; NumT I32T; NumT I32T] --> [], [] @@ -595,32 +600,32 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in [] --> [], [] | Load memop -> - check_memop c memop num_size (Lib.Option.map fst) e.at; - [NumT I32T] --> [NumT memop.ty], [] + let t = check_memop c memop num_size (Lib.Option.map fst) e.at in + [NumT I32T] --> [NumT t], [] | Store memop -> - check_memop c memop num_size (fun sz -> sz) e.at; - [NumT I32T; NumT memop.ty] --> [], [] + let t = check_memop c memop num_size (fun sz -> sz) e.at in + [NumT I32T; NumT t] --> [], [] | VecLoad memop -> - check_memop c memop vec_size (Lib.Option.map fst) e.at; - [NumT I32T] --> [VecT memop.ty], [] + let t = check_memop c memop vec_size (Lib.Option.map fst) e.at in + [NumT I32T] --> [VecT t], [] | VecStore memop -> - check_memop c memop vec_size (fun _ -> None) e.at; - [NumT I32T; VecT memop.ty] --> [], [] + let t = check_memop c memop vec_size (fun _ -> None) e.at in + [NumT I32T; VecT t] --> [], [] | VecLoadLane (memop, i) -> - check_memop c memop vec_size (fun sz -> Some sz) e.at; - require (i < vec_size memop.ty / Pack.packed_size memop.pack) e.at + let t = check_memop c memop vec_size (fun sz -> Some sz) e.at in + require (i < vec_size t / Pack.packed_size memop.pack) e.at "invalid lane index"; - [NumT I32T; VecT memop.ty] --> [VecT memop.ty], [] + [NumT I32T; VecT t] --> [VecT t], [] | VecStoreLane (memop, i) -> - check_memop c memop vec_size (fun sz -> Some sz) e.at; - require (i < vec_size memop.ty / Pack.packed_size memop.pack) e.at + let t = check_memop c memop vec_size (fun sz -> Some sz) e.at in + require (i < vec_size t / Pack.packed_size memop.pack) e.at "invalid lane index"; - [NumT I32T; VecT memop.ty] --> [], [] + [NumT I32T; VecT t] --> [], [] | MemorySize -> let _mt = memory c (0l @@ e.at) in @@ -648,8 +653,8 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in [] --> [], [] | RefNull ht -> - check_heap_type c ht e.at; - [] --> [RefT (Null, ht)], [] + let ht' = check_heap_type c ht e.at in + [] --> [RefT (Null, ht')], [] | RefIsNull -> let (_, ht) = peek_ref 0 s e.at in @@ -661,9 +666,8 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in | RefFunc x -> let ft = func c x in - let y = Lib.Option.force (Lib.List32.index_of (DefFuncT ft) c.types) in refer_func c x; - [] --> [RefT (NoNull, DefHT (Stat y))], [] + [] --> [RefT (NoNull, DefHT (DefFuncT ft))], [] | Const v -> let t = NumT (type_num v.it) in @@ -778,8 +782,7 @@ and check_block (c : context) (es : instr list) (it : instr_type) at = and check_catch (ct : idx * instr list) (c : context) (ft : instr_type) at = let (x, es) = ct in - let TagT y = tag c x in - let FuncT (ts1, _) = func_type c (as_stat_var y @@ at) in + let FuncT (ts1, _) = as_func_tag_type (tag c x) in let InstrT (_, ts2, xs) = ft in check_block c es (InstrT (ts1, ts2, xs)) at @@ -798,11 +801,16 @@ and check_catch (ct : idx * instr list) (c : context) (ft : instr_type) at = *) let check_local (c : context) (loc : local) : local_type = - check_val_type c loc.it.ltype loc.at; - let init = if defaultable loc.it.ltype then Set else Unset in - LocalT (init, loc.it.ltype) + let t = check_val_type c loc.it.ltype loc.at in + let init = if defaultable t then Set else Unset in + LocalT (init, t) + +let check_func (c : context) (f : func) : context = + let {ftype; locals; body} = f.it in + let ft = func_type c ftype in + {c with funcs = c.funcs @ [ft]} -let check_func (c : context) (f : func) = +let check_func_body (c : context) (f : func) = let {ftype; locals; body} = f.it in let FuncT (ts1, ts2) = func_type c ftype in let lts = List.map (check_local c) locals in @@ -830,34 +838,42 @@ let check_const (c : context) (const : const) (t : val_type) = check_block c const.it (InstrT ([], [t], [])) const.at -(* Tables, Memories, Globals, Tags *) +(* Globals, Tables, Memories, Tags *) -let check_table (c : context) (tab : table) = +let check_global (c : context) (glob : global) : context = + let {gtype; ginit} = glob.it in + let GlobalT (_mut, t) as gt = check_global_type c gtype glob.at in + check_const c ginit t; + {c with globals = c.globals @ [gt]} + +let check_table (c : context) (tab : table) : context = let {ttype; tinit} = tab.it in - check_table_type c ttype tab.at; - let TableT (_lim, rt) = ttype in - check_const c tinit (RefT rt) + let TableT (_lim, rt) as tt = check_table_type c ttype tab.at in + check_const c tinit (RefT rt); + {c with tables = c.tables @ [tt]} -let check_memory (c : context) (mem : memory) = +let check_memory (c : context) (mem : memory) : context = let {mtype} = mem.it in - check_memory_type c mtype mem.at + let mt = check_memory_type c mtype mem.at in + {c with memories = c.memories @ [mt]} let check_elem_mode (c : context) (t : ref_type) (mode : segment_mode) = match mode.it with | Passive -> () | Active {index; offset} -> let TableT (_lim, et) = table c index in - require (match_ref_type c.types t et) mode.at + require (match_ref_type t et) mode.at ("type mismatch: element segment's type " ^ string_of_ref_type t ^ " does not match table's element type " ^ string_of_ref_type et); check_const c offset (NumT I32T) | Declarative -> () -let check_elem (c : context) (seg : elem_segment) = +let check_elem (c : context) (seg : elem_segment) : context = let {etype; einit; emode} = seg.it in - check_ref_type c etype seg.at; - List.iter (fun const -> check_const c const (RefT etype)) einit; - check_elem_mode c etype emode + let rt = check_ref_type c etype seg.at in + List.iter (fun const -> check_const c const (RefT rt)) einit; + check_elem_mode c rt emode; + {c with elems = c.elems @ [rt]} let check_data_mode (c : context) (mode : segment_mode) = match mode.it with @@ -867,31 +883,22 @@ let check_data_mode (c : context) (mode : segment_mode) = check_const c offset (NumT I32T) | Declarative -> assert false -let check_data (c : context) (seg : data_segment) = +let check_data (c : context) (seg : data_segment) : context = let {dinit; dmode} = seg.it in - check_data_mode c dmode + check_data_mode c dmode; + {c with datas = c.datas @ [()]} -let check_global (c : context) (glob : global) = - let {gtype; ginit} = glob.it in - check_global_type c gtype glob.at; - let GlobalT (_mut, t) = gtype in - check_const c ginit t - -let check_tag (c : context) (tag : tag) = +let check_tag (c : context) (tag : tag) : context = let {tagtype} = tag.it in - check_tag_type c tagtype tag.at + let tag' = check_tag_type c tagtype tag.at in + {c with tags = c.tags @ [tag']} (* Modules *) -let check_start (c : context) (start : start) = - let {sfunc} = start.it in - require (func c sfunc = FuncT ([], [])) start.at - "start function must not have parameters or results" - let check_type (c : context) (ty : type_) : context = - check_def_type c ty.it ty.at; - {c with types = c.types @ [ty.it]} + let dt = check_def_type c ty.it ty.at in + {c with types = c.types @ [dt]} let check_import (c : context) (im : import) : context = let {module_name = _; item_name = _; idesc} = im.it in @@ -900,17 +907,18 @@ let check_import (c : context) (im : import) : context = let ft = func_type c x in {c with funcs = c.funcs @ [ft]} | TableImport tt -> - check_table_type c tt idesc.at; - {c with tables = c.tables @ [tt]} + let tt' = check_table_type c tt idesc.at in + {c with tables = c.tables @ [tt']} | MemoryImport mt -> - check_memory_type c mt idesc.at; - {c with memories = c.memories @ [mt]} + let mt' = check_memory_type c mt idesc.at in + {c with memories = c.memories @ [mt']} | GlobalImport gt -> - check_global_type c gt idesc.at; - {c with globals = c.globals @ [gt]} - | TagImport et -> - check_tag_type c et idesc.at; - {c with tags = c.tags @ [et]} + let gt' = check_global_type c gt idesc.at in + {c with globals = c.globals @ [gt']} + | TagImport x -> + let et = check_tag_type c (TagT (VarHT (StatX x.it))) idesc.at in + {c with tags = c.tags @ [et]} + module NameSet = Set.Make(struct type t = Ast.name let compare = compare end) @@ -926,36 +934,31 @@ let check_export (c : context) (set : NameSet.t) (ex : export) : NameSet.t = require (not (NameSet.mem name set)) ex.at "duplicate export name"; NameSet.add name set +let check_start (c : context) (start : start) = + let {sfunc} = start.it in + require (func c sfunc = FuncT ([], [])) start.at + "start function must not have parameters or results" + + +let check_list f xs (c : context) : context = + List.fold_left f c xs let check_module (m : module_) = - let - { types; imports; tables; memories; globals; tags; funcs; - start; elems; datas; exports } = m.it - in - let c0 = List.fold_left check_type empty_context types in - let c1 = List.fold_left check_import c0 imports in - let c2 = - { c1 with - funcs = c1.funcs @ List.map (fun f -> func_type c1 f.it.ftype) funcs; - tables = c1.tables @ List.map (fun tab -> tab.it.ttype) tables; - memories = c1.memories @ List.map (fun mem -> mem.it.mtype) memories; - tags = c1.tags @ List.map (fun tag -> tag.it.tagtype) tags; - elems = List.map (fun elem -> elem.it.etype) elems; - datas = List.map (fun _data -> ()) datas; - refs = Free.module_ ({m.it with funcs = []; start = None} @@ m.at); - } - in + let refs = Free.module_ ({m.it with funcs = []; start = None} @@ m.at) in let c = - { c2 with globals = c1.globals @ List.map (fun g -> g.it.gtype) globals } + {empty_context with refs} + |> check_list check_type m.it.types + |> check_list check_import m.it.imports + |> check_list check_func m.it.funcs + |> check_list check_global m.it.globals + |> check_list check_tag m.it.tags + |> check_list check_table m.it.tables + |> check_list check_memory m.it.memories + |> check_list check_elem m.it.elems + |> check_list check_data m.it.datas in - List.iter (check_global c2) globals; - List.iter (check_table c2) tables; - List.iter (check_memory c2) memories; - List.iter (check_tag c2) tags; - List.iter (check_elem c2) elems; - List.iter (check_data c2) datas; - List.iter (check_func c) funcs; - Lib.Option.app (check_start c) start; - ignore (List.fold_left (check_export c) NameSet.empty exports); require (List.length c.memories <= 1) m.at - "multiple memories are not allowed (yet)" + "multiple memories are not allowed (yet)"; + List.iter (check_func_body c) m.it.funcs; + Option.iter (check_start c) m.it.start; + ignore (List.fold_left (check_export c) NameSet.empty m.it.exports) diff --git a/proposals/function-references/Overview.md b/proposals/function-references/Overview.md index 57947c5a3..6aa48b1d9 100644 --- a/proposals/function-references/Overview.md +++ b/proposals/function-references/Overview.md @@ -62,9 +62,9 @@ The function `$hof` takes a function pointer as parameter, and is invoked by `$c It is also possible to create a typed function table: ```wasm -(table 0 (ref $i32-i32)) +(table 1 (ref $i32-i32) (ref.func $inc)) ``` -Such a table can neither contain `null` entries nor functions of another type. Any use of `call_indirect` on this table does hence avoid all runtime checks beyond the basic bounds check. By using multiple tables, each one can be given a homogeneous type. The table can be initialised with an initializer or by growing it. +Such a table can neither contain `null` entries nor functions of another type. Because entries can't be `null`, tables of concrete type are required to be declared with an explicit initialisation value. Any use of `call_indirect` on this table does hence avoid all runtime checks beyond the basic bounds check. By using multiple tables, each one can be given a homogeneous type. The table can be initialised with an initializer or by growing it. Typed function references are a subtype of `funcref`, so they can also be used as untyped references. All previous uses of `ref.func` remain valid: ```wasm @@ -272,7 +272,7 @@ Typing of instruction sequences is updated to account for initialization of loca - `epsilon : [] -> [] epsilon` Note: These typing rules do not try to eliminate duplicate indices, but an implementation could. - + A subsumption rule allows to go to a supertype for any instruction: * `instr` @@ -302,8 +302,8 @@ Table definitions have an initialiser value: | ------ | --------------- | ---------- | | -0x10 | `funcref` | | | -0x11 | `externref` | | -| -0x14 | `(ref null ht)` | `$t : heaptype` | -| -0x15 | `(ref ht)` | `$t : heaptype` | +| -0x1c | `(ref ht)` | `$t : heaptype` | +| -0x1d | `(ref null ht)` | `$t : heaptype` | #### Heap Types @@ -321,8 +321,8 @@ The opcode for heap types is encoded as an `s33`. | ------ | ------------------------ | ---------- | | 0x14 | `call_ref $t` | `$t : u32` | | 0x15 | `return_call_ref $t` | `$t : u32` | -| 0xd3 | `ref.as_non_null` | | -| 0xd4 | `br_on_null $l` | `$l : u32` | +| 0xd4 | `ref.as_non_null` | | +| 0xd5 | `br_on_null $l` | `$l : u32` | | 0xd6 | `br_on_non_null $l` | `$l : u32` | ### Tables diff --git a/test/core/data.wast b/test/core/data.wast index b1e123975..a007388cf 100644 --- a/test/core/data.wast +++ b/test/core/data.wast @@ -81,15 +81,6 @@ (data (global.get $g) "a") ) -(assert_invalid - (module (memory 1) (global i32 (i32.const 0)) (data (global.get 0) "a")) - "unknown global" -) -(assert_invalid - (module (memory 1) (global $g i32 (i32.const 0)) (data (global.get $g) "a")) - "unknown global" -) - ;; Corner cases diff --git a/test/core/elem.wast b/test/core/elem.wast index 4a399ecae..0e6ea202a 100644 --- a/test/core/elem.wast +++ b/test/core/elem.wast @@ -84,6 +84,14 @@ (table $t funcref (elem (ref.func $f) (ref.null func) (ref.func $g))) ) +(module + (func $f) + (func $g) + + (table $t 10 (ref func) (ref.func $f)) + (elem (i32.const 3) $g) +) + ;; Basic use @@ -167,15 +175,6 @@ (assert_return (invoke "call-7") (i32.const 65)) (assert_return (invoke "call-9") (i32.const 66)) -(assert_invalid - (module (table 1 funcref) (global i32 (i32.const 0)) (elem (global.get 0) $f) (func $f)) - "unknown global" -) -(assert_invalid - (module (table 1 funcref) (global $g i32 (i32.const 0)) (elem (global.get $g) $f) (func $f)) - "unknown global" -) - ;; Corner cases @@ -233,6 +232,7 @@ (elem (i32.const 1) $f) ) + ;; Invalid bounds for elements (assert_trap @@ -337,6 +337,7 @@ "out of bounds table access" ) + ;; Implicitly dropped elements (module @@ -359,6 +360,7 @@ ) (assert_trap (invoke "init") "out of bounds table access") + ;; Element without table (assert_invalid @@ -369,6 +371,7 @@ "unknown table" ) + ;; Invalid offsets (assert_invalid @@ -489,6 +492,7 @@ "constant expression required" ) + ;; Invalid elements (assert_invalid @@ -540,6 +544,7 @@ "constant expression required" ) + ;; Two elements target the same slot (module @@ -568,6 +573,7 @@ ) (assert_return (invoke "call-overwritten-element") (i32.const 66)) + ;; Element sections across multiple modules change the same table (module $module1 diff --git a/test/core/global.wast b/test/core/global.wast index 03d8b117a..6881b8361 100644 --- a/test/core/global.wast +++ b/test/core/global.wast @@ -348,15 +348,6 @@ "unknown global" ) -(assert_invalid - (module (global i32 (i32.const 0)) (global i32 (global.get 0))) - "unknown global" -) -(assert_invalid - (module (global $g i32 (i32.const 0)) (global i32 (global.get $g))) - "unknown global" -) - (assert_invalid (module (global i32 (global.get 1)) (global i32 (i32.const 0))) "unknown global" diff --git a/test/core/table.wast b/test/core/table.wast index 16e35a801..1142c7843 100644 --- a/test/core/table.wast +++ b/test/core/table.wast @@ -95,6 +95,31 @@ (assert_return (invoke "get3") (ref.func)) +(assert_invalid + (module + (type $f (func)) + (table 10 (ref $f)) + ) + "type mismatch" +) + +(assert_invalid + (module + (type $f (func)) + (table 0 (ref $f)) + ) + "type mismatch" +) + +(assert_invalid + (module + (type $f (func)) + (table 0 0 (ref $f)) + ) + "type mismatch" +) + + ;; Duplicate table identifiers (assert_malformed diff --git a/test/core/type-equivalence.wast b/test/core/type-equivalence.wast index 4e295061f..4d6288b1f 100644 --- a/test/core/type-equivalence.wast +++ b/test/core/type-equivalence.wast @@ -118,15 +118,15 @@ (func (export "f1") (param (ref $t1))) (func (export "f2") (param (ref $t1))) ) -(register "M") +(register "N") (module (type $s0 (func (param i32) (result f32))) (type $s1 (func (param i32 (ref $s0)) (result (ref $s0)))) (type $s2 (func (param i32 (ref $s0)) (result (ref $s0)))) (type $t1 (func (param (ref $s1)) (result (ref $s2)))) (type $t2 (func (param (ref $s2)) (result (ref $s1)))) - (func (import "M" "f1") (param (ref $t1))) - (func (import "M" "f1") (param (ref $t2))) - (func (import "M" "f2") (param (ref $t1))) - (func (import "M" "f2") (param (ref $t1))) + (func (import "N" "f1") (param (ref $t1))) + (func (import "N" "f1") (param (ref $t2))) + (func (import "N" "f2") (param (ref $t1))) + (func (import "N" "f2") (param (ref $t1))) ) From fe51e7d779599b235934f4654f5b8d87cbfd033f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Thu, 21 Sep 2023 16:34:01 +0200 Subject: [PATCH 62/82] Fix CI interpreter --- .github/workflows/ci-interpreter.yml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/.github/workflows/ci-interpreter.yml b/.github/workflows/ci-interpreter.yml index 44cc511b6..d5105ad3f 100644 --- a/.github/workflows/ci-interpreter.yml +++ b/.github/workflows/ci-interpreter.yml @@ -1,4 +1,4 @@ -2name: CI for interpreter & tests +name: CI for interpreter & tests on: push: @@ -33,4 +33,4 @@ jobs: - name: Run tests # TODO: disable node.js run until it fully implements proposal # run: cd interpreter && opam exec make JS=node ci - run: cd interpreter && opam exec make ci + run: cd interpreter && opam exec make test From d7aa1d1c69fbccdeaf4fdc5b24aed059437890cc Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Thu, 5 Oct 2023 13:39:47 +0200 Subject: [PATCH 63/82] Expand tag types --- interpreter/valid/valid.ml | 17 ++++++++++++----- 1 file changed, 12 insertions(+), 5 deletions(-) diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index cea85eae1..5e28feda3 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -86,6 +86,13 @@ let array_type (c : context) x = | DefArrayT at -> at | _ -> error x.at ("non-array type " ^ I32.to_string_u x.it) +let tag_type (c : context) x = + let TagT ht = tag c x in + match ht with + | DefHT dt -> TagT (DefHT dt) + | VarHT (StatX y) -> TagT (as_heap_str_type (DefFuncT (func_type c (y @@ x.at)))) + | _ -> assert false + let refer category (s : Free.Set.t) x = if not (Free.Set.mem x.it s) then error x.at @@ -416,7 +423,7 @@ let check_resume_table (c : context) ts2 (xys : (idx * idx) list) at = | _ -> assert false in List.iter (fun (x1, x2) -> - let FuncT (ts3, ts4) = as_func_tag_type (tag c x1) in + let FuncT (ts3, ts4) = as_func_tag_type (tag_type c x1) in let (_, ts') = label c x2 in match Lib.List.last_opt ts' with | Some (RefT (nul', ht)) when is_heap_cont_type ht -> @@ -479,7 +486,7 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in (ts1 @ [NumT I32T]) --> ts2, List.map (fun x -> x @@ e.at) xs | Throw x -> - let tag = tag c x in + let tag = tag_type c x in check_tag_type c tag e.at; let FuncT (ts1, _) = as_func_tag_type tag in ts1 -->... [], [] @@ -634,7 +641,7 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in [RefT (NoNull, as_heap_str_type (DefContT ct'))], [] | Suspend x -> - let tag = tag c x in + let tag = tag_type c x in let FuncT (ts1, ts2) = as_func_tag_type tag in ts1 --> ts2, [] @@ -647,7 +654,7 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in | ResumeThrow (x, y, xys) -> let ct = cont_type c x in let FuncT (ts1, ts2) = as_func_cont_type ct in - let tag = tag c y in + let tag = tag_type c y in let FuncT (ts0, _) = as_func_tag_type tag in check_resume_table c ts2 xys e.at; (ts0 @ [RefT (Null, as_heap_str_type (DefContT ct))]) --> ts2, [] @@ -1030,7 +1037,7 @@ and check_block (c : context) (es : instr list) (it : instr_type) at = and check_catch (ct : idx * instr list) (c : context) (ft : instr_type) at = let (x, es) = ct in - let FuncT (ts1, _) = as_func_tag_type (tag c x) in + let FuncT (ts1, _) = as_func_tag_type (tag_type c x) in let InstrT (_, ts2, xs) = ft in check_block c es (InstrT (ts1, ts2, xs)) at From 5e0e3f864f717b6476cf08b2a37716bdfcc6be06 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Thu, 5 Oct 2023 13:46:22 +0200 Subject: [PATCH 64/82] Fix try-catch assertion error. --- interpreter/valid/valid.ml | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 5e28feda3..37693dd63 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -124,7 +124,8 @@ let check_heap_type (c : context) (t : heap_type) at = | FuncHT | NoFuncHT | ExternHT | NoExternHT -> () | VarHT (StatX x) -> let _dt = type_ c (x @@ at) in () - | VarHT (RecX _) | DefHT _ -> assert false + | VarHT (RecX _) -> assert false + | DefHT _ -> () | BotHT -> () let check_ref_type (c : context) (t : ref_type) at = From 8ce5b1ff9ef4101b3f6fe74b162bb375a413759f Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Wed, 18 Oct 2023 15:37:01 +0200 Subject: [PATCH 65/82] Fix remaining bugs after merge with the GC proposal. --- interpreter/binary/decode.ml | 2 + interpreter/binary/encode.ml | 2 + interpreter/exec/eval.ml | 22 ++- interpreter/syntax/free.ml | 1 + interpreter/syntax/types.ml | 18 +-- interpreter/valid/match.ml | 6 +- interpreter/valid/valid.ml | 98 +++++++------- test/core/cont.wast | 252 +++++++++++++++++------------------ 8 files changed, 203 insertions(+), 198 deletions(-) diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index b5dcaf3dc..70ad7c96b 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -189,6 +189,7 @@ let heap_type s = | -0x14 -> I31HT | -0x15 -> StructHT | -0x16 -> ArrayHT + | -0x17 -> ContHT | _ -> error s pos "malformed heap type" ) ] s @@ -206,6 +207,7 @@ let ref_type s = | -0x14 -> (Null, I31HT) | -0x15 -> (Null, StructHT) | -0x16 -> (Null, ArrayHT) + | -0x17 -> (Null, ContHT) | -0x1c -> (NoNull, heap_type s) | -0x1d -> (Null, heap_type s) | _ -> error s pos "malformed reference type" diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 78bce9caa..11f578afe 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -125,6 +125,7 @@ struct | NoFuncHT -> s7 (-0x0d) | ExternHT -> s7 (-0x11) | NoExternHT -> s7 (-0x0e) + | ContHT -> s7 (-0x17) | VarHT x -> var_type s33 x | DefHT _ | BotHT -> assert false @@ -143,6 +144,7 @@ struct | (Null, NoFuncHT) -> s7 (-0x0d) | (Null, ExternHT) -> s7 (-0x11) | (Null, NoExternHT) -> s7 (-0x0e) + | (Null, ContHT) -> s7 (-0x17) | (Null, t) -> s7 (-0x1d); heap_type t | (NoNull, t) -> s7 (-0x1c); heap_type t diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index dcaad9a41..27e2b5f46 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -177,6 +177,18 @@ let drop n (vs : 'a stack) at = let split n (vs : 'a stack) at = take n vs at, drop n vs at +let str_type_of_heap_type (inst : module_inst) ht : str_type = + match ht with + | VarHT (StatX x | RecX x) -> str_type inst (x @@ Source.no_region) + | DefHT dt -> expand_def_type dt + | _ -> Printf.printf "HERE\n%!"; assert false + +let func_type_of_cont_type (inst : module_inst) (ContT ht) : func_type = + as_func_str_type (str_type_of_heap_type inst ht) + +let func_type_of_tag_type (inst : module_inst) (TagT ht) : func_type = + as_func_str_type (str_type_of_heap_type inst ht) + (* Evaluation *) @@ -243,7 +255,7 @@ let rec step (c : config) : config = | Throw x, vs -> let tagt = tag c.frame.inst x in - let FuncT (ts, _) = as_func_tag_type (Tag.type_of tagt) in + let FuncT (ts, _) = func_type_of_tag_type c.frame.inst (Tag.type_of tagt) in let vs0, vs' = split (Lib.List32.length ts) vs e.at in vs', [Throwing (tagt, vs0) @@ e.at] @@ -354,7 +366,7 @@ let rec step (c : config) : config = | ContBind (x, y), Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> let ct = cont_type c.frame.inst y in let ct = subst_cont_type (subst_of c.frame.inst) ct in - let FuncT (ts', _) = as_func_cont_type ct in + let FuncT (ts', _) = func_type_of_cont_type c.frame.inst ct in let args, vs' = try split (Int32.sub n (Lib.List32.length ts')) vs e.at with Failure _ -> Crash.error e.at "type mismatch at continuation bind" @@ -365,7 +377,7 @@ let rec step (c : config) : config = | Suspend x, vs -> let tagt = tag c.frame.inst x in - let FuncT (ts, _) = as_func_tag_type (Tag.type_of tagt) in + let FuncT (ts, _) = func_type_of_tag_type c.frame.inst (Tag.type_of tagt) in let args, vs' = split (Lib.List32.length ts) vs e.at in vs', [Suspending (tagt, args, fun code -> code) @@ e.at] @@ -389,7 +401,7 @@ let rec step (c : config) : config = | ResumeThrow (x, y, xls), Ref (ContRef ({contents = Some (n, ctxt)} as cont)) :: vs -> let tagt = tag c.frame.inst y in - let FuncT (ts, _) = as_func_tag_type (Tag.type_of tagt) in + let FuncT (ts, _) = func_type_of_tag_type c.frame.inst (Tag.type_of tagt) in let hs = List.map (fun (x, l) -> tag c.frame.inst x, l) xls in let args, vs' = split (Lib.List32.length ts) vs e.at in cont := None; @@ -1231,7 +1243,7 @@ let rec step (c : config) : config = | Handle (Some hs, (vs', {it = Suspending (tagt, vs1, ctxt); at} :: es')), vs when List.mem_assq tagt hs -> - let FuncT (_, ts) = as_func_tag_type (Tag.type_of tagt) in + let FuncT (_, ts) = func_type_of_tag_type c.frame.inst (Tag.type_of tagt) in let ctxt' code = compose (ctxt code) (vs', es') in [Ref (ContRef (ref (Some (Lib.List32.length ts, ctxt'))))] @ vs1 @ vs, [Plain (Br (List.assq tagt hs)) @@ e.at] diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml index bad7efc4e..c945e9efd 100644 --- a/interpreter/syntax/free.ml +++ b/interpreter/syntax/free.ml @@ -81,6 +81,7 @@ let heap_type = function | I31HT | StructHT | ArrayHT -> empty | FuncHT | NoFuncHT -> empty | ExternHT | NoExternHT -> empty + | ContHT -> empty | VarHT x -> var_type x | DefHT _ct -> empty (* assume closed *) | BotHT -> empty diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml index 939b600da..f37badcb2 100644 --- a/interpreter/syntax/types.ml +++ b/interpreter/syntax/types.ml @@ -18,6 +18,7 @@ type heap_type = | AnyHT | NoneHT | EqHT | I31HT | StructHT | ArrayHT | FuncHT | NoFuncHT | ExternHT | NoExternHT + | ContHT | VarHT of var | DefHT of def_type | BotHT @@ -149,6 +150,7 @@ let subst_heap_type s = function | NoFuncHT -> NoFuncHT | ExternHT -> ExternHT | NoExternHT -> NoExternHT + | ContHT -> ContHT | VarHT x -> s x | DefHT dt -> DefHT dt (* assume closed *) | BotHT -> BotHT @@ -277,7 +279,6 @@ let unpacked_storage_type = function let unpacked_field_type (FieldT (_mut, t)) = unpacked_storage_type t - let as_func_str_type (st : str_type) : func_type = match st with | DefFuncT ft -> ft @@ -288,17 +289,6 @@ let as_cont_str_type (dt : str_type) : cont_type = | DefContT ct -> ct | _ -> assert false -let as_func_heap_type (ht : heap_type) : func_type = - match ht with - | DefHT dt -> as_func_str_type (expand_def_type dt) - | _ -> assert false - -let as_func_cont_type (ContT ct) : func_type = - as_func_heap_type ct - -let as_func_tag_type (TagT et) : func_type = - as_func_heap_type et - let as_struct_str_type (st : str_type) : struct_type = match st with | DefStructT st -> st @@ -309,9 +299,6 @@ let as_array_str_type (st : str_type) : array_type = | DefArrayT at -> at | _ -> assert false -let as_heap_str_type (st : str_type) : heap_type = - DefHT (DefT (RecT [SubT (Final, [], st)], Int32.of_int 0)) - let extern_type_of_import_type (ImportT (et, _, _)) = et let extern_type_of_export_type (ExportT (et, _)) = et @@ -372,6 +359,7 @@ let rec string_of_heap_type = function | NoFuncHT -> "nofunc" | ExternHT -> "extern" | NoExternHT -> "noextern" + | ContHT -> "cont" | VarHT x -> string_of_var x | DefHT dt -> "(" ^ string_of_def_type dt ^ ")" | BotHT -> "something" diff --git a/interpreter/valid/match.ml b/interpreter/valid/match.ml index bd8b871ab..4e15d9efb 100644 --- a/interpreter/valid/match.ml +++ b/interpreter/valid/match.ml @@ -13,7 +13,7 @@ let lookup c x = Lib.List32.nth c x let abs_of_str_type _c = function | DefStructT _ | DefArrayT _ -> StructHT | DefFuncT _ -> FuncHT - | DefContT _ -> assert false (* TODO(dhil): should we add an abstract ContHT? *) + | DefContT _ -> ContHT let rec top_of_str_type c st = top_of_heap_type c (abs_of_str_type c st) @@ -22,6 +22,7 @@ and top_of_heap_type c = function | AnyHT | NoneHT | EqHT | StructHT | ArrayHT | I31HT -> AnyHT | FuncHT | NoFuncHT -> FuncHT | ExternHT | NoExternHT -> ExternHT + | ContHT -> ContHT | DefHT dt -> top_of_str_type c (expand_def_type dt) | VarHT (StatX x) -> top_of_str_type c (expand_def_type (lookup c x)) | VarHT (RecX _) | BotHT -> assert false @@ -33,6 +34,7 @@ and bot_of_heap_type c = function | AnyHT | NoneHT | EqHT | StructHT | ArrayHT | I31HT -> NoneHT | FuncHT | NoFuncHT -> NoFuncHT | ExternHT | NoExternHT -> NoExternHT + | ContHT -> ContHT | DefHT dt -> bot_of_str_type c (expand_def_type dt) | VarHT (StatX x) -> bot_of_str_type c (expand_def_type (lookup c x)) | VarHT (RecX _) | BotHT -> assert false @@ -73,6 +75,7 @@ let rec match_heap_type c t1 t2 = | NoneHT, t -> match_heap_type c t AnyHT | NoFuncHT, t -> match_heap_type c t FuncHT | NoExternHT, t -> match_heap_type c t ExternHT + | ContHT, t -> match_heap_type c t ContHT | VarHT (StatX x1), _ -> match_heap_type c (DefHT (lookup c x1)) t2 | _, VarHT (StatX x2) -> match_heap_type c t1 (DefHT (lookup c x2)) | DefHT dt1, DefHT dt2 -> match_def_type c dt1 dt2 @@ -85,6 +88,7 @@ let rec match_heap_type c t1 t2 = | DefArrayT _, EqHT -> true | DefArrayT _, ArrayHT -> true | DefFuncT _, FuncHT -> true + | DefContT _, ContHT -> true | _ -> false ) | BotHT, _ -> true diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 37693dd63..285b7b549 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -74,7 +74,7 @@ let func_type (c : context) x = let cont_type (c : context) x = match expand_def_type (type_ c x) with | DefContT ct -> ct - | _ -> error x.at ("non-continuation type " ^ Int32.to_string x.it) + | _ as t -> Printf.printf "%s\n%!" (string_of_str_type t); error x.at ("non-continuation type " ^ Int32.to_string x.it) let struct_type (c : context) x = match expand_def_type (type_ c x) with @@ -86,13 +86,6 @@ let array_type (c : context) x = | DefArrayT at -> at | _ -> error x.at ("non-array type " ^ I32.to_string_u x.it) -let tag_type (c : context) x = - let TagT ht = tag c x in - match ht with - | DefHT dt -> TagT (DefHT dt) - | VarHT (StatX y) -> TagT (as_heap_str_type (DefFuncT (func_type c (y @@ x.at)))) - | _ -> assert false - let refer category (s : Free.Set.t) x = if not (Free.Set.mem x.it s) then error x.at @@ -100,6 +93,28 @@ let refer category (s : Free.Set.t) x = let refer_func (c : context) x = refer "function" c.refs.Free.funcs x +(* Conversions *) + +let cont_type_of_heap_type (c : context) (ht : heap_type) at : cont_type = + match ht with + | DefHT dt -> as_cont_str_type (expand_def_type dt) + | VarHT (RecX x | StatX x) -> cont_type c (x @@ at) + | _ -> assert false + +let func_type_of_heap_type (c : context) (ht : heap_type) at : func_type = + match ht with + | DefHT dt -> as_func_str_type (expand_def_type dt) + | VarHT (RecX x | StatX x) -> func_type c (x @@ at) + | _ -> assert false + +let func_type_of_cont_type (c : context) (ContT ht) at : func_type = + func_type_of_heap_type c ht at + +let func_type_of_tag_type (c : context) (TagT ht) at : func_type = + func_type_of_heap_type c ht at + +let heap_type_of_str_type (_c : context) (st : str_type) : heap_type = + DefHT (DefT (RecT [SubT (Final, [], st)], Int32.of_int 0)) (* Types *) @@ -122,10 +137,11 @@ let check_heap_type (c : context) (t : heap_type) at = match t with | AnyHT | NoneHT | EqHT | I31HT | StructHT | ArrayHT | FuncHT | NoFuncHT - | ExternHT | NoExternHT -> () + | ExternHT | NoExternHT + | ContHT -> () | VarHT (StatX x) -> let _dt = type_ c (x @@ at) in () | VarHT (RecX _) -> assert false - | DefHT _ -> () + | DefHT _ -> assert false | BotHT -> () let check_ref_type (c : context) (t : ref_type) at = @@ -404,32 +420,13 @@ let check_memop (c : context) (memop : ('t, 's) memop) ty_size get_sz at = *) let check_resume_table (c : context) ts2 (xys : (idx * idx) list) at = - let is_heap_cont_type = function - | VarHT (StatX x) -> - (try ignore(cont_type c (x @@ at)); true with _ -> false) - | DefHT dt -> - (match expand_def_type dt with - | DefContT _ -> true - | _ -> false) - | _ -> false - in - let extract_cont_heap_type = function - | VarHT (StatX x) -> - let ContT ht = cont_type c (x @@ at) in - ht - | DefHT dt -> - (match expand_def_type dt with - | DefContT (ContT ht) -> ht - | _ -> assert false) - | _ -> assert false - in List.iter (fun (x1, x2) -> - let FuncT (ts3, ts4) = as_func_tag_type (tag_type c x1) in + let FuncT (ts3, ts4) = func_type_of_tag_type c (tag c x1) x1.at in let (_, ts') = label c x2 in match Lib.List.last_opt ts' with - | Some (RefT (nul', ht)) when is_heap_cont_type ht -> - let ht' = extract_cont_heap_type ht in - let ft' = as_func_heap_type ht' in + | Some (RefT (nul', ht)) -> + let ct = cont_type_of_heap_type c ht x2.at in + let ft' = func_type_of_cont_type c ct x2.at in require (match_func_type c.types (FuncT (ts4, ts2)) ft') x2.at "type mismatch in continuation type"; check_stack c (ts3 @ [RefT (nul', ht)]) ts' x2.at @@ -487,9 +484,8 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in (ts1 @ [NumT I32T]) --> ts2, List.map (fun x -> x @@ e.at) xs | Throw x -> - let tag = tag_type c x in - check_tag_type c tag e.at; - let FuncT (ts1, _) = as_func_tag_type tag in + let tag = tag c x in + let FuncT (ts1, _) = func_type_of_tag_type c tag x.at in ts1 -->... [], [] | Rethrow x -> @@ -624,41 +620,41 @@ let rec check_instr (c : context) (e : instr) (s : infer_result_type) : infer_in | ContNew x -> let ct = cont_type c x in - let ft = as_func_cont_type ct in - [RefT (Null, as_heap_str_type (DefFuncT ft))] --> + let ft = func_type_of_cont_type c ct x.at in + [RefT (Null, heap_type_of_str_type c (DefFuncT ft))] --> [RefT (NoNull, DefHT (type_ c x))], [] | ContBind (x, y) -> let ct = cont_type c x in - let FuncT (ts1, ts2) = as_func_cont_type ct in + let FuncT (ts1, ts2) = func_type_of_cont_type c ct x.at in let ct' = cont_type c y in - let FuncT (ts1', _) as ft' = as_func_cont_type ct' in + let FuncT (ts1', _) as ft' = func_type_of_cont_type c ct' y.at in require (List.length ts1 >= List.length ts1') x.at "type mismatch in continuation arguments"; let ts11, ts12 = Lib.List.split (List.length ts1 - List.length ts1') ts1 in require (match_func_type c.types (FuncT (ts12, ts2)) ft') e.at "type mismatch in continuation types"; - (ts11 @ [RefT (Null, as_heap_str_type (DefContT ct))]) --> - [RefT (NoNull, as_heap_str_type (DefContT ct'))], [] + (ts11 @ [RefT (Null, heap_type_of_str_type c (DefContT ct))]) --> + [RefT (NoNull, heap_type_of_str_type c (DefContT ct'))], [] | Suspend x -> - let tag = tag_type c x in - let FuncT (ts1, ts2) = as_func_tag_type tag in + let tag = tag c x in + let FuncT (ts1, ts2) = func_type_of_tag_type c tag x.at in ts1 --> ts2, [] | Resume (x, xys) -> let ct = cont_type c x in - let FuncT (ts1, ts2) = as_func_cont_type ct in + let FuncT (ts1, ts2) = func_type_of_cont_type c ct x.at in check_resume_table c ts2 xys e.at; - (ts1 @ [RefT (Null, as_heap_str_type (DefContT ct))]) --> ts2, [] + (ts1 @ [RefT (Null, heap_type_of_str_type c (DefContT ct))]) --> ts2, [] | ResumeThrow (x, y, xys) -> let ct = cont_type c x in - let FuncT (ts1, ts2) = as_func_cont_type ct in - let tag = tag_type c y in - let FuncT (ts0, _) = as_func_tag_type tag in + let FuncT (ts1, ts2) = func_type_of_cont_type c ct x.at in + let tag = tag c y in + let FuncT (ts0, _) = func_type_of_tag_type c tag y.at in check_resume_table c ts2 xys e.at; - (ts0 @ [RefT (Null, as_heap_str_type (DefContT ct))]) --> ts2, [] + (ts0 @ [RefT (Null, heap_type_of_str_type c (DefContT ct))]) --> ts2, [] | Barrier (bt, es) -> let InstrT (ts1, ts2, xs) as ft = check_block_type c bt e.at in @@ -1038,7 +1034,7 @@ and check_block (c : context) (es : instr list) (it : instr_type) at = and check_catch (ct : idx * instr list) (c : context) (ft : instr_type) at = let (x, es) = ct in - let FuncT (ts1, _) = as_func_tag_type (tag_type c x) in + let FuncT (ts1, _) = func_type_of_tag_type c (tag c x) x.at in let InstrT (_, ts2, xs) = ft in check_block c es (InstrT (ts1, ts2, xs)) at diff --git a/test/core/cont.wast b/test/core/cont.wast index 041c4ab34..cdb3f022d 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -418,129 +418,129 @@ ;; Nested example: generator in a thread -(module $concurrent-generator - (func $log (import "spectest" "print_i64") (param i64)) - - (tag $syield (import "scheduler" "yield")) - (tag $spawn (import "scheduler" "spawn") (param (ref $cont))) - (func $scheduler (import "scheduler" "scheduler") (param $main (ref $cont))) - - (type $ghook (func (param i64))) - (func $gsum (import "generator" "sum") (param i64 i64) (result i64)) - (global $ghook (import "generator" "hook") (mut (ref $ghook))) - - (global $result (mut i64) (i64.const 0)) - (global $done (mut i32) (i32.const 0)) - - (elem declare func $main $bg-thread $syield) - - (func $syield (param $i i64) - (call $log (local.get $i)) - (suspend $syield) - ) - - (func $bg-thread - (call $log (i64.const -10)) - (loop $l - (call $log (i64.const -11)) - (suspend $syield) - (br_if $l (i32.eqz (global.get $done))) - ) - (call $log (i64.const -12)) - ) - - (func $main (param $i i64) (param $j i64) - (suspend $spawn (cont.new $cont (ref.func $bg-thread))) - (global.set $ghook (ref.func $syield)) - (global.set $result (call $gsum (local.get $i) (local.get $j))) - (global.set $done (i32.const 1)) - ) - - (type $proc (func)) - (type $pproc (func (param i64 i64))) - (type $cont (cont $proc)) - (type $pcont (cont $pproc)) - (func (export "sum") (param $i i64) (param $j i64) (result i64) - (call $log (i64.const -1)) - (call $scheduler - (cont.bind $pcont $cont (local.get $i) (local.get $j) (cont.new $pcont (ref.func $main))) - ) - (call $log (i64.const -2)) - (global.get $result) - ) -) - -(assert_return (invoke "sum" (i64.const 10) (i64.const 20)) (i64.const 165)) - - -;; cont.bind - -(module - (type $f2 (func (param i32 i32) (result i32 i32 i32 i32 i32 i32))) - (type $f4 (func (param i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32))) - (type $f6 (func (param i32 i32 i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32))) - - (type $k2 (cont $f2)) - (type $k4 (cont $f4)) - (type $k6 (cont $f6)) - - (elem declare func $f) - (func $f (param i32 i32 i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32) - (local.get 0) (local.get 1) (local.get 2) - (local.get 3) (local.get 4) (local.get 5) - ) - - (func (export "run") (result i32 i32 i32 i32 i32 i32) - (local $k6 (ref null $k6)) - (local $k4 (ref null $k4)) - (local $k2 (ref null $k2)) - (local.set $k6 (cont.new $k6 (ref.func $f))) - (local.set $k4 (cont.bind $k6 $k4 (i32.const 1) (i32.const 2) (local.get $k6))) - (local.set $k2 (cont.bind $k4 $k2 (i32.const 3) (i32.const 4) (local.get $k4))) - (resume $k2 (i32.const 5) (i32.const 6) (local.get $k2)) - ) -) - -(assert_return (invoke "run") - (i32.const 1) (i32.const 2) (i32.const 3) - (i32.const 4) (i32.const 5) (i32.const 6) -) - - -(module - (tag $e (result i32 i32 i32 i32 i32 i32)) - - (type $f0 (func (result i32 i32 i32 i32 i32 i32 i32))) - (type $f2 (func (param i32 i32) (result i32 i32 i32 i32 i32 i32 i32))) - (type $f4 (func (param i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32 i32))) - (type $f6 (func (param i32 i32 i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32 i32))) - - (type $k0 (cont $f0)) - (type $k2 (cont $f2)) - (type $k4 (cont $f4)) - (type $k6 (cont $f6)) - - (elem declare func $f) - (func $f (result i32 i32 i32 i32 i32 i32 i32) - (i32.const 0) (suspend $e) - ) - - (func (export "run") (result i32 i32 i32 i32 i32 i32 i32) - (local $k6 (ref null $k6)) - (local $k4 (ref null $k4)) - (local $k2 (ref null $k2)) - (block $l (result (ref $k6)) - (resume $k0 (tag $e $l) (cont.new $k0 (ref.func $f))) - (unreachable) - ) - (local.set $k6) - (local.set $k4 (cont.bind $k6 $k4 (i32.const 1) (i32.const 2) (local.get $k6))) - (local.set $k2 (cont.bind $k4 $k2 (i32.const 3) (i32.const 4) (local.get $k4))) - (resume $k2 (i32.const 5) (i32.const 6) (local.get $k2)) - ) -) - -(assert_return (invoke "run") - (i32.const 0) (i32.const 1) (i32.const 2) (i32.const 3) - (i32.const 4) (i32.const 5) (i32.const 6) -) +;; (module $concurrent-generator +;; (func $log (import "spectest" "print_i64") (param i64)) + +;; (tag $syield (import "scheduler" "yield")) +;; (tag $spawn (import "scheduler" "spawn") (param (ref $cont))) +;; (func $scheduler (import "scheduler" "scheduler") (param $main (ref $cont))) + +;; (type $ghook (func (param i64))) +;; (func $gsum (import "generator" "sum") (param i64 i64) (result i64)) +;; (global $ghook (import "generator" "hook") (mut (ref $ghook))) + +;; (global $result (mut i64) (i64.const 0)) +;; (global $done (mut i32) (i32.const 0)) + +;; (elem declare func $main $bg-thread $syield) + +;; (func $syield (param $i i64) +;; (call $log (local.get $i)) +;; (suspend $syield) +;; ) + +;; (func $bg-thread +;; (call $log (i64.const -10)) +;; (loop $l +;; (call $log (i64.const -11)) +;; (suspend $syield) +;; (br_if $l (i32.eqz (global.get $done))) +;; ) +;; (call $log (i64.const -12)) +;; ) + +;; (func $main (param $i i64) (param $j i64) +;; (suspend $spawn (cont.new $cont (ref.func $bg-thread))) +;; (global.set $ghook (ref.func $syield)) +;; (global.set $result (call $gsum (local.get $i) (local.get $j))) +;; (global.set $done (i32.const 1)) +;; ) + +;; (type $proc (func)) +;; (type $pproc (func (param i64 i64))) +;; (type $cont (cont $proc)) +;; (type $pcont (cont $pproc)) +;; (func (export "sum") (param $i i64) (param $j i64) (result i64) +;; (call $log (i64.const -1)) +;; (call $scheduler +;; (cont.bind $pcont $cont (local.get $i) (local.get $j) (cont.new $pcont (ref.func $main))) +;; ) +;; (call $log (i64.const -2)) +;; (global.get $result) +;; ) +;; ) + +;; (assert_return (invoke "sum" (i64.const 10) (i64.const 20)) (i64.const 165)) + + +;; ;; cont.bind + +;; (module +;; (type $f2 (func (param i32 i32) (result i32 i32 i32 i32 i32 i32))) +;; (type $f4 (func (param i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32))) +;; (type $f6 (func (param i32 i32 i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32))) + +;; (type $k2 (cont $f2)) +;; (type $k4 (cont $f4)) +;; (type $k6 (cont $f6)) + +;; (elem declare func $f) +;; (func $f (param i32 i32 i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32) +;; (local.get 0) (local.get 1) (local.get 2) +;; (local.get 3) (local.get 4) (local.get 5) +;; ) + +;; (func (export "run") (result i32 i32 i32 i32 i32 i32) +;; (local $k6 (ref null $k6)) +;; (local $k4 (ref null $k4)) +;; (local $k2 (ref null $k2)) +;; (local.set $k6 (cont.new $k6 (ref.func $f))) +;; (local.set $k4 (cont.bind $k6 $k4 (i32.const 1) (i32.const 2) (local.get $k6))) +;; (local.set $k2 (cont.bind $k4 $k2 (i32.const 3) (i32.const 4) (local.get $k4))) +;; (resume $k2 (i32.const 5) (i32.const 6) (local.get $k2)) +;; ) +;; ) + +;; (assert_return (invoke "run") +;; (i32.const 1) (i32.const 2) (i32.const 3) +;; (i32.const 4) (i32.const 5) (i32.const 6) +;; ) + + +;; (module +;; (tag $e (result i32 i32 i32 i32 i32 i32)) + +;; (type $f0 (func (result i32 i32 i32 i32 i32 i32 i32))) +;; (type $f2 (func (param i32 i32) (result i32 i32 i32 i32 i32 i32 i32))) +;; (type $f4 (func (param i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32 i32))) +;; (type $f6 (func (param i32 i32 i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32 i32))) + +;; (type $k0 (cont $f0)) +;; (type $k2 (cont $f2)) +;; (type $k4 (cont $f4)) +;; (type $k6 (cont $f6)) + +;; (elem declare func $f) +;; (func $f (result i32 i32 i32 i32 i32 i32 i32) +;; (i32.const 0) (suspend $e) +;; ) + +;; (func (export "run") (result i32 i32 i32 i32 i32 i32 i32) +;; (local $k6 (ref null $k6)) +;; (local $k4 (ref null $k4)) +;; (local $k2 (ref null $k2)) +;; (block $l (result (ref $k6)) +;; (resume $k0 (tag $e $l) (cont.new $k0 (ref.func $f))) +;; (unreachable) +;; ) +;; (local.set $k6) +;; (local.set $k4 (cont.bind $k6 $k4 (i32.const 1) (i32.const 2) (local.get $k6))) +;; (local.set $k2 (cont.bind $k4 $k2 (i32.const 3) (i32.const 4) (local.get $k4))) +;; (resume $k2 (i32.const 5) (i32.const 6) (local.get $k2)) +;; ) +;; ) + +;; (assert_return (invoke "run") +;; (i32.const 0) (i32.const 1) (i32.const 2) (i32.const 3) +;; (i32.const 4) (i32.const 5) (i32.const 6) +;; ) From 697ac8956714963a541d0254e200343743598c36 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Wed, 18 Oct 2023 15:38:19 +0200 Subject: [PATCH 66/82] Fix nit --- interpreter/valid/valid.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 285b7b549..85edc7d78 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -196,7 +196,7 @@ let check_memory_type (c : context) (mt : memory_type) at = let check_tag_type (c : context) (et : tag_type) at = match et with - | TagT ft -> check_heap_type c ft at + | TagT ht -> check_heap_type c ht at let check_global_type (c : context) (gt : global_type) at = let GlobalT (_mut, t) = gt in From 52ec7207b2b46272e1a6bf956204270b6dd0032b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Wed, 18 Oct 2023 17:15:37 +0200 Subject: [PATCH 67/82] Address comments --- interpreter/exec/eval.ml | 4 +- interpreter/valid/valid.ml | 11 +- test/core/cont.wast | 252 ++++++++++++++++++------------------- 3 files changed, 134 insertions(+), 133 deletions(-) diff --git a/interpreter/exec/eval.ml b/interpreter/exec/eval.ml index 27e2b5f46..39641d391 100644 --- a/interpreter/exec/eval.ml +++ b/interpreter/exec/eval.ml @@ -179,9 +179,9 @@ let split n (vs : 'a stack) at = take n vs at, drop n vs at let str_type_of_heap_type (inst : module_inst) ht : str_type = match ht with - | VarHT (StatX x | RecX x) -> str_type inst (x @@ Source.no_region) + | VarHT (StatX x) -> str_type inst (x @@ Source.no_region) | DefHT dt -> expand_def_type dt - | _ -> Printf.printf "HERE\n%!"; assert false + | _ -> assert false let func_type_of_cont_type (inst : module_inst) (ContT ht) : func_type = as_func_str_type (str_type_of_heap_type inst ht) diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 85edc7d78..976c06b7e 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -74,7 +74,7 @@ let func_type (c : context) x = let cont_type (c : context) x = match expand_def_type (type_ c x) with | DefContT ct -> ct - | _ as t -> Printf.printf "%s\n%!" (string_of_str_type t); error x.at ("non-continuation type " ^ Int32.to_string x.it) + | _ -> error x.at ("non-continuation type " ^ Int32.to_string x.it) let struct_type (c : context) x = match expand_def_type (type_ c x) with @@ -93,18 +93,19 @@ let refer category (s : Free.Set.t) x = let refer_func (c : context) x = refer "function" c.refs.Free.funcs x + (* Conversions *) let cont_type_of_heap_type (c : context) (ht : heap_type) at : cont_type = match ht with | DefHT dt -> as_cont_str_type (expand_def_type dt) - | VarHT (RecX x | StatX x) -> cont_type c (x @@ at) + | VarHT (StatX x) -> cont_type c (x @@ at) | _ -> assert false let func_type_of_heap_type (c : context) (ht : heap_type) at : func_type = match ht with | DefHT dt -> as_func_str_type (expand_def_type dt) - | VarHT (RecX x | StatX x) -> func_type c (x @@ at) + | VarHT (StatX x) -> func_type c (x @@ at) | _ -> assert false let func_type_of_cont_type (c : context) (ContT ht) at : func_type = @@ -116,6 +117,7 @@ let func_type_of_tag_type (c : context) (TagT ht) at : func_type = let heap_type_of_str_type (_c : context) (st : str_type) : heap_type = DefHT (DefT (RecT [SubT (Final, [], st)], Int32.of_int 0)) + (* Types *) let check_limits {min; max} range at msg = @@ -140,8 +142,7 @@ let check_heap_type (c : context) (t : heap_type) at = | ExternHT | NoExternHT | ContHT -> () | VarHT (StatX x) -> let _dt = type_ c (x @@ at) in () - | VarHT (RecX _) -> assert false - | DefHT _ -> assert false + | VarHT (RecX _) | DefHT _ -> assert false | BotHT -> () let check_ref_type (c : context) (t : ref_type) at = diff --git a/test/core/cont.wast b/test/core/cont.wast index cdb3f022d..041c4ab34 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -418,129 +418,129 @@ ;; Nested example: generator in a thread -;; (module $concurrent-generator -;; (func $log (import "spectest" "print_i64") (param i64)) - -;; (tag $syield (import "scheduler" "yield")) -;; (tag $spawn (import "scheduler" "spawn") (param (ref $cont))) -;; (func $scheduler (import "scheduler" "scheduler") (param $main (ref $cont))) - -;; (type $ghook (func (param i64))) -;; (func $gsum (import "generator" "sum") (param i64 i64) (result i64)) -;; (global $ghook (import "generator" "hook") (mut (ref $ghook))) - -;; (global $result (mut i64) (i64.const 0)) -;; (global $done (mut i32) (i32.const 0)) - -;; (elem declare func $main $bg-thread $syield) - -;; (func $syield (param $i i64) -;; (call $log (local.get $i)) -;; (suspend $syield) -;; ) - -;; (func $bg-thread -;; (call $log (i64.const -10)) -;; (loop $l -;; (call $log (i64.const -11)) -;; (suspend $syield) -;; (br_if $l (i32.eqz (global.get $done))) -;; ) -;; (call $log (i64.const -12)) -;; ) - -;; (func $main (param $i i64) (param $j i64) -;; (suspend $spawn (cont.new $cont (ref.func $bg-thread))) -;; (global.set $ghook (ref.func $syield)) -;; (global.set $result (call $gsum (local.get $i) (local.get $j))) -;; (global.set $done (i32.const 1)) -;; ) - -;; (type $proc (func)) -;; (type $pproc (func (param i64 i64))) -;; (type $cont (cont $proc)) -;; (type $pcont (cont $pproc)) -;; (func (export "sum") (param $i i64) (param $j i64) (result i64) -;; (call $log (i64.const -1)) -;; (call $scheduler -;; (cont.bind $pcont $cont (local.get $i) (local.get $j) (cont.new $pcont (ref.func $main))) -;; ) -;; (call $log (i64.const -2)) -;; (global.get $result) -;; ) -;; ) - -;; (assert_return (invoke "sum" (i64.const 10) (i64.const 20)) (i64.const 165)) - - -;; ;; cont.bind - -;; (module -;; (type $f2 (func (param i32 i32) (result i32 i32 i32 i32 i32 i32))) -;; (type $f4 (func (param i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32))) -;; (type $f6 (func (param i32 i32 i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32))) - -;; (type $k2 (cont $f2)) -;; (type $k4 (cont $f4)) -;; (type $k6 (cont $f6)) - -;; (elem declare func $f) -;; (func $f (param i32 i32 i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32) -;; (local.get 0) (local.get 1) (local.get 2) -;; (local.get 3) (local.get 4) (local.get 5) -;; ) - -;; (func (export "run") (result i32 i32 i32 i32 i32 i32) -;; (local $k6 (ref null $k6)) -;; (local $k4 (ref null $k4)) -;; (local $k2 (ref null $k2)) -;; (local.set $k6 (cont.new $k6 (ref.func $f))) -;; (local.set $k4 (cont.bind $k6 $k4 (i32.const 1) (i32.const 2) (local.get $k6))) -;; (local.set $k2 (cont.bind $k4 $k2 (i32.const 3) (i32.const 4) (local.get $k4))) -;; (resume $k2 (i32.const 5) (i32.const 6) (local.get $k2)) -;; ) -;; ) - -;; (assert_return (invoke "run") -;; (i32.const 1) (i32.const 2) (i32.const 3) -;; (i32.const 4) (i32.const 5) (i32.const 6) -;; ) - - -;; (module -;; (tag $e (result i32 i32 i32 i32 i32 i32)) - -;; (type $f0 (func (result i32 i32 i32 i32 i32 i32 i32))) -;; (type $f2 (func (param i32 i32) (result i32 i32 i32 i32 i32 i32 i32))) -;; (type $f4 (func (param i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32 i32))) -;; (type $f6 (func (param i32 i32 i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32 i32))) - -;; (type $k0 (cont $f0)) -;; (type $k2 (cont $f2)) -;; (type $k4 (cont $f4)) -;; (type $k6 (cont $f6)) - -;; (elem declare func $f) -;; (func $f (result i32 i32 i32 i32 i32 i32 i32) -;; (i32.const 0) (suspend $e) -;; ) - -;; (func (export "run") (result i32 i32 i32 i32 i32 i32 i32) -;; (local $k6 (ref null $k6)) -;; (local $k4 (ref null $k4)) -;; (local $k2 (ref null $k2)) -;; (block $l (result (ref $k6)) -;; (resume $k0 (tag $e $l) (cont.new $k0 (ref.func $f))) -;; (unreachable) -;; ) -;; (local.set $k6) -;; (local.set $k4 (cont.bind $k6 $k4 (i32.const 1) (i32.const 2) (local.get $k6))) -;; (local.set $k2 (cont.bind $k4 $k2 (i32.const 3) (i32.const 4) (local.get $k4))) -;; (resume $k2 (i32.const 5) (i32.const 6) (local.get $k2)) -;; ) -;; ) - -;; (assert_return (invoke "run") -;; (i32.const 0) (i32.const 1) (i32.const 2) (i32.const 3) -;; (i32.const 4) (i32.const 5) (i32.const 6) -;; ) +(module $concurrent-generator + (func $log (import "spectest" "print_i64") (param i64)) + + (tag $syield (import "scheduler" "yield")) + (tag $spawn (import "scheduler" "spawn") (param (ref $cont))) + (func $scheduler (import "scheduler" "scheduler") (param $main (ref $cont))) + + (type $ghook (func (param i64))) + (func $gsum (import "generator" "sum") (param i64 i64) (result i64)) + (global $ghook (import "generator" "hook") (mut (ref $ghook))) + + (global $result (mut i64) (i64.const 0)) + (global $done (mut i32) (i32.const 0)) + + (elem declare func $main $bg-thread $syield) + + (func $syield (param $i i64) + (call $log (local.get $i)) + (suspend $syield) + ) + + (func $bg-thread + (call $log (i64.const -10)) + (loop $l + (call $log (i64.const -11)) + (suspend $syield) + (br_if $l (i32.eqz (global.get $done))) + ) + (call $log (i64.const -12)) + ) + + (func $main (param $i i64) (param $j i64) + (suspend $spawn (cont.new $cont (ref.func $bg-thread))) + (global.set $ghook (ref.func $syield)) + (global.set $result (call $gsum (local.get $i) (local.get $j))) + (global.set $done (i32.const 1)) + ) + + (type $proc (func)) + (type $pproc (func (param i64 i64))) + (type $cont (cont $proc)) + (type $pcont (cont $pproc)) + (func (export "sum") (param $i i64) (param $j i64) (result i64) + (call $log (i64.const -1)) + (call $scheduler + (cont.bind $pcont $cont (local.get $i) (local.get $j) (cont.new $pcont (ref.func $main))) + ) + (call $log (i64.const -2)) + (global.get $result) + ) +) + +(assert_return (invoke "sum" (i64.const 10) (i64.const 20)) (i64.const 165)) + + +;; cont.bind + +(module + (type $f2 (func (param i32 i32) (result i32 i32 i32 i32 i32 i32))) + (type $f4 (func (param i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32))) + (type $f6 (func (param i32 i32 i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32))) + + (type $k2 (cont $f2)) + (type $k4 (cont $f4)) + (type $k6 (cont $f6)) + + (elem declare func $f) + (func $f (param i32 i32 i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32) + (local.get 0) (local.get 1) (local.get 2) + (local.get 3) (local.get 4) (local.get 5) + ) + + (func (export "run") (result i32 i32 i32 i32 i32 i32) + (local $k6 (ref null $k6)) + (local $k4 (ref null $k4)) + (local $k2 (ref null $k2)) + (local.set $k6 (cont.new $k6 (ref.func $f))) + (local.set $k4 (cont.bind $k6 $k4 (i32.const 1) (i32.const 2) (local.get $k6))) + (local.set $k2 (cont.bind $k4 $k2 (i32.const 3) (i32.const 4) (local.get $k4))) + (resume $k2 (i32.const 5) (i32.const 6) (local.get $k2)) + ) +) + +(assert_return (invoke "run") + (i32.const 1) (i32.const 2) (i32.const 3) + (i32.const 4) (i32.const 5) (i32.const 6) +) + + +(module + (tag $e (result i32 i32 i32 i32 i32 i32)) + + (type $f0 (func (result i32 i32 i32 i32 i32 i32 i32))) + (type $f2 (func (param i32 i32) (result i32 i32 i32 i32 i32 i32 i32))) + (type $f4 (func (param i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32 i32))) + (type $f6 (func (param i32 i32 i32 i32 i32 i32) (result i32 i32 i32 i32 i32 i32 i32))) + + (type $k0 (cont $f0)) + (type $k2 (cont $f2)) + (type $k4 (cont $f4)) + (type $k6 (cont $f6)) + + (elem declare func $f) + (func $f (result i32 i32 i32 i32 i32 i32 i32) + (i32.const 0) (suspend $e) + ) + + (func (export "run") (result i32 i32 i32 i32 i32 i32 i32) + (local $k6 (ref null $k6)) + (local $k4 (ref null $k4)) + (local $k2 (ref null $k2)) + (block $l (result (ref $k6)) + (resume $k0 (tag $e $l) (cont.new $k0 (ref.func $f))) + (unreachable) + ) + (local.set $k6) + (local.set $k4 (cont.bind $k6 $k4 (i32.const 1) (i32.const 2) (local.get $k6))) + (local.set $k2 (cont.bind $k4 $k2 (i32.const 3) (i32.const 4) (local.get $k4))) + (resume $k2 (i32.const 5) (i32.const 6) (local.get $k2)) + ) +) + +(assert_return (invoke "run") + (i32.const 0) (i32.const 1) (i32.const 2) (i32.const 3) + (i32.const 4) (i32.const 5) (i32.const 6) +) From 47367c94e302c075ccc8102a6257d633455510ba Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Thu, 19 Oct 2023 15:24:14 +0200 Subject: [PATCH 68/82] More tests --- test/core/cont.wast | 61 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 61 insertions(+) diff --git a/test/core/cont.wast b/test/core/cont.wast index 041c4ab34..407b0e7be 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -133,6 +133,67 @@ (assert_trap (invoke "non-linear-3") "continuation already consumed") (assert_trap (invoke "non-linear-4") "continuation already consumed") +(assert_invalid + (module + (type $ft (func)) + (func + (cont.new $ft (ref.null $ft)) + (drop))) + "non-continuation type 0") + +(assert_invalid + (module + (type $ft (func)) + (type $ct (cont $ft)) + (func + (resume $ft (ref.null $ct)) + (unreachable))) + "non-continuation type 0") + +(assert_invalid + (module + (type $ft (func)) + (type $ct (cont $ft)) + (func + (cont.bind $ft $ct (ref.null $ct)) + (unreachable))) + "non-continuation type 0") + +(assert_invalid + (module + (type $ft (func)) + (type $ct (cont $ft)) + (func + (cont.bind $ct $ft (ref.null $ct)) + (unreachable))) + "non-continuation type 0") + +(assert_invalid + (module + (type $ft (func)) + (type $ct (cont $ft)) + (tag $foo) + (func + (block $on_foo (result (ref $ft)) + (resume $ct (tag $foo $on_foo) (ref.null $ct)) + (unreachable) + ) + (drop))) + "non-continuation type 0") + +(assert_invalid + (module + (type $ft (func)) + (type $ct (cont $ft)) + (tag $foo) + (func + (block $on_foo (result (ref $ct) (ref $ft)) + (resume $ct (tag $foo $on_foo) (ref.null $ct)) + (unreachable) + ) + (drop) + (drop))) + "non-continuation type 0") ;; Simple state example From c81ef8967f078900fc43433e537b4f2406d17f8a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Thu, 19 Oct 2023 15:26:49 +0200 Subject: [PATCH 69/82] Test for resume_throw too --- test/core/cont.wast | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/test/core/cont.wast b/test/core/cont.wast index 407b0e7be..c3ce4b18b 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -150,6 +150,16 @@ (unreachable))) "non-continuation type 0") +(assert_invalid + (module + (type $ft (func)) + (type $ct (cont $ft)) + (tag $exn) + (func + (resume_throw $ft $exn (ref.null $ct)) + (unreachable))) + "non-continuation type 0") + (assert_invalid (module (type $ft (func)) From 4eb38ce985b3eed805afe651eb3e471a0fcf7ca3 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Thu, 19 Oct 2023 19:09:11 +0200 Subject: [PATCH 70/82] Add NoContHT --- interpreter/binary/decode.ml | 2 ++ interpreter/binary/encode.ml | 2 ++ interpreter/syntax/free.ml | 2 +- interpreter/syntax/types.ml | 4 +++- interpreter/valid/match.ml | 6 +++--- interpreter/valid/valid.ml | 8 ++++---- 6 files changed, 15 insertions(+), 9 deletions(-) diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index 70ad7c96b..2606ecb7a 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -190,6 +190,7 @@ let heap_type s = | -0x15 -> StructHT | -0x16 -> ArrayHT | -0x17 -> ContHT + | -0x18 -> NoContHT | _ -> error s pos "malformed heap type" ) ] s @@ -208,6 +209,7 @@ let ref_type s = | -0x15 -> (Null, StructHT) | -0x16 -> (Null, ArrayHT) | -0x17 -> (Null, ContHT) + | -0x18 -> (Null, NoContHT) | -0x1c -> (NoNull, heap_type s) | -0x1d -> (Null, heap_type s) | _ -> error s pos "malformed reference type" diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 11f578afe..af3ee88ca 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -126,6 +126,7 @@ struct | ExternHT -> s7 (-0x11) | NoExternHT -> s7 (-0x0e) | ContHT -> s7 (-0x17) + | NoContHT -> s7 (-0x18) | VarHT x -> var_type s33 x | DefHT _ | BotHT -> assert false @@ -145,6 +146,7 @@ struct | (Null, ExternHT) -> s7 (-0x11) | (Null, NoExternHT) -> s7 (-0x0e) | (Null, ContHT) -> s7 (-0x17) + | (Null, NoContHT) -> s7 (-0x18) | (Null, t) -> s7 (-0x1d); heap_type t | (NoNull, t) -> s7 (-0x1c); heap_type t diff --git a/interpreter/syntax/free.ml b/interpreter/syntax/free.ml index c945e9efd..12d9ae889 100644 --- a/interpreter/syntax/free.ml +++ b/interpreter/syntax/free.ml @@ -81,7 +81,7 @@ let heap_type = function | I31HT | StructHT | ArrayHT -> empty | FuncHT | NoFuncHT -> empty | ExternHT | NoExternHT -> empty - | ContHT -> empty + | ContHT | NoContHT -> empty | VarHT x -> var_type x | DefHT _ct -> empty (* assume closed *) | BotHT -> empty diff --git a/interpreter/syntax/types.ml b/interpreter/syntax/types.ml index f37badcb2..eda20e439 100644 --- a/interpreter/syntax/types.ml +++ b/interpreter/syntax/types.ml @@ -18,7 +18,7 @@ type heap_type = | AnyHT | NoneHT | EqHT | I31HT | StructHT | ArrayHT | FuncHT | NoFuncHT | ExternHT | NoExternHT - | ContHT + | ContHT | NoContHT | VarHT of var | DefHT of def_type | BotHT @@ -151,6 +151,7 @@ let subst_heap_type s = function | ExternHT -> ExternHT | NoExternHT -> NoExternHT | ContHT -> ContHT + | NoContHT -> NoContHT | VarHT x -> s x | DefHT dt -> DefHT dt (* assume closed *) | BotHT -> BotHT @@ -360,6 +361,7 @@ let rec string_of_heap_type = function | ExternHT -> "extern" | NoExternHT -> "noextern" | ContHT -> "cont" + | NoContHT -> "nocont" | VarHT x -> string_of_var x | DefHT dt -> "(" ^ string_of_def_type dt ^ ")" | BotHT -> "something" diff --git a/interpreter/valid/match.ml b/interpreter/valid/match.ml index 4e15d9efb..3e53dd1d0 100644 --- a/interpreter/valid/match.ml +++ b/interpreter/valid/match.ml @@ -22,7 +22,7 @@ and top_of_heap_type c = function | AnyHT | NoneHT | EqHT | StructHT | ArrayHT | I31HT -> AnyHT | FuncHT | NoFuncHT -> FuncHT | ExternHT | NoExternHT -> ExternHT - | ContHT -> ContHT + | ContHT | NoContHT -> ContHT | DefHT dt -> top_of_str_type c (expand_def_type dt) | VarHT (StatX x) -> top_of_str_type c (expand_def_type (lookup c x)) | VarHT (RecX _) | BotHT -> assert false @@ -34,7 +34,7 @@ and bot_of_heap_type c = function | AnyHT | NoneHT | EqHT | StructHT | ArrayHT | I31HT -> NoneHT | FuncHT | NoFuncHT -> NoFuncHT | ExternHT | NoExternHT -> NoExternHT - | ContHT -> ContHT + | ContHT | NoContHT -> NoContHT | DefHT dt -> bot_of_str_type c (expand_def_type dt) | VarHT (StatX x) -> bot_of_str_type c (expand_def_type (lookup c x)) | VarHT (RecX _) | BotHT -> assert false @@ -75,7 +75,7 @@ let rec match_heap_type c t1 t2 = | NoneHT, t -> match_heap_type c t AnyHT | NoFuncHT, t -> match_heap_type c t FuncHT | NoExternHT, t -> match_heap_type c t ExternHT - | ContHT, t -> match_heap_type c t ContHT + | NoContHT, t -> match_heap_type c t ContHT | VarHT (StatX x1), _ -> match_heap_type c (DefHT (lookup c x1)) t2 | _, VarHT (StatX x2) -> match_heap_type c t1 (DefHT (lookup c x2)) | DefHT dt1, DefHT dt2 -> match_def_type c dt1 dt2 diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 976c06b7e..dc755f332 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -98,13 +98,13 @@ let refer_func (c : context) x = refer "function" c.refs.Free.funcs x let cont_type_of_heap_type (c : context) (ht : heap_type) at : cont_type = match ht with - | DefHT dt -> as_cont_str_type (expand_def_type dt) + | DefHT dt -> assert false | VarHT (StatX x) -> cont_type c (x @@ at) | _ -> assert false let func_type_of_heap_type (c : context) (ht : heap_type) at : func_type = match ht with - | DefHT dt -> as_func_str_type (expand_def_type dt) + | DefHT dt -> assert false | VarHT (StatX x) -> func_type c (x @@ at) | _ -> assert false @@ -140,7 +140,7 @@ let check_heap_type (c : context) (t : heap_type) at = | AnyHT | NoneHT | EqHT | I31HT | StructHT | ArrayHT | FuncHT | NoFuncHT | ExternHT | NoExternHT - | ContHT -> () + | ContHT | NoContHT -> () | VarHT (StatX x) -> let _dt = type_ c (x @@ at) in () | VarHT (RecX _) | DefHT _ -> assert false | BotHT -> () @@ -424,7 +424,7 @@ let check_resume_table (c : context) ts2 (xys : (idx * idx) list) at = List.iter (fun (x1, x2) -> let FuncT (ts3, ts4) = func_type_of_tag_type c (tag c x1) x1.at in let (_, ts') = label c x2 in - match Lib.List.last_opt ts' with + match Lib.List.last_opt ts' with | Some (RefT (nul', ht)) -> let ct = cont_type_of_heap_type c ht x2.at in let ft' = func_type_of_cont_type c ct x2.at in From 92c223da434831ad41dab4442876c838394aa94a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Fri, 20 Oct 2023 10:24:26 +0200 Subject: [PATCH 71/82] Add contref, nullcontref, etc to the wat/wast formats --- interpreter/text/lexer.mll | 3 +++ interpreter/text/parser.mly | 5 +++++ 2 files changed, 8 insertions(+) diff --git a/interpreter/text/lexer.mll b/interpreter/text/lexer.mll index 8a1f264f7..38eb72c5e 100644 --- a/interpreter/text/lexer.mll +++ b/interpreter/text/lexer.mll @@ -167,6 +167,9 @@ rule token = parse | "noextern" -> NOEXTERN | "externref" -> EXTERNREF | "nullexternref" -> NULLEXTERNREF + | "nocont" -> NOCONT + | "contref" -> CONTREF + | "nullcontref" -> NULLCONTREF | "ref" -> REF | "null" -> NULL diff --git a/interpreter/text/parser.mly b/interpreter/text/parser.mly index 7594d9e43..85d6ae8b7 100644 --- a/interpreter/text/parser.mly +++ b/interpreter/text/parser.mly @@ -272,6 +272,7 @@ let inline_tag_type (c : context) (TagT ht) at = %token VEC_SHAPE %token ANYREF NULLREF EQREF I31REF STRUCTREF ARRAYREF %token FUNCREF NULLFUNCREF EXTERNREF NULLEXTERNREF +%token NOCONT CONTREF NULLCONTREF %token ANY NONE EQ I31 REF NOFUNC EXTERN NOEXTERN NULL %token MUT FIELD STRUCT ARRAY SUB FINAL REC %token UNREACHABLE NOP DROP SELECT @@ -354,6 +355,8 @@ heap_type : | NOFUNC { fun c -> NoFuncHT } | EXTERN { fun c -> ExternHT } | NOEXTERN { fun c -> NoExternHT } + | CONT { fun c -> ContHT } + | NOCONT { fun c -> NoContHT } | var { fun c -> VarHT (StatX ($1 c type_).it) } ref_type : @@ -368,6 +371,8 @@ ref_type : | NULLFUNCREF { fun c -> (Null, NoFuncHT) } /* Sugar */ | EXTERNREF { fun c -> (Null, ExternHT) } /* Sugar */ | NULLEXTERNREF { fun c -> (Null, NoExternHT) } /* Sugar */ + | CONTREF { fun c -> (Null, ContHT) } /* Sugar */ + | NULLCONTREF { fun c -> (Null, NoContHT) } /* Sugar */ val_type : | NUM_TYPE { fun c -> NumT $1 } From 9072739ca912e9675d9cd50b60c09e137dce2b3e Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Fri, 20 Oct 2023 13:59:52 +0200 Subject: [PATCH 72/82] Update opcodes again --- interpreter/binary/decode.ml | 8 ++++---- interpreter/binary/encode.ml | 6 +++--- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/interpreter/binary/decode.ml b/interpreter/binary/decode.ml index 2606ecb7a..2218a23e4 100644 --- a/interpreter/binary/decode.ml +++ b/interpreter/binary/decode.ml @@ -179,6 +179,7 @@ let heap_type s = (fun s -> VarHT (var_type s33 s)); (fun s -> match s7 s with + | -0x0b -> NoContHT | -0x0d -> NoFuncHT | -0x0e -> NoExternHT | -0x0f -> NoneHT @@ -189,8 +190,7 @@ let heap_type s = | -0x14 -> I31HT | -0x15 -> StructHT | -0x16 -> ArrayHT - | -0x17 -> ContHT - | -0x18 -> NoContHT + | -0x18 -> ContHT | _ -> error s pos "malformed heap type" ) ] s @@ -198,6 +198,7 @@ let heap_type s = let ref_type s = let pos = pos s in match s7 s with + | -0x0b -> (Null, NoContHT) | -0x0d -> (Null, NoFuncHT) | -0x0e -> (Null, NoExternHT) | -0x0f -> (Null, NoneHT) @@ -208,8 +209,7 @@ let ref_type s = | -0x14 -> (Null, I31HT) | -0x15 -> (Null, StructHT) | -0x16 -> (Null, ArrayHT) - | -0x17 -> (Null, ContHT) - | -0x18 -> (Null, NoContHT) + | -0x18 -> (Null, ContHT) | -0x1c -> (NoNull, heap_type s) | -0x1d -> (Null, heap_type s) | _ -> error s pos "malformed reference type" diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index af3ee88ca..6c255482f 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -125,8 +125,8 @@ struct | NoFuncHT -> s7 (-0x0d) | ExternHT -> s7 (-0x11) | NoExternHT -> s7 (-0x0e) - | ContHT -> s7 (-0x17) - | NoContHT -> s7 (-0x18) + | ContHT -> s7 (-0x18) + | NoContHT -> s7 (-0x0b) | VarHT x -> var_type s33 x | DefHT _ | BotHT -> assert false @@ -146,7 +146,7 @@ struct | (Null, ExternHT) -> s7 (-0x11) | (Null, NoExternHT) -> s7 (-0x0e) | (Null, ContHT) -> s7 (-0x17) - | (Null, NoContHT) -> s7 (-0x18) + | (Null, NoContHT) -> s7 (-0x0b) | (Null, t) -> s7 (-0x1d); heap_type t | (NoNull, t) -> s7 (-0x1c); heap_type t From d13dc883a4e42fb3b6a5dedb6760cb0e1a5079ca Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Fri, 20 Oct 2023 14:02:26 +0200 Subject: [PATCH 73/82] Fix opcode --- interpreter/binary/encode.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/interpreter/binary/encode.ml b/interpreter/binary/encode.ml index 6c255482f..7b0f2f96d 100644 --- a/interpreter/binary/encode.ml +++ b/interpreter/binary/encode.ml @@ -145,7 +145,7 @@ struct | (Null, NoFuncHT) -> s7 (-0x0d) | (Null, ExternHT) -> s7 (-0x11) | (Null, NoExternHT) -> s7 (-0x0e) - | (Null, ContHT) -> s7 (-0x17) + | (Null, ContHT) -> s7 (-0x18) | (Null, NoContHT) -> s7 (-0x0b) | (Null, t) -> s7 (-0x1d); heap_type t | (NoNull, t) -> s7 (-0x1c); heap_type t From 4ce065742b5a05c06c090a3b15189a5e7e799461 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Mon, 13 Nov 2023 08:59:39 +0100 Subject: [PATCH 74/82] Merge with spec, function-references, and gc From 41bf3b95e8bc7f95b2c8acc5927f074dfef0dd4a Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Wed, 6 Dec 2023 10:24:47 +0100 Subject: [PATCH 75/82] Update Overview.md (#15) This is a quick pass over the overview document. I have added type annotations and the tag filter list on `resume_throw`. --------- Co-authored-by: Andreas Rossberg --- proposals/continuations/Overview.md | 54 +++++++++++++++++------------ 1 file changed, 31 insertions(+), 23 deletions(-) diff --git a/proposals/continuations/Overview.md b/proposals/continuations/Overview.md index 568c6783b..7b4e5fc09 100644 --- a/proposals/continuations/Overview.md +++ b/proposals/continuations/Overview.md @@ -19,33 +19,40 @@ Based on [typed reference proposal](https://github.com/WebAssembly/function-refe - `cont.new $ct : [(ref null? $ft)] -> [(ref $ct)]` - iff `$ct = cont $ft` -* `cont.bind ` binds a continuation to (partial) arguments - - `cont.bind $ct : [t3* (ref null? $ct')] -> [(ref $ct)]` +* `cont.bind ` binds a continuation to (partial) arguments + - `cont.bind $ct $ct' : [t3* (ref null? $ct)] -> [(ref $ct')]` - iff `$ct = cont $ft` - - and `$ft = [t1*] -> [t2*]` + - and `$ft = [t3* t1*] -> [t2*]` - and `$ct' = cont $ft'` - - and `$ft' = [t3* t1'*] -> [t2'*]` - - and `[t1'*] -> [t2'*] <: [t1*] -> [t2*]` + - and `$ft' = [t1'*] -> [t2'*]` + - and `[t1*] -> [t2*] <: [t1'*] -> [t2'*]` * `suspend ` suspends the current continuation - `suspend $t : [t1*] -> [t2*]` - iff `tag $t : [t1*] -> [t2*]` -* `resume (tag )*` resumes a continuation - - `resume (tag $e $l)* : [t1* (ref null? $ct)] -> [t2*]` +* `resume (tag )*` resumes a continuation + - `resume $ct (tag $t $l)* : [t1* (ref null? $ct)] -> [t2*]` - iff `$ct = cont $ft` - and `$ft = [t1*] -> [t2*]` - and `(tag $t : [te1*] -> [te2*])*` - and `(label $l : [te1'* (ref null? $ct')])*` - and `([te1*] <: [te1'*])*` - and `($ct' = cont $ft')*` - - and `([te2*] -> [t2*] <: $ft')*` + - and `$ft' = [t1'*] -> [t2'*]` + - and `([te2*] -> [t2*] <: [t1'*] -> [t2'*])*` -* `resume_throw ` aborts a continuation - - `resume_throw $e : [te* (ref null? $ct)] -> [t2*]` - - iff `exception $e : [te*]` +* `resume_throw (tag )` aborts a continuation + - `resume_throw $ct $e (tag $t $l): [te* (ref null? $ct)] -> [t2*]` + - iff `(tag $e : [te*] -> [])` - and `$ct = cont $ft` - and `$ft = [t1*] -> [t2*]` + - and `(tag $t : [te1*] -> [te2*])*` + - and `(label $l : [te1'* (ref null? $ct')])*` + - and `([te1*] <: [te1'*])*` + - and `($ct' = cont $ft')*` + - and `$ft' = [t1'*] -> [t2'*]` + - and `([te2*] -> [t2*] <: [t1'*] -> [t2'*])*` * `barrier * end` blocks suspension - `barrier $l bt instr* end : [t1*] -> [t2*]` @@ -111,36 +118,37 @@ H^ea ::= - and `$ct = cont $ft` - and `$ft = [t1^n] -> [t2*]` -* `S; F; (ref.null t) (cont.bind $ct) --> S; F; trap` +* `S; F; (ref.null t) (cont.bind $ct $ct') --> S; F; trap` -* `S; F; (ref.cont ca) (cont.bind $ct) --> S'; F; trap` +* `S; F; (ref.cont ca) (cont.bind $ct $ct') --> S'; F; trap` - iff `S.conts[ca] = epsilon` -* `S; F; v^n (ref.cont ca) (cont.bind $ct) --> S'; F; (ref.const |S.conts|)` +* `S; F; v^n (ref.cont ca) (cont.bind $ct $ct') --> S'; F; (ref.const |S.conts|)` - iff `S.conts[ca] = (E' : n')` - - and `$ct = cont $ft` - - and `$ft = [t1'*] -> [t2'*]` + - and `$ct' = cont $ft'` + - and `$ft' = [t1'*] -> [t2'*]` - and `n = n' - |t1'*|` - and `S' = S with conts[ca] = epsilon with conts += (E : |t1'*|)` - and `E = E'[v^n _]` -* `S; F; (ref.null t) (resume (tag $e $l)*) --> S; F; trap` +* `S; F; (ref.null t) (resume $ct (tag $e $l)*) --> S; F; trap` -* `S; F; (ref.cont ca) (resume (tag $e $l)*) --> S; F; trap` +* `S; F; (ref.cont ca) (resume $ct (tag $e $l)*) --> S; F; trap` - iff `S.conts[ca] = epsilon` -* `S; F; v^n (ref.cont ca) (resume (tag $e $l)*) --> S'; F; handle{(ea $l)*} E[v^n] end` +* `S; F; v^n (ref.cont ca) (resume $ct (tag $t $l)*) --> S'; F; handle{(ea $l)*} E[v^n] end` - iff `S.conts[ca] = (E : n)` - - and `(ea = F.tags[$e])*` + - and `(ea = F.tags[$t])*` - and `S' = S with conts[ca] = epsilon` -* `S; F; (ref.null t) (resume_throw $e) --> S; F; trap` +* `S; F; (ref.null t) (resume_throw $ct $e (tag $t $l)*) --> S; F; trap` -* `S; F; (ref.cont ca) (resume_throw $e) --> S; F; trap` +* `S; F; (ref.cont ca) (resume_throw $ct $e (tag $t $l)*) --> S; F; trap` - iff `S.conts[ca] = epsilon` -* `S; F; v^m (ref.cont ca) (resume_throw $e) --> S'; F; E[v^m (throw $e)]` +* `S; F; v^m (ref.cont ca) (resume_throw $ct $e (tag $t $l)*) --> S'; F; handle{(ea $l)*} E[v^m (throw $e)] end` - iff `S.conts[ca] = (E : n)` + - and `(ea = F.tags[$t])*` - and `S.tags[F.tags[$e]].type = [t1^m] -> [t2*]` - and `S' = S with conts[ca] = epsilon` From a9ec313df893d0167ea4ec3130e7b069369d29ab Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Thu, 25 Jan 2024 16:11:27 +0100 Subject: [PATCH 76/82] Resolve wasmfx/specfx#17 (#18) This patch (re)installs the check for continuation type well-formedness. Resolves wasmfx/specfx#17 --------- Co-authored-by: Andreas Rossberg --- interpreter/valid/valid.ml | 4 +++- test/core/cont.wast | 23 +++++++++++++++++++++++ 2 files changed, 26 insertions(+), 1 deletion(-) diff --git a/interpreter/valid/valid.ml b/interpreter/valid/valid.ml index 9bb145941..1edeeb250 100644 --- a/interpreter/valid/valid.ml +++ b/interpreter/valid/valid.ml @@ -183,7 +183,9 @@ let check_func_type (c : context) (ft : func_type) at = let check_cont_type (c : context) (ct : cont_type) at = match ct with - | ContT ft -> check_heap_type c ft at + | ContT (VarHT (StatX x)) -> + let _dt = func_type c (x @@ at) in () + | _ -> assert false let check_table_type (c : context) (tt : table_type) at = let TableT (lim, t) = tt in diff --git a/test/core/cont.wast b/test/core/cont.wast index c3ce4b18b..784cf025c 100644 --- a/test/core/cont.wast +++ b/test/core/cont.wast @@ -205,6 +205,29 @@ (drop))) "non-continuation type 0") +(assert_invalid + (module + (type $ct (cont $ct))) + "non-function type 0") + +(assert_invalid + (module + (rec + (type $s0 (struct (field (ref 0) (ref 1) (ref $s0) (ref $s1)))) + (type $s1 (struct (field (ref 0) (ref 1) (ref $s0) (ref $s1)))) + ) + (type $ct (cont $s0))) + "non-function type 0") + +(module + (rec + (type $f1 (func (param (ref $f2)))) + (type $f2 (func (param (ref $f1)))) + ) + (type $c1 (cont $f1)) + (type $c2 (cont $f2)) +) + ;; Simple state example (module $state From ee9cbe76b851b15c1eda45664a03ee2fd8267c1d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Tue, 13 Feb 2024 18:24:37 +0100 Subject: [PATCH 77/82] Update the instruction set descriptions in the Explainer document (#27) This patch brings the description of the proposed instruction set extension in sync with the reference implementation. It also fixes a few other bugs such as a dead link in the TOC and the syntax in the examples. The document still warrants a refactoring as some things could do with better explanations, some TODOs left to complete, and some of the examples still make use of deprecated features from the function-references proposal. --- proposals/continuations/Explainer.md | 196 ++++++++++++++------------- 1 file changed, 99 insertions(+), 97 deletions(-) diff --git a/proposals/continuations/Explainer.md b/proposals/continuations/Explainer.md index 43fe12453..904a52bf6 100644 --- a/proposals/continuations/Explainer.md +++ b/proposals/continuations/Explainer.md @@ -15,7 +15,7 @@ single new reference type for *continuations*. 3. [Instruction set](#instruction-set) 1. [Declaring control tags](#declaring-control-tags) 2. [Creating continuations](#creating-continuations) - 3. [Resuming continuations](#resuming-continuations) + 3. [Invoking continuations](#invoking-continuations) 4. [Suspending continuations](#suspending-continuations) 5. [Binding continuations](#binding-continuations) 6. [Trapping continuations](#trapping-continuations) @@ -158,7 +158,7 @@ stacks, but other implementations are also possible. The proposal adds a new reference type for continuations. -```wasm +```wast (cont $t) ``` @@ -168,7 +168,7 @@ continuation, and whose return types `tr*` describes the stack shape after the continuation has run to completion. As a shorthand, we will often write the function type inline and write a continuation type as -```wasm +```wast (cont [tp*] -> [tr*]) ``` @@ -179,7 +179,7 @@ A control tag is similar to an exception extended with a result type *resumable* exception. A tag declaration provides the type signature of a control tag. -```wasm +```wast (tag $e (param tp*) (result tr*)) ``` @@ -195,7 +195,7 @@ for indicating that such a declaration is in scope. The following instruction creates a continuation in *suspended state* from a function. -```wasm +```wast cont.new $ct : [(ref $ft)] -> [(ref $ct)] where: - $ft = func [t1*] -> [t2*] @@ -215,38 +215,40 @@ The first way to invoke a continuation resumes the continuation under a *handler*, which handles subsequent control suspensions within the continuation. -```wasm - resume (tag $e $l)* : [tp* (ref $ct)] -> [tr*] +```wast + resume $ct (tag $e $l)* : [tp* (ref $ct)] -> [tr*] where: - $ct = cont [tp*] -> [tr*] ``` -The `resume` instruction is parameterised by a handler defined by a -collection of pairs of control tags and labels. Each pair maps a -control tag to a label pointing to its corresponding handler code. The -`resume` instruction consumes its continuation argument, meaning a -continuation may be resumed only once. +The `resume` instruction is parameterised by a continuation type and a +handler dispatch table defined by a collection of pairs of control +tags and labels. Each pair maps a control tag to a label pointing to +its corresponding handler code. The `resume` instruction consumes its +continuation argument, meaning a continuation may be resumed only +once. The second way to invoke a continuation is to raise an exception at the control tag invocation site. This amounts to performing "an abortive action" which causes the stack to be unwound. -```wasm - resume_throw $exn : [tp* (ref $ct)])] -> [tr*] +```wast + resume_throw $ct $exn (tag $e $l)* : [tp* (ref $ct)])] -> [tr*] where: - $ct = cont [ta*] -> [tr*] - $exn : [tp*] -> [] ``` -The instruction `resume_throw` is parameterised by the exception to be -raised at the control tag invocation site. As with `resume`, this -instruction also fully consumes its continuation -argument. Operationally, this instruction raises the exception `$exn` -with parameters of type `tp*` at the control tag invocation point in -the context of the supplied continuation. As an exception is being -raised (the continuation is not actually being supplied a value) the -parameter types for the continuation `ta*` are unconstrained. +The instruction `resume_throw` is parameterised by a continuation +type, the exception to be raised at the control tag invocation site, +and a handler dispatch table. As with `resume`, this instruction also +fully consumes its continuation argument. Operationally, this +instruction raises the exception `$exn` with parameters of type `tp*` +at the control tag invocation point in the context of the supplied +continuation. As an exception is being raised (the continuation is not +actually being supplied a value) the parameter types for the +continuation `ta*` are unconstrained. ### Suspending continuations @@ -254,7 +256,7 @@ A computation running inside a continuation can suspend itself by invoking one of the declared control tags. -```wasm +```wast suspend $e : [tp*] -> [tr*] where: - $e : [tp*] -> [tr*] @@ -282,8 +284,8 @@ continuation with compatible type (the [Examples](#examples) section provides several example usages of `cont.bind`). -```wasm - cont.bind $ct2 : [tp1* (ref $ct1)] -> [(ref $ct2)] +```wast + cont.bind $ct1 $ct2 : [tp1* (ref $ct1)] -> [(ref $ct2)] where: $ct1 = cont [tp1* tp2*] -> [tr*] $ct2 = cont [tp2*] -> [tr*] @@ -302,7 +304,7 @@ certain abstraction or language boundaries, we provide an instruction for explicitly trapping attempts at reifying stacks across a certain point. -```wasm +```wast barrier $l bt instr* end : [t1*] -> [t2*] where: - bt = [t1*] -> [t2*] @@ -353,7 +355,7 @@ continuations. In their most basic *static* form we assume a fixed collection of cooperative threads with a single tag that allows a thread to signal that it is willing to yield. -```wasm +```wast (module $lwt (tag $yield (export "yield")) ) @@ -363,7 +365,7 @@ thread to signal that it is willing to yield. The `$yield` tag takes no parameter and has no result. Having declared it, we can now write some cooperative threads as functions. -```wasm +```wast (module $example (tag $yield (import "lwt" "yield")) (func $log (import "spectest" "print_i32") (param i32)) @@ -405,7 +407,7 @@ tag, because we have not yet specified how to handle it. We now define a scheduler. -```wasm +```wast (module $scheduler (type $func (func)) (type $cont (cont $func)) @@ -421,8 +423,8 @@ We now define a scheduler. (loop $l (if (call $queue-empty) (then (return))) (block $on_yield (result (ref $cont)) - (resume (tag $yield $on_yield) - (call $dequeue) + (resume $cont (tag $yield $on_yield) + (call $dequeue) ) (br $l) ;; thread terminated ) ;; $on_yield (result (ref $cont)) @@ -452,7 +454,7 @@ new continuation for each, enqueue the continuations, and invoke the scheduler. The `cont.new` operation turns a function reference into a corresponding continuation reference. -```wasm +```wast (module (type $func (func)) (type $cont (cont $func)) @@ -469,9 +471,9 @@ corresponding continuation reference. (elem declare func $thread1 $thread2 $thread3) (func (export "run") - (call $enqueue (cont.new (type $cont) (ref.func $thread1))) - (call $enqueue (cont.new (type $cont) (ref.func $thread2))) - (call $enqueue (cont.new (type $cont) (ref.func $thread3))) + (call $enqueue (cont.new $cont (ref.func $thread1))) + (call $enqueue (cont.new $cont (ref.func $thread2))) + (call $enqueue (cont.new $cont (ref.func $thread3))) (call $log (i32.const -1)) (call $scheduler) @@ -505,7 +507,7 @@ The threads are interleaved as expected. We can make our lightweight threads functionality considerably more expressive by allowing new threads to be forked dynamically. -```wasm +```wast (module $lwt (type $func (func)) (type $cont (cont $func)) @@ -520,7 +522,7 @@ We declare a new `$fork` tag that takes a continuation as a parameter and (like `$yield`) returns no result. Now we modify our example to fork each of the three threads from a single main thread. -```wasm +```wast (module $example (type $func (func)) (type $cont (cont $func)) @@ -534,11 +536,11 @@ example to fork each of the three threads from a single main thread. (func $main (export "main") (call $log (i32.const 0)) - (suspend $fork (cont.new (type $cont) (ref.func $thread1))) + (suspend $fork (cont.new $cont (ref.func $thread1))) (call $log (i32.const 1)) - (suspend $fork (cont.new (type $cont) (ref.func $thread2))) + (suspend $fork (cont.new $cont (ref.func $thread2))) (call $log (i32.const 2)) - (suspend $fork (cont.new (type $cont) (ref.func $thread3))) + (suspend $fork (cont.new $cont (ref.func $thread3))) (call $log (i32.const 3)) ) @@ -570,7 +572,7 @@ example to fork each of the three threads from a single main thread. ``` As with the static example we define a scheduler module. -```wasm +```wast (module $scheduler (type $func (func)) (type $cont (cont $func)) @@ -590,15 +592,15 @@ In this example we illustrate five different schedulers. First, we write a baseline synchronous scheduler which simply runs the current thread to completion without actually yielding. -```wasm +```wast (func $sync (export "sync") (param $nextk (ref null $cont)) (loop $l (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (tag $yield $on_yield) - (tag $fork $on_fork) - (local.get $nextk) + (resume $cont (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) ) (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated @@ -656,7 +658,7 @@ threads in sequence. Following a similar pattern, we define four different asynchronous schedulers. -```wasm +```wast ;; four asynchronous schedulers: ;; * kt and tk don't yield on encountering a fork ;; 1) kt runs the continuation, queuing up the new thread for later @@ -671,9 +673,9 @@ schedulers. (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (tag $yield $on_yield) - (tag $fork $on_fork) - (local.get $nextk) + (resume $cont (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) ) (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated @@ -695,9 +697,9 @@ schedulers. (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (tag $yield $on_yield) - (tag $fork $on_fork) - (local.get $nextk) + (resume $cont (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) ) (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated @@ -719,9 +721,9 @@ schedulers. (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (tag $yield $on_yield) - (tag $fork $on_fork) - (local.get $nextk) + (resume $cont (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) ) (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated @@ -744,9 +746,9 @@ schedulers. (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (tag $yield $on_yield) - (tag $fork $on_fork) - (local.get $nextk) + (resume $cont (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) ) (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated @@ -772,7 +774,7 @@ current and newly forked threads. We run our example using each of the five schedulers. -```wasm +```wast (module (type $func (func)) (type $cont (cont $func)) @@ -791,15 +793,15 @@ We run our example using each of the five schedulers. (func (export "run") (call $log (i32.const -1)) - (call $scheduler1 (cont.new (type $cont) (ref.func $main))) + (call $scheduler1 (cont.new $cont (ref.func $main))) (call $log (i32.const -2)) - (call $scheduler2 (cont.new (type $cont) (ref.func $main))) + (call $scheduler2 (cont.new $cont (ref.func $main))) (call $log (i32.const -3)) - (call $scheduler3 (cont.new (type $cont) (ref.func $main))) + (call $scheduler3 (cont.new $cont (ref.func $main))) (call $log (i32.const -4)) - (call $scheduler4 (cont.new (type $cont) (ref.func $main))) + (call $scheduler4 (cont.new $cont (ref.func $main))) (call $log (i32.const -5)) - (call $scheduler5 (cont.new (type $cont) (ref.func $main))) + (call $scheduler5 (cont.new $cont (ref.func $main))) (call $log (i32.const -6)) ) ) @@ -901,7 +903,7 @@ delimited control operators. First we implement control/prompt. -```wasm +```wast ;; interface to control/prompt (module $control (type $func (func)) ;; [] -> [] @@ -931,8 +933,8 @@ First we implement control/prompt. (tag $control (export "control") (param (ref $cont-func))) ;; control : [([contref ([] -> [])] -> [])] -> [] (func $prompt (export "prompt") (param $nextk (ref null $cont)) ;; prompt : [(contref ([] -> []))] -> [] (block $on_control (result (ref $cont-func) (ref $cont)) - (resume (tag $control $on_control) - (local.get $nextk)) + (resume $cont (tag $control $on_control) + (local.get $nextk)) (return) ) ;; $on_control (param (ref $cont-func) (ref $cont)) (let (local $h (ref $cont-func)) (local $k (ref $cont)) @@ -964,7 +966,7 @@ handlers for defining different schedulers. Here instead we parameterise the whole example by the behaviour of yielding and forking as `$yield` and `$fork` functions. -```wasm +```wast (module $example (type $func (func)) ;; [] -> [] (type $cont (cont $func)) ;; cont ([] -> []) @@ -982,18 +984,18 @@ forking as `$yield` and `$fork` functions. (func $main (export "main") (param $yield (ref $func)) (param $fork (ref $cont-func)) (call $log (i32.const 0)) (call_ref - (cont.bind (type $cont) (local.get $yield) (local.get $fork) - (cont.new (type $func-cont-func-cont) (ref.func $thread1))) + (cont.bind $func-cont-func-cont $cont (local.get $yield) (local.get $fork) + (cont.new $func-cont-func-cont (ref.func $thread1))) (local.get $fork)) (call $log (i32.const 1)) (call_ref - (cont.bind (type $cont) (local.get $yield) (local.get $fork) - (cont.new (type $func-cont-func-cont) (ref.func $thread2))) + (cont.bind $func-cont-func-cont $cont (local.get $yield) (local.get $fork) + (cont.new $func-cont-func-cont (ref.func $thread2))) (local.get $fork)) (call $log (i32.const 2)) (call_ref - (cont.bind (type $cont) (local.get $yield) (local.get $fork) - (cont.new (type $func-cont-func-cont) (ref.func $thread3))) + (cont.bind $func-cont-func-cont $cont (local.get $yield) (local.get $fork) + (cont.new $func-cont-func-cont (ref.func $thread3))) (local.get $fork)) (call $log (i32.const 3)) ) @@ -1034,7 +1036,7 @@ We now define a scheduler module analogous to that of the previous dynamic lightweight thread example. As before, we will implement five different schedulers. -```wasm +```wast (module (type $func (func)) ;; [] -> [] (type $cont (cont $func)) ;; cont ([] -> []) @@ -1067,7 +1069,7 @@ Unlike before, with control/prompt a generic scheduler loop must be decoupled from the implementations of each operation (yield / fork) as the latter are passed in as arguments to user code -```wasm +```wast ;; generic boilerplate scheduler (func $scheduler (param $nextk (ref null $cont)) (loop $loop @@ -1088,7 +1090,7 @@ fork. First, we do the baseline synchronous scheduler. -```wasm +```wast ;; synchronous scheduler (func $handle-yield-sync (param $k (ref $cont)) (call $scheduler (local.get $k)) @@ -1105,7 +1107,7 @@ First, we do the baseline synchronous scheduler. ) (func $sync (export "sync") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-sync) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-sync) (local.get $k))) ) ``` @@ -1119,7 +1121,7 @@ All of the asynchronous schedulers make use of the same implementation of yield, which enqueues the continuation of the current thread and dequeues the next available thread. -```wasm +```wast ;; asynchronous yield (used by all asynchronous schedulers) (func $handle-yield (param $k (ref $cont)) (call $enqueue (local.get $k)) @@ -1132,7 +1134,7 @@ dequeues the next available thread. Each asynchronous scheduler uses its own implementation of fork. -```wasm +```wast ;; four asynchronous implementations of fork: ;; * kt and tk don't yield on encountering a fork ;; 1) kt runs the continuation, queuing up the new thread for later @@ -1151,7 +1153,7 @@ Each asynchronous scheduler uses its own implementation of fork. ) (func $kt (export "kt") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-kt) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-kt) (local.get $k))) ) ;; no yield on fork, new thread first @@ -1164,7 +1166,7 @@ Each asynchronous scheduler uses its own implementation of fork. ) (func $tk (export "tk") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-tk) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-tk) (local.get $k))) ) ;; yield on fork, continuation first @@ -1178,7 +1180,7 @@ Each asynchronous scheduler uses its own implementation of fork. ) (func $ykt (export "ykt") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-ykt) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-ykt) (local.get $k))) ) ;; yield on fork, new thread first @@ -1192,7 +1194,7 @@ Each asynchronous scheduler uses its own implementation of fork. ) (func $ytk (export "ytk") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-ytk) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-ytk) (local.get $k))) ) ) (register "scheduler") @@ -1203,7 +1205,7 @@ lightweight threads example, but the types are more complex due to the need to index the handled computation (`$main` in this case) by the implementations of forking and yielding. -```wasm +```wast (module (type $func (func)) ;; [] -> [] (type $cont (cont $func)) ;; cont ([] -> []) @@ -1228,15 +1230,15 @@ implementations of forking and yielding. (func $run (export "run") (call $log (i32.const -1)) - (call $scheduler-sync (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-sync (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -2)) - (call $scheduler-kt (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-kt (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -3)) - (call $scheduler-tk (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-tk (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -4)) - (call $scheduler-ykt (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-ykt (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -5)) - (call $scheduler-ytk (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-ytk (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -6)) ) ) @@ -1436,8 +1438,8 @@ We can accommodate named handlers by introducing a new reference type executing a variant of the `resume` instruction and is passed to the continuation: -```wasm - resume_with (tag $e $l)* : [ t1* (ref $ht) ] -> [ t2* ] +```wast + resume_with $ht $ct (tag $e $l)* : [ t1* (ref $ht) (ref $ct) ] -> [ t2* ] where: - $ht = handler t2* - $ct = cont ([ (ref $ht) t1* ] -> [ t2* ]) @@ -1451,8 +1453,8 @@ construction. This instruction is complemented by an instruction for suspending to a specific handler: -```wasm - suspend_to $e : [ s* (ref $ht) ] -> [ t* ] +```wast + suspend_to $ht $e : [ s* (ref $ht) ] -> [ t* ] where: - $ht = handler tr* - $e : [ s* ] -> [ t* ] @@ -1478,7 +1480,7 @@ symmetric `switch_to` primitive. Given named handlers, it is possible to introduce a somewhat magic instruction for switching directly to another continuation: -```wasm +```wast switch_to : [ t1* (ref $ct1) (ref $ht) ] -> [ t2* ] where: - $ht = handler t3* @@ -1488,7 +1490,7 @@ instruction for switching directly to another continuation: This behaves as if there was a built-in tag -```wasm +```wast (tag $Switch (param t1* (ref $ct1)) (result t3*)) ``` @@ -1510,7 +1512,7 @@ In fact, symmetric switching need not necessarily be tied to named handlers, since there could also be an indirect version with dynamic handler lookup: -```wasm +```wast switch : [ t1* (ref $ct1) ] -> [ t2* ] where: - $ct1 = cont ([ (ref $ct2) t1* ] -> [ t3* ]) From 88774bd5cbb86526d2ff68f0020c93f4d0782826 Mon Sep 17 00:00:00 2001 From: Asumu Takikawa Date: Wed, 14 Feb 2024 16:01:50 -0800 Subject: [PATCH 78/82] [spec] minor formatting adjustment --- document/core/appendix/embedding.rst | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/document/core/appendix/embedding.rst b/document/core/appendix/embedding.rst index c0a19791d..408803a3d 100644 --- a/document/core/appendix/embedding.rst +++ b/document/core/appendix/embedding.rst @@ -674,7 +674,7 @@ Matching .. math:: \begin{array}{lclll} - \F{match\_reftype}(t_1, t_2) &=& \TRUE && (\iff \vdashvaltypematch t_1 \matchesvaltype t_2) \\ + \F{match\_reftype}(t_1, t_2) &=& \TRUE && (\iff {} \vdashvaltypematch t_1 \matchesvaltype t_2) \\ \F{match\_reftype}(t_1, t_2) &=& \FALSE && (\otherwise) \\ \end{array} @@ -690,6 +690,6 @@ Matching .. math:: \begin{array}{lclll} - \F{match\_externtype}(\X{et}_1, \X{et}_2) &=& \TRUE && (\iff \vdashexterntypematch \X{et}_1 \matchesexterntype \X{et}_2) \\ + \F{match\_externtype}(\X{et}_1, \X{et}_2) &=& \TRUE && (\iff {} \vdashexterntypematch \X{et}_1 \matchesexterntype \X{et}_2) \\ \F{match\_externtype}(\X{et}_1, \X{et}_2) &=& \FALSE && (\otherwise) \\ \end{array} From e49a5b7c39b68e155f87641d6f0f30b479f8c5cb Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Fri, 12 Apr 2024 12:46:35 +0200 Subject: [PATCH 79/82] Maybe fix bikeshed error; at least silencing it for now. --- document/js-api/index.bs | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/document/js-api/index.bs b/document/js-api/index.bs index 464689623..1f0b76cc9 100644 --- a/document/js-api/index.bs +++ b/document/js-api/index.bs @@ -1302,7 +1302,7 @@ The internal methods of an [=Exported GC Object=] use the following implementati 1. Return keys. -
+
To create a new Exported GC Object from a WebAssembly [=object address=] |objectaddr| and a string |objectkind|, perform the following steps: 1. Assert: |objectkind| is either "array" or "struct". From 02de8d17ee5e6662844e06c2c3b50e576169682d Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Fri, 12 Apr 2024 14:44:52 +0200 Subject: [PATCH 80/82] Disable W3C publish workflow --- .github/workflows/w3c-publish.yml | 3 +++ 1 file changed, 3 insertions(+) diff --git a/.github/workflows/w3c-publish.yml b/.github/workflows/w3c-publish.yml index eeade04eb..2d49ffbb0 100644 --- a/.github/workflows/w3c-publish.yml +++ b/.github/workflows/w3c-publish.yml @@ -11,6 +11,9 @@ on: jobs: publish-to-w3c-TR: runs-on: ubuntu-latest + # TODO(dhil): The following effectively disables this workflow. It + # should be removed before merging with upstream. + if: false steps: - name: Checkout repo uses: actions/checkout@v2 From a324dba05e968abc46a24515b029ef5855fc51ec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Fri, 12 Apr 2024 15:32:52 +0200 Subject: [PATCH 81/82] Fix control-lwt example (#30) --- .../continuations/examples/control-lwt.wast | 95 +++++++++++-------- 1 file changed, 55 insertions(+), 40 deletions(-) diff --git a/proposals/continuations/examples/control-lwt.wast b/proposals/continuations/examples/control-lwt.wast index 1c1e6496b..d7c00cb3c 100644 --- a/proposals/continuations/examples/control-lwt.wast +++ b/proposals/continuations/examples/control-lwt.wast @@ -24,16 +24,18 @@ ;; ;; (Technically this is control0/prompt0 rather than ;; control/prompt.) - (tag $control (export "control") (param (ref $cont-func))) ;; control : ([cont ([] -> [])] -> []) -> [] + (tag $control (export "control") (param (ref $cont-cont))) ;; control : ([cont ([] -> [])] -> []) -> [] (func $prompt (export "prompt") (param $nextk (ref null $cont)) ;; prompt : cont ([] -> []) -> [] - (block $on_control (result (ref $cont-func) (ref $cont)) - (resume (tag $control $on_control) - (local.get $nextk)) + (local $h (ref $cont-cont)) + (local $k (ref $cont)) + (block $on_control (result (ref $cont-cont) (ref $cont)) + (resume $cont (tag $control $on_control) + (local.get $nextk)) (return) ) ;; $on_control (param (ref $cont-func) (ref $cont)) - (let (local $h (ref $cont-func)) (local $k (ref $cont)) - (call_ref (local.get $k) (local.get $h)) - ) + (local.set $k) + (local.set $h) + (resume $cont-cont (local.get $k) (local.get $h)) ) ) (register "control") @@ -57,44 +59,44 @@ (func $main (export "main") (param $yield (ref $func)) (param $fork (ref $cont-func)) (call $log (i32.const 0)) - (call_ref - (cont.bind (type $cont) (local.get $yield) (local.get $fork) - (cont.new (type $func-cont-func-cont) (ref.func $thread1))) + (call_ref $cont-func + (cont.bind $func-cont-func-cont $cont (local.get $yield) (local.get $fork) + (cont.new $func-cont-func-cont (ref.func $thread1))) (local.get $fork)) (call $log (i32.const 1)) - (call_ref - (cont.bind (type $cont) (local.get $yield) (local.get $fork) - (cont.new (type $func-cont-func-cont) (ref.func $thread2))) + (call_ref $cont-func + (cont.bind $func-cont-func-cont $cont (local.get $yield) (local.get $fork) + (cont.new $func-cont-func-cont (ref.func $thread2))) (local.get $fork)) (call $log (i32.const 2)) - (call_ref - (cont.bind (type $cont) (local.get $yield) (local.get $fork) - (cont.new (type $func-cont-func-cont) (ref.func $thread3))) + (call_ref $cont-func + (cont.bind $func-cont-func-cont $cont (local.get $yield) (local.get $fork) + (cont.new $func-cont-func-cont (ref.func $thread3))) (local.get $fork)) (call $log (i32.const 3)) ) (func $thread1 (param $yield (ref $func)) (param $fork (ref $cont-func)) (call $log (i32.const 10)) - (call_ref (local.get $yield)) + (call_ref $func (local.get $yield)) (call $log (i32.const 11)) - (call_ref (local.get $yield)) + (call_ref $func (local.get $yield)) (call $log (i32.const 12)) ) (func $thread2 (param $yield (ref $func)) (param $fork (ref $cont-func)) (call $log (i32.const 20)) - (call_ref (local.get $yield)) + (call_ref $func (local.get $yield)) (call $log (i32.const 21)) - (call_ref (local.get $yield)) + (call_ref $func (local.get $yield)) (call $log (i32.const 22)) ) (func $thread3 (param $yield (ref $func)) (param $fork (ref $cont-func)) (call $log (i32.const 30)) - (call_ref (local.get $yield)) + (call_ref $func (local.get $yield)) (call $log (i32.const 31)) - (call_ref (local.get $yield)) + (call_ref $func (local.get $yield)) (call $log (i32.const 32)) ) ) @@ -170,6 +172,9 @@ (type $func-cont-func-func (func (param (ref $func)) (param (ref $cont-func)))) ;; ([] -> []) -> ([cont ([] -> [])] -> []) -> [] (type $func-cont-func-cont (cont $func-cont-func-func)) ;; cont (([] -> []) -> ([cont ([] -> [])] -> []) -> []) + (type $func-cont-cont (func (param (ref $cont)) (param (ref $cont)))) + (type $cont-cont-func (cont $func-cont-cont)) + (func $log (import "spectest" "print_i32") (param i32)) ;; queue interface @@ -184,7 +189,7 @@ $fork-sync $fork-kt $fork-tk $fork-ykt $fork-ytk) ;; control/prompt interface - (tag $control (import "control" "control") (param (ref $cont-func))) ;; control : ([cont ([] -> [])] -> []) -> [] + (tag $control (import "control" "control") (param (ref $cont-cont))) ;; control : ([cont ([] -> [])] -> []) -> [] (func $prompt (import "control" "prompt") (param $nextk (ref null $cont))) ;; prompt : cont ([] -> []) -> [] ;; generic boilerplate scheduler @@ -215,18 +220,20 @@ (call $scheduler (local.get $k)) ) (func $yield-sync - (suspend $control (ref.func $handle-yield)) + (suspend $control (cont.new $cont-cont (ref.func $handle-yield))) ) (func $handle-fork-sync (param $t (ref $cont)) (param $k (ref $cont)) (call $enqueue (local.get $t)) (call $scheduler (local.get $k)) ) (func $fork-sync (param $t (ref $cont)) - (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-sync))) + (suspend $control + (cont.bind $cont-cont-func $cont-cont (local.get $t) + (cont.new $cont-cont-func (ref.func $handle-fork-sync)))) ) (func $sync (export "sync") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-sync) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-sync) (local.get $k))) ) ;; asynchronous yield (used by all asynchronous schedulers) @@ -235,7 +242,7 @@ (call $scheduler (call $dequeue)) ) (func $yield - (suspend $control (ref.func $handle-yield)) + (suspend $control (cont.new $cont-cont (ref.func $handle-yield))) ) ;; four asynchronous implementations of fork: ;; * kt and tk don't yield on encountering a fork @@ -251,11 +258,13 @@ (call $scheduler (local.get $k)) ) (func $fork-kt (param $t (ref $cont)) - (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-kt))) + (suspend $control + (cont.bind $cont-cont-func $cont-cont (local.get $t) + (cont.new $cont-cont-func (ref.func $handle-fork-kt)))) ) (func $kt (export "kt") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-kt) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-kt) (local.get $k))) ) ;; no yield on fork, new thread first @@ -264,11 +273,13 @@ (call $scheduler (local.get $t)) ) (func $fork-tk (param $t (ref $cont)) - (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-tk))) + (suspend $control + (cont.bind $cont-cont-func $cont-cont (local.get $t) + (cont.new $cont-cont-func (ref.func $handle-fork-tk)))) ) (func $tk (export "tk") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-tk) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-tk) (local.get $k))) ) ;; yield on fork, continuation first @@ -278,11 +289,13 @@ (call $scheduler (call $dequeue)) ) (func $fork-ykt (param $t (ref $cont)) - (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-ykt))) + (suspend $control + (cont.bind $cont-cont-func $cont-cont (local.get $t) + (cont.new $cont-cont-func (ref.func $handle-fork-ykt)))) ) (func $ykt (export "ykt") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-ykt) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-ykt) (local.get $k))) ) ;; yield on fork, new thread first @@ -292,11 +305,13 @@ (call $scheduler (call $dequeue)) ) (func $fork-ytk (param $t (ref $cont)) - (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-ytk))) + (suspend $control + (cont.bind $cont-cont-func $cont-cont (local.get $t) + (cont.new $cont-cont-func (ref.func $handle-fork-ytk)))) ) (func $ytk (export "ytk") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-ytk) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-ytk) (local.get $k))) ) ) (register "scheduler") @@ -325,15 +340,15 @@ (func $run (export "run") (call $log (i32.const -1)) - (call $scheduler-sync (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-sync (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -2)) - (call $scheduler-kt (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-kt (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -3)) - (call $scheduler-tk (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-tk (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -4)) - (call $scheduler-ykt (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-ykt (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -5)) - (call $scheduler-ytk (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-ytk (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -6)) ) ) From 902e33d515b4fd39bc3bcc2c2c3b4d26209e5103 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Daniel=20Hillerstr=C3=B6m?= Date: Fri, 12 Apr 2024 15:42:18 +0200 Subject: [PATCH 82/82] WasmFX documents&examples --- proposals/continuations/Explainer.md | 196 +++++++++--------- proposals/continuations/Overview.md | 54 +++-- .../continuations/examples/actor-lwt.wast | 80 +++---- proposals/continuations/examples/actor.wast | 74 +++---- .../continuations/examples/async-await.wast | 79 +++---- .../continuations/examples/control-lwt.wast | 95 +++++---- .../continuations/examples/fun-actor-lwt.wast | 146 +++++++------ proposals/continuations/examples/fun-lwt.wast | 42 ++-- .../continuations/examples/fun-pipes.wast | 8 +- .../continuations/examples/fun-state.wast | 6 +- .../continuations/examples/generators.wast | 166 +++++++++++++++ proposals/continuations/examples/lwt.wast | 26 +-- proposals/continuations/examples/pipes.wast | 8 +- .../continuations/examples/static-lwt.wast | 10 +- 14 files changed, 589 insertions(+), 401 deletions(-) create mode 100644 proposals/continuations/examples/generators.wast diff --git a/proposals/continuations/Explainer.md b/proposals/continuations/Explainer.md index f5cd25ef8..904a52bf6 100644 --- a/proposals/continuations/Explainer.md +++ b/proposals/continuations/Explainer.md @@ -15,7 +15,7 @@ single new reference type for *continuations*. 3. [Instruction set](#instruction-set) 1. [Declaring control tags](#declaring-control-tags) 2. [Creating continuations](#creating-continuations) - 3. [Resuming continuations](#resuming-continuations) + 3. [Invoking continuations](#invoking-continuations) 4. [Suspending continuations](#suspending-continuations) 5. [Binding continuations](#binding-continuations) 6. [Trapping continuations](#trapping-continuations) @@ -158,7 +158,7 @@ stacks, but other implementations are also possible. The proposal adds a new reference type for continuations. -```wasm +```wast (cont $t) ``` @@ -168,7 +168,7 @@ continuation, and whose return types `tr*` describes the stack shape after the continuation has run to completion. As a shorthand, we will often write the function type inline and write a continuation type as -```wasm +```wast (cont [tp*] -> [tr*]) ``` @@ -179,7 +179,7 @@ A control tag is similar to an exception extended with a result type *resumable* exception. A tag declaration provides the type signature of a control tag. -```wasm +```wast (tag $e (param tp*) (result tr*)) ``` @@ -195,7 +195,7 @@ for indicating that such a declaration is in scope. The following instruction creates a continuation in *suspended state* from a function. -```wasm +```wast cont.new $ct : [(ref $ft)] -> [(ref $ct)] where: - $ft = func [t1*] -> [t2*] @@ -215,38 +215,40 @@ The first way to invoke a continuation resumes the continuation under a *handler*, which handles subsequent control suspensions within the continuation. -```wasm - resume (tag $e $l)* : [tp* (ref $ct)] -> [tr*] +```wast + resume $ct (tag $e $l)* : [tp* (ref $ct)] -> [tr*] where: - $ct = cont [tp*] -> [tr*] ``` -The `resume` instruction is parameterised by a handler defined by a -collection of pairs of control tags and labels. Each pair maps a -control tag to a label pointing to its corresponding handler code. The -`resume` instruction consumes its continuation argument, meaning a -continuation may be resumed only once. +The `resume` instruction is parameterised by a continuation type and a +handler dispatch table defined by a collection of pairs of control +tags and labels. Each pair maps a control tag to a label pointing to +its corresponding handler code. The `resume` instruction consumes its +continuation argument, meaning a continuation may be resumed only +once. The second way to invoke a continuation is to raise an exception at the control tag invocation site. This amounts to performing "an abortive action" which causes the stack to be unwound. -```wasm - resume_throw $exn : [tp* (ref $ct)])] -> [tr*] +```wast + resume_throw $ct $exn (tag $e $l)* : [tp* (ref $ct)])] -> [tr*] where: - $ct = cont [ta*] -> [tr*] - $exn : [tp*] -> [] ``` -The instruction `resume_throw` is parameterised by the exception to be -raised at the control tag invocation site. As with `resume`, this -instruction also fully consumes its continuation -argument. Operationally, this instruction raises the exception `$exn` -with parameters of type `tp*` at the control tag invocation point in -the context of the supplied continuation. As an exception is being -raised (the continuation is not actually being supplied a value) the -parameter types for the continuation `ta*` are unconstrained. +The instruction `resume_throw` is parameterised by a continuation +type, the exception to be raised at the control tag invocation site, +and a handler dispatch table. As with `resume`, this instruction also +fully consumes its continuation argument. Operationally, this +instruction raises the exception `$exn` with parameters of type `tp*` +at the control tag invocation point in the context of the supplied +continuation. As an exception is being raised (the continuation is not +actually being supplied a value) the parameter types for the +continuation `ta*` are unconstrained. ### Suspending continuations @@ -254,7 +256,7 @@ A computation running inside a continuation can suspend itself by invoking one of the declared control tags. -```wasm +```wast suspend $e : [tp*] -> [tr*] where: - $e : [tp*] -> [tr*] @@ -282,8 +284,8 @@ continuation with compatible type (the [Examples](#examples) section provides several example usages of `cont.bind`). -```wasm - cont.bind $ct2 : [tp1* (ref $ct1)] -> [(ref $ct2)] +```wast + cont.bind $ct1 $ct2 : [tp1* (ref $ct1)] -> [(ref $ct2)] where: $ct1 = cont [tp1* tp2*] -> [tr*] $ct2 = cont [tp2*] -> [tr*] @@ -302,7 +304,7 @@ certain abstraction or language boundaries, we provide an instruction for explicitly trapping attempts at reifying stacks across a certain point. -```wasm +```wast barrier $l bt instr* end : [t1*] -> [t2*] where: - bt = [t1*] -> [t2*] @@ -353,7 +355,7 @@ continuations. In their most basic *static* form we assume a fixed collection of cooperative threads with a single tag that allows a thread to signal that it is willing to yield. -```wasm +```wast (module $lwt (tag $yield (export "yield")) ) @@ -363,7 +365,7 @@ thread to signal that it is willing to yield. The `$yield` tag takes no parameter and has no result. Having declared it, we can now write some cooperative threads as functions. -```wasm +```wast (module $example (tag $yield (import "lwt" "yield")) (func $log (import "spectest" "print_i32") (param i32)) @@ -405,7 +407,7 @@ tag, because we have not yet specified how to handle it. We now define a scheduler. -```wasm +```wast (module $scheduler (type $func (func)) (type $cont (cont $func)) @@ -421,8 +423,8 @@ We now define a scheduler. (loop $l (if (call $queue-empty) (then (return))) (block $on_yield (result (ref $cont)) - (resume (tag $yield $on_yield) - (call $dequeue) + (resume $cont (tag $yield $on_yield) + (call $dequeue) ) (br $l) ;; thread terminated ) ;; $on_yield (result (ref $cont)) @@ -452,7 +454,7 @@ new continuation for each, enqueue the continuations, and invoke the scheduler. The `cont.new` operation turns a function reference into a corresponding continuation reference. -```wasm +```wast (module (type $func (func)) (type $cont (cont $func)) @@ -469,9 +471,9 @@ corresponding continuation reference. (elem declare func $thread1 $thread2 $thread3) (func (export "run") - (call $enqueue (cont.new (type $cont) (ref.func $thread1))) - (call $enqueue (cont.new (type $cont) (ref.func $thread2))) - (call $enqueue (cont.new (type $cont) (ref.func $thread3))) + (call $enqueue (cont.new $cont (ref.func $thread1))) + (call $enqueue (cont.new $cont (ref.func $thread2))) + (call $enqueue (cont.new $cont (ref.func $thread3))) (call $log (i32.const -1)) (call $scheduler) @@ -505,7 +507,7 @@ The threads are interleaved as expected. We can make our lightweight threads functionality considerably more expressive by allowing new threads to be forked dynamically. -```wasm +```wast (module $lwt (type $func (func)) (type $cont (cont $func)) @@ -520,7 +522,7 @@ We declare a new `$fork` tag that takes a continuation as a parameter and (like `$yield`) returns no result. Now we modify our example to fork each of the three threads from a single main thread. -```wasm +```wast (module $example (type $func (func)) (type $cont (cont $func)) @@ -534,11 +536,11 @@ example to fork each of the three threads from a single main thread. (func $main (export "main") (call $log (i32.const 0)) - (suspend $fork (cont.new (type $cont) (ref.func $thread1))) + (suspend $fork (cont.new $cont (ref.func $thread1))) (call $log (i32.const 1)) - (suspend $fork (cont.new (type $cont) (ref.func $thread2))) + (suspend $fork (cont.new $cont (ref.func $thread2))) (call $log (i32.const 2)) - (suspend $fork (cont.new (type $cont) (ref.func $thread3))) + (suspend $fork (cont.new $cont (ref.func $thread3))) (call $log (i32.const 3)) ) @@ -570,7 +572,7 @@ example to fork each of the three threads from a single main thread. ``` As with the static example we define a scheduler module. -```wasm +```wast (module $scheduler (type $func (func)) (type $cont (cont $func)) @@ -590,15 +592,15 @@ In this example we illustrate five different schedulers. First, we write a baseline synchronous scheduler which simply runs the current thread to completion without actually yielding. -```wasm +```wast (func $sync (export "sync") (param $nextk (ref null $cont)) (loop $l (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (tag $yield $on_yield) - (tag $fork $on_fork) - (local.get $nextk) + (resume $cont (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) ) (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated @@ -656,7 +658,7 @@ threads in sequence. Following a similar pattern, we define four different asynchronous schedulers. -```wasm +```wast ;; four asynchronous schedulers: ;; * kt and tk don't yield on encountering a fork ;; 1) kt runs the continuation, queuing up the new thread for later @@ -671,9 +673,9 @@ schedulers. (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (tag $yield $on_yield) - (tag $fork $on_fork) - (local.get $nextk) + (resume $cont (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) ) (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated @@ -695,9 +697,9 @@ schedulers. (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (tag $yield $on_yield) - (tag $fork $on_fork) - (local.get $nextk) + (resume $cont (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) ) (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated @@ -719,9 +721,9 @@ schedulers. (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (tag $yield $on_yield) - (tag $fork $on_fork) - (local.get $nextk) + (resume $cont (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) ) (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated @@ -744,9 +746,9 @@ schedulers. (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (tag $yield $on_yield) - (tag $fork $on_fork) - (local.get $nextk) + (resume $cont (tag $yield $on_yield) + (tag $fork $on_fork) + (local.get $nextk) ) (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated @@ -772,7 +774,7 @@ current and newly forked threads. We run our example using each of the five schedulers. -```wasm +```wast (module (type $func (func)) (type $cont (cont $func)) @@ -791,15 +793,15 @@ We run our example using each of the five schedulers. (func (export "run") (call $log (i32.const -1)) - (call $scheduler1 (cont.new (type $cont) (ref.func $main))) + (call $scheduler1 (cont.new $cont (ref.func $main))) (call $log (i32.const -2)) - (call $scheduler2 (cont.new (type $cont) (ref.func $main))) + (call $scheduler2 (cont.new $cont (ref.func $main))) (call $log (i32.const -3)) - (call $scheduler3 (cont.new (type $cont) (ref.func $main))) + (call $scheduler3 (cont.new $cont (ref.func $main))) (call $log (i32.const -4)) - (call $scheduler4 (cont.new (type $cont) (ref.func $main))) + (call $scheduler4 (cont.new $cont (ref.func $main))) (call $log (i32.const -5)) - (call $scheduler5 (cont.new (type $cont) (ref.func $main))) + (call $scheduler5 (cont.new $cont (ref.func $main))) (call $log (i32.const -6)) ) ) @@ -901,7 +903,7 @@ delimited control operators. First we implement control/prompt. -```wasm +```wast ;; interface to control/prompt (module $control (type $func (func)) ;; [] -> [] @@ -931,8 +933,8 @@ First we implement control/prompt. (tag $control (export "control") (param (ref $cont-func))) ;; control : [([contref ([] -> [])] -> [])] -> [] (func $prompt (export "prompt") (param $nextk (ref null $cont)) ;; prompt : [(contref ([] -> []))] -> [] (block $on_control (result (ref $cont-func) (ref $cont)) - (resume (tag $control $on_control) - (local.get $nextk)) + (resume $cont (tag $control $on_control) + (local.get $nextk)) (return) ) ;; $on_control (param (ref $cont-func) (ref $cont)) (let (local $h (ref $cont-func)) (local $k (ref $cont)) @@ -964,7 +966,7 @@ handlers for defining different schedulers. Here instead we parameterise the whole example by the behaviour of yielding and forking as `$yield` and `$fork` functions. -```wasm +```wast (module $example (type $func (func)) ;; [] -> [] (type $cont (cont $func)) ;; cont ([] -> []) @@ -982,18 +984,18 @@ forking as `$yield` and `$fork` functions. (func $main (export "main") (param $yield (ref $func)) (param $fork (ref $cont-func)) (call $log (i32.const 0)) (call_ref - (cont.bind (type $cont) (local.get $yield) (local.get $fork) - (cont.new (type $func-cont-func-cont) (ref.func $thread1))) + (cont.bind $func-cont-func-cont $cont (local.get $yield) (local.get $fork) + (cont.new $func-cont-func-cont (ref.func $thread1))) (local.get $fork)) (call $log (i32.const 1)) (call_ref - (cont.bind (type $cont) (local.get $yield) (local.get $fork) - (cont.new (type $func-cont-func-cont) (ref.func $thread2))) + (cont.bind $func-cont-func-cont $cont (local.get $yield) (local.get $fork) + (cont.new $func-cont-func-cont (ref.func $thread2))) (local.get $fork)) (call $log (i32.const 2)) (call_ref - (cont.bind (type $cont) (local.get $yield) (local.get $fork) - (cont.new (type $func-cont-func-cont) (ref.func $thread3))) + (cont.bind $func-cont-func-cont $cont (local.get $yield) (local.get $fork) + (cont.new $func-cont-func-cont (ref.func $thread3))) (local.get $fork)) (call $log (i32.const 3)) ) @@ -1034,7 +1036,7 @@ We now define a scheduler module analogous to that of the previous dynamic lightweight thread example. As before, we will implement five different schedulers. -```wasm +```wast (module (type $func (func)) ;; [] -> [] (type $cont (cont $func)) ;; cont ([] -> []) @@ -1067,7 +1069,7 @@ Unlike before, with control/prompt a generic scheduler loop must be decoupled from the implementations of each operation (yield / fork) as the latter are passed in as arguments to user code -```wasm +```wast ;; generic boilerplate scheduler (func $scheduler (param $nextk (ref null $cont)) (loop $loop @@ -1088,7 +1090,7 @@ fork. First, we do the baseline synchronous scheduler. -```wasm +```wast ;; synchronous scheduler (func $handle-yield-sync (param $k (ref $cont)) (call $scheduler (local.get $k)) @@ -1105,7 +1107,7 @@ First, we do the baseline synchronous scheduler. ) (func $sync (export "sync") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-sync) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-sync) (local.get $k))) ) ``` @@ -1119,7 +1121,7 @@ All of the asynchronous schedulers make use of the same implementation of yield, which enqueues the continuation of the current thread and dequeues the next available thread. -```wasm +```wast ;; asynchronous yield (used by all asynchronous schedulers) (func $handle-yield (param $k (ref $cont)) (call $enqueue (local.get $k)) @@ -1132,7 +1134,7 @@ dequeues the next available thread. Each asynchronous scheduler uses its own implementation of fork. -```wasm +```wast ;; four asynchronous implementations of fork: ;; * kt and tk don't yield on encountering a fork ;; 1) kt runs the continuation, queuing up the new thread for later @@ -1151,7 +1153,7 @@ Each asynchronous scheduler uses its own implementation of fork. ) (func $kt (export "kt") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-kt) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-kt) (local.get $k))) ) ;; no yield on fork, new thread first @@ -1164,7 +1166,7 @@ Each asynchronous scheduler uses its own implementation of fork. ) (func $tk (export "tk") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-tk) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-tk) (local.get $k))) ) ;; yield on fork, continuation first @@ -1178,7 +1180,7 @@ Each asynchronous scheduler uses its own implementation of fork. ) (func $ykt (export "ykt") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-ykt) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-ykt) (local.get $k))) ) ;; yield on fork, new thread first @@ -1192,7 +1194,7 @@ Each asynchronous scheduler uses its own implementation of fork. ) (func $ytk (export "ytk") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-ytk) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-ytk) (local.get $k))) ) ) (register "scheduler") @@ -1203,7 +1205,7 @@ lightweight threads example, but the types are more complex due to the need to index the handled computation (`$main` in this case) by the implementations of forking and yielding. -```wasm +```wast (module (type $func (func)) ;; [] -> [] (type $cont (cont $func)) ;; cont ([] -> []) @@ -1228,15 +1230,15 @@ implementations of forking and yielding. (func $run (export "run") (call $log (i32.const -1)) - (call $scheduler-sync (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-sync (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -2)) - (call $scheduler-kt (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-kt (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -3)) - (call $scheduler-tk (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-tk (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -4)) - (call $scheduler-ykt (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-ykt (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -5)) - (call $scheduler-ytk (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-ytk (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -6)) ) ) @@ -1436,8 +1438,8 @@ We can accommodate named handlers by introducing a new reference type executing a variant of the `resume` instruction and is passed to the continuation: -```wasm - resume_with (tag $e $l)* : [ t1* (ref $ct) ] -> [ t2* ] +```wast + resume_with $ht $ct (tag $e $l)* : [ t1* (ref $ht) (ref $ct) ] -> [ t2* ] where: - $ht = handler t2* - $ct = cont ([ (ref $ht) t1* ] -> [ t2* ]) @@ -1451,8 +1453,8 @@ construction. This instruction is complemented by an instruction for suspending to a specific handler: -```wasm - suspend_to $e : [ s* (ref $ht) ] -> [ t* ] +```wast + suspend_to $ht $e : [ s* (ref $ht) ] -> [ t* ] where: - $ht = handler tr* - $e : [ s* ] -> [ t* ] @@ -1478,7 +1480,7 @@ symmetric `switch_to` primitive. Given named handlers, it is possible to introduce a somewhat magic instruction for switching directly to another continuation: -```wasm +```wast switch_to : [ t1* (ref $ct1) (ref $ht) ] -> [ t2* ] where: - $ht = handler t3* @@ -1488,7 +1490,7 @@ instruction for switching directly to another continuation: This behaves as if there was a built-in tag -```wasm +```wast (tag $Switch (param t1* (ref $ct1)) (result t3*)) ``` @@ -1510,7 +1512,7 @@ In fact, symmetric switching need not necessarily be tied to named handlers, since there could also be an indirect version with dynamic handler lookup: -```wasm +```wast switch : [ t1* (ref $ct1) ] -> [ t2* ] where: - $ct1 = cont ([ (ref $ct2) t1* ] -> [ t3* ]) diff --git a/proposals/continuations/Overview.md b/proposals/continuations/Overview.md index 568c6783b..7b4e5fc09 100644 --- a/proposals/continuations/Overview.md +++ b/proposals/continuations/Overview.md @@ -19,33 +19,40 @@ Based on [typed reference proposal](https://github.com/WebAssembly/function-refe - `cont.new $ct : [(ref null? $ft)] -> [(ref $ct)]` - iff `$ct = cont $ft` -* `cont.bind ` binds a continuation to (partial) arguments - - `cont.bind $ct : [t3* (ref null? $ct')] -> [(ref $ct)]` +* `cont.bind ` binds a continuation to (partial) arguments + - `cont.bind $ct $ct' : [t3* (ref null? $ct)] -> [(ref $ct')]` - iff `$ct = cont $ft` - - and `$ft = [t1*] -> [t2*]` + - and `$ft = [t3* t1*] -> [t2*]` - and `$ct' = cont $ft'` - - and `$ft' = [t3* t1'*] -> [t2'*]` - - and `[t1'*] -> [t2'*] <: [t1*] -> [t2*]` + - and `$ft' = [t1'*] -> [t2'*]` + - and `[t1*] -> [t2*] <: [t1'*] -> [t2'*]` * `suspend ` suspends the current continuation - `suspend $t : [t1*] -> [t2*]` - iff `tag $t : [t1*] -> [t2*]` -* `resume (tag )*` resumes a continuation - - `resume (tag $e $l)* : [t1* (ref null? $ct)] -> [t2*]` +* `resume (tag )*` resumes a continuation + - `resume $ct (tag $t $l)* : [t1* (ref null? $ct)] -> [t2*]` - iff `$ct = cont $ft` - and `$ft = [t1*] -> [t2*]` - and `(tag $t : [te1*] -> [te2*])*` - and `(label $l : [te1'* (ref null? $ct')])*` - and `([te1*] <: [te1'*])*` - and `($ct' = cont $ft')*` - - and `([te2*] -> [t2*] <: $ft')*` + - and `$ft' = [t1'*] -> [t2'*]` + - and `([te2*] -> [t2*] <: [t1'*] -> [t2'*])*` -* `resume_throw ` aborts a continuation - - `resume_throw $e : [te* (ref null? $ct)] -> [t2*]` - - iff `exception $e : [te*]` +* `resume_throw (tag )` aborts a continuation + - `resume_throw $ct $e (tag $t $l): [te* (ref null? $ct)] -> [t2*]` + - iff `(tag $e : [te*] -> [])` - and `$ct = cont $ft` - and `$ft = [t1*] -> [t2*]` + - and `(tag $t : [te1*] -> [te2*])*` + - and `(label $l : [te1'* (ref null? $ct')])*` + - and `([te1*] <: [te1'*])*` + - and `($ct' = cont $ft')*` + - and `$ft' = [t1'*] -> [t2'*]` + - and `([te2*] -> [t2*] <: [t1'*] -> [t2'*])*` * `barrier * end` blocks suspension - `barrier $l bt instr* end : [t1*] -> [t2*]` @@ -111,36 +118,37 @@ H^ea ::= - and `$ct = cont $ft` - and `$ft = [t1^n] -> [t2*]` -* `S; F; (ref.null t) (cont.bind $ct) --> S; F; trap` +* `S; F; (ref.null t) (cont.bind $ct $ct') --> S; F; trap` -* `S; F; (ref.cont ca) (cont.bind $ct) --> S'; F; trap` +* `S; F; (ref.cont ca) (cont.bind $ct $ct') --> S'; F; trap` - iff `S.conts[ca] = epsilon` -* `S; F; v^n (ref.cont ca) (cont.bind $ct) --> S'; F; (ref.const |S.conts|)` +* `S; F; v^n (ref.cont ca) (cont.bind $ct $ct') --> S'; F; (ref.const |S.conts|)` - iff `S.conts[ca] = (E' : n')` - - and `$ct = cont $ft` - - and `$ft = [t1'*] -> [t2'*]` + - and `$ct' = cont $ft'` + - and `$ft' = [t1'*] -> [t2'*]` - and `n = n' - |t1'*|` - and `S' = S with conts[ca] = epsilon with conts += (E : |t1'*|)` - and `E = E'[v^n _]` -* `S; F; (ref.null t) (resume (tag $e $l)*) --> S; F; trap` +* `S; F; (ref.null t) (resume $ct (tag $e $l)*) --> S; F; trap` -* `S; F; (ref.cont ca) (resume (tag $e $l)*) --> S; F; trap` +* `S; F; (ref.cont ca) (resume $ct (tag $e $l)*) --> S; F; trap` - iff `S.conts[ca] = epsilon` -* `S; F; v^n (ref.cont ca) (resume (tag $e $l)*) --> S'; F; handle{(ea $l)*} E[v^n] end` +* `S; F; v^n (ref.cont ca) (resume $ct (tag $t $l)*) --> S'; F; handle{(ea $l)*} E[v^n] end` - iff `S.conts[ca] = (E : n)` - - and `(ea = F.tags[$e])*` + - and `(ea = F.tags[$t])*` - and `S' = S with conts[ca] = epsilon` -* `S; F; (ref.null t) (resume_throw $e) --> S; F; trap` +* `S; F; (ref.null t) (resume_throw $ct $e (tag $t $l)*) --> S; F; trap` -* `S; F; (ref.cont ca) (resume_throw $e) --> S; F; trap` +* `S; F; (ref.cont ca) (resume_throw $ct $e (tag $t $l)*) --> S; F; trap` - iff `S.conts[ca] = epsilon` -* `S; F; v^m (ref.cont ca) (resume_throw $e) --> S'; F; E[v^m (throw $e)]` +* `S; F; v^m (ref.cont ca) (resume_throw $ct $e (tag $t $l)*) --> S'; F; handle{(ea $l)*} E[v^m (throw $e)] end` - iff `S.conts[ca] = (E : n)` + - and `(ea = F.tags[$t])*` - and `S.tags[F.tags[$e]].type = [t1^m] -> [t2*]` - and `S' = S with conts[ca] = epsilon` diff --git a/proposals/continuations/examples/actor-lwt.wast b/proposals/continuations/examples/actor-lwt.wast index ead651eea..60d879591 100644 --- a/proposals/continuations/examples/actor-lwt.wast +++ b/proposals/continuations/examples/actor-lwt.wast @@ -52,7 +52,7 @@ (loop $l (if (i32.eqz (local.get $n)) (then (suspend $send (i32.const 42) (local.get $p))) - (else (local.set $p (suspend $spawn (cont.bind (type $cont) (local.get $p) (cont.new (type $i-cont) (ref.func $next))))) + (else (local.set $p (suspend $spawn (cont.bind $i-cont $cont (local.get $p) (cont.new $i-cont (ref.func $next))))) (local.set $n (i32.sub (local.get $n) (i32.const 1))) (br $l)) ) @@ -73,7 +73,7 @@ (table $queue 0 (ref null $cont)) (memory 1) - (exception $too-many-mailboxes) + (tag $too-many-mailboxes) (global $qdelta i32 (i32.const 10)) @@ -190,8 +190,8 @@ (func $log (import "spectest" "print_i32") (param i32)) - (exception $too-many-mailboxes) - (exception $too-many-messages) + (tag $too-many-mailboxes) + (tag $too-many-messages) (memory 1) @@ -274,7 +274,7 @@ (loop $l (if (i32.eqz (local.get $n)) (then (suspend $send (i32.const 42) (local.get $p))) - (else (local.set $p (suspend $spawn (cont.bind (type $cont) (local.get $p) (cont.new (type $i-cont) (ref.func $next))))) + (else (local.set $p (suspend $spawn (cont.bind $i-cont $cont (local.get $p) (cont.new $i-cont (ref.func $next))))) (local.set $n (i32.sub (local.get $n) (i32.const 1))) (br $l)) ) @@ -371,7 +371,7 @@ (if (call $queue-empty) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (tag $yield $on_yield) (tag $fork $on_fork) + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (call $dequeue) ) (br $l) ;; thread terminated @@ -397,8 +397,8 @@ ;; -1 means empty - (exception $too-many-mailboxes) - (exception $too-many-messages) + (tag $too-many-mailboxes) + (tag $too-many-messages) (memory 1) @@ -489,52 +489,52 @@ (elem declare func $actk) (func $actk (param $mine i32) (param $nextk (ref $cont)) + (local $ik (ref $i-cont)) + (local $k (ref $cont)) + (local $you (ref $cont)) + (local $yours i32) (loop $l (block $on_self (result (ref $i-cont)) (block $on_spawn (result (ref $cont) (ref $i-cont)) (block $on_send (result i32 i32 (ref $cont)) (block $on_recv (result (ref $i-cont)) - (resume (tag $self $on_self) - (tag $spawn $on_spawn) - (tag $send $on_send) - (tag $recv $on_recv) - (local.get $nextk) + (resume $cont (tag $self $on_self) + (tag $spawn $on_spawn) + (tag $send $on_send) + (tag $recv $on_recv) + (local.get $nextk) ) (return) ) ;; $on_recv (result (ref $i-cont)) - (let (local $ik (ref $i-cont)) - ;; block this thread until the mailbox is non-empty - (loop $blocked - (if (call $empty-mb (local.get $mine)) - (then (suspend $yield) - (br $blocked)) - ) + (local.set $ik) + ;; block this thread until the mailbox is non-empty + (loop $blocked + (if (call $empty-mb (local.get $mine)) + (then (suspend $yield) + (br $blocked)) ) - (local.set $nextk (cont.bind (type $cont) (call $recv-from-mb (local.get $mine)) (local.get $ik))) ) + (local.set $nextk (cont.bind $i-cont $cont (call $recv-from-mb (local.get $mine)) (local.get $ik))) (br $l) ) ;; $on_send (result i32 i32 (ref $cont)) - (let (param i32 i32) (local $k (ref $cont)) - (call $send-to-mb) - (local.set $nextk (local.get $k)) - ) + (local.set $k) + (call $send-to-mb) + (local.set $nextk (local.get $k)) (br $l) ) ;; $on_spawn (result (ref $cont) (ref $i-cont)) - (let (local $you (ref $cont)) (local $ik (ref $i-cont)) - (call $new-mb) - (let (local $yours i32) - (suspend $fork (cont.bind (type $cont) - (local.get $yours) - (local.get $you) - (cont.new (type $ic-cont) (ref.func $actk)))) - (local.set $nextk (cont.bind (type $cont) (local.get $yours) (local.get $ik))) - ) - ) + (local.set $ik) + (local.set $you) + (call $new-mb) + (local.set $yours) + (suspend $fork (cont.bind $ic-cont $cont + (local.get $yours) + (local.get $you) + (cont.new $ic-cont (ref.func $actk)))) + (local.set $nextk (cont.bind $i-cont $cont (local.get $yours) (local.get $ik))) (br $l) ) ;; $on_self (result (ref $i-cont)) - (let (local $ik (ref $i-cont)) - (local.set $nextk (cont.bind (type $cont) (local.get $mine) (local.get $ik))) - ) + (local.set $ik) + (local.set $nextk (cont.bind $i-cont $cont (local.get $mine) (local.get $ik))) (br $l) ) ) @@ -560,7 +560,7 @@ (func $scheduler (import "scheduler" "run") (param $k (ref $cont))) (func $run-actor (export "run-actor") (param $k (ref $cont)) - (call $scheduler (cont.bind (type $cont) (local.get $k) (cont.new (type $cont-cont) (ref.func $act)))) + (call $scheduler (cont.bind $cont-cont $cont (local.get $k) (cont.new $cont-cont (ref.func $act)))) ) ) (register "actor-scheduler") @@ -578,7 +578,7 @@ (func $chain (import "chain" "chain") (param $n i32)) (func $run-chain (export "run-chain") (param $n i32) - (call $run-actor (cont.bind (type $cont) (local.get $n) (cont.new (type $i-cont) (ref.func $chain)))) + (call $run-actor (cont.bind $i-cont $cont (local.get $n) (cont.new $i-cont (ref.func $chain)))) ) ) diff --git a/proposals/continuations/examples/actor.wast b/proposals/continuations/examples/actor.wast index 3a8d36f48..151c08d58 100644 --- a/proposals/continuations/examples/actor.wast +++ b/proposals/continuations/examples/actor.wast @@ -52,7 +52,7 @@ (loop $l (if (i32.eqz (local.get $n)) (then (suspend $send (i32.const 42) (local.get $p))) - (else (local.set $p (suspend $spawn (cont.bind (type $cont) (local.get $p) (cont.new (type $i-cont) (ref.func $next))))) + (else (local.set $p (suspend $spawn (cont.bind $i-cont $cont (local.get $p) (cont.new $i-cont (ref.func $next))))) (local.set $n (i32.sub (local.get $n) (i32.const 1))) (br $l)) ) @@ -73,7 +73,7 @@ (table $queue 0 (ref null $cont)) (memory 1) - (exception $too-many-mailboxes) + (tag $too-many-mailboxes) (global $qdelta i32 (i32.const 10)) @@ -190,8 +190,8 @@ (func $log (import "spectest" "print_i32") (param i32)) - (exception $too-many-mailboxes) - (exception $too-many-messages) + (tag $too-many-mailboxes) + (tag $too-many-messages) (memory 1) @@ -296,10 +296,10 @@ (local $res i32) (suspend $recv) (local.set $res) - (resume (local.get $res) (local.get $ik)) + (resume $i-cont (local.get $res) (local.get $ik)) ) (func $recv-again (param $ik (ref $i-cont)) (result (ref $cont)) - (cont.bind (type $cont) (local.get $ik) (cont.new (type $i-cont-cont) (ref.func $recv-againf))) + (cont.bind $i-cont-cont $cont (local.get $ik) (cont.new $i-cont-cont (ref.func $recv-againf))) ) ;; There are multiple ways of avoiding the need for @@ -317,6 +317,10 @@ (func $run (export "run") (param $nextk (ref null $cont)) (local $mine i32) ;; current mailbox + (local $ik (ref $i-cont)) + (local $k (ref $cont)) + (local $you (ref $cont)) + (local $yours i32) (call $init) (local.set $mine (call $new-mb)) (loop $l @@ -325,48 +329,44 @@ (block $on_spawn (result (ref $cont) (ref $i-cont)) (block $on_send (result i32 i32 (ref $cont)) (block $on_recv (result (ref $i-cont)) - (resume (tag $self $on_self) - (tag $spawn $on_spawn) - (tag $send $on_send) - (tag $recv $on_recv) - (local.get $nextk) + (resume $cont (tag $self $on_self) + (tag $spawn $on_spawn) + (tag $send $on_send) + (tag $recv $on_recv) + (local.get $nextk) ) (local.set $mine (call $dequeue-mb)) (local.set $nextk (call $dequeue-k)) (br $l) ) ;; $on_recv (result (ref $i-cont)) - (let (local $ik (ref $i-cont)) - ;; block this thread until the mailbox is non-empty - (if (call $empty-mb (local.get $mine)) - (then (call $enqueue-mb (local.get $mine)) - (call $enqueue-k (call $recv-again (local.get $ik))) - (local.set $mine (call $dequeue-mb)) - (local.set $nextk (call $dequeue-k)) - (br $l)) - ) - (local.set $nextk (cont.bind (type $cont) (call $recv-from-mb (local.get $mine)) (local.get $ik))) + (local.set $ik) + ;; block this thread until the mailbox is non-empty + (if (call $empty-mb (local.get $mine)) + (then (call $enqueue-mb (local.get $mine)) + (call $enqueue-k (call $recv-again (local.get $ik))) + (local.set $mine (call $dequeue-mb)) + (local.set $nextk (call $dequeue-k)) + (br $l)) ) + (local.set $nextk (cont.bind $i-cont $cont (call $recv-from-mb (local.get $mine)) (local.get $ik))) (br $l) ) ;; $on_send (result i32 i32 (ref $cont)) - (let (param i32 i32) (local $k (ref $cont)) - (call $send-to-mb) - (local.set $nextk (local.get $k)) - ) + (local.set $k) + (call $send-to-mb) + (local.set $nextk (local.get $k)) (br $l) ) ;; $on_spawn (result (ref $cont) (ref $i-cont)) - (let (local $you (ref $cont)) (local $ik (ref $i-cont)) - (call $new-mb) - (let (local $yours i32) - (call $enqueue-mb (local.get $yours)) - (call $enqueue-k (local.get $you)) - (local.set $nextk (cont.bind (type $cont) (local.get $yours) (local.get $ik))) - ) - ) + (local.set $ik) + (local.set $you) + (call $new-mb) + (local.set $yours) + (call $enqueue-mb (local.get $yours)) + (call $enqueue-k (local.get $you)) + (local.set $nextk (cont.bind $i-cont $cont (local.get $yours) (local.get $ik))) (br $l) ) ;; $on_self (result (ref $i-cont)) - (let (local $ik (ref $i-cont)) - (local.set $nextk (cont.bind (type $cont) (local.get $mine) (local.get $ik))) - ) + (local.set $ik) + (local.set $nextk (cont.bind $i-cont $cont (local.get $mine) (local.get $ik))) (br $l) ) ) @@ -388,7 +388,7 @@ (func $chain (import "chain" "chain") (param $n i32)) (func $run-chain (export "run-chain") (param $n i32) - (call $act (cont.bind (type $cont) (local.get $n) (cont.new (type $i-cont) (ref.func $chain)))) + (call $act (cont.bind $i-cont $cont (local.get $n) (cont.new $i-cont (ref.func $chain)))) ) ) diff --git a/proposals/continuations/examples/async-await.wast b/proposals/continuations/examples/async-await.wast index 514ed4170..53570c3bc 100644 --- a/proposals/continuations/examples/async-await.wast +++ b/proposals/continuations/examples/async-await.wast @@ -72,11 +72,11 @@ (local $y i32) (call $log (i32.const -1)) - (local.set $p (suspend $async (cont.bind (type $i-cont) (i32.const 1) (i32.const 3) (cont.new (type $iii-cont) (ref.func $sum))))) + (local.set $p (suspend $async (cont.bind $iii-cont $i-cont (i32.const 1) (i32.const 3) (cont.new $iii-cont (ref.func $sum))))) (call $log (i32.const -2)) - (local.set $q (suspend $async (cont.bind (type $i-cont) (i32.const 5) (i32.const 7) (cont.new (type $iii-cont) (ref.func $sum))))) + (local.set $q (suspend $async (cont.bind $iii-cont $i-cont (i32.const 5) (i32.const 7) (cont.new $iii-cont (ref.func $sum))))) (call $log (i32.const -3)) - (local.set $r (suspend $async (cont.bind (type $i-cont) (i32.const 10) (i32.const 15) (cont.new (type $iii-cont) (ref.func $sum))))) + (local.set $r (suspend $async (cont.bind $iii-cont $i-cont (i32.const 10) (i32.const 15) (cont.new $iii-cont (ref.func $sum))))) (call $log (i32.const -4)) (local.set $x (i32.mul (suspend $await (local.get $p)) @@ -163,8 +163,8 @@ ;; a simplistic implementation of promises that assumes a maximum of ;; 1000 promises and a maximum of one observer per promise - (exception $too-many-promises) - (exception $too-many-observers) + (tag $too-many-promises) + (tag $too-many-observers) (global $num-promises (mut i32) (i32.const 0)) (global $max-promises i32 (i32.const 1000)) @@ -217,7 +217,7 @@ (if (ref.is_null (local.get $k)) (then (return (ref.null $cont))) ) - (return (cont.bind (type $cont) (local.get $v) (local.get $k))) + (return (cont.bind $i-cont $cont (local.get $v) (local.get $k))) ) ) (register "promise") @@ -254,53 +254,56 @@ (func $fulfill-promise (import "promise" "fulfill") (param $p i32) (param $v i32) (result (ref null $cont))) (func $run (export "run") (param $nextk (ref null $cont)) + (local $p i32) + (local $v i32) + (local $ik (ref $i-cont)) + (local $ak (ref $i-cont)) + (local $k (ref null $cont)) (loop $l (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fulfill (result i32 i32 (ref $cont)) (block $on_async (result (ref $i-cont) (ref $i-cont)) (block $on_await (result i32 (ref $i-cont)) - (resume (tag $yield $on_yield) - (tag $fulfill $on_fulfill) - (tag $async $on_async) - (tag $await $on_await) - (local.get $nextk) + (resume $cont (tag $yield $on_yield) + (tag $fulfill $on_fulfill) + (tag $async $on_async) + (tag $await $on_await) + (local.get $nextk) ) (local.set $nextk (call $dequeue)) (br $l) ;; thread terminated ) ;; $on_await (result i32 (ref $i-cont)) - (let (local $p i32) (local $ik (ref $i-cont)) - (if (call $promise-fulfilled (local.get $p)) - ;; if promise fulfilled then run continuation partially applied to value - (then (local.set $nextk (cont.bind (type $cont) (call $promise-value (local.get $p)) (local.get $ik)))) - ;; else add continuation to promise and run next continuation from the queue - (else (call $await-promise (local.get $p) (local.get $ik)) - (local.set $nextk (call $dequeue))) - ) + (local.set $ik) + (local.set $p) + (if (call $promise-fulfilled (local.get $p)) + ;; if promise fulfilled then run continuation partially applied to value + (then (local.set $nextk (cont.bind $i-cont $cont (call $promise-value (local.get $p)) (local.get $ik)))) + ;; else add continuation to promise and run next continuation from the queue + (else (call $await-promise (local.get $p) (local.get $ik)) + (local.set $nextk (call $dequeue))) ) (br $l) ) ;; $on_async (result (ref $i-func) (ref $i-cont)) - (let (local $ak (ref $i-cont)) (local $ik (ref $i-cont)) - ;; create new promise - (call $new-promise) - (let (local $p i32) - ;; enqueue continuation partially applied to promise - (call $enqueue (cont.bind (type $cont) (local.get $p) (local.get $ik))) - ;; run computation partially applied to promise - (local.set $nextk (cont.bind (type $cont) (local.get $p) (local.get $ak))) - ) - ) + (local.set $ik) + (local.set $ak) + ;; create new promise + (call $new-promise) + (local.set $p) + ;; enqueue continuation partially applied to promise + (call $enqueue (cont.bind $i-cont $cont (local.get $p) (local.get $ik))) + ;; run computation partially applied to promise + (local.set $nextk (cont.bind $i-cont $cont (local.get $p) (local.get $ak))) (br $l) ) ;; $on_fulfill (result i32 i32 (ref $cont)) (local.set $nextk) - (let (local $p i32) (local $v i32) - (call $fulfill-promise (local.get $p) (local.get $v)) - (let (local $k (ref null $cont)) - (if (ref.is_null (local.get $k)) - (then) - (else (call $enqueue (local.get $k))) - ) - ) + (local.set $v) + (local.set $p) + (call $fulfill-promise (local.get $p) (local.get $v)) + (local.set $k) + (if (ref.is_null (local.get $k)) + (then) + (else (call $enqueue (local.get $k))) ) (br $l) ) ;; $on_yield (result (ref $cont)) @@ -325,7 +328,7 @@ (elem declare func $run-example) (func (export "run") - (call $scheduler (cont.new (type $cont) (ref.func $run-example))) + (call $scheduler (cont.new $cont (ref.func $run-example))) ) ) diff --git a/proposals/continuations/examples/control-lwt.wast b/proposals/continuations/examples/control-lwt.wast index 1c1e6496b..d7c00cb3c 100644 --- a/proposals/continuations/examples/control-lwt.wast +++ b/proposals/continuations/examples/control-lwt.wast @@ -24,16 +24,18 @@ ;; ;; (Technically this is control0/prompt0 rather than ;; control/prompt.) - (tag $control (export "control") (param (ref $cont-func))) ;; control : ([cont ([] -> [])] -> []) -> [] + (tag $control (export "control") (param (ref $cont-cont))) ;; control : ([cont ([] -> [])] -> []) -> [] (func $prompt (export "prompt") (param $nextk (ref null $cont)) ;; prompt : cont ([] -> []) -> [] - (block $on_control (result (ref $cont-func) (ref $cont)) - (resume (tag $control $on_control) - (local.get $nextk)) + (local $h (ref $cont-cont)) + (local $k (ref $cont)) + (block $on_control (result (ref $cont-cont) (ref $cont)) + (resume $cont (tag $control $on_control) + (local.get $nextk)) (return) ) ;; $on_control (param (ref $cont-func) (ref $cont)) - (let (local $h (ref $cont-func)) (local $k (ref $cont)) - (call_ref (local.get $k) (local.get $h)) - ) + (local.set $k) + (local.set $h) + (resume $cont-cont (local.get $k) (local.get $h)) ) ) (register "control") @@ -57,44 +59,44 @@ (func $main (export "main") (param $yield (ref $func)) (param $fork (ref $cont-func)) (call $log (i32.const 0)) - (call_ref - (cont.bind (type $cont) (local.get $yield) (local.get $fork) - (cont.new (type $func-cont-func-cont) (ref.func $thread1))) + (call_ref $cont-func + (cont.bind $func-cont-func-cont $cont (local.get $yield) (local.get $fork) + (cont.new $func-cont-func-cont (ref.func $thread1))) (local.get $fork)) (call $log (i32.const 1)) - (call_ref - (cont.bind (type $cont) (local.get $yield) (local.get $fork) - (cont.new (type $func-cont-func-cont) (ref.func $thread2))) + (call_ref $cont-func + (cont.bind $func-cont-func-cont $cont (local.get $yield) (local.get $fork) + (cont.new $func-cont-func-cont (ref.func $thread2))) (local.get $fork)) (call $log (i32.const 2)) - (call_ref - (cont.bind (type $cont) (local.get $yield) (local.get $fork) - (cont.new (type $func-cont-func-cont) (ref.func $thread3))) + (call_ref $cont-func + (cont.bind $func-cont-func-cont $cont (local.get $yield) (local.get $fork) + (cont.new $func-cont-func-cont (ref.func $thread3))) (local.get $fork)) (call $log (i32.const 3)) ) (func $thread1 (param $yield (ref $func)) (param $fork (ref $cont-func)) (call $log (i32.const 10)) - (call_ref (local.get $yield)) + (call_ref $func (local.get $yield)) (call $log (i32.const 11)) - (call_ref (local.get $yield)) + (call_ref $func (local.get $yield)) (call $log (i32.const 12)) ) (func $thread2 (param $yield (ref $func)) (param $fork (ref $cont-func)) (call $log (i32.const 20)) - (call_ref (local.get $yield)) + (call_ref $func (local.get $yield)) (call $log (i32.const 21)) - (call_ref (local.get $yield)) + (call_ref $func (local.get $yield)) (call $log (i32.const 22)) ) (func $thread3 (param $yield (ref $func)) (param $fork (ref $cont-func)) (call $log (i32.const 30)) - (call_ref (local.get $yield)) + (call_ref $func (local.get $yield)) (call $log (i32.const 31)) - (call_ref (local.get $yield)) + (call_ref $func (local.get $yield)) (call $log (i32.const 32)) ) ) @@ -170,6 +172,9 @@ (type $func-cont-func-func (func (param (ref $func)) (param (ref $cont-func)))) ;; ([] -> []) -> ([cont ([] -> [])] -> []) -> [] (type $func-cont-func-cont (cont $func-cont-func-func)) ;; cont (([] -> []) -> ([cont ([] -> [])] -> []) -> []) + (type $func-cont-cont (func (param (ref $cont)) (param (ref $cont)))) + (type $cont-cont-func (cont $func-cont-cont)) + (func $log (import "spectest" "print_i32") (param i32)) ;; queue interface @@ -184,7 +189,7 @@ $fork-sync $fork-kt $fork-tk $fork-ykt $fork-ytk) ;; control/prompt interface - (tag $control (import "control" "control") (param (ref $cont-func))) ;; control : ([cont ([] -> [])] -> []) -> [] + (tag $control (import "control" "control") (param (ref $cont-cont))) ;; control : ([cont ([] -> [])] -> []) -> [] (func $prompt (import "control" "prompt") (param $nextk (ref null $cont))) ;; prompt : cont ([] -> []) -> [] ;; generic boilerplate scheduler @@ -215,18 +220,20 @@ (call $scheduler (local.get $k)) ) (func $yield-sync - (suspend $control (ref.func $handle-yield)) + (suspend $control (cont.new $cont-cont (ref.func $handle-yield))) ) (func $handle-fork-sync (param $t (ref $cont)) (param $k (ref $cont)) (call $enqueue (local.get $t)) (call $scheduler (local.get $k)) ) (func $fork-sync (param $t (ref $cont)) - (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-sync))) + (suspend $control + (cont.bind $cont-cont-func $cont-cont (local.get $t) + (cont.new $cont-cont-func (ref.func $handle-fork-sync)))) ) (func $sync (export "sync") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-sync) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-sync) (local.get $k))) ) ;; asynchronous yield (used by all asynchronous schedulers) @@ -235,7 +242,7 @@ (call $scheduler (call $dequeue)) ) (func $yield - (suspend $control (ref.func $handle-yield)) + (suspend $control (cont.new $cont-cont (ref.func $handle-yield))) ) ;; four asynchronous implementations of fork: ;; * kt and tk don't yield on encountering a fork @@ -251,11 +258,13 @@ (call $scheduler (local.get $k)) ) (func $fork-kt (param $t (ref $cont)) - (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-kt))) + (suspend $control + (cont.bind $cont-cont-func $cont-cont (local.get $t) + (cont.new $cont-cont-func (ref.func $handle-fork-kt)))) ) (func $kt (export "kt") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-kt) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-kt) (local.get $k))) ) ;; no yield on fork, new thread first @@ -264,11 +273,13 @@ (call $scheduler (local.get $t)) ) (func $fork-tk (param $t (ref $cont)) - (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-tk))) + (suspend $control + (cont.bind $cont-cont-func $cont-cont (local.get $t) + (cont.new $cont-cont-func (ref.func $handle-fork-tk)))) ) (func $tk (export "tk") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-tk) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-tk) (local.get $k))) ) ;; yield on fork, continuation first @@ -278,11 +289,13 @@ (call $scheduler (call $dequeue)) ) (func $fork-ykt (param $t (ref $cont)) - (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-ykt))) + (suspend $control + (cont.bind $cont-cont-func $cont-cont (local.get $t) + (cont.new $cont-cont-func (ref.func $handle-fork-ykt)))) ) (func $ykt (export "ykt") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-ykt) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-ykt) (local.get $k))) ) ;; yield on fork, new thread first @@ -292,11 +305,13 @@ (call $scheduler (call $dequeue)) ) (func $fork-ytk (param $t (ref $cont)) - (suspend $control (func.bind (type $cont-func) (local.get $t) (ref.func $handle-fork-ytk))) + (suspend $control + (cont.bind $cont-cont-func $cont-cont (local.get $t) + (cont.new $cont-cont-func (ref.func $handle-fork-ytk)))) ) (func $ytk (export "ytk") (param $k (ref $func-cont-func-cont)) (call $scheduler - (cont.bind (type $cont) (ref.func $yield) (ref.func $fork-ytk) (local.get $k))) + (cont.bind $func-cont-func-cont $cont (ref.func $yield) (ref.func $fork-ytk) (local.get $k))) ) ) (register "scheduler") @@ -325,15 +340,15 @@ (func $run (export "run") (call $log (i32.const -1)) - (call $scheduler-sync (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-sync (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -2)) - (call $scheduler-kt (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-kt (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -3)) - (call $scheduler-tk (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-tk (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -4)) - (call $scheduler-ykt (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-ykt (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -5)) - (call $scheduler-ytk (cont.new (type $func-cont-func-cont) (ref.func $main))) + (call $scheduler-ytk (cont.new $func-cont-func-cont (ref.func $main))) (call $log (i32.const -6)) ) ) diff --git a/proposals/continuations/examples/fun-actor-lwt.wast b/proposals/continuations/examples/fun-actor-lwt.wast index 2b1f95fd8..a9cfff911 100644 --- a/proposals/continuations/examples/fun-actor-lwt.wast +++ b/proposals/continuations/examples/fun-actor-lwt.wast @@ -45,7 +45,7 @@ (loop $l (if (i32.eqz (local.get $n)) (then (suspend $send (i32.const 42) (local.get $p))) - (else (local.set $p (suspend $spawn (cont.bind (type $cont) (local.get $p) (cont.new (type $i-cont) (ref.func $next))))) + (else (local.set $p (suspend $spawn (cont.bind $i-cont $cont (local.get $p) (cont.new $i-cont (ref.func $next))))) (local.set $n (i32.sub (local.get $n) (i32.const 1))) (br $l)) ) @@ -143,7 +143,7 @@ (if (call $queue-empty) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (tag $yield $on_yield) (tag $fork $on_fork) + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (call $dequeue) ) (br $l) ;; thread terminated @@ -169,8 +169,8 @@ ;; -1 means empty - (exception $too-many-mailboxes) - (exception $too-many-messages) + (tag $too-many-mailboxes) + (tag $too-many-messages) (memory 1) @@ -253,107 +253,101 @@ ;; resume with $ik applied to $res (func $act-res (param $mine i32) (param $res i32) (param $ik (ref $i-cont)) + (local $yours i32) + (local $k (ref $cont)) + (local $you (ref $cont)) (block $on_self (result (ref $i-cont)) (block $on_spawn (result (ref $cont) (ref $i-cont)) (block $on_send (result i32 i32 (ref $cont)) (block $on_recv (result (ref $i-cont)) ;; this should really be a tail call to the continuation ;; do we need a 'return_resume' operator? - (resume (tag $self $on_self) - (tag $spawn $on_spawn) - (tag $send $on_send) - (tag $recv $on_recv) - (local.get $res) (local.get $ik) + (resume $i-cont (tag $self $on_self) + (tag $spawn $on_spawn) + (tag $send $on_send) + (tag $recv $on_recv) + (local.get $res) (local.get $ik) ) (return) ) ;; $on_recv (result (ref $i-cont)) - (let (local $ik (ref $i-cont)) - ;; block this thread until the mailbox is non-empty - (loop $l - (if (call $empty-mb (local.get $mine)) - (then (suspend $yield) - (br $l)) - ) + (local.set $ik) + ;; block this thread until the mailbox is non-empty + (loop $l + (if (call $empty-mb (local.get $mine)) + (then (suspend $yield) + (br $l)) ) - (call $recv-from-mb (local.get $mine)) - (local.set $res) - (return_call $act-res (local.get $mine) (local.get $res) (local.get $ik))) - (unreachable) + ) + (call $recv-from-mb (local.get $mine)) + (local.set $res) + (return_call $act-res (local.get $mine) (local.get $res) (local.get $ik)) ) ;; $on_send (result i32 i32 (ref $cont)) - (let (param i32 i32) (local $k (ref $cont)) - (call $send-to-mb) - (return_call $act-nullary (local.get $mine) (local.get $k))) - (unreachable) + (local.set $k) + (call $send-to-mb) + (return_call $act-nullary (local.get $mine) (local.get $k)) ) ;; $on_spawn (result (ref $cont) (ref $i-cont)) - (let (local $you (ref $cont)) (local $ik (ref $i-cont)) - (call $new-mb) - (let (local $yours i32) - (suspend $fork (cont.bind (type $cont) - (local.get $yours) - (local.get $you) - (cont.new (type $icont-cont) (ref.func $act-nullary)))) - (return_call $act-res (local.get $mine) (local.get $yours) (local.get $ik)) - ) - ) - (unreachable) + (local.set $ik) + (local.set $you) + (call $new-mb) + (local.set $yours) + (suspend $fork (cont.bind $icont-cont $cont + (local.get $yours) + (local.get $you) + (cont.new $icont-cont (ref.func $act-nullary)))) + (return_call $act-res (local.get $mine) (local.get $yours) (local.get $ik)) ) ;; $on_self (result (ref $i-cont)) - (let (local $ik (ref $i-cont)) - (return_call $act-res (local.get $mine) (local.get $mine) (local.get $ik)) - ) - (unreachable) + (local.set $ik) + (return_call $act-res (local.get $mine) (local.get $mine) (local.get $ik)) ) ;; resume with nullary continuation (func $act-nullary (param $mine i32) (param $k (ref $cont)) (local $res i32) + (local $ik (ref $i-cont)) + (local $you (ref $cont)) + (local $yours i32) (block $on_self (result (ref $i-cont)) (block $on_spawn (result (ref $cont) (ref $i-cont)) (block $on_send (result i32 i32 (ref $cont)) (block $on_recv (result (ref $i-cont)) ;; this should really be a tail call to the continuation ;; do we need a 'return_resume' operator? - (resume (tag $self $on_self) - (tag $spawn $on_spawn) - (tag $send $on_send) - (tag $recv $on_recv) - (local.get $k) + (resume $cont (tag $self $on_self) + (tag $spawn $on_spawn) + (tag $send $on_send) + (tag $recv $on_recv) + (local.get $k) ) (return) ) ;; $on_recv (result (ref $i-cont)) - (let (local $ik (ref $i-cont)) - ;; block this thread until the mailbox is non-empty - (loop $l - (if (call $empty-mb (local.get $mine)) - (then (suspend $yield) - (br $l)) - ) + (local.set $ik) + ;; block this thread until the mailbox is non-empty + (loop $l + (if (call $empty-mb (local.get $mine)) + (then (suspend $yield) + (br $l)) ) - (call $recv-from-mb (local.get $mine)) - (local.set $res) - (return_call $act-res (local.get $mine) (local.get $res) (local.get $ik))) - (unreachable) + ) + (call $recv-from-mb (local.get $mine)) + (local.set $res) + (return_call $act-res (local.get $mine) (local.get $res) (local.get $ik)) ) ;; $on_send (result i32 i32 (ref $cont)) - (let (param i32 i32) (local $k (ref $cont)) - (call $send-to-mb) - (return_call $act-nullary (local.get $mine) (local.get $k))) - (unreachable) + (local.set $k) + (call $send-to-mb) + (return_call $act-nullary (local.get $mine) (local.get $k)) ) ;; $on_spawn (result (ref $cont) (ref $i-cont)) - (let (local $you (ref $cont)) (local $ik (ref $i-cont)) - (call $new-mb) - (let (local $yours i32) - (suspend $fork (cont.bind (type $cont) - (local.get $yours) - (local.get $you) - (cont.new (type $icont-cont) (ref.func $act-nullary)))) - (return_call $act-res (local.get $mine) (local.get $yours) (local.get $ik)) - ) - ) - (unreachable) + (local.set $ik) + (local.set $you) + (call $new-mb) + (local.set $yours) + (suspend $fork (cont.bind $icont-cont $cont + (local.get $yours) + (local.get $you) + (cont.new $icont-cont (ref.func $act-nullary)))) + (return_call $act-res (local.get $mine) (local.get $yours) (local.get $ik)) ) ;; $on_self (result (ref $i-cont)) - (let (local $ik (ref $i-cont)) - (return_call $act-res (local.get $mine) (local.get $mine) (local.get $ik)) - ) - (unreachable) + (local.set $ik) + (return_call $act-res (local.get $mine) (local.get $mine) (local.get $ik)) ) (func $act (export "act") (param $k (ref $cont)) @@ -379,7 +373,7 @@ (func $scheduler (import "scheduler" "run") (param $k (ref $cont))) (func $run-actor (export "run-actor") (param $k (ref $cont)) - (call $scheduler (cont.bind (type $cont) (local.get $k) (cont.new (type $cont-cont) (ref.func $act)))) + (call $scheduler (cont.bind $cont-cont $cont (local.get $k) (cont.new $cont-cont (ref.func $act)))) ) ) (register "actor-scheduler") @@ -397,7 +391,7 @@ (func $chain (import "chain" "chain") (param $n i32)) (func $run-chain (export "run-chain") (param $n i32) - (call $run-actor (cont.bind (type $cont) (local.get $n) (cont.new (type $i-cont) (ref.func $chain)))) + (call $run-actor (cont.bind $i-cont $cont (local.get $n) (cont.new $i-cont (ref.func $chain)))) ) ) diff --git a/proposals/continuations/examples/fun-lwt.wast b/proposals/continuations/examples/fun-lwt.wast index 0da82ee55..2b57b53df 100644 --- a/proposals/continuations/examples/fun-lwt.wast +++ b/proposals/continuations/examples/fun-lwt.wast @@ -23,11 +23,11 @@ (func $main (export "main") (call $log (i32.const 0)) - (suspend $fork (cont.new (type $cont) (ref.func $thread1))) + (suspend $fork (cont.new $cont (ref.func $thread1))) (call $log (i32.const 1)) - (suspend $fork (cont.new (type $cont) (ref.func $thread2))) + (suspend $fork (cont.new $cont (ref.func $thread2))) (call $log (i32.const 2)) - (suspend $fork (cont.new (type $cont) (ref.func $thread3))) + (suspend $fork (cont.new $cont (ref.func $thread3))) (call $log (i32.const 3)) ) @@ -132,16 +132,16 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk) ) (return_call $sync (call $dequeue)) ) ;; $on_fork (result (ref $func) (ref $cont)) - (let (param (ref $cont)) (result (ref $cont)) (local $nextk (ref $cont)) + (local.set $nextk) (call $enqueue) - (return_call $sync (local.get $nextk))) + (return_call $sync (local.get $nextk)) ) ;; $on_yield (result (ref $cont)) (return_call $sync) ) @@ -159,16 +159,16 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk) ) (return_call $tk (call $dequeue)) ) ;; $on_fork (result (ref $func) (ref $cont)) - (let (param (ref $cont)) (result (ref $cont)) (local $nextk (ref $cont)) + (local.set $nextk) (call $enqueue) - (return_call $tk (local.get $nextk))) + (return_call $tk (local.get $nextk)) ) ;; $on_yield (result (ref $cont)) (call $enqueue) (return_call $tk (call $dequeue)) @@ -179,7 +179,7 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk)) @@ -196,7 +196,7 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk) @@ -213,16 +213,16 @@ ;; yield on fork, new thread first (func $ytk (export "ytk") (param $nextk (ref null $cont)) + (local $k (ref $cont)) (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk)) + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk)) (return_call $ytk (call $dequeue)) ) ;; $on_fork (result (ref $cont) (ref $cont)) - (let (param (ref $cont)) (local $k (ref $cont)) - (call $enqueue) - (call $enqueue (local.get $k)) - ) + (local.set $k) + (call $enqueue) + (call $enqueue (local.get $k)) (return_call $ytk (call $dequeue)) ) ;; $on_yield (result (ref $cont)) (call $enqueue) @@ -250,15 +250,15 @@ (func (export "run") (call $log (i32.const -1)) - (call $scheduler-sync (cont.new (type $cont) (ref.func $main))) + (call $scheduler-sync (cont.new $cont (ref.func $main))) (call $log (i32.const -2)) - (call $scheduler-kt (cont.new (type $cont) (ref.func $main))) + (call $scheduler-kt (cont.new $cont (ref.func $main))) (call $log (i32.const -3)) - (call $schedule-tk (cont.new (type $cont) (ref.func $main))) + (call $schedule-tk (cont.new $cont (ref.func $main))) (call $log (i32.const -4)) - (call $scheduler-ykt (cont.new (type $cont) (ref.func $main))) + (call $scheduler-ykt (cont.new $cont (ref.func $main))) (call $log (i32.const -5)) - (call $scheduler-ytk (cont.new (type $cont) (ref.func $main))) + (call $scheduler-ytk (cont.new $cont (ref.func $main))) (call $log (i32.const -6)) ) ) diff --git a/proposals/continuations/examples/fun-pipes.wast b/proposals/continuations/examples/fun-pipes.wast index 55697ad21..4c4008de7 100644 --- a/proposals/continuations/examples/fun-pipes.wast +++ b/proposals/continuations/examples/fun-pipes.wast @@ -10,7 +10,7 @@ (func $piper (param $n i32) (param $p (ref $producer)) (param $c (ref $consumer)) (block $on-receive (result (ref $consumer)) - (resume (tag $receive $on-receive) (local.get $n) (local.get $c)) + (resume $consumer (tag $receive $on-receive) (local.get $n) (local.get $c)) (return) ) ;; receive (local.set $c) @@ -20,7 +20,7 @@ (func $copiper (param $c (ref $consumer)) (param $p (ref $producer)) (local $n i32) (block $on-send (result i32 (ref $producer)) - (resume (tag $send $on-send) (local.get $p)) + (resume $producer (tag $send $on-send) (local.get $p)) (return) ) ;; send (local.set $p) @@ -79,8 +79,8 @@ ) (func (export "run") (param $n i32) - (call $pipe (cont.bind (type $producer) (local.get $n) (cont.new (type $consumer) (ref.func $nats))) - (cont.new (type $consumer) (ref.func $sum)) + (call $pipe (cont.bind $consumer $producer (local.get $n) (cont.new $consumer (ref.func $nats))) + (cont.new $consumer (ref.func $sum)) ) ) ) diff --git a/proposals/continuations/examples/fun-state.wast b/proposals/continuations/examples/fun-state.wast index 23d6c62a9..440aaedfb 100644 --- a/proposals/continuations/examples/fun-state.wast +++ b/proposals/continuations/examples/fun-state.wast @@ -12,7 +12,7 @@ (func $getting (param $k (ref $gk)) (param $s i32) (result i32) (block $on_get (result (ref $gk)) (block $on_set (result i32 (ref $sk)) - (resume (tag $get $on_get) (tag $set $on_set) + (resume $gk (tag $get $on_get) (tag $set $on_set) (local.get $s) (local.get $k) ) (return) @@ -26,7 +26,7 @@ (func $setting (param $s i32) (param $k (ref $sk)) (result i32) (block $on_get (result (ref $gk)) (block $on_set (result i32 (ref $sk)) - (resume (tag $get $on_get) (tag $set $on_set) + (resume $sk (tag $get $on_get) (tag $set $on_set) (local.get $k) ) (return) @@ -54,7 +54,7 @@ (elem declare func $f) (func (export "run") (result i32) - (call $setting (i32.const 0) (cont.new (type $sk) (ref.func $f))) + (call $setting (i32.const 0) (cont.new $sk (ref.func $f))) ) ) diff --git a/proposals/continuations/examples/generators.wast b/proposals/continuations/examples/generators.wast new file mode 100644 index 000000000..a7ce4e057 --- /dev/null +++ b/proposals/continuations/examples/generators.wast @@ -0,0 +1,166 @@ +;; Generators + +;; generator interface +(module $generator + (tag $yield (export "yield") (param i32)) +) +(register "generator") + +(module $examples + (type $func (func)) + (type $cont (cont $func)) + + (tag $yield (import "generator" "yield") (param i32)) + + (func $log (import "spectest" "print_i32") (param i32)) + + ;; yields successive natural numbers + (func $naturals (export "naturals") + (local $n i32) + (loop $l + (suspend $yield (local.get $n)) + (local.set $n (i32.add (local.get $n) (i32.const 1))) + (br $l) + ) + ) + + ;; yields 1-2-3 + (func $one-two-three (export "one-two-three") + (suspend $yield (i32.const 1)) + (suspend $yield (i32.const 2)) + (suspend $yield (i32.const 3)) + ) + + ;; yields successive Fibonacci numbers + (func $fibonacci (export "fibonacci") + (local $a i32) + (local $b i32) + (local $t i32) + (local.set $b (i32.const 1)) + (loop $l + (suspend $yield (local.get $a)) + (local.set $t (local.get $a)) + (local.set $a (local.get $b)) + (local.set $b (i32.add (local.get $t) (local.get $a))) + (br $l) + ) + ) + + (func $print-first (export "print-first") (param $n i32) (param $k (ref $cont)) + (loop $l + (block $on_yield (result i32 (ref $cont)) + (if (local.get $n) + (then (resume $cont (tag $yield $on_yield) (local.get $k))) + ) + (return) + ) ;; $on_yield (result i32 (ref $cont)) + (local.set $k) + (call $log) + (local.set $n (i32.add (local.get $n) (i32.const -1))) + (br $l) + ) + (unreachable) + ) + + (func $sum-first (export "sum-first") (param $n i32) (param $k (ref $cont)) (result i32) + (local $sum i32) + (loop $l + (block $on_yield (result i32 (ref $cont)) + (if (local.get $n) + (then (resume $cont (tag $yield $on_yield) (local.get $k))) + ) + (return (local.get $sum)) + ) ;; $on_yield (result i32 (ref $cont)) + (local.set $k) + (local.set $sum (i32.add (local.get $sum))) + (local.set $n (i32.add (local.get $n) (i32.const -1))) + (br $l) + ) + (unreachable) + ) +) +(register "examples") + +;; storing generators in a global table and then accessing them through i32 handles +;; without knowledge of handlers +(module $manager + (type $func (func)) + (type $cont (cont $func)) + + (tag $yield (import "generator" "yield") (param i32)) + + (table $active 0 (ref null $cont)) + + (func $init (export "init") (param $k (ref $cont)) (result i32) + (table.grow $active (local.get $k) (i32.const 1)) + ) + + (func $next (export "next") (param $g i32) (result i32) + (local $next_k (ref $cont)) + (local $next_v i32) + (block $on_yield (result i32 (ref $cont)) + (resume $cont (tag $yield $on_yield) + (table.get $active (local.get $g)) + ) + (return (i32.const -1)) + ) ;; $on_yield (result i32 (ref $cont)) + (local.set $next_k) + (local.set $next_v) + (table.set (local.get $g) (local.get $next_k)) + (return (local.get $next_v)) + ) +) +(register "manager") + +(module + (type $func (func)) + (type $cont (cont $func)) + + (elem declare func $naturals $fibonacci $one-two-three) + + (func $log (import "spectest" "print_i32") (param i32)) + (func $naturals (import "examples" "naturals")) + (func $fibonacci (import "examples" "fibonacci")) + (func $one-two-three (import "examples" "one-two-three")) + (func $print-first (import "examples" "print-first") (param $n i32) (param $k (ref $cont))) + (func $sum-first (import "examples" "sum-first") (param $n i32) (param $k (ref $cont)) (result i32)) + (func $init (import "manager" "init") (param $k (ref $cont)) (result i32)) + (func $next (import "manager" "next") (param i32) (result i32)) + + (func $print-with-next (param $n i32) (param $gen i32) + (loop $l + (if (i32.eqz (local.get $n)) (then (return))) + (call $next (local.get $gen)) + (call $log) + (local.set $n (i32.add (local.get $n) (i32.const -1))) + (br $l) + ) + ) + + (func $interleave-naturals-and-fib + (local $gen1 i32) + (local $gen2 i32) + (local.set $gen1 (call $init (cont.new $cont (ref.func $naturals)))) + (local.set $gen2 (call $init (cont.new $cont (ref.func $fibonacci)))) + (call $print-with-next (i32.const 5) (local.get $gen1)) + (call $print-with-next (i32.const 5) (local.get $gen2)) + (call $print-with-next (i32.const 5) (local.get $gen1)) + (call $print-with-next (i32.const 5) (local.get $gen2)) + (call $print-with-next (i32.const 5) (local.get $gen1)) + (call $print-with-next (i32.const 5) (local.get $gen2)) + (call $print-with-next (i32.const 5) (local.get $gen1)) + (call $print-with-next (i32.const 5) (local.get $gen2)) + ) + + (func $main (export "main") + (call $interleave-naturals-and-fib) + (call $print-first (i32.const 42) (cont.new $cont (ref.func $naturals))) + (call $print-first (i32.const 42) (cont.new $cont (ref.func $fibonacci))) + (call $sum-first (i32.const 101) (cont.new $cont (ref.func $naturals))) + (call $log) + (call $sum-first (i32.const 10) (cont.new $cont (ref.func $one-two-three))) + (call $log) + ) +) + +(invoke "main") diff --git a/proposals/continuations/examples/lwt.wast b/proposals/continuations/examples/lwt.wast index 6a5955a58..65232d5bc 100644 --- a/proposals/continuations/examples/lwt.wast +++ b/proposals/continuations/examples/lwt.wast @@ -23,11 +23,11 @@ (func $main (export "main") (call $log (i32.const 0)) - (suspend $fork (cont.new (type $cont) (ref.func $thread1))) + (suspend $fork (cont.new $cont (ref.func $thread1))) (call $log (i32.const 1)) - (suspend $fork (cont.new (type $cont) (ref.func $thread2))) + (suspend $fork (cont.new $cont (ref.func $thread2))) (call $log (i32.const 2)) - (suspend $fork (cont.new (type $cont) (ref.func $thread3))) + (suspend $fork (cont.new $cont (ref.func $thread3))) (call $log (i32.const 3)) ) @@ -134,7 +134,7 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk) @@ -165,7 +165,7 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk) @@ -189,7 +189,7 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk) @@ -213,7 +213,7 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk) @@ -238,7 +238,7 @@ (if (ref.is_null (local.get $nextk)) (then (return))) (block $on_yield (result (ref $cont)) (block $on_fork (result (ref $cont) (ref $cont)) - (resume + (resume $cont (tag $yield $on_yield) (tag $fork $on_fork) (local.get $nextk) @@ -278,15 +278,15 @@ (func (export "run") (call $log (i32.const -1)) - (call $scheduler-sync (cont.new (type $cont) (ref.func $main))) + (call $scheduler-sync (cont.new $cont (ref.func $main))) (call $log (i32.const -2)) - (call $scheduler-kt (cont.new (type $cont) (ref.func $main))) + (call $scheduler-kt (cont.new $cont (ref.func $main))) (call $log (i32.const -3)) - (call $schedule-tk (cont.new (type $cont) (ref.func $main))) + (call $schedule-tk (cont.new $cont (ref.func $main))) (call $log (i32.const -4)) - (call $scheduler-ykt (cont.new (type $cont) (ref.func $main))) + (call $scheduler-ykt (cont.new $cont (ref.func $main))) (call $log (i32.const -5)) - (call $scheduler-ytk (cont.new (type $cont) (ref.func $main))) + (call $scheduler-ytk (cont.new $cont (ref.func $main))) (call $log (i32.const -6)) ) ) diff --git a/proposals/continuations/examples/pipes.wast b/proposals/continuations/examples/pipes.wast index 573b9491a..e35817856 100644 --- a/proposals/continuations/examples/pipes.wast +++ b/proposals/continuations/examples/pipes.wast @@ -19,7 +19,7 @@ (if (local.get $consuming) (then (block $on-receive (result (ref $consumer)) - (resume (tag $receive $on-receive) (local.get $n) (local.get $c)) + (resume $consumer (tag $receive $on-receive) (local.get $n) (local.get $c)) (return) ) ;; receive (local.set $c) @@ -28,7 +28,7 @@ ) ) ;; else producing (block $on-send (result i32 (ref $producer)) - (resume (tag $send $on-send) (local.get $p)) + (resume $producer (tag $send $on-send) (local.get $p)) (return) ) ;; send (local.set $p) @@ -86,8 +86,8 @@ ) (func (export "run") (param $n i32) - (call $pipe (cont.bind (type $producer) (local.get $n) (cont.new (type $consumer) (ref.func $nats))) - (cont.new (type $consumer) (ref.func $sum)) + (call $pipe (cont.bind $consumer $producer (local.get $n) (cont.new $consumer (ref.func $nats))) + (cont.new $consumer (ref.func $sum)) ) ) ) diff --git a/proposals/continuations/examples/static-lwt.wast b/proposals/continuations/examples/static-lwt.wast index 0bd0b376b..22bd0f34d 100644 --- a/proposals/continuations/examples/static-lwt.wast +++ b/proposals/continuations/examples/static-lwt.wast @@ -110,8 +110,8 @@ (loop $l (if (call $queue-empty) (then (return))) (block $on_yield (result (ref $cont)) - (resume (tag $yield $on_yield) - (call $dequeue) + (resume $cont (tag $yield $on_yield) + (call $dequeue) ) (br $l) ;; thread terminated ) ;; $on_yield (result (ref $cont)) @@ -138,9 +138,9 @@ (elem declare func $thread1 $thread2 $thread3) (func (export "run") - (call $enqueue (cont.new (type $cont) (ref.func $thread1))) - (call $enqueue (cont.new (type $cont) (ref.func $thread2))) - (call $enqueue (cont.new (type $cont) (ref.func $thread3))) + (call $enqueue (cont.new $cont (ref.func $thread1))) + (call $enqueue (cont.new $cont (ref.func $thread2))) + (call $enqueue (cont.new $cont (ref.func $thread3))) (call $log (i32.const -1)) (call $scheduler)