Skip to content

Commit 3b255d9

Browse files
sunfishcodesunfishcode
committed
Syntax sugar for if, if-else, forever, break, and switch.
1 parent b901ca0 commit 3b255d9

File tree

8 files changed

+150
-55
lines changed

8 files changed

+150
-55
lines changed

‎ml-proto/src/host/lexer.mll

Lines changed: 7 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -127,6 +127,12 @@ rule token = parse
127127
| "br" { BR }
128128
| "br_if" { BRIF }
129129
| "br_unless" { BRUNLESS }
130+
| "if" { IF }
131+
| "else" { ELSE }
132+
| "forever" { FOREVER }
133+
| "case" { CASE }
134+
| "fallthrough" { FALLTHROUGH }
135+
| "break" { BREAK }
130136
| "call" { CALL }
131137
| "call_import" { CALLIMPORT }
132138
| "call_indirect" { CALLINDIRECT }
@@ -150,6 +156,7 @@ rule token = parse
150156
{ STORETRUNC (truncop t sz a) }
151157

152158
| (nxx as t)".br_switch" { BRSWITCH (value_type t) }
159+
| (nxx as t)".switch" { SWITCH (value_type t) }
153160
| (nxx as t)".const" { CONST (value_type t) }
154161

155162
| (ixx as t)".clz" { UNARY (intop t Int32Op.Clz Int64Op.Clz) }

‎ml-proto/src/host/parser.mly

Lines changed: 57 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -84,6 +84,12 @@ let bind_label c x =
8484
Error.error x.at ("duplicate label " ^ x.it);
8585
{c with labels = VarMap.add x.it 0 (VarMap.map ((+) 1) c.labels)}
8686

87+
let sugar_label c =
88+
(label c ("(syntax sugar)" @@ at())) @@ at()
89+
90+
let bind_sugar_label c =
91+
{c with labels = VarMap.add "(syntax sugar)" 0 (VarMap.map ((+) 1) c.labels)}
92+
8793
let anon space n = space.count <- space.count + n
8894

8995
let anon_func c = anon c.funcs 1
@@ -100,6 +106,7 @@ let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels}
100106
%token FUNC PARAM RESULT LOCAL MODULE MEMORY SEGMENT IMPORT EXPORT TABLE
101107
%token PAGESIZE MEMORYSIZE RESIZEMEMORY
102108
%token ASSERTINVALID ASSERTEQ ASSERTTRAP INVOKE
109+
%token IF ELSE FOREVER SWITCH CASE FALLTHROUGH BREAK
103110
%token EOF
104111

