Obfuscating Loop1

ml-proto/host/parser.mly

@@ -251,7 +251,7 @@ expr1 :
     { fun c -> let c', l = $2 c in Block (l, $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) }
+  | BR_IF expr var expr_opt { fun c -> Br_if ($2 c, $3 c label, $4 c) }
   | LOOP labeling labeling expr_list
     { fun c -> let c', l1 = $2 c in let c'', l2 = $3 c' in
       let c''' = if l1.it = Unlabelled then anon_label c'' else c'' in

ml-proto/spec/ast.ml

@@ -14,7 +14,7 @@ and expr' =
   | Block of labeling * expr list
   | If of expr * expr
   | If_else of expr * expr * expr
-  | Br_if of expr * var
+  | Br_if of expr * var * expr option
   | Loop of labeling * labeling * expr list
   | Label of expr
   | Br of var * expr option

ml-proto/spec/check.ml

@@ -228,9 +228,10 @@ and check_exprs c ts es =
   with Invalid_argument _ -> error (Source.ats es) "arity mismatch"
 
 and check_expr_opt c et eo at =
-  match eo with
-  | Some e -> check_expr c et e
-  | None -> check_type None et at
+  match et, eo with
+  | Some t, Some e -> check_expr c et e
+  | None, None -> ()
+  | _ -> error at "arity mismatch"
 
 and check_literal c et l =
   check_type (Some (type_value l.it)) et l.at

ml-proto/spec/desugar.ml

@@ -18,7 +18,8 @@ and expr' = function
   | A.Block (l, es) -> labeling l (K.Block (List.map expr es))
   | A.If (e1, e2) -> K.If (expr e1, expr e2, K.Nop @@ Source.after e2.at)
   | A.If_else (e1, e2, e3) -> K.If (expr e1, expr e2, expr e3)
-  | A.Br_if (e, x) -> expr' (A.If (e, A.Br (x, None) @@ x.at))
+  | A.Br_if (e, x, eo) ->
+    K.If (expr e, K.Break (x, Lib.Option.map expr eo) @@ x.at, opt eo)
   | A.Loop (l1, l2, es) when l2.it = A.Unlabelled -> K.Loop (seq es)
   | A.Loop (l1, l2, es) -> labeling l1 (K.Loop (seq es))
   | A.Label e -> K.Label (expr e)
@@ -60,6 +61,10 @@ and seq = function
   | [e] -> expr e
   | es -> K.Block (List.map expr es) @@@ List.map Source.at es
 
+and opt = function
+  | None -> K.Nop @@ Source.no_region
+  | Some e -> K.Block [expr e; K.Nop @@ e.at] @@ e.at
+
 
 (* Functions and Modules *)
 

ml-proto/test/labels.wast

@@ -24,7 +24,7 @@
     (loop $exit $cont
       (set_local $i (i32.add (get_local $i) (i32.const 1)))
       (if (i32.eq (get_local $i) (i32.const 5))
-        (br $cont (i32.const -1))
+        (br $cont)
       )
       (if (i32.eq (get_local $i) (i32.const 8))
         (br $exit (get_local $i))
@@ -34,6 +34,19 @@
     )
   )
 
+  (func $loop3 (param $max i32) (result i32)
+    (local $i i32)
+    (set_local $i (i32.const 1))
+    (loop $exit $cont
+      (set_local $i (i32.add (get_local $i) (get_local $i)))
+      (if (i32.gt_u (get_local $i) (get_local $max))
+        (br $exit (get_local $i))
+      )
+      (br $cont)
+    )
+  )
+
+
   (func $switch (param i32) (result i32)
     (label $ret
       (i32.mul (i32.const 10)
@@ -58,16 +71,36 @@
     )
   )
 
+  (func $br_if (result i32)
+    (local $i i32)
+    (set_local $i (i32.const 0))
+    (block $outer
+      (block $inner
+        (br_if (i32.const 0) $inner)
+        (set_local $i (i32.or (get_local $i) (i32.const 0x1)))
+        (br_if (i32.const 1) $inner)
+        (set_local $i (i32.or (get_local $i) (i32.const 0x2)))
+      )
+      (br_if (i32.const 0) $outer (set_local $i (i32.or (get_local $i) (i32.const 0x4))))
+      (set_local $i (i32.or (get_local $i) (i32.const 0x8)))
+      (br_if (i32.const 1) $outer (set_local $i (i32.or (get_local $i) (i32.const 0x10))))
+      (set_local $i (i32.or (get_local $i) (i32.const 0x20)))
+    )
+  )
+
   (export "block" $block)
   (export "loop1" $loop1)
   (export "loop2" $loop2)
+  (export "loop3" $loop3)
   (export "switch" $switch)
   (export "return" $return)
+  (export "br_if" $br_if)
 )
 
 (assert_return (invoke "block") (i32.const 1))
 (assert_return (invoke "loop1") (i32.const 5))
 (assert_return (invoke "loop2") (i32.const 8))
+(assert_return (invoke "loop3" (i32.const 8)) (i32.const 16))
 (assert_return (invoke "switch" (i32.const 0)) (i32.const 50))
 (assert_return (invoke "switch" (i32.const 1)) (i32.const 20))
 (assert_return (invoke "switch" (i32.const 2)) (i32.const 20))
@@ -77,4 +110,9 @@
 (assert_return (invoke "return" (i32.const 0)) (i32.const 0))
 (assert_return (invoke "return" (i32.const 1)) (i32.const 2))
 (assert_return (invoke "return" (i32.const 2)) (i32.const 2))
+(assert_return (invoke "br_if") (i32.const 0x1d))
+
+(assert_invalid (module (func (loop $l (br $l (i32.const 0))))) "arity mismatch")
+(assert_invalid (module (func (block $l (f32.neg (br_if (i32.const 1) $l)) (nop)))) "type mismatch")
+(assert_invalid (module (func (result f32) (block $l (br_if (i32.const 1) $l (f32.const 0))))) "type mismatch")
 

ml-proto/test/switch.wast

@@ -12,7 +12,7 @@
         (case $2)  ;; fallthrough
         (case $3 (set_local $j (i32.sub (i32.const 0) (get_local $i))) (br 0))
         (case $4 (br 0))
-        (case $5 (br 0 (set_local $j (i32.const 101))))
+        (case $5 (set_local $j (i32.const 101)) (br 0))
         (case $6 (set_local $j (i32.const 101)))  ;; fallthrough
         (case $default (set_local $j (i32.const 102)))
         (case $7)