Implement 1a (WebAssembly#63)

interpreter/binary/decode.ml

@@ -323,14 +323,7 @@ let rec instr s =
 
   | 0x16 as b -> illegal s pos b
 
-  | 0x17 ->
-    let bt = block_type s in
-    let locs = locals s in
-    let es = instr_block s in
-    end_ s;
-    let_ bt locs es
-
-  | 0x18 | 0x19 as b -> illegal s pos b
+  | 0x17 | 0x18 | 0x19 as b -> illegal s pos b
 
   | 0x1a -> drop
   | 0x1b -> select None

interpreter/binary/encode.ml

@@ -189,8 +189,6 @@ struct
       op 0x04; block_type bt; list instr es1;
       if es2 <> [] then op 0x05;
       list instr es2; end_ ()
-    | Let (bt, locs, es) ->
-      op 0x17; block_type bt; locals locs; list instr es; end_ ()
 
     | Br x -> op 0x0c; var x
     | BrIf x -> op 0x0d; var x

interpreter/exec/eval.ml

@@ -49,7 +49,7 @@ type 'a stack = 'a list
 type frame =
 {
   inst : module_inst;
-  locals : value ref list;
+  locals : value option ref list;
 }
 
 type code = value stack * admin_instr list
@@ -64,7 +64,6 @@ and admin_instr' =
   | 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
 
 type config =
@@ -74,8 +73,8 @@ type config =
   budget : int;  (* to model stack overflow *)
 }
 
-let frame inst = {inst; locals = []}
-let config inst vs es = {frame = frame inst; code = vs, es; budget = 300}
+let frame inst locals = {inst; locals}
+let config inst vs es = {frame = frame inst []; code = vs, es; budget = 300}
 
 let plain e = Plain e.it @@ e.at
 
@@ -184,16 +183,6 @@ let rec step (c : config) : config =
         else
           vs', [Plain (Block (bt, es1)) @@ e.at]
 
-      | Let (bt, locals, es'), vs ->
-        let vs0, 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])
-          ) @@ e.at
-        ]
-
       | Br x, vs ->
         [], [Breaking (x.it, vs) @@ e.at]
 
@@ -266,14 +255,19 @@ let rec step (c : config) : config =
           v1 :: vs', []
 
       | LocalGet x, vs ->
-        !(local c.frame x) :: vs, []
+        (match !(local c.frame x) with
+        | Some v ->
+          v :: vs, []
+        | None ->
+          Crash.error e.at "read of uninitialized local"
+        )
 
       | LocalSet x, v :: vs' ->
-        local c.frame x := v;
+        local c.frame x := Some v;
         vs', []
 
       | LocalTee x, v :: vs' ->
-        local c.frame x := v;
+        local c.frame x := Some v;
         v :: vs', []
 
       | GlobalGet x, vs ->
