Skip to content

Commit

Permalink
Explainer document (WebAssembly#14)
Browse files Browse the repository at this point in the history
Add explainer document for Typed Continuations proposal.

Co-authored-by: Sam Lindley <Sam.Lindley@ed.ac.uk>
Co-authored-by: Andreas Rossberg <rossberg@chromium.org>
  • Loading branch information
3 people authored Dec 14, 2021
1 parent 5cb386e commit 6b6f0e3
Show file tree
Hide file tree
Showing 32 changed files with 2,855 additions and 563 deletions.
26 changes: 13 additions & 13 deletions interpreter/binary/decode.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -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 =
Expand Down Expand Up @@ -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 *)
Expand All @@ -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 =
Expand Down Expand Up @@ -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;
Expand All @@ -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)
Expand Down
22 changes: 11 additions & 11 deletions interpreter/binary/encode.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 *)

Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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 =
Expand All @@ -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
Expand Down Expand Up @@ -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;
Expand Down
74 changes: 37 additions & 37 deletions interpreter/exec/eval.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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]
Expand Down Expand Up @@ -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]
Expand All @@ -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]
Expand All @@ -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;
Expand Down Expand Up @@ -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]
Expand All @@ -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']
Expand All @@ -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, []
Expand Down Expand Up @@ -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]
Expand All @@ -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']
Expand Down Expand Up @@ -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
Expand Down Expand Up @@ -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
Expand All @@ -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 =
Expand Down Expand Up @@ -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) =
Expand Down Expand Up @@ -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
Expand All @@ -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 =
Expand Down
8 changes: 4 additions & 4 deletions interpreter/host/spectest.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down Expand Up @@ -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
10 changes: 0 additions & 10 deletions interpreter/runtime/event.ml

This file was deleted.

7 changes: 0 additions & 7 deletions interpreter/runtime/event.mli

This file was deleted.

Loading

0 comments on commit 6b6f0e3

Please sign in to comment.