Give set_local/store result types

ml-proto/spec/check.ml

@@ -171,8 +171,9 @@ let rec check_expr c et e =
     check_type (Some (local c x)) et e.at
 
   | SetLocal (x, e1) ->
-    check_expr c (Some (local c x)) e1;
-    check_type None et e.at
+    let t = local c x in
+    check_expr c (Some t) e1;
+    check_type (Some t) et e.at
 
   | Load (memop, e1) ->
     check_load c et memop e1 e.at
@@ -250,7 +251,7 @@ and check_store c et memop e1 e2 at =
   check_align memop.align at;
   check_expr c (Some Int32Type) e1;
   check_expr c (Some memop.ty) e2;
-  check_type None et at
+  check_type (Some memop.ty) et at
 
 and check_align align at =
   Lib.Option.app (fun a ->

ml-proto/spec/eval.ml

@@ -166,7 +166,7 @@ let rec eval_expr (c : config) (e : expr) =
   | SetLocal (x, e1) ->
     let v1 = some (eval_expr c e1) e1.at in
     local c x := v1;
-    None
+    Some v1
 
   | Load ({ty; align = _}, e1) ->
     let v1 = some (eval_expr c e1) e1.at in
@@ -180,7 +180,7 @@ let rec eval_expr (c : config) (e : expr) =
     let a = Memory.address_of_value v1 in
     (try Memory.store c.module_.memory a v2
     with exn -> memory_error e.at exn);
-    None
+    Some v2
 
   | LoadExtend ({memop = {ty; align = _}; sz; ext}, e1) ->
     let v1 = some (eval_expr c e1) e1.at in
@@ -194,7 +194,7 @@ let rec eval_expr (c : config) (e : expr) =
     let a = Memory.address_of_value v1 in
     (try Memory.store_wrap c.module_.memory a sz v2
     with exn -> memory_error e.at exn);
-    None
+    Some v2
 
   | Const v ->
     Some v.it

ml-proto/test/expected-output/store_retval.wast.log

@@ -0,0 +1,13 @@
+1 : i32
+2 : i64
+3. : f32
+4. : f64
+11 : i32
+12 : i64
+13. : f32
+14. : f64
+512 : i32
+65536 : i32
+512 : i64
+65536 : i64
+4294967296 : i64

ml-proto/test/store_retval.wast

@@ -0,0 +1,51 @@
+(module
+    (memory 100)
+
+    (import $print_i32 "stdio" "print" (param i32))
+    (import $print_i64 "stdio" "print" (param i64))
+    (import $print_f32 "stdio" "print" (param f32))
+    (import $print_f64 "stdio" "print" (param f64))
+
+    (func $run
+        (local $i32 i32) (local $i64 i64) (local $f32 f32) (local $f64 f64)
+        (call_import $print_i32 (set_local $i32 (i32.const 1)))
+        (call_import $print_i64 (set_local $i64 (i64.const 2)))
+        (call_import $print_f32 (set_local $f32 (f32.const 3)))
+        (call_import $print_f64 (set_local $f64 (f64.const 4)))
+
+        (call_import $print_i32 (i32.store (i32.const 0) (i32.const 11)))
+        (call_import $print_i64 (i64.store (i32.const 0) (i64.const 12)))
+        (call_import $print_f32 (f32.store (i32.const 0) (f32.const 13)))
+        (call_import $print_f64 (f64.store (i32.const 0) (f64.const 14)))
+
+        (call_import $print_i32 (i32.store8 (i32.const 0) (i32.const 512)))
+        (call_import $print_i32 (i32.store16 (i32.const 0) (i32.const 65536)))
+        (call_import $print_i64 (i64.store8 (i32.const 0) (i64.const 512)))
+        (call_import $print_i64 (i64.store16 (i32.const 0) (i64.const 65536)))
+        (call_import $print_i64 (i64.store32 (i32.const 0) (i64.const 4294967296)))
+    )
+    (export "run" $run)
+)
+
+(invoke "run")
+
+(assert_invalid
+    (module (func (local $i32 i32) (local $i64 i64)
+        (set_local $i64 (set_local $i32 (i32.const 1)))))
+    "type mismatch: expression has type i32 but the context requires i64"
+)
+(assert_invalid
+    (module (func (local $i32 i32) (local $i64 i64)
+        (set_local $i32 (set_local $i64 (i64.const 1)))))
+    "type mismatch: expression has type i64 but the context requires i32"
+)
+(assert_invalid
+    (module (func (local $f32 f32) (local $f64 f64)
+        (set_local $f64 (set_local $f32 (f32.const 1)))))
+    "type mismatch: expression has type f32 but the context requires f64"
+)
+(assert_invalid
+    (module (func (local $f32 f32) (local $f64 f64)
+        (set_local $f32 (set_local $f64 (f64.const 1)))))
+    "type mismatch: expression has type f64 but the context requires f32"
+)