Add set action

Author: rossberg

interpreter/README.md

@@ -393,6 +393,7 @@ module:
 action:
   ( invoke <name>? <string> <arg>* )         ;; invoke function export
   ( get <name>? <string> )                   ;; get global export
+  ( set <name>? <string> <arg> )             ;; set global export
 
 arg:
   <literal>                                  ;; literal argument

interpreter/script/js.ml

@@ -296,6 +296,9 @@ let literal lit =
 let get t at =
   [], GlobalImport t @@ at, [], [GlobalGet (subject_idx @@ at) @@ at]
 
+let set t at =
+  [], GlobalImport t @@ at, [], [GlobalSet (subject_idx @@ at) @@ at]
+
 let invoke ft at =
   let FuncType (ts, _) = ft in
   [ft @@ at], FuncImport (subject_type_idx @@ at) @@ at,
@@ -583,19 +586,25 @@ let of_wrapper mods x_opt name wrap_action opds wrap_assertion at =
 let rec of_action mods act =
   match act.it with
   | Invoke (x_opt, name, args) ->
+    let opds = List.map (of_argument mods) args in
     "call(" ^ of_var_opt mods x_opt ^ ", " ^ of_name name ^ ", " ^
-      "[" ^ String.concat ", " (List.map (of_arg mods) args) ^ "].flat())",
+      "[" ^ String.concat ", " opds ^ "].flat())",
     let FuncType (_, ts2) as ft = lookup_func mods x_opt name act.at in
     if is_js_func_type ft then None else
-    let opds = List.map (of_arg mods) args in
     Some (of_wrapper mods x_opt name (invoke ft) opds, ts2)
   | Get (x_opt, name) ->
     "get(" ^ of_var_opt mods x_opt ^ ", " ^ of_name name ^ ")",
     let GlobalType (t, _) as gt = lookup_global mods x_opt name act.at in
     if is_js_global_type gt then None else
     Some (of_wrapper mods x_opt name (get gt) [], [t])
+  | Set (x_opt, name, arg) ->
+    let opd = of_argument mods arg in
+    "set(" ^ of_var_opt mods x_opt ^ ", " ^ of_name name ^ ", " ^ opd ^ ")",
+    let GlobalType (t, _) as gt = lookup_global mods x_opt name act.at in
+    if is_js_global_type gt then None else
+    Some (of_wrapper mods x_opt name (set gt) [opd], [t])
 
-and of_arg mods arg =
+and of_argument mods arg =
   match arg.it with
   | LiteralArg lit -> of_literal lit
   | ActionArg act ->

interpreter/script/run.ml

@@ -349,7 +349,7 @@ let rec run_action act : Values.value list =
     (match Instance.export inst name with
     | Some (Instance.ExternFunc f) ->
       let Types.FuncType (ts1, _) = Func.type_of f in
-      let vs = List.concat_map run_arg args in
+      let vs = List.concat_map run_argument args in
       if List.length vs <> List.length ts1 then
         Script.error act.at "wrong number of arguments";
       List.iteri (fun i (v, t) ->
@@ -360,7 +360,6 @@ let rec run_action act : Values.value list =
     | Some _ -> Assert.error act.at "export is not a function"
     | None -> Assert.error act.at "undefined export"
     )
-
  | Get (x_opt, name) ->
     trace ("Getting global \"" ^ Ast.string_of_name name ^ "\"...");
     let inst = lookup_instance x_opt act.at in
@@ -369,8 +368,21 @@ let rec run_action act : Values.value list =
     | Some _ -> Assert.error act.at "export is not a global"
     | None -> Assert.error act.at "undefined export"
     )
+ | Set (x_opt, name, arg) ->
+    trace ("Setting global \"" ^ Ast.string_of_name name ^ "\"...");
+    let inst = lookup_instance x_opt act.at in
+    let v =
+      match run_argument arg with
+      | [v] -> v
+      | _ -> Assert.error act.at "wrong number of arguments"
+    in
+    (match Instance.export inst name with
+    | Some (Instance.ExternGlobal gl) -> Global.store gl v; []
+    | Some _ -> Assert.error act.at "export is not a global"
+    | None -> Assert.error act.at "undefined export"
+    )
 
-and run_arg arg : Values.value list =
+and run_argument arg : Values.value list =
   match arg.it with
   | LiteralArg lit -> [lit.it]
   | ActionArg act -> run_action act

interpreter/script/script.ml

@@ -15,6 +15,7 @@ type action = action' Source.phrase
 and action' =
   | Invoke of var option * Ast.name * arg list
   | Get of var option * Ast.name
+  | Set of var option * Ast.name * arg
 
 and arg = arg' Source.phrase
 and arg' =

