[interpreter] adjust try_delegate semantics

Accounting for the discussion in

  #176

adjust try_delegate so that it can target any block.

Author: takikawa

interpreter/valid/valid.ml

@@ -14,7 +14,7 @@ let require b at s = if not b then error at s
 
 (* Context *)
 
-type label_kind = BodyLabel | BlockLabel | TryLabel | CatchLabel
+type label_kind = BlockLabel | CatchLabel
 
 type context =
 {
@@ -409,7 +409,7 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type =
 
   | TryCatch (bt, es, cts, ca) ->
     let FuncType (ts1, ts2) as ft = check_block_type c bt in
-    let c_try = {c with labels = (TryLabel, ts2) :: c.labels} in
+    let c_try = {c with labels = (BlockLabel, ts2) :: c.labels} in
     let c_catch = {c with labels = (CatchLabel, ts2) :: c.labels} in
     check_block c_try es ft e.at;
     List.iter (fun ct -> check_catch ct c_catch ft e.at) cts;
@@ -419,8 +419,8 @@ let rec check_instr (c : context) (e : instr) (s : infer_stack_type) : op_type =
   | TryDelegate (bt, es, x) ->
     let FuncType (ts1, ts2) as ft = check_block_type c bt in
     let (kind, _) = label c x in
-    require (kind = TryLabel || kind = BodyLabel) e.at "invalid delegate label";
-    check_block {c with labels = (TryLabel, ts2) :: c.labels} es ft e.at;
+    require (kind = BlockLabel) e.at "invalid delegate label";
+    check_block {c with labels = (BlockLabel, ts2) :: c.labels} es ft e.at;
     ts1 --> ts2
 
   | Throw x ->
@@ -524,7 +524,7 @@ let check_type (t : type_) =
 let check_func (c : context) (f : func) =
   let {ftype; locals; body} = f.it in
   let FuncType (ts1, ts2) = type_ c ftype in
-  let c' = {c with locals = ts1 @ locals; results = ts2; labels = [(BodyLabel, ts2)]} in
+  let c' = {c with locals = ts1 @ locals; results = ts2; labels = [(BlockLabel, ts2)]} in
   check_block c' body (FuncType ([], ts2)) f.at
 
 let check_tag (c : context) (t : tag) =

test/core/try_delegate.wast

@@ -45,6 +45,13 @@
     )
   )
 
+  (func (export "delegate-to-block") (result i32)
+    (try (result i32)
+      (do (block (try (do (throw $e0)) (delegate 0)))
+          (i32.const 0))
+      (catch_all (i32.const 1)))
+  )
+
   (func (export "delegate-to-caller")
     (try (do (try (do (throw $e0)) (delegate 1))) (catch_all))
   )
@@ -92,6 +99,8 @@
 
 (assert_return (invoke "delegate-skip") (i32.const 3))
 
+(assert_return (invoke "delegate-to-block") (i32.const 1))
+
 (assert_exception (invoke "delegate-to-caller"))
 
 (assert_malformed
@@ -118,8 +127,3 @@
   (module (func (try (do) (delegate 1))))
   "unknown label"
 )
-
-(assert_invalid
-  (module (func (block (try (do) (delegate 0)))))
-  "invalid delegate label"
-)