Merge pull request #163 from WebAssembly/control

Implement changes to control flow operators

ml-proto/README.md

@@ -82,24 +82,11 @@ Note however that the REPL currently is too dumb to allow multi-line input. :)
 See `wasm -h` for (the few) options.
 
 
-## Language
-
-For most part, the language understood by the interpreter is based on Ben's V8 prototype, but I took the liberty to try out a few simplifications and generalisations:
-
-* *Expression Language.* There is no distinction between statements and expressions, everything is an expression. Some have an empty return type. Consequently, there is no need for a comma operator or ternary operator.
-
-* *Simple Loops*. Like in Ben's prototype, there is only one sort of loop, the infinite one, which can only be terminated by an explicit `break`. In such a language, a `continue` statement actually is completely redundant, because it equivalent to a `break` to a label on the loop's *body*. So I dropped `continue`.
-
-* *Break with Arguments.* In the spirit of a true expression language, `break` can carry arguments, which then become the result of the labelled expression it cuts to.
-
-* *Switch with Explicit Fallthru*. By default, a switch arm is well-behaved in that it does *not* fall through to the next case. However, it can be marked as fallthru explicitly.
-
-
 ## Core Language vs External Language
 
 The implementation tries to separate the concern of what is the language (and its semantics) from what is its external encoding. In that spirit, the actual AST is regular and minimal, while certain abbreviations are considered "syntactic sugar" of an external representation optimised for compactness.
 
-For example, `if` always has an else-branch in the AST, but in the external format an else-less conditional is allowed as an abbreviation for one with `nop`. Similarly, blocks can sometimes be left implicit in sub-expressions. Furthermore, fallthru is a flag on each `switch` arm in the AST, but an explicit "opcode" in the external form.
+For example, `if` always has an else-branch in the AST, but in the external format an else-less conditional is allowed as an abbreviation for one with `nop`. Similarly, blocks can sometimes be left implicit in sub-expressions.
 
 Here, the external format is S-expressions, but similar considerations would apply to a binary encoding. That is, there would be codes for certain abbreviations, but these are just a matter of the encoding.
 
@@ -132,18 +119,19 @@ expr:
   ( nop )
   ( block <expr>+ )
   ( block <var> <expr>+ )                        ;; = (label <var> (block <expr>+))
-  ( if <expr> <expr> <expr> )
-  ( if <expr> <expr> )                           ;; = (if <expr> <expr> (nop))
-  ( loop <expr>* )                               ;; = (loop (block <expr>*))
-  ( loop <var> <var>? <expr>* )                  ;; = (label <var> (loop (block <var>? <expr>*)))
+  ( if_else <expr> <expr> <expr> )
+  ( if <expr> <expr> )                           ;; = (if_else <expr> <expr> (nop))
+  ( br_if <expr> <var> )                         ;; = (if_else <expr> (br <var>) (nop))
+  ( loop <var>? <expr>* )                        ;; = (loop <var>? (block <expr>*))
+  ( loop <var> <var> <expr>* )                   ;; = (label <var> (loop <var> (block <expr>*)))
   ( label <var>? <expr> )
-  ( break <var> <expr>? )
-  ( <type>.switch <expr> <case>* <expr> )
-  ( <type>.switch <var> <expr> <case>* <expr> )  ;; = (label <var> (<type>.switch <expr> <case>* <expr>))
+  ( br <var> <expr>? )
+  ( return <expr>? )                             ;; = (br <current_depth> <expr>?)
+  ( tableswitch <expr> <switch> <target> <case>* )
+  ( tableswitch <var> <expr> <switch> <target> <case>* )  ;; = (label <var> (tableswitch <expr> <switch> <target> <case>*))
   ( call <var> <expr>* )
   ( call_import <var> <expr>* )
   ( call_indirect <var> <expr> <expr>* )
-  ( return <expr>? )                             ;; = (break <current_depth> <expr>?)
   ( get_local <var> )
   ( set_local <var> <expr> )
   ( <type>.load((8|16)_<sign>)? <offset>? <align>? <expr> )
@@ -157,9 +145,15 @@ expr:
   ( memory_size )
   ( grow_memory <expr> )
 