interpreter/text/arrange.ml

@@ -702,11 +702,13 @@ let access x_opt n =
 let rec action mode act =
   match act.it with
   | Invoke (x_opt, name, args) ->
-    Node ("invoke" ^ access x_opt name, List.map (arg mode) args)
+    Node ("invoke" ^ access x_opt name, List.map (argument mode) args)
   | Get (x_opt, name) ->
     Node ("get" ^ access x_opt name, [])
+  | Set (x_opt, name, arg) ->
+    Node ("set" ^ access x_opt name, [argument mode arg])
 
-and arg mode arg =
+and argument mode arg =
   match arg.it with
   | LiteralArg lit -> literal mode lit
   | ActionArg act -> action mode act

interpreter/text/lexer.mll

@@ -678,6 +678,7 @@ rule token = parse
       | "register" -> REGISTER
       | "invoke" -> INVOKE
       | "get" -> GET
+      | "set" -> SET
       | "assert_malformed" -> ASSERT_MALFORMED
       | "assert_invalid" -> ASSERT_INVALID
       | "assert_unlinkable" -> ASSERT_UNLINKABLE

interpreter/text/parser.mly

@@ -232,7 +232,7 @@ let inline_type_explicit (c : context) x ft at =
 %token FUNC START TYPE PARAM RESULT LOCAL GLOBAL
 %token TABLE ELEM MEMORY DATA DECLARE OFFSET ITEM IMPORT EXPORT
 %token MODULE BIN QUOTE
-%token SCRIPT REGISTER INVOKE GET
+%token SCRIPT REGISTER INVOKE GET SET
 %token ASSERT_MALFORMED ASSERT_INVALID ASSERT_UNLINKABLE
 %token ASSERT_RETURN ASSERT_TRAP ASSERT_EXHAUSTION
 %token<Script.nan> NAN
@@ -1019,6 +1019,8 @@ action :
     { Invoke ($3, $4, $5) @@ at () }
   | LPAR GET module_var_opt name RPAR
     { Get ($3, $4) @@ at() }
+  | LPAR SET module_var_opt name arg RPAR
+    { Set ($3, $4, $5) @@ at() }
 
 assertion :
   | LPAR ASSERT_MALFORMED script_module STRING RPAR

test/core/script.wast

@@ -7,7 +7,7 @@
 )
 
 (module $m2
-  (global (export "g") i32 (i32.const 42))
+  (global (export "g") (mut i32) (i32.const 42))
   (func (export "f") (result i32) (i32.const 42))
   (func (export "add3") (param i32 i32 i32) (result i32)
     (i32.add (i32.add (local.get 0) (local.get 1)) (local.get 2))
@@ -21,17 +21,25 @@
 (assert_return (get $m1 "g") (i32.const 41))
 (assert_return (get $m2 "g") (i32.const 42))
 
+(set "g" (i32.const 43))
+(assert_return (set "g" (i32.const 43)))
+(assert_return (get "g") (i32.const 43))
+(set $m2 "g" (i32.const 44))
+(assert_return (get "g") (i32.const 44))
+(set "g" (invoke $m1 "inc" (get "g")))
+(assert_return (get "g") (i32.const 45))
+
 (assert_return (invoke "f") (i32.const 42))
 (assert_return (invoke $m1 "f") (i32.const 41))
 (assert_return (invoke $m2 "f") (i32.const 42))
 
 (assert_return (invoke $m1 "inc" (i32.const 2)) (i32.const 3))
 (assert_return (invoke $m1 "inc" (get $m1 "g")) (i32.const 42))
-(assert_return (invoke $m1 "inc" (get $m2 "g")) (i32.const 43))
-(assert_return (invoke $m1 "inc" (invoke $m1 "inc" (get "g"))) (i32.const 44))
+(assert_return (invoke $m1 "inc" (get $m2 "g")) (i32.const 46))
+(assert_return (invoke $m1 "inc" (invoke $m1 "inc" (get "g"))) (i32.const 47))
 
-(assert_return (invoke "add3" (get $m1 "g") (invoke $m1 "inc" (get "g")) (get "g")) (i32.const 126))
-(assert_return (invoke "add3" (invoke "swap" (get $m1 "g") (invoke $m1 "inc" (get "g"))) (i32.const -20)) (i32.const 64))
+(assert_return (invoke "add3" (get $m1 "g") (invoke $m1 "inc" (get "g")) (get "g")) (i32.const 132))
+(assert_return (invoke "add3" (invoke "swap" (get $m1 "g") (invoke $m1 "inc" (get "g"))) (i32.const -20)) (i32.const 67))
 
 
 (module