105112
%token<string> INT
@@ -109,6 +116,7 @@ let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels}
109116
%token<Types.value_type> TYPE
110117
%token<Types.value_type> CONST
111118
%token<Types.value_type> BRSWITCH
119+
%token<Types.value_type> SWITCH
112120
%token<Ast.unop> UNARY
113121
%token<Ast.binop> BINARY
114122
%token<Ast.relop> COMPARE
@@ -175,6 +183,33 @@ oper :
175183
fun c -> BrSwitch ($1 @@ at, $2 c, $3 c label,
176184
List.map (fun (x,y) -> ((literal at x $1).it, y c label)) $4,
177185
$5 c) }
186+
/* Sugar: if statements */
187+
| IF expr expr
188+
{ fun c -> let at = at() in
189+
let c' = (anon_label c) in
190+
Block [BrUnless (0 @@ at, $2 c', None) @@ at; $3 c'] }
191+
/* Sugar: if-else statements */
192+
| IF expr expr expr
193+
{ fun c -> let at = at() in
194+
let c' = (anon_label c) in
195+
Block [Block [BrUnless (0 @@ at, $2 c', None) @@ at;
196+
Br (1 @@ at, Some ($3 (anon_label c'))) @@ at] @@ at;
197+
$4 c'] }
198+
/* Sugar: forever-loop statements */
199+
| FOREVER expr_list
200+
{ fun c -> let at = at() in
201+
let c' = (bind_sugar_label c) in
202+
let c'' = (anon_label c') in
203+
Block [Loop (List.append ($2 c'') [Br (0 @@ at, None) @@ at]) @@ at]
204+
}
205+
/* Sugar: switch statements */
206+
| SWITCH expr arms
207+
{ let at1 = ati 1 in
208+
fun c -> let c' = (bind_sugar_label c) in
209+
let x, y = $3 c' in
210+
Block [Switch ($1 @@ at1, $2 c', List.map (fun a -> a $1) x, y) @@ at1] }
211+
/* Sugar: break statements */
212+
| BREAK expr_opt { fun c -> Br (sugar_label c, $2 c) }
178213
| CALL var expr_list { fun c -> Call ($2 c func, $3 c) }
179214
| CALLIMPORT var expr_list { fun c -> CallImport ($2 c import, $3 c) }
180215
| CALLINDIRECT var expr expr_list
@@ -204,6 +239,28 @@ expr_list :
204239
| expr expr_list { fun c -> $1 c :: $2 c }
205240
;
206241
242+
expr_block :
243+
| expr { $1 }
244+
| expr expr expr_list /* Sugar */
245+
{ let at = at() in fun c -> Block ($1 c :: $2 c :: $3 c) @@ at }
246+
;
247+
fallthrough :
248+
| /* empty */ { false }
249+
| FALLTHROUGH { true }
250+
;
251+
arm :
252+
| LPAR CASE literal expr_block fallthrough RPAR
253+
{ let at = at() in let at3 = ati 3 in
254+
fun c t ->
255+
{value = literal at3 $3 t; expr = $4 c; fallthru = $5} @@ at }
256+
| LPAR CASE literal RPAR /* Sugar */
257+
{ let at = at() in let at3 = ati 3 in let at4 = ati 4 in
258+
fun c t ->
259+
{value = literal at3 $3 t; expr = Nop @@ at4; fallthru = true} @@ at }
260+
;
261+
arms :
262+
| expr { fun c -> [], $1 c }
263+
| arm arms { fun c -> let x, y = $2 c in $1 c :: x, y }
207264
208265
br_switch_arm :
209266
| INT var { ($1, $2) }

‎ml-proto/src/spec/ast.ml

Lines changed: 10 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -81,6 +81,7 @@ and expr' =
8181
| BrIf of var * expr * expr option
8282
| BrUnless of var * expr * expr option
8383
| BrSwitch of value_type * expr * var * (value * var) list * expr option
84+
| Switch of value_type * expr * arm list * expr
8485
| Call of var * expr list
8586
| CallImport of var * expr list
8687
| CallIndirect of var * expr * expr list
@@ -100,6 +101,15 @@ and expr' =
100101
| MemorySize
101102
| ResizeMemory of expr
102103

104+
and arm = arm' Source.phrase
105+
and arm' =
106+
{
107+
value : literal;
108+
expr : expr;
109+
fallthru : bool
110+
}
111+
112+
103113
(* Functions and Modules *)
104114

105115
type memory = memory' Source.phrase

‎ml-proto/src/spec/check.ml

Lines changed: 12 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -149,6 +149,13 @@ let rec check_expr c et e =
149149
check_expr c (Some t.it) ec;
150150
check_expr_option c (label c default) eo e.at
151151

152+
| Switch (t, e1, arms, e2) ->
153+
require (t.it = Int32Type || t.it = Int64Type) t.at "invalid switch type";
154+
(* TODO: Check that cases are unique. *)
155+
check_expr c (Some t.it) e1;
156+
List.iter (check_arm c t.it et) arms;
157+
check_expr c et e2
158+
152159
| Call (x, es) ->
153160
let {ins; out} = func c x in
154161
check_exprs c ins es;
@@ -237,6 +244,11 @@ and check_expr_option c et eo at =
237244
and check_literal c et l =
238245
check_type (Some (type_value l.it)) et l.at
239246

247+
and check_arm c t et arm =
248+
let {value = l; expr = e; fallthru} = arm.it in
249+
check_literal c (Some t) l;
250+
check_expr c (if fallthru then None else et) e
251+
240252
and check_load c et memop e1 at =
241253
check_align memop.align at;
242254
check_expr c (Some Int32Type) e1;

‎ml-proto/src/spec/eval.ml

Lines changed: 17 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -158,6 +158,13 @@ let rec eval_expr (c : config) (e : expr) =
158158
with Not_found -> default)
159159
(eval_expr_option c eo))
160160

161+
| Switch (_t, e1, arms, e2) ->
162+
let vo = some (eval_expr c e1) e1.at in
163+
(match List.fold_left (eval_arm c vo) `Seek arms with
164+
| `Seek | `Fallthru -> eval_expr c e2
165+
| `Done vs -> vs
166+
)
167+
161168
| Call (x, es) ->
162169
let vs = List.map (fun vo -> some (eval_expr c vo) vo.at) es in
163170
eval_func c.modul (func c x) vs
@@ -265,6 +272,16 @@ and eval_expr_option c eo =
265272
| Some e -> eval_expr c e
266273
| None -> None
267274

275+
and eval_arm c vo stage arm =
276+
let {value; expr = e; fallthru} = arm.it in
277+
match stage, vo = value.it with
278+
| `Seek, true | `Fallthru, _ ->
279+
if fallthru
280+
then (ignore (eval_expr c e); `Fallthru)
281+
else `Done (eval_expr c e)
282+
| `Seek, false | `Done _, _ ->
283+
stage
284+
268285
and eval_func (m : instance) (f : func) (evs : value list) =
269286
let module Return = MakeLabel () in
270287
let args = List.map ref evs in

‎ml-proto/test/sugar-fac.wase

Lines changed: 11 additions & 13 deletions
Original file line numberDiff line numberDiff line change
@@ -25,15 +25,13 @@
2525
(local i64 i64)
2626
(set_local 1 (get_local 0))
2727
(set_local 2 (i64.const 1))
28-
(label
29-
(loop
30-
(if
31-
(i64.eq (get_local 1) (i64.const 0))
32-
(break 0)
33-
(block
34-
(set_local 2 (i64.mul (get_local 1) (get_local 2)))
35-
(set_local 1 (i64.sub (get_local 1) (i64.const 1)))
36-
)
28+
(forever
29+
(if
30+
(i64.eq (get_local 1) (i64.const 0))
31+
(break)
32+
(block
33+
(set_local 2 (i64.mul (get_local 1) (get_local 2)))
34+
(set_local 1 (i64.sub (get_local 1) (i64.const 1)))
3735
)
3836
)
3937
)
@@ -46,18 +44,18 @@
4644
(local $res i64)
4745
(set_local $i (get_local $n))
4846
(set_local $res (i64.const 1))
49-
(label $done
50-
(loop
47+
(block
48+
(forever
5149
(if
5250
(i64.eq (get_local $i) (i64.const 0))
53-
(break $done)
51+
(br $done)
5452
(block
5553
(set_local $res (i64.mul (get_local $i) (get_local $res)))
5654
(set_local $i (i64.sub (get_local $i) (i64.const 1)))
5755
)
5856
)
5957
)
60-
)
58+
$done)
6159
(return (get_local $res))
6260
)
6361

‎ml-proto/test/sugar-memory.wase

Lines changed: 24 additions & 28 deletions
Original file line numberDiff line numberDiff line change
@@ -82,21 +82,19 @@
8282
(func $aligned (result i32)
8383
(local i32 i32 i32)
8484
(set_local 0 (i32.const 10))
85-
(label
86-
(loop
87-
(if
88-
(i32.eq (get_local 0) (i32.const 0))
89-
(break)
90-
)
91-
(set_local 2 (i32.mul (get_local 0) (i32.const 4)))
92-
(i32.store (get_local 2) (get_local 0))
93-
(set_local 1 (i32.load (get_local 2)))
94-
(if
95-
(i32.ne (get_local 0) (get_local 1))
96-
(return (i32.const 0))
97-
)
98-
(set_local 0 (i32.sub (get_local 0) (i32.const 1)))
85+
(forever
86+
(if
87+
(i32.eq (get_local 0) (i32.const 0))
88+
(break)
9989
)
90+
(set_local 2 (i32.mul (get_local 0) (i32.const 4)))
91+
(i32.store (get_local 2) (get_local 0))
92+
(set_local 1 (i32.load (get_local 2)))
93+
(if
94+
(i32.ne (get_local 0) (get_local 1))
95+
(return (i32.const 0))
96+
)
97+
(set_local 0 (i32.sub (get_local 0) (i32.const 1)))
10098
)
10199
(return (i32.const 1))
102100
)
@@ -105,21 +103,19 @@
105103
(func $unaligned (result i32)
106104
(local i32 f64 f64)
107105
(set_local 0 (i32.const 10))
108-
(label
109-
(loop
110-
(if
111-
(i32.eq (get_local 0) (i32.const 0))
112-
(break)
113-
)
114-
(set_local 2 (f64.convert_s/i32 (get_local 0)))
115-
(f64.store/1 (get_local 0) (get_local 2))
116-
(set_local 1 (f64.load/1 (get_local 0)))
117-
(if
118-
(f64.ne (get_local 2) (get_local 1))
119-
(return (i32.const 0))
120-
)
121-
(set_local 0 (i32.sub (get_local 0) (i32.const 1)))
106+
(forever
107+
(if
108+
(i32.eq (get_local 0) (i32.const 0))
109+
(break)
110+
)
111+
(set_local 2 (f64.convert_s/i32 (get_local 0)))
112+
(f64.store/1 (get_local 0) (get_local 2))
113+
(set_local 1 (f64.load/1 (get_local 0)))
114+
(if
115+
(f64.ne (get_local 2) (get_local 1))
116+
(return (i32.const 0))
122117
)
118+
(set_local 0 (i32.sub (get_local 0) (i32.const 1)))
123119
)
124120
(return (i32.const 1))
125121
)

‎ml-proto/test/switch.wase

Lines changed: 12 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -5,17 +5,15 @@
55
(func $stmt (param $i i32) (result i32)
66
(local $j i32)
77
(set_local $j (i32.const 100))
8-
(label
9-
(i32.switch (get_local $i)
10-
(case 0 (return (get_local $i)))
11-
(case 1 (nop) fallthrough)
12-
(case 2) ;; implicit fallthrough
13-
(case 3 (set_local $j (i32.sub (i32.const 0) (get_local $i))) (break))
14-
(case 4 (break))
15-
(case 5 (set_local $j (i32.const 101)))
16-
(case 6 (set_local $j (i32.const 101)) fallthrough)
17-
(;default;) (set_local $j (i32.const 102))
18-
)
8+
(i32.switch (get_local $i)
9+
(case 0 (return (get_local $i)))
10+
(case 1 (nop) fallthrough)
11+
(case 2) ;; implicit fallthrough
12+
(case 3 (set_local $j (i32.sub (i32.const 0) (get_local $i))) (break))
13+
(case 4 (break))
14+
(case 5 (set_local $j (i32.const 101)))
15+
(case 6 (set_local $j (i32.const 101)) fallthrough)
16+
(;default;) (set_local $j (i32.const 102))
1917
)
2018
(return (get_local $j))
2119
)
@@ -25,16 +23,16 @@
2523
(local $j i64)
2624
(set_local $j (i64.const 100))
2725
(return
28-
(label $l
26+
(block
2927
(i64.switch (get_local $i)
3028
(case 0 (return (get_local $i)))
3129
(case 1 (nop) fallthrough)
3230
(case 2) ;; implicit fallthrough
33-
(case 3 (break $l (i64.sub (i64.const 0) (get_local $i))))
31+
(case 3 (br $l (i64.sub (i64.const 0) (get_local $i))))
3432
(case 6 (set_local $j (i64.const 101)) fallthrough)
3533
(;default;) (get_local $j)
3634
)
37-
)
35+
$l)
3836
)
3937
)
4038

0 commit comments

Comments
 (0)