+switch:
+  ( table <target>* )
+
+target:
+  ( case <var> )
+  ( br <var> )                                   ;; = (case <var'>) with (case <var'> (br <var>))
+
 case:
-  ( case <value> <expr>* fallthrough? )  ;; = (case <int> (block <expr>*) fallthrough?)
-  ( case <value> )                       ;; = (case <int> (nop) fallthrough)
+  ( case <var>? <expr>* )                        ;; = (case <var>? (block <expr>*))
 
 func:   ( func <name>? <type>? <param>* <result>? <local>* <expr>* )
 type:   ( type <var> )
@@ -225,7 +219,7 @@ The implementation consists of the following parts:
 
 * *Validator* (`check.ml[i]`). Does a recursive walk of the AST, passing down the *expected* type for expressions (or rather, a list thereof, because of multi-values), and checking each expression against that. An expected empty list of types can be matched by any result, corresponding to implicit dropping of unused values (e.g. in a block).
 
-* *Evaluator* (`eval.ml[i]`, `values.ml`, `arithmetic.ml[i]`, `memory.ml[i]`). Evaluation of control transfer (`break` and `return`) is implemented using local exceptions as "labels". While these are allocated dynamically in the code and addressed via a stack, that is merely to simplify the code. In reality, these would be static jumps.
+* *Evaluator* (`eval.ml[i]`, `values.ml`, `arithmetic.ml[i]`, `memory.ml[i]`). Evaluation of control transfer (`br` and `return`) is implemented using local exceptions as "labels". While these are allocated dynamically in the code and addressed via a stack, that is merely to simplify the code. In reality, these would be static jumps.
 
 * *Driver* (`main.ml`, `script.ml[i]`, `error.ml`, `print.ml[i]`, `flags.ml`). Executes scripts, reports results or errors, etc.
 

ml-proto/host/lexer.mll

@@ -134,11 +134,13 @@ rule token = parse
   | "nop" { NOP }
   | "block" { BLOCK }
   | "if" { IF }
+  | "if_else" { IF_ELSE }
   | "loop" { LOOP }
   | "label" { LABEL }
-  | "break" { BREAK }
+  | "br" { BR }
+  | "br_if" { BR_IF }
+  | "tableswitch" { TABLESWITCH }
   | "case" { CASE }
-  | "fallthrough" { FALLTHROUGH }
   | "call" { CALL }
   | "call_import" { CALL_IMPORT }
   | "call_indirect" { CALL_INDIRECT }
@@ -158,7 +160,6 @@ rule token = parse
   | "offset="(digits as s) { OFFSET (Int64.of_string s) }
   | "align="(digits as s) { ALIGN (int_of_string s) }
 
-  | (nxx as t)".switch" { SWITCH (value_type t) }
   | (nxx as t)".const" { CONST (value_type t) }
 
   | (ixx as t)".clz" { UNARY (intop t Int32Op.Clz Int64Op.Clz) }

ml-proto/host/parser.mly

@@ -80,16 +80,19 @@ let empty_types () = {tmap = VarMap.empty; tlist = []}
 
 type context =
   {types : types; funcs : space; imports : space; locals : space;
-   labels : int VarMap.t}
+   labels : int VarMap.t; cases : space}
 
-let c0 () =
+let empty_context () =
   {types = empty_types (); funcs = empty (); imports = empty ();
-   locals = empty (); labels = VarMap.empty}
+   locals = empty (); labels = VarMap.empty; cases = empty ()}
 
 let enter_func c =
   assert (VarMap.is_empty c.labels);
   {c with labels = VarMap.add "return" 0 c.labels; locals = empty ()}
 
+let enter_switch c =
+  {c with cases = empty ()}
+
 let type_ c x =
   try VarMap.find x.it c.types.tmap
   with Not_found -> error x.at ("unknown type " ^ x.it)
@@ -101,6 +104,7 @@ let lookup category space x =
 let func c x = lookup "function" c.funcs x
 let import c x = lookup "import" c.imports x
 let local c x = lookup "local" c.locals x