@@ -676,18 +670,6 @@ let rec step (c : config) : config =
       let c' = step {c with code = code'} in
       vs, [Label (n, es0, c'.code) @@ e.at]
 
-    | Local (n, vs0, (vs', [])), vs ->
-      vs' @ vs, []
-
-    | Local (n, vs0, (vs', e' :: es')), vs when is_jumping e' ->
-      vs' @ vs, [e']
-
-    | 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
-      vs, [Local (n, vs0', c'.code) @@ e.at]
-
     | Frame (n, frame', (vs', [])), vs ->
       vs' @ vs, []
 
@@ -710,17 +692,17 @@ let rec step (c : config) : config =
 
     | Invoke f, vs ->
       let FuncType (ts1, ts2) = Func.type_of f in
-      let args, vs' = split (List.length ts1) vs e.at in
+      let n1, n2 = List.length ts1, List.length ts2 in
+      let args, vs' = split n1 vs e.at in
       (match f with
       | Func.AstFunc (_, inst', func) ->
         let {locals; body; _} = func.it in
         let m = Lib.Promise.value inst' in
         let ts = List.map (fun t -> Types.sem_value_type m.types t.it) locals in
-        let vs0 = List.rev args @ List.map default_value ts in
-        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]
+        let locals' = List.(rev (map Option.some args) @ map default_value ts) in
+        let frame' = {inst = m; locals = List.map ref locals'} in
+        let instr' = [Label (n2, [], ([], List.map plain body)) @@ func.at] in
+        vs', [Frame (n2, frame', ([], instr')) @@ e.at]
 
       | Func.HostFunc (_, f) ->
         (try List.rev (f (List.rev args)) @ vs', []

interpreter/host/spectest.ml

@@ -29,10 +29,10 @@ let print_value v =
   Printf.printf "%s : %s\n"
     (string_of_value v) (string_of_value_type (type_of_value v))
 
-let print (FuncType (_, out)) vs =
+let print _ vs =
   List.iter print_value vs;
   flush_all ();
-  List.map default_value out
+  []
 
 
 let lookup name t =

interpreter/runtime/value.ml

@@ -133,22 +133,22 @@ let eq v1 v2 =
 (* Defaults *)
 
 let default_num = function
-  | I32Type -> I32 I32.zero
-  | I64Type -> I64 I64.zero
-  | F32Type -> F32 F32.zero
-  | F64Type -> F64 F64.zero
+  | I32Type -> Some (Num (I32 I32.zero))
+  | I64Type -> Some (Num (I64 I64.zero))
+  | F32Type -> Some (Num (F32 F32.zero))
+  | F64Type -> Some (Num (F64 F64.zero))
 
 let default_vec = function
-  | V128Type -> V128 V128.zero
+  | V128Type -> Some (Vec (V128 V128.zero))
 
 let default_ref = function
-  | (Nullable, t) -> NullRef t
-  | (NonNullable, _) -> assert false
+  | (Nullable, t) -> Some (Ref (NullRef t))
+  | (NonNullable, _) -> None
 
 let default_value = function
-  | NumType t' -> Num (default_num t')
-  | VecType t' -> Vec (default_vec t')
-  | RefType t' -> Ref (default_ref t')
+  | NumType t' -> default_num t'
+  | VecType t' -> default_vec t'
+  | RefType t' -> default_ref t'
   | BotType -> assert false
 
 

interpreter/syntax/ast.ml

@@ -148,7 +148,6 @@ and instr' =
   | Block of block_type * instr list  (* execute in sequence *)
   | 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 *)
   | Br of idx                         (* break to n-th surrounding label *)
   | BrIf of idx                       (* conditional break *)
   | BrTable of idx list * idx         (* indexed break *)

interpreter/syntax/free.ml

@@ -108,9 +108,6 @@ let rec instr (e : instr) =
   | Const _ | Test _ | Compare _ | Unary _ | Binary _ | Convert _ -> empty
   | Block (bt, es) | Loop (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}
   | Br x | BrIf x | BrOnNull x | BrOnNonNull x -> labels (idx x)
   | BrTable (xs, x) -> list (fun x -> labels (idx x)) (x::xs)
   | Return | CallRef | ReturnCallRef -> empty

interpreter/syntax/operators.ml

@@ -21,7 +21,6 @@ let select t = Select t
 let block bt es = Block (bt, es)
 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 br x = Br x
 let br_if x = BrIf x

interpreter/syntax/types.ml

@@ -1,11 +1,14 @@
 (* Types *)
 
-type name = int list
+type type_idx = int32
+type local_idx = int32
+type name = Utf8.unicode
 
-and syn_var = int32
+and syn_var = type_idx
 and sem_var = def_type Lib.Promise.t
 and var = SynVar of syn_var | SemVar of sem_var
 
+and init = Initialized | Uninitialized
 and nullability = NonNullable | Nullable
 and num_type = I32Type | I64Type | F32Type | F64Type
 and vec_type = V128Type
@@ -16,6 +19,7 @@ and value_type =
   NumType of num_type | VecType of vec_type | RefType of ref_type | BotType
 
 and result_type = value_type list
+and instr_type = result_type * result_type * local_idx list
 and func_type = FuncType of result_type * result_type
 and def_type = FuncDefType of func_type
 
@@ -24,6 +28,7 @@ type mutability = Immutable | Mutable
 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 local_type = LocalType of value_type * init
 type extern_type =
   | ExternFuncType of func_type
   | ExternTableType of table_type
@@ -207,10 +212,12 @@ let string_of_name n =
   List.iter escape n;
   Buffer.contents b
 
+let string_of_idx x = I32.to_string_u x
+
 let rec string_of_var =
   let inner = ref false in
   function
-  | SynVar x -> I32.to_string_u x
+  | SynVar x -> string_of_idx x
   | SemVar x ->
     if !inner then "..." else
     ( inner := true;

interpreter/text/arrange.ml

@@ -448,9 +448,6 @@ let rec instr e =
     | If (bt, es1, es2) ->
       "if", block_type bt @
         [Node ("then", list instr es1); Node ("else", list instr es2)]
-    | Let (bt, locals, es) ->
-      "let", block_type bt @ decls "local" (List.map Source.it locals) @
-        list instr es
     | Br x -> "br " ^ var x, []
     | BrIf x -> "br_if " ^ var x, []
     | BrTable (xs, x) ->

interpreter/text/parser.mly

@@ -142,19 +142,6 @@ let force_locals (c : context) =
   List.fold_right Stdlib.(@@) !(c.deferred_locals) ();
   c.deferred_locals := []
 
-let merge_locals (c : context) (c' : context) at =
-  force_locals c';  (* check that there aren't too many locals locally *)
-  if VarMap.is_empty c'.locals.map then
-    defer_locals c (fun () -> bind "local" c.locals c'.locals.count at)
-  else
-  (
-    force_locals c;
-    let n = c.locals.count in
-    ignore (bind "local" c.locals c'.locals.count at);
-    c.locals.map <- VarMap.union (fun x i1 i2 -> Some i1)
-      c.locals.map (scoped "local" n c'.locals at).map
-  )
-
 
 let lookup category space x =
   try VarMap.find x.it space.map
@@ -241,7 +228,7 @@ let inline_func_type_explicit (c : context) x ft at =
 %token NAT INT FLOAT STRING VAR
 %token NUM_TYPE VEC_TYPE VEC_SHAPE FUNCREF EXTERNREF REF EXTERN NULL MUT
 %token UNREACHABLE NOP DROP SELECT
-%token BLOCK END IF THEN ELSE LOOP LET
+%token BLOCK END IF THEN ELSE LOOP
 %token BR BR_IF BR_TABLE BR_ON_NULL BR_ON_NON_NULL
 %token CALL CALL_REF CALL_INDIRECT RETURN RETURN_CALL_REF
 %token LOCAL_GET LOCAL_SET LOCAL_TEE GLOBAL_GET GLOBAL_SET
@@ -618,10 +605,6 @@ block_instr :
   | IF labeling_opt block ELSE labeling_end_opt instr_list END labeling_end_opt
     { fun c -> let c' = $2 c ($5 @ $8) in
       let ts, es1 = $3 c' in if_ ts es1 ($6 c') }
-  | LET labeling_opt let_block END labeling_end_opt
-    { 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 }
 
 block :
   | type_use block_param_body
@@ -653,59 +636,6 @@ block_result_body :
       FuncType (ins, snd $3 c @ out), es }
 
 
-let_block :
-  | type_use let_block_param_body
-    { let at = at () in
-      fun c c' -> let ft, ls, es = $2 c c' in
-      let x = inline_func_type_explicit c ($1 c type_) ft at in
-      VarBlockType (SynVar x.it), ls, es }
-  | let_block_param_body  /* Sugar */
-    { let at = at () in
-      fun c c' -> let ft, ls, es = $1 c c' in
-      let bt =
-        match ft with
-        | FuncType ([], []) -> ValBlockType None
-        | FuncType ([], [t]) -> ValBlockType (Some t)
-        | ft ->  VarBlockType (SynVar (inline_func_type c ft at).it)
-      in bt, ls, es }
-
-let_block_param_body :
-  | let_block_result_body { $1 }
-  | LPAR PARAM value_type_list RPAR let_block_param_body
-    { fun c c' ->
-      let FuncType (ins, out), ls, es = $5 c c' in
-      FuncType (snd $3 c @ ins, out), ls, es }
-
-let_block_result_body :
-  | let_block_local_body
-    { let at = at () in
-      fun c c' -> let ls, es = $1 c c' at in FuncType ([], []), ls, es }
-  | LPAR RESULT value_type_list RPAR let_block_result_body
-    { fun c c' ->
-      let FuncType (ins, out), ls, es = $5 c c' in
-      FuncType (ins, snd $3 c @ out), ls, es }
-
-let_block_local_body :
-  | instr_list
-    { fun c c' at -> merge_locals c' c at; [], $1 c' }
-  | LPAR LOCAL local_type_list RPAR let_block_local_body
-    { let at3 = ati 3 in let at4 = ati 4 in
-      fun c c' at -> ignore (anon_locals c' (fst $3) at3);
-      let at' = {left = at.left; right = at4.right} in
-      let ls, es = $5 c c' at' in snd $3 c @ ls, es }
-  | LPAR LOCAL bind_var local_type RPAR let_block_local_body  /* Sugar */
-    { let at5 = ati 5 in
-      fun c c' at -> ignore (bind_local c' $3);
-      let at' = {left = at.left; right = at5.right} in
-      let ls, es = $6 c c' at' in $4 c :: ls, es }
-
-local_type :
-  | value_type { let at = at () in fun c -> $1 c @@ at }
-
-local_type_list :
-  | /* empty */ { 0l, fun c -> [] }
-  | local_type local_type_list { I32.add (fst $2) 1l, fun c -> $1 c :: snd $2 c }
-
 expr :  /* Sugar */
   | LPAR expr1 RPAR
     { let at = at () in fun c -> let es, e' = $2 c in es @ [e' @@ at] }
@@ -726,10 +656,6 @@ expr1 :  /* Sugar */
   | IF labeling_opt if_block
     { fun c -> let c' = $2 c [] in
       let bt, (es, es1, es2) = $3 c c' in es, if_ bt es1 es2 }
-  | LET labeling_opt let_block
-    { 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 }
 
 select_expr_results :
   | LPAR RESULT value_type_list RPAR select_expr_results
@@ -893,6 +819,13 @@ func_body :
     { fun c -> ignore (bind_local c $3); let f = $6 c in
       {f with locals = $4 c :: f.locals} }
 
+local_type :
+  | value_type { let at = at () in fun c -> $1 c @@ at }
+
+local_type_list :
+  | /* empty */ { 0l, fun c -> [] }
+  | local_type local_type_list { I32.add (fst $2) 1l, fun c -> $1 c :: snd $2 c }
+
 
 /* Tables, Memories & Globals */