+let case c x = lookup "case" c.cases x
 let label c x =
   try VarMap.find x.it c.labels
   with Not_found -> error x.at ("unknown label " ^ x.it)
@@ -120,6 +124,7 @@ let bind category space x =
 let bind_func c x = bind "function" c.funcs x
 let bind_import c x = bind "import" c.imports x
 let bind_local c x = bind "local" c.locals x
+let bind_case c x = bind "case" c.cases x
 let bind_label c x =
   {c with labels = VarMap.add x.it 0 (VarMap.map ((+) 1) c.labels)}
 
@@ -131,6 +136,7 @@ let anon space n = space.count <- space.count + n
 let anon_func c = anon c.funcs 1
 let anon_import c = anon c.imports 1
 let anon_locals c ts = anon c.locals (List.length ts)
+let anon_case c = anon c.cases 1
 let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels}
 
 let empty_type = {ins = []; out = None}
@@ -153,7 +159,7 @@ let implicit_decl c t at =
 %}
 
 %token INT FLOAT TEXT VAR VALUE_TYPE LPAR RPAR
-%token NOP BLOCK IF LOOP LABEL BREAK SWITCH CASE FALLTHROUGH
+%token NOP BLOCK IF IF_ELSE LOOP LABEL BR BR_IF TABLESWITCH CASE
 %token CALL CALL_IMPORT CALL_INDIRECT RETURN
 %token GET_LOCAL SET_LOCAL LOAD STORE LOAD_EXTEND STORE_WRAP OFFSET ALIGN
 %token CONST UNARY BINARY COMPARE CONVERT
@@ -169,12 +175,11 @@ let implicit_decl c t at =
 %token<string> VAR
 %token<Types.value_type> VALUE_TYPE
 %token<Types.value_type> CONST
-%token<Types.value_type> SWITCH
 %token<Ast.unop> UNARY
 %token<Ast.binop> BINARY
+%token<Ast.selop> SELECT
 %token<Ast.relop> COMPARE
 %token<Ast.cvt> CONVERT
-%token<Ast.selectop> SELECT
 %token<Ast.memop> LOAD
 %token<Ast.memop> STORE
 %token<Ast.extop> LOAD_EXTEND
@@ -248,21 +253,25 @@ expr1 :
   | NOP { fun c -> nop }
   | BLOCK labeling expr expr_list
     { fun c -> let c', l = $2 c in block (l, $3 c' :: $4 c') }
-  | IF expr expr expr_opt { fun c -> if_ ($2 c, $3 c, $4 c) }
+  | IF_ELSE expr expr expr { fun c -> if_else ($2 c, $3 c, $4 c) }
+  | IF expr expr { fun c -> if_ ($2 c, $3 c) }
+  | BR_IF expr var { fun c -> br_if ($2 c, $3 c label) }
   | LOOP labeling labeling expr_list
     { fun c -> let c', l1 = $2 c in let c'', l2 = $3 c' in
-      loop (l1, l2, $4 c'') }
+      let c''' = if l1.it = Unlabelled then anon_label c'' else c'' in
+      loop (l1, l2, $4 c''') }
   | LABEL labeling expr
     { fun c -> let c', l = $2 c in
       let c'' = if l.it = Unlabelled then anon_label c' else c' in
       Sugar.label ($3 c'') }
-  | BREAK var expr_opt { fun c -> break ($2 c label, $3 c) }
+  | BR var expr_opt { fun c -> br ($2 c label, $3 c) }
   | RETURN expr_opt
     { let at1 = ati 1 in
       fun c -> return (label c ("return" @@ at1) @@ at1, $2 c) }
-  | SWITCH labeling expr cases
-    { fun c -> let c', l = $2 c in let cs, e = $4 c' in
-      switch (l, $1, $3 c', List.map (fun a -> a $1) cs, e) }
+  | TABLESWITCH labeling expr LPAR TABLE case_list RPAR case target_list
+    { fun c -> let c', l = $2 c in let e = $3 c' in
+      let c'' = enter_switch c' in let es = $9 c'' in
+      tableswitch (l, e, $6 c'', $8 c'', es) }
   | CALL var expr_list { fun c -> call ($2 c func, $3 c) }
   | CALL_IMPORT var expr_list { fun c -> call_import ($2 c import, $3 c) }
   | CALL_INDIRECT var expr expr_list
@@ -280,9 +289,9 @@ expr1 :
   | CONST literal { fun c -> const (literal $2 $1) }
   | UNARY expr { fun c -> unary ($1, $2 c) }
   | BINARY expr expr { fun c -> binary ($1, $2 c, $3 c) }
+  | SELECT expr expr expr { fun c -> select ($1, $2 c, $3 c, $4 c) }
   | COMPARE expr expr { fun c -> compare ($1, $2 c, $3 c) }
   | CONVERT expr { fun c -> convert ($1, $2 c) }
-  | SELECT expr expr expr { fun c -> select ($1, $2 c, $3 c, $4 c) }
   | UNREACHABLE { fun c -> unreachable }
   | PAGE_SIZE { fun c -> host (PageSize, []) }
   | MEMORY_SIZE { fun c -> host (MemorySize, []) }
@@ -298,23 +307,21 @@ expr_list :
   | expr expr_list { fun c -> $1 c :: $2 c }
 ;
 
-fallthrough :
-  | /* empty */ { false }
-  | FALLTHROUGH { true }
-;
-
 case :
-  | LPAR case1 RPAR { let at = at () in fun c t -> $2 c t @@ at }
+  | LPAR CASE var RPAR { let at = at () in fun c -> Case ($3 c case) @@ at }
+  | LPAR BR var RPAR { let at = at () in fun c -> Case_br ($3 c label) @@ at }
+;
+case_list :
+  | /* empty */ { fun c -> [] }
+  | case case_list { fun c -> $1 c :: $2 c }
 ;
-case1 :
-  | CASE literal expr expr_list fallthrough
-    { fun c t -> case (literal $2 t, Some ($3 c :: $4 c, $5)) }
-  | CASE literal
-    { fun c t -> case (literal $2 t, None) }
+target :
+  | LPAR CASE expr_list RPAR { fun c -> anon_case c; $3 c }
+  | LPAR CASE bind_var expr_list RPAR { fun c -> bind_case c $3; $4 c }
 ;
-cases :
-  | expr { fun c -> [], $1 c }
-  | case cases { fun c -> let x, y = $2 c in $1 c :: x, y }
+target_list :
+  | /* empty */ { fun c -> [] }
+  | target target_list { fun c -> let e = $1 c in let es = $2 c in e :: es }
 ;
 
 
@@ -450,7 +457,7 @@ module_fields :
       | None -> {m with memory = Some $1} }
 ;
 module_ :
-  | LPAR MODULE module_fields RPAR { $3 (c0 ()) @@ at () }
+  | LPAR MODULE module_fields RPAR { $3 (empty_context ()) @@ at () }
 ;
 
 

ml-proto/spec/ast.ml

@@ -36,22 +36,22 @@ struct
   type unop = Clz | Ctz | Popcnt
   type binop = Add | Sub | Mul | DivS | DivU | RemS | RemU
              | And | Or | Xor | Shl | ShrU | ShrS
+  type selop = Select
   type relop = Eq | Ne | LtS | LtU | LeS | LeU | GtS | GtU | GeS | GeU
   type cvt = ExtendSInt32 | ExtendUInt32 | WrapInt64
            | TruncSFloat32 | TruncUFloat32 | TruncSFloat64 | TruncUFloat64
            | ReinterpretFloat
-  type selectop = Select
 end
 
 module FloatOp () =
 struct
   type unop = Neg | Abs | Ceil | Floor | Trunc | Nearest | Sqrt
   type binop = Add | Sub | Mul | Div | CopySign | Min | Max
+  type selop = Select
   type relop = Eq | Ne | Lt | Le | Gt | Ge
   type cvt = ConvertSInt32 | ConvertUInt32 | ConvertSInt64 | ConvertUInt64
            | PromoteFloat32 | DemoteFloat64
            | ReinterpretInt
-  type selectop = Select
 end
 
 module Int32Op = IntOp ()
@@ -63,7 +63,7 @@ type unop = (Int32Op.unop, Int64Op.unop, Float32Op.unop, Float64Op.unop) op
 type binop = (Int32Op.binop, Int64Op.binop, Float32Op.binop, Float64Op.binop) op
 type relop = (Int32Op.relop, Int64Op.relop, Float32Op.relop, Float64Op.relop) op
 type cvt = (Int32Op.cvt, Int64Op.cvt, Float32Op.cvt, Float64Op.cvt) op
-type selectop = (Int32Op.selectop, Int64Op.selectop, Float32Op.selectop, Float64Op.selectop) op
+type selop = (Int32Op.selop, Int64Op.selop, Float32Op.selop, Float64Op.selop) op
 
 type memop = {ty : value_type; offset : Memory.offset; align : int option}
 type extop = {memop : memop; sz : Memory.mem_size; ext : Memory.extension}
@@ -82,38 +82,30 @@ type literal = value Source.phrase
 
 type expr = expr' Source.phrase
 and expr' =
-  | Nop                                            (* do nothing *)
-  | Block of expr list                             (* execute in sequence *)
-  | If of expr * expr * expr                       (* conditional *)
-  | Loop of expr                                   (* infinite loop *)
-  | Label of expr                                  (* labelled expression *)
-  | Break of var * expr option                     (* break to n-th surrounding label *)
-  | Switch of value_type * expr * case list * expr (* switch, latter expr is default *)
-  | Call of var * expr list                        (* call function *)
-  | CallImport of var * expr list                  (* call imported function *)
-  | CallIndirect of var * expr * expr list         (* call function through table *)
-  | GetLocal of var                                (* read local variable *)
-  | SetLocal of var * expr                         (* write local variable *)
-  | Load of memop * expr                           (* read memory at address *)
-  | Store of memop * expr * expr                   (* write memory at address *)
-  | LoadExtend of extop * expr                     (* read memory at address and extend *)
-  | StoreWrap of wrapop * expr * expr              (* wrap and write to memory at address *)
-  | Const of literal                               (* constant *)
-  | Unary of unop * expr                           (* unary arithmetic operator *)
-  | Binary of binop * expr * expr                  (* binary arithmetic operator *)
-  | Compare of relop * expr * expr                 (* arithmetic comparison *)
-  | Convert of cvt * expr                          (* conversion *)
-  | Select of selectop * expr * expr * expr        (* branchless conditional *)
+  | Nop                                     (* do nothing *)
+  | Block of expr list                      (* execute in sequence *)
+  | If of expr * expr * expr                (* conditional *)
+  | Loop of expr                            (* infinite loop *)
+  | Label of expr                           (* labelled expression *)
+  | Break of var * expr option              (* break to n-th surrounding label *)
+  | Switch of expr * var list * var * expr list   (* table switch *)
+  | Call of var * expr list                 (* call function *)
+  | CallImport of var * expr list           (* call imported function *)
+  | CallIndirect of var * expr * expr list  (* call function through table *)
+  | GetLocal of var                         (* read local variable *)
+  | SetLocal of var * expr                  (* write local variable *)
+  | Load of memop * expr                    (* read memory at address *)
+  | Store of memop * expr * expr            (* write memory at address *)
+  | LoadExtend of extop * expr              (* read memory at address and extend *)
+  | StoreWrap of wrapop * expr * expr       (* wrap and write to memory at address *)
+  | Const of literal                        (* constant *)
+  | Unary of unop * expr                    (* unary arithmetic operator *)
+  | Binary of binop * expr * expr           (* binary arithmetic operator *)
+  | Select of selop * expr * expr * expr    (* branchless conditional *)
+  | Compare of relop * expr * expr          (* arithmetic comparison *)
+  | Convert of cvt * expr                   (* conversion *)
   | Unreachable                                    (* trap *)
-  | Host of hostop * expr list                     (* host interaction *)
-
-and case = case' Source.phrase
-and case' =
-{
-  value : literal;
-  expr : expr;
-  fallthru : bool
-}
+  | Host of hostop * expr list              (* host interaction *)
 
 
 (* Functions and Modules *)