From e4558f56891117378b73b3c19f4d0b03b0e52a6c Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Fri, 2 Oct 2015 15:41:47 +0200 Subject: [PATCH 1/5] Syntactic sugar for labels --- ml-proto/README.md | 10 +++--- ml-proto/host/parser.mly | 24 +++++++++---- ml-proto/test/labels.wast | 74 +++++++++++++++++++++++++++++++++++++++ ml-proto/test/memory.wast | 4 +-- ml-proto/test/switch.wast | 4 +-- 5 files changed, 102 insertions(+), 14 deletions(-) create mode 100644 ml-proto/test/labels.wast diff --git a/ml-proto/README.md b/ml-proto/README.md index 4dd685ab47..1948ba009d 100644 --- a/ml-proto/README.md +++ b/ml-proto/README.md @@ -130,13 +130,15 @@ cvtop: trunc_s | trunc_u | extend_s | extend_u | ... expr: ( nop ) ( block + ) + ( block + ) ;; = (label (block +)) ( if ) - ( if ) ;; = (if (nop)) - ( loop * ) ;; = (loop (block *)) - ( label ? * ) ;; = (label (block *)) + ( if ) ;; = (if (nop)) + ( loop * ) ;; = (loop (block *)) + ( loop ? * ) ;; = (label (loop (block ? *))) + ( label ? ) ( break ? ) - ( break ) ;; = (break 0) ( .switch * ) + ( .switch * ) ;; = (label (.switch * )) ( call * ) ( call_import * ) ( call_indirect * ) diff --git a/ml-proto/host/parser.mly b/ml-proto/host/parser.mly index 954cb46dd7..8f6e73865e 100644 --- a/ml-proto/host/parser.mly +++ b/ml-proto/host/parser.mly @@ -82,8 +82,6 @@ let bind_func c x = bind "function" c.funcs x let bind_import c x = bind "import" c.imports x let bind_local c x = bind "local" c.locals x let bind_label c x = - if VarMap.mem x.it c.labels then - Error.error x.at ("duplicate label " ^ x.it); {c with labels = VarMap.add x.it 0 (VarMap.map ((+) 1) c.labels)} let anon space n = space.count <- space.count + n @@ -161,19 +159,33 @@ expr : oper : | NOP { fun c -> Nop } | BLOCK expr expr_list { fun c -> Block ($2 c :: $3 c) } + | BLOCK bind_var expr expr_list /* Sugar */ + { let at = at() in + fun c -> let c' = bind_label c $2 in + Label (Block ($3 c' :: $4 c') @@ at) } | IF expr expr expr { fun c -> If ($2 c, $3 c, $4 c) } | IF expr expr /* Sugar */ { let at1 = ati 1 in fun c -> If ($2 c, $3 c, Nop @@ at1) } | LOOP expr_block { fun c -> Loop ($2 c) } - | LABEL expr_block { fun c -> Label ($2 (anon_label c)) } - | LABEL bind_var expr_block /* Sugar */ - { fun c -> Label ($3 (bind_label c $2)) } + | LOOP bind_var expr_block /* Sugar */ + { let at = at() in + fun c -> let c' = bind_label c $2 in Label (Loop ($3 c') @@ at) } + | LOOP bind_var bind_var expr_block /* Sugar */ + { let at = at() in + fun c -> let c' = bind_label (bind_label c $2) $3 in + Label (Loop (Label ($4 c') @@ at) @@ at) } + | LABEL expr { fun c -> let c' = anon_label c in Label ($2 c') } + | LABEL bind_var expr /* Sugar */ + { fun c -> let c' = bind_label c $2 in Label ($3 c') } | BREAK var expr_opt { fun c -> Break ($2 c label, $3 c) } - | BREAK { let at = at() in fun c -> Break (0 @@ at, None) } /* Sugar */ | SWITCH expr arms { let at1 = ati 1 in fun c -> let x, y = $3 c in Switch ($1 @@ at1, $2 c, List.map (fun a -> a $1) x, y) } + | SWITCH bind_var expr arms /* Sugar */ + { let at = at() in let at2 = ati 2 in + fun c -> let c' = bind_label c $2 in let x, y = $4 c' in + Label (Switch ($1 @@ at2, $3 c', List.map (fun a -> a $1) x, y) @@ at) } | CALL var expr_list { fun c -> Call ($2 c func, $3 c) } | CALLIMPORT var expr_list { fun c -> CallImport ($2 c import, $3 c) } | CALLINDIRECT var expr expr_list diff --git a/ml-proto/test/labels.wast b/ml-proto/test/labels.wast new file mode 100644 index 0000000000..e4ca34d9c2 --- /dev/null +++ b/ml-proto/test/labels.wast @@ -0,0 +1,74 @@ +(module + (func $block (result i32) + (block $exit + (break $exit (i32.const 1)) + (i32.const 0) + ) + ) + + (func $loop1 (result i32) + (local $i i32) + (set_local $i (i32.const 0)) + (loop $exit + (set_local $i (i32.add (get_local $i) (i32.const 1))) + (if (i32.eq (get_local $i) (i32.const 5)) + (break $exit (get_local $i)) + ) + ) + ) + + (func $loop2 (result i32) + (local $i i32) + (set_local $i (i32.const 0)) + (loop $exit $cont + (set_local $i (i32.add (get_local $i) (i32.const 1))) + (if (i32.eq (get_local $i) (i32.const 5)) + (break $cont (i32.const -1)) + ) + (if (i32.eq (get_local $i) (i32.const 8)) + (break $exit (get_local $i)) + ) + (set_local $i (i32.add (get_local $i) (i32.const 1))) + ) + ) + + (func $switch (param i32) (result i32) + (label $ret + (i32.mul (i32.const 10) + (i32.switch $exit (get_local 0) + (case 1 (i32.const 1)) + (case 2 (break $exit (i32.const 2))) + (case 3 (break $ret (i32.const 3))) + (i32.const 4) + ) + ) + ) + ) + + (func $return (param i32) (result i32) + (i32.switch (get_local 0) + (case 1 (return (i32.const 1))) + (case 2 (i32.const 2)) + (i32.const 3) + ) + ) + + (export "block" $block) + (export "loop1" $loop1) + (export "loop2" $loop2) + (export "switch" $switch) + (export "return" $return) +) + +(assert_return (invoke "block") (i32.const 1)) +(assert_return (invoke "loop1") (i32.const 5)) +(assert_return (invoke "loop2") (i32.const 8)) +(assert_return (invoke "switch" (i32.const 1)) (i32.const 10)) +(assert_return (invoke "switch" (i32.const 2)) (i32.const 20)) +(assert_return (invoke "switch" (i32.const 3)) (i32.const 3)) +(assert_return (invoke "switch" (i32.const 4)) (i32.const 40)) +(assert_return (invoke "switch" (i32.const 5)) (i32.const 40)) +(assert_return (invoke "return" (i32.const 1)) (i32.const 1)) +(assert_return (invoke "return" (i32.const 2)) (i32.const 2)) +(assert_return (invoke "return" (i32.const 3)) (i32.const 3)) + diff --git a/ml-proto/test/memory.wast b/ml-proto/test/memory.wast index f27a8b82cb..a5153317ef 100644 --- a/ml-proto/test/memory.wast +++ b/ml-proto/test/memory.wast @@ -86,7 +86,7 @@ (loop (if (i32.eq (get_local 0) (i32.const 0)) - (break) + (break 0) ) (set_local 2 (i32.mul (get_local 0) (i32.const 4))) (i32.store (get_local 2) (get_local 0)) @@ -109,7 +109,7 @@ (loop (if (i32.eq (get_local 0) (i32.const 0)) - (break) + (break 0) ) (set_local 2 (f64.convert_s/i32 (get_local 0))) (f64.store/1 (get_local 0) (get_local 2)) diff --git a/ml-proto/test/switch.wast b/ml-proto/test/switch.wast index fd62bd2f64..9a13fec3b5 100644 --- a/ml-proto/test/switch.wast +++ b/ml-proto/test/switch.wast @@ -10,8 +10,8 @@ (case 0 (return (get_local $i))) (case 1 (nop) fallthrough) (case 2) ;; implicit fallthrough - (case 3 (set_local $j (i32.sub (i32.const 0) (get_local $i))) (break)) - (case 4 (break)) + (case 3 (set_local $j (i32.sub (i32.const 0) (get_local $i))) (break 0)) + (case 4 (break 0)) (case 5 (set_local $j (i32.const 101))) (case 6 (set_local $j (i32.const 101)) fallthrough) (;default;) (set_local $j (i32.const 102)) From 815db6de2dcf5c1beb61cedb9b2dab917fdbf535 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Thu, 8 Oct 2015 18:06:14 +0200 Subject: [PATCH 2/5] Factor out desugaring from parser to spec --- ml-proto/given/lib.ml | 5 ++ ml-proto/given/lib.mli | 1 + ml-proto/host/parser.mly | 111 ++++++++++++++++++--------------------- ml-proto/spec/sugar.ml | 40 ++++++++++++++ ml-proto/spec/sugar.mli | 15 ++++++ 5 files changed, 113 insertions(+), 59 deletions(-) create mode 100644 ml-proto/spec/sugar.ml create mode 100644 ml-proto/spec/sugar.mli diff --git a/ml-proto/given/lib.ml b/ml-proto/given/lib.ml index 9ab792ef25..1258cd30dc 100644 --- a/ml-proto/given/lib.ml +++ b/ml-proto/given/lib.ml @@ -29,6 +29,11 @@ end module Option = struct + let get o x = + match o with + | Some y -> y + | None -> x + let map f = function | Some x -> Some (f x) | None -> None diff --git a/ml-proto/given/lib.mli b/ml-proto/given/lib.mli index 155cae477c..702f8038fd 100644 --- a/ml-proto/given/lib.mli +++ b/ml-proto/given/lib.mli @@ -15,6 +15,7 @@ end module Option : sig + val get : 'a option -> 'a -> 'a val map : ('a -> 'b) -> 'a option -> 'b option val app : ('a -> unit) -> 'a option -> unit end diff --git a/ml-proto/host/parser.mly b/ml-proto/host/parser.mly index 8f6e73865e..5a66f996c5 100644 --- a/ml-proto/host/parser.mly +++ b/ml-proto/host/parser.mly @@ -126,7 +126,7 @@ let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels} /* Types */ value_type : - | TYPE { $1 @@ at() } + | TYPE { $1 @@ at () } ; value_type_list : | /* empty */ { [] } @@ -142,50 +142,51 @@ literal : ; var : - | INT { let at = at() in fun c lookup -> int_of_string $1 @@ at } - | VAR { let at = at() in fun c lookup -> lookup c ($1 @@ at) @@ at } + | INT { let at = at () in fun c lookup -> int_of_string $1 @@ at } + | VAR { let at = at () in fun c lookup -> lookup c ($1 @@ at) @@ at } ; var_list : | /* empty */ { fun c lookup -> [] } | var var_list { fun c lookup -> $1 c lookup :: $2 c lookup } ; bind_var : - | VAR { $1 @@ at() } + | VAR { $1 @@ at () } ; expr : - | LPAR oper RPAR { let at = at() in fun c -> $2 c @@ at } + | LPAR oper RPAR { let at = at () in fun c -> $2 c @@ at } ; oper : | NOP { fun c -> Nop } | BLOCK expr expr_list { fun c -> Block ($2 c :: $3 c) } | BLOCK bind_var expr expr_list /* Sugar */ - { let at = at() in + { let at = at () in fun c -> let c' = bind_label c $2 in - Label (Block ($3 c' :: $4 c') @@ at) } + Sugar.labelled_block at ($3 c' :: $4 c) } | IF expr expr expr { fun c -> If ($2 c, $3 c, $4 c) } | IF expr expr /* Sugar */ - { let at1 = ati 1 in fun c -> If ($2 c, $3 c, Nop @@ at1) } - | LOOP expr_block { fun c -> Loop ($2 c) } - | LOOP bind_var expr_block /* Sugar */ - { let at = at() in - fun c -> let c' = bind_label c $2 in Label (Loop ($3 c') @@ at) } - | LOOP bind_var bind_var expr_block /* Sugar */ - { let at = at() in + { fun c -> Sugar.if_only ($2 c, $3 c) } + | LOOP expr_list { let at = at () in fun c -> Sugar.loop_seq at ($2 c) } + | LOOP bind_var expr_list /* Sugar */ + { let at = at () in + fun c -> let c' = bind_label c $2 in + Sugar.labelled_loop_seq at ($3 c') } + | LOOP bind_var bind_var expr_list /* Sugar */ + { let at = at () in fun c -> let c' = bind_label (bind_label c $2) $3 in - Label (Loop (Label ($4 c') @@ at) @@ at) } + Sugar.labelled_loop_seq2 at ($4 c') } | LABEL expr { fun c -> let c' = anon_label c in Label ($2 c') } | LABEL bind_var expr /* Sugar */ { fun c -> let c' = bind_label c $2 in Label ($3 c') } | BREAK var expr_opt { fun c -> Break ($2 c label, $3 c) } | SWITCH expr arms { let at1 = ati 1 in - fun c -> let x, y = $3 c in - Switch ($1 @@ at1, $2 c, List.map (fun a -> a $1) x, y) } + fun c -> let arms, e = $3 c in + Switch ($1 @@ at1, $2 c, List.map (fun a -> a $1) arms, e) } | SWITCH bind_var expr arms /* Sugar */ - { let at = at() in let at2 = ati 2 in - fun c -> let c' = bind_label c $2 in let x, y = $4 c' in - Label (Switch ($1 @@ at2, $3 c', List.map (fun a -> a $1) x, y) @@ at) } + { let at = at () in let at2 = ati 2 in + fun c -> let c' = bind_label c $2 in let arms, e = $4 c' in + Sugar.labelled_switch at ($1 @@ at2, $3 c', List.map (fun a -> a $1) arms, e) } | CALL var expr_list { fun c -> Call ($2 c func, $3 c) } | CALLIMPORT var expr_list { fun c -> CallImport ($2 c import, $3 c) } | CALLINDIRECT var expr expr_list @@ -197,7 +198,7 @@ oper : | STORE expr expr { fun c -> Store ($1, $2 c, $3 c) } | LOADEXTEND expr { fun c -> LoadExtend ($1, $2 c) } | STOREWRAP expr expr { fun c -> StoreWrap ($1, $2 c, $3 c) } - | CONST literal { let at = at() in fun c -> Const (literal at $2 $1) } + | CONST literal { let at = at () in fun c -> Const (literal at $2 $1) } | UNARY expr { fun c -> Unary ($1, $2 c) } | BINARY expr expr { fun c -> Binary ($1, $2 c, $3 c) } | COMPARE expr expr { fun c -> Compare ($1, $2 c, $3 c) } @@ -214,40 +215,33 @@ expr_list : | /* empty */ { fun c -> [] } | expr expr_list { fun c -> $1 c :: $2 c } ; -expr_block : - | expr { $1 } - | expr expr expr_list /* Sugar */ - { let at = at() in fun c -> Block ($1 c :: $2 c :: $3 c) @@ at } -; fallthrough : | /* empty */ { false } | FALLTHROUGH { true } ; arm : - | LPAR CASE literal expr_block fallthrough RPAR - { let at = at() in let at3 = ati 3 in - fun c t -> - {value = literal at3 $3 t; expr = $4 c; fallthru = $5} @@ at } + | LPAR CASE literal expr expr_list fallthrough RPAR + { let at = at () in let at3 = ati 3 in + fun c t -> Sugar.case_seq (literal at3 $3 t, $4 c :: $5 c, $6) @@ at } | LPAR CASE literal RPAR /* Sugar */ - { let at = at() in let at3 = ati 3 in let at4 = ati 4 in - fun c t -> - {value = literal at3 $3 t; expr = Nop @@ at4; fallthru = true} @@ at } + { let at = at () in let at3 = ati 3 in + fun c t -> Sugar.case_only (literal at3 $3 t) @@ at } ; arms : | expr { fun c -> [], $1 c } - | arm arms { fun c -> let x, y = $2 c in $1 c :: x, y } + | arm arms { fun c -> let x, y = $2 c in $1 c :: x, y } /* Sugar */ ; /* Functions */ func_fields : - | /* empty */ /* Sugar */ - { let at = at() in - fun c -> {params = []; result = None; locals = []; body = Nop @@ at} } - | expr_block - { fun c -> {params = []; result = None; locals = []; body = $1 c} } + | expr_list + { let at = at () in + fun c -> + {params = []; result = None; locals = []; + body = Sugar.func_body ($1 c) @@ at} } | LPAR PARAM value_type_list RPAR func_fields { fun c -> anon_locals c $3; let f = $5 c in {f with params = $3 @ f.params} } @@ -255,11 +249,11 @@ func_fields : { fun c -> bind_local c $3; let f = $6 c in {f with params = $4 :: f.params} } | LPAR RESULT value_type RPAR func_fields - { let at = at() in + { let at = at () in fun c -> let f = $5 c in - match f.result with - | Some _ -> Error.error at "more than one return type" - | None -> {f with result = Some $3} } + match f.result with + | Some _ -> Error.error at "more than one return type" + | None -> {f with result = Some $3} } | LPAR LOCAL value_type_list RPAR func_fields { fun c -> anon_locals c $3; let f = $5 c in {f with locals = $3 @ f.locals} } @@ -269,10 +263,10 @@ func_fields : ; func : | LPAR FUNC func_fields RPAR - { let at = at() in + { let at = at () in fun c -> anon_func c; fun () -> $3 (enter_func c) @@ at } | LPAR FUNC bind_var func_fields RPAR /* Sugar */ - { let at = at() in + { let at = at () in fun c -> bind_func c $3; fun () -> $4 (enter_func c) @@ at } ; @@ -281,7 +275,7 @@ func : segment : | LPAR SEGMENT INT TEXT RPAR - { {Memory.addr = Int64.of_string $3; Memory.data = $4} @@ at() } + { {Memory.addr = Int64.of_string $3; Memory.data = $4} @@ at () } ; segment_list : | /* empty */ { [] } @@ -291,10 +285,10 @@ segment_list : memory : | LPAR MEMORY INT INT segment_list RPAR { {initial = Int64.of_string $3; max = Int64.of_string $4; segments = $5} - @@ at() } + @@ at () } | LPAR MEMORY INT segment_list RPAR { {initial = Int64.of_string $3; max = Int64.of_string $3; segments = $4} - @@ at() } + @@ at () } ; func_params : @@ -306,18 +300,18 @@ func_result : ; import : | LPAR IMPORT bind_var TEXT TEXT func_params func_result RPAR - { let at = at() in fun c -> bind_import c $3; + { let at = at () in fun c -> bind_import c $3; {module_name = $4; func_name = $5; func_params = $6; func_result = $7 } @@ at } | LPAR IMPORT TEXT TEXT func_params func_result RPAR /* Sugar */ - { let at = at() in fun c -> anon_import c; + { let at = at () in fun c -> anon_import c; {module_name = $3; func_name = $4; func_params = $5; func_result = $6 } @@ at } ; export : | LPAR EXPORT TEXT var RPAR - { let at = at() in fun c -> {name = $3; func = $4 c func} @@ at } + { let at = at () in fun c -> {name = $3; func = $4 c func} @@ at } ; module_fields : @@ -344,23 +338,22 @@ module_fields : | None -> {m with memory = Some $1} } ; module_ : - | LPAR MODULE module_fields RPAR { $3 (c0 ()) @@ at() } + | LPAR MODULE module_fields RPAR { $3 (c0 ()) @@ at () } ; /* Scripts */ cmd : - | module_ { Define $1 @@ at() } - | LPAR ASSERTINVALID module_ TEXT RPAR { AssertInvalid ($3, $4) @@ at() } - | LPAR INVOKE TEXT expr_list RPAR - { Invoke ($3, $4 (c0 ())) @@ at() } + | module_ { Define $1 @@ at () } + | LPAR ASSERTINVALID module_ TEXT RPAR { AssertInvalid ($3, $4) @@ at () } + | LPAR INVOKE TEXT expr_list RPAR { Invoke ($3, $4 (c0 ())) @@ at () } | LPAR ASSERTRETURN LPAR INVOKE TEXT expr_list RPAR expr RPAR - { AssertReturn ($5, $6 (c0 ()), $8 (c0 ())) @@ at() } + { AssertReturn ($5, $6 (c0 ()), $8 (c0 ())) @@ at () } | LPAR ASSERTRETURNNAN LPAR INVOKE TEXT expr_list RPAR RPAR - { AssertReturnNaN ($5, $6 (c0 ())) @@ at() } + { AssertReturnNaN ($5, $6 (c0 ())) @@ at () } | LPAR ASSERTTRAP LPAR INVOKE TEXT expr_list RPAR TEXT RPAR - { AssertTrap ($5, $6 (c0 ()), $8) @@ at() } + { AssertTrap ($5, $6 (c0 ()), $8) @@ at () } ; cmd_list : | /* empty */ { [] } diff --git a/ml-proto/spec/sugar.ml b/ml-proto/spec/sugar.ml new file mode 100644 index 0000000000..60111a21c8 --- /dev/null +++ b/ml-proto/spec/sugar.ml @@ -0,0 +1,40 @@ +open Source +open Ast + + +let expr_seq es = + match es with + | [] -> Nop @@ Source.no_region + | [e] -> e + | es -> Block es @@@ List.map Source.at es + + +let labelled_block at es = + Label (Block es @@ at) + +let if_only (e1, e2) = + If (e1, e2, Nop @@ Source.after e2.at) + +let loop_seq at es = + Loop (expr_seq es) + +let labelled_loop_seq at es = + Label (Loop (expr_seq es) @@ at) + +let labelled_loop_seq2 at es = + Label (Loop (Label (expr_seq es) @@ at) @@ at) + +let labelled_switch at (t, e1, arms, e2) = + Label (Switch (t, e1, arms, e2) @@ at) + + +let case_seq (l, es, fallthru) = + {value = l; expr = expr_seq es; fallthru} + +let case_only l = + {value = l; expr = Nop @@ Source.after l.at; fallthru = true} + + +let func_body es = + (expr_seq es).it + diff --git a/ml-proto/spec/sugar.mli b/ml-proto/spec/sugar.mli new file mode 100644 index 0000000000..12eee7fed3 --- /dev/null +++ b/ml-proto/spec/sugar.mli @@ -0,0 +1,15 @@ +open Ast + +val labelled_block : Source.region -> expr list -> expr' +val if_only : expr * expr -> expr' +val loop_seq : Source.region -> expr list -> expr' +val labelled_loop_seq : Source.region -> expr list -> expr' +val labelled_loop_seq2 : Source.region -> expr list -> expr' +val labelled_switch : + Source.region -> value_type * expr * arm list * expr -> expr' + +val case_seq : Ast.literal * Ast.expr list * bool -> Ast.arm' +val case_only : Ast.literal -> Ast.arm' + +val func_body : Ast.expr list -> Ast.expr' + From 3415c42091fc6689496045446dd78fe09501607d Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Thu, 8 Oct 2015 18:27:18 +0200 Subject: [PATCH 3/5] Desugar 'return' --- ml-proto/README.md | 2 +- ml-proto/host/parser.mly | 6 ++++-- ml-proto/spec/ast.ml | 1 - ml-proto/spec/check.ml | 3 --- ml-proto/spec/eval.ml | 12 +++--------- ml-proto/spec/sugar.ml | 5 ++++- ml-proto/spec/sugar.mli | 1 + 7 files changed, 13 insertions(+), 17 deletions(-) diff --git a/ml-proto/README.md b/ml-proto/README.md index 1948ba009d..3e83b397fb 100644 --- a/ml-proto/README.md +++ b/ml-proto/README.md @@ -142,7 +142,7 @@ expr: ( call * ) ( call_import * ) ( call_indirect * ) - ( return ? ) + ( return ? ) ;; = (break ?) ( get_local ) ( set_local ) ( .load((8|16)_)?(/)? ) diff --git a/ml-proto/host/parser.mly b/ml-proto/host/parser.mly index 5a66f996c5..e21caf3801 100644 --- a/ml-proto/host/parser.mly +++ b/ml-proto/host/parser.mly @@ -58,7 +58,7 @@ let c0 () = let enter_func c = assert (VarMap.is_empty c.labels); - {c with locals = empty ()} + {c with labels = VarMap.add "return" 0 c.labels; locals = empty ()} let lookup category space x = try VarMap.find x.it space.map @@ -191,7 +191,9 @@ oper : | CALLIMPORT var expr_list { fun c -> CallImport ($2 c import, $3 c) } | CALLINDIRECT var expr expr_list { fun c -> CallIndirect ($2 c table, $3 c, $4 c) } - | RETURN expr_opt { fun c -> Return ($2 c) } + | RETURN expr_opt /* Sugar */ + { let at1 = ati 1 in + fun c -> Sugar.return (label c ("return" @@ at1) @@ at1, $2 c) } | GETLOCAL var { fun c -> GetLocal ($2 c local) } | SETLOCAL var expr { fun c -> SetLocal ($2 c local, $3 c) } | LOAD expr { fun c -> Load ($1, $2 c) } diff --git a/ml-proto/spec/ast.ml b/ml-proto/spec/ast.ml index 1b3ee7a922..44eda0cb28 100644 --- a/ml-proto/spec/ast.ml +++ b/ml-proto/spec/ast.ml @@ -84,7 +84,6 @@ and expr' = | Call of var * expr list (* call function *) | CallImport of var * expr list (* call imported function *) | CallIndirect of var * expr * expr list (* call function through table *) - | Return of expr option (* return, optionally with a value *) | GetLocal of var (* read local variable *) | SetLocal of var * expr (* write local variable *) | Load of memop * expr (* read memory at address *) diff --git a/ml-proto/spec/check.ml b/ml-proto/spec/check.ml index 28afc891f0..7d7d7761b9 100644 --- a/ml-proto/spec/check.ml +++ b/ml-proto/spec/check.ml @@ -161,9 +161,6 @@ let rec check_expr c et e = check_exprs c ins es; check_type out et e.at - | Return eo -> - check_expr_option c c.return eo e.at - | GetLocal x -> check_type (Some (local c x)) et e.at diff --git a/ml-proto/spec/eval.ml b/ml-proto/spec/eval.ml index 121d5fa51a..0156a52061 100644 --- a/ml-proto/spec/eval.ml +++ b/ml-proto/spec/eval.ml @@ -38,8 +38,7 @@ type config = { module_ : instance; locals : value ref list; - labels : label list; - return : label + labels : label list } let lookup category list x = @@ -167,9 +166,6 @@ let rec eval_expr (c : config) (e : expr) = (* TODO: The conversion to int could overflow. *) eval_func c.module_ (table c x (Int32.to_int i @@ e1.at)) vs - | Return eo -> - raise (c.return (eval_expr_option c eo)) - | GetLocal x -> Some !(local c x) @@ -270,13 +266,11 @@ and eval_arm c vo stage arm = stage and eval_func (m : instance) (f : func) (evs : value list) = - let module Return = MakeLabel () in let args = List.map ref evs in let vars = List.map (fun t -> ref (default_value t.it)) f.it.locals in let locals = args @ vars in - let c = {module_ = m; locals; labels = []; return = Return.label} in - try eval_expr c f.it.body - with Return.Label vo -> vo + let c = {module_ = m; locals; labels = []} in + eval_expr c f.it.body (* Modules *) diff --git a/ml-proto/spec/sugar.ml b/ml-proto/spec/sugar.ml index 60111a21c8..379000b5d6 100644 --- a/ml-proto/spec/sugar.ml +++ b/ml-proto/spec/sugar.ml @@ -15,6 +15,9 @@ let labelled_block at es = let if_only (e1, e2) = If (e1, e2, Nop @@ Source.after e2.at) +let return (x, eo) = + Break (x, eo) + let loop_seq at es = Loop (expr_seq es) @@ -36,5 +39,5 @@ let case_only l = let func_body es = - (expr_seq es).it + Label (expr_seq es) diff --git a/ml-proto/spec/sugar.mli b/ml-proto/spec/sugar.mli index 12eee7fed3..d2fe6c1b1c 100644 --- a/ml-proto/spec/sugar.mli +++ b/ml-proto/spec/sugar.mli @@ -2,6 +2,7 @@ open Ast val labelled_block : Source.region -> expr list -> expr' val if_only : expr * expr -> expr' +val return : var * expr option -> expr' val loop_seq : Source.region -> expr list -> expr' val labelled_loop_seq : Source.region -> expr list -> expr' val labelled_loop_seq2 : Source.region -> expr list -> expr' From 533dd8a9ae6d7611592e979ae8fa50b4fc01d058 Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Fri, 9 Oct 2015 11:17:06 +0200 Subject: [PATCH 4/5] Construct all opcodes as sugar --- ml-proto/host/parser.mly | 137 +++++++++++++++++++-------------------- ml-proto/spec/ast.ml | 56 ++++++++-------- ml-proto/spec/check.ml | 8 +-- ml-proto/spec/eval.ml | 8 +-- ml-proto/spec/sugar.ml | 96 ++++++++++++++++++++++----- ml-proto/spec/sugar.mli | 40 ++++++++---- 6 files changed, 211 insertions(+), 134 deletions(-) diff --git a/ml-proto/host/parser.mly b/ml-proto/host/parser.mly index e21caf3801..edfa8a5eee 100644 --- a/ml-proto/host/parser.mly +++ b/ml-proto/host/parser.mly @@ -5,6 +5,7 @@ %{ open Source open Ast +open Sugar open Script @@ -31,16 +32,16 @@ let parse_error s = Error.error Source.no_region s (* Literals *) -let literal at s t = +let literal s t = try match t with - | Types.Int32Type -> Values.Int32 (I32.of_string s) @@ at - | Types.Int64Type -> Values.Int64 (I64.of_string s) @@ at - | Types.Float32Type -> Values.Float32 (F32.of_string s) @@ at - | Types.Float64Type -> Values.Float64 (F64.of_string s) @@ at + | Types.Int32Type -> Values.Int32 (I32.of_string s.it) @@ s.at + | Types.Int64Type -> Values.Int64 (I64.of_string s.it) @@ s.at + | Types.Float32Type -> Values.Float32 (F32.of_string s.it) @@ s.at + | Types.Float64Type -> Values.Float64 (F64.of_string s.it) @@ s.at with - | Failure reason -> Error.error at ("constant out of range: " ^ reason) - | _ -> Error.error at "constant out of range" + | Failure reason -> Error.error s.at ("constant out of range: " ^ reason) + | _ -> Error.error s.at "constant out of range" (* Symbolic variables *) @@ -115,9 +116,12 @@ let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels} %token CONVERT %token LOAD %token STORE -%token LOADEXTEND +%token LOADEXTEND %token STOREWRAP +%nonassoc VAR +%nonassoc LOW + %start script %type script @@ -137,8 +141,8 @@ value_type_list : /* Expressions */ literal : - | INT { $1 } - | FLOAT { $1 } + | INT { $1 @@ at () } + | FLOAT { $1 @@ at () } ; var : @@ -153,61 +157,52 @@ bind_var : | VAR { $1 @@ at () } ; +labeling : + | /* empty */ %prec LOW { let at = at () in fun c -> c, Unlabelled @@ at } + | bind_var { let at = at () in fun c -> bind_label c $1, Labelled @@ at } +; + expr : - | LPAR oper RPAR { let at = at () in fun c -> $2 c @@ at } + | LPAR expr1 RPAR { let at = at () in fun c -> $2 c @@ at } ; -oper : - | NOP { fun c -> Nop } - | BLOCK expr expr_list { fun c -> Block ($2 c :: $3 c) } - | BLOCK bind_var expr expr_list /* Sugar */ - { let at = at () in - fun c -> let c' = bind_label c $2 in - Sugar.labelled_block at ($3 c' :: $4 c) } - | IF expr expr expr { fun c -> If ($2 c, $3 c, $4 c) } - | IF expr expr /* Sugar */ - { fun c -> Sugar.if_only ($2 c, $3 c) } - | LOOP expr_list { let at = at () in fun c -> Sugar.loop_seq at ($2 c) } - | LOOP bind_var expr_list /* Sugar */ - { let at = at () in - fun c -> let c' = bind_label c $2 in - Sugar.labelled_loop_seq at ($3 c') } - | LOOP bind_var bind_var expr_list /* Sugar */ - { let at = at () in - fun c -> let c' = bind_label (bind_label c $2) $3 in - Sugar.labelled_loop_seq2 at ($4 c') } - | LABEL expr { fun c -> let c' = anon_label c in Label ($2 c') } - | LABEL bind_var expr /* Sugar */ - { fun c -> let c' = bind_label c $2 in Label ($3 c') } - | BREAK var expr_opt { fun c -> Break ($2 c label, $3 c) } - | SWITCH expr arms +expr1 : + | NOP { fun c -> nop } + | BLOCK labeling expr expr_list + { fun c -> let c', l = $2 c in block (l, $3 c' :: $4 c') } + | IF expr expr expr_opt { fun c -> if_ ($2 c, $3 c, $4 c) } + | LOOP labeling labeling expr_list + { fun c -> let c', l1 = $2 c in let c'', l2 = $3 c' in + loop (l1, l2, $4 c'') } + | LABEL labeling expr + { fun c -> let c', l = $2 c in + let c'' = if l.it = Unlabelled then anon_label c' else c' in + Sugar.label ($3 c'') } + | BREAK var expr_opt { fun c -> break ($2 c label, $3 c) } + | RETURN expr_opt { let at1 = ati 1 in - fun c -> let arms, e = $3 c in - Switch ($1 @@ at1, $2 c, List.map (fun a -> a $1) arms, e) } - | SWITCH bind_var expr arms /* Sugar */ - { let at = at () in let at2 = ati 2 in - fun c -> let c' = bind_label c $2 in let arms, e = $4 c' in - Sugar.labelled_switch at ($1 @@ at2, $3 c', List.map (fun a -> a $1) arms, e) } - | CALL var expr_list { fun c -> Call ($2 c func, $3 c) } - | CALLIMPORT var expr_list { fun c -> CallImport ($2 c import, $3 c) } - | CALLINDIRECT var expr expr_list - { fun c -> CallIndirect ($2 c table, $3 c, $4 c) } - | RETURN expr_opt /* Sugar */ + fun c -> return (label c ("return" @@ at1) @@ at1, $2 c) } + | SWITCH labeling expr cases { let at1 = ati 1 in - fun c -> Sugar.return (label c ("return" @@ at1) @@ at1, $2 c) } - | GETLOCAL var { fun c -> GetLocal ($2 c local) } - | SETLOCAL var expr { fun c -> SetLocal ($2 c local, $3 c) } - | LOAD expr { fun c -> Load ($1, $2 c) } - | STORE expr expr { fun c -> Store ($1, $2 c, $3 c) } - | LOADEXTEND expr { fun c -> LoadExtend ($1, $2 c) } - | STOREWRAP expr expr { fun c -> StoreWrap ($1, $2 c, $3 c) } - | CONST literal { let at = at () in fun c -> Const (literal at $2 $1) } - | UNARY expr { fun c -> Unary ($1, $2 c) } - | BINARY expr expr { fun c -> Binary ($1, $2 c, $3 c) } - | COMPARE expr expr { fun c -> Compare ($1, $2 c, $3 c) } - | CONVERT expr { fun c -> Convert ($1, $2 c) } - | PAGESIZE { fun c -> PageSize } - | MEMORYSIZE { fun c -> MemorySize } - | RESIZEMEMORY expr { fun c -> ResizeMemory ($2 c) } + fun c -> let c', l = $2 c in let cs, e = $4 c' in + switch (l, $1 @@ at1, $3 c', List.map (fun a -> a $1) cs, e) } + | CALL var expr_list { fun c -> call ($2 c func, $3 c) } + | CALLIMPORT var expr_list { fun c -> call_import ($2 c import, $3 c) } + | CALLINDIRECT var expr expr_list + { fun c -> call_indirect ($2 c table, $3 c, $4 c) } + | GETLOCAL var { fun c -> get_local ($2 c local) } + | SETLOCAL var expr { fun c -> set_local ($2 c local, $3 c) } + | LOAD expr { fun c -> load ($1, $2 c) } + | STORE expr expr { fun c -> store ($1, $2 c, $3 c) } + | LOADEXTEND expr { fun c -> load_extend ($1, $2 c) } + | STOREWRAP expr expr { fun c -> store_wrap ($1, $2 c, $3 c) } + | CONST literal { fun c -> const (literal $2 $1) } + | UNARY expr { fun c -> unary ($1, $2 c) } + | BINARY expr expr { fun c -> binary ($1, $2 c, $3 c) } + | COMPARE expr expr { fun c -> compare ($1, $2 c, $3 c) } + | CONVERT expr { fun c -> convert ($1, $2 c) } + | PAGESIZE { fun c -> page_size } + | MEMORYSIZE { fun c -> memory_size } + | RESIZEMEMORY expr { fun c -> resize_memory ($2 c) } ; expr_opt : | /* empty */ { fun c -> None } @@ -222,17 +217,19 @@ fallthrough : | /* empty */ { false } | FALLTHROUGH { true } ; -arm : - | LPAR CASE literal expr expr_list fallthrough RPAR - { let at = at () in let at3 = ati 3 in - fun c t -> Sugar.case_seq (literal at3 $3 t, $4 c :: $5 c, $6) @@ at } - | LPAR CASE literal RPAR /* Sugar */ - { let at = at () in let at3 = ati 3 in - fun c t -> Sugar.case_only (literal at3 $3 t) @@ at } + +case : + | LPAR case1 RPAR { let at = at () in fun c t -> $2 c t @@ at } +; +case1 : + | CASE literal expr expr_list fallthrough + { fun c t -> case (literal $2 t, Some ($3 c :: $4 c, $5)) } + | CASE literal + { fun c t -> case (literal $2 t, None) } ; -arms : +cases : | expr { fun c -> [], $1 c } - | arm arms { fun c -> let x, y = $2 c in $1 c :: x, y } /* Sugar */ + | case cases { fun c -> let x, y = $2 c in $1 c :: x, y } ; diff --git a/ml-proto/spec/ast.ml b/ml-proto/spec/ast.ml index 44eda0cb28..0bd14c35e6 100644 --- a/ml-proto/spec/ast.ml +++ b/ml-proto/spec/ast.ml @@ -64,7 +64,7 @@ type relop = (Int32Op.relop, Int64Op.relop, Float32Op.relop, Float64Op.relop) op type cvt = (Int32Op.cvt, Int64Op.cvt, Float32Op.cvt, Float64Op.cvt) op type memop = {ty : Types.value_type; align : int option} -type extendop = {memop : memop; sz : Memory.mem_size; ext : Memory.extension} +type extop = {memop : memop; sz : Memory.mem_size; ext : Memory.extension} type wrapop = {memop : memop; sz : Memory.mem_size} (* Expressions *) @@ -74,33 +74,33 @@ type literal = value Source.phrase type expr = expr' Source.phrase and expr' = - | Nop (* do nothing *) - | Block of expr list (* execute in sequence *) - | If of expr * expr * expr (* conditional *) - | Loop of expr (* infinite loop *) - | Label of expr (* labelled expression *) - | Break of var * expr option (* break to n-th surrounding label *) - | Switch of value_type * expr * arm list * expr (* switch, latter expr is default *) - | Call of var * expr list (* call function *) - | CallImport of var * expr list (* call imported function *) - | CallIndirect of var * expr * expr list (* call function through table *) - | GetLocal of var (* read local variable *) - | SetLocal of var * expr (* write local variable *) - | Load of memop * expr (* read memory at address *) - | Store of memop * expr * expr (* write memory at address *) - | LoadExtend of extendop * expr (* read memory at address and extend *) - | StoreWrap of wrapop * expr * expr (* wrap and write to memory at address *) - | Const of literal (* constant *) - | Unary of unop * expr (* unary arithmetic operator *) - | Binary of binop * expr * expr (* binary arithmetic operator *) - | Compare of relop * expr * expr (* arithmetic comparison *) - | Convert of cvt * expr (* conversion *) - | PageSize (* return host-defined page_size *) - | MemorySize (* return current size of linear memory *) - | ResizeMemory of expr (* resize linear memory *) - -and arm = arm' Source.phrase -and arm' = + | Nop (* do nothing *) + | Block of expr list (* execute in sequence *) + | If of expr * expr * expr (* conditional *) + | Loop of expr (* infinite loop *) + | Label of expr (* labelled expression *) + | Break of var * expr option (* break to n-th surrounding label *) + | Switch of value_type * expr * case list * expr (* switch, latter expr is default *) + | Call of var * expr list (* call function *) + | CallImport of var * expr list (* call imported function *) + | CallIndirect of var * expr * expr list (* call function through table *) + | GetLocal of var (* read local variable *) + | SetLocal of var * expr (* write local variable *) + | Load of memop * expr (* read memory at address *) + | Store of memop * expr * expr (* write memory at address *) + | LoadExtend of extop * expr (* read memory at address and extend *) + | StoreWrap of wrapop * expr * expr (* wrap and write to memory at address *) + | Const of literal (* constant *) + | Unary of unop * expr (* unary arithmetic operator *) + | Binary of binop * expr * expr (* binary arithmetic operator *) + | Compare of relop * expr * expr (* arithmetic comparison *) + | Convert of cvt * expr (* conversion *) + | PageSize (* return host-defined page_size *) + | MemorySize (* return current size of linear memory *) + | ResizeMemory of expr (* resize linear memory *) + +and case = case' Source.phrase +and case' = { value : literal; expr : expr; diff --git a/ml-proto/spec/check.ml b/ml-proto/spec/check.ml index 7d7d7761b9..92a1cad6f3 100644 --- a/ml-proto/spec/check.ml +++ b/ml-proto/spec/check.ml @@ -138,11 +138,11 @@ let rec check_expr c et e = | Break (x, eo) -> check_expr_option c (label c x) eo e.at - | Switch (t, e1, arms, e2) -> + | Switch (t, e1, cs, e2) -> require (t.it = Int32Type || t.it = Int64Type) t.at "invalid switch type"; (* TODO: Check that cases are unique. *) check_expr c (Some t.it) e1; - List.iter (check_arm c t.it et) arms; + List.iter (check_case c t.it et) cs; check_expr c et e2 | Call (x, es) -> @@ -234,8 +234,8 @@ and check_expr_option c et eo at = and check_literal c et l = check_type (Some (type_value l.it)) et l.at -and check_arm c t et arm = - let {value = l; expr = e; fallthru} = arm.it in +and check_case c t et case = + let {value = l; expr = e; fallthru} = case.it in check_literal c (Some t) l; check_expr c (if fallthru then None else et) e diff --git a/ml-proto/spec/eval.ml b/ml-proto/spec/eval.ml index 0156a52061..ea69ba152e 100644 --- a/ml-proto/spec/eval.ml +++ b/ml-proto/spec/eval.ml @@ -145,9 +145,9 @@ let rec eval_expr (c : config) (e : expr) = | Break (x, eo) -> raise (label c x (eval_expr_option c eo)) - | Switch (_t, e1, arms, e2) -> + | Switch (_t, e1, cs, e2) -> let vo = some (eval_expr c e1) e1.at in - (match List.fold_left (eval_arm c vo) `Seek arms with + (match List.fold_left (eval_case c vo) `Seek cs with | `Seek | `Fallthru -> eval_expr c e2 | `Done vs -> vs ) @@ -255,8 +255,8 @@ and eval_expr_option c eo = | Some e -> eval_expr c e | None -> None -and eval_arm c vo stage arm = - let {value; expr = e; fallthru} = arm.it in +and eval_case c vo stage case = + let {value; expr = e; fallthru} = case.it in match stage, vo = value.it with | `Seek, true | `Fallthru, _ -> if fallthru diff --git a/ml-proto/spec/sugar.ml b/ml-proto/spec/sugar.ml index 379000b5d6..134bb4dd1b 100644 --- a/ml-proto/spec/sugar.ml +++ b/ml-proto/spec/sugar.ml @@ -2,6 +2,14 @@ open Source open Ast +type labeling = labeling' phrase +and labeling' = Unlabelled | Labelled + +let labeling l e = + match l.it with + | Unlabelled -> e + | Labelled -> Label (e @@ l.at) + let expr_seq es = match es with | [] -> Nop @@ Source.no_region @@ -9,35 +17,89 @@ let expr_seq es = | es -> Block es @@@ List.map Source.at es -let labelled_block at es = - Label (Block es @@ at) +let nop = + Nop + +let block (l, es) = + labeling l (Block es) + +let if_ (e1, e2, eo) = + let e3 = Lib.Option.get eo (Nop @@ Source.after e2.at) in + If (e1, e2, e3) + +let loop (l1, l2, es) = + let e = expr_seq es in + labeling l1 (Loop (labeling l2 e.it @@ e.at)) -let if_only (e1, e2) = - If (e1, e2, Nop @@ Source.after e2.at) +let label e = + Label e + +let break (x, e) = + Break (x, e) let return (x, eo) = Break (x, eo) -let loop_seq at es = - Loop (expr_seq es) +let switch (l, t, e1, cs, e2) = + labeling l (Switch (t, e1, cs, e2)) + +let call (x, es) = + Call (x, es) + +let call_import (x, es) = + CallImport (x, es) + +let call_indirect (x, e, es) = + CallIndirect (x, e, es) + +let get_local x = + GetLocal x -let labelled_loop_seq at es = - Label (Loop (expr_seq es) @@ at) +let set_local (x, e) = + SetLocal (x, e) -let labelled_loop_seq2 at es = - Label (Loop (Label (expr_seq es) @@ at) @@ at) +let load (memop, e) = + Load (memop, e) -let labelled_switch at (t, e1, arms, e2) = - Label (Switch (t, e1, arms, e2) @@ at) +let store (memop, e1, e2) = + Store (memop, e1, e2) +let load_extend (extop, e) = + LoadExtend (extop, e) -let case_seq (l, es, fallthru) = - {value = l; expr = expr_seq es; fallthru} +let store_wrap (wrapop, e1, e2) = + StoreWrap (wrapop, e1, e2) -let case_only l = - {value = l; expr = Nop @@ Source.after l.at; fallthru = true} +let const c = + Const c + +let unary (unop, e) = + Unary (unop, e) + +let binary (binop, e1, e2) = + Binary (binop, e1, e2) + +let compare (relop, e1, e2) = + Compare (relop, e1, e2) + +let convert (cvt, e) = + Convert (cvt, e) + +let page_size = + PageSize + +let memory_size = + MemorySize + +let resize_memory e = + ResizeMemory e + + +let case (c, br) = + match br with + | Some (es, fallthru) -> {value = c; expr = expr_seq es; fallthru} + | None -> {value = c; expr = Nop @@ Source.after c.at; fallthru = true} let func_body es = Label (expr_seq es) - diff --git a/ml-proto/spec/sugar.mli b/ml-proto/spec/sugar.mli index d2fe6c1b1c..2cb3cdf3ca 100644 --- a/ml-proto/spec/sugar.mli +++ b/ml-proto/spec/sugar.mli @@ -1,16 +1,34 @@ open Ast -val labelled_block : Source.region -> expr list -> expr' -val if_only : expr * expr -> expr' -val return : var * expr option -> expr' -val loop_seq : Source.region -> expr list -> expr' -val labelled_loop_seq : Source.region -> expr list -> expr' -val labelled_loop_seq2 : Source.region -> expr list -> expr' -val labelled_switch : - Source.region -> value_type * expr * arm list * expr -> expr' +type labeling = labeling' Source.phrase +and labeling' = Unlabelled | Labelled -val case_seq : Ast.literal * Ast.expr list * bool -> Ast.arm' -val case_only : Ast.literal -> Ast.arm' +val nop : expr' +val block : labeling * expr list -> expr' +val if_ : expr * expr * expr option -> expr' +val loop : labeling * labeling * expr list -> expr' +val label : expr -> expr' +val break : var * expr option -> expr' +val return : var * expr option -> expr' +val switch : labeling * value_type * expr * case list * expr -> expr' +val call : var * expr list -> expr' +val call_import : var * expr list -> expr' +val call_indirect : var * expr * expr list -> expr' +val get_local : var -> expr' +val set_local : var * expr -> expr' +val load : memop * expr -> expr' +val store : memop * expr * expr -> expr' +val load_extend : extop * expr -> expr' +val store_wrap : wrapop * expr * expr -> expr' +val const : literal -> expr' +val unary : unop * expr -> expr' +val binary : binop * expr * expr -> expr' +val compare : relop * expr * expr -> expr' +val convert : cvt * expr -> expr' +val page_size : expr' +val memory_size : expr' +val resize_memory : expr -> expr' -val func_body : Ast.expr list -> Ast.expr' +val case : literal * (expr list * bool) option -> case' +val func_body : expr list -> expr' From 0282cdb60d19e0bbe993fa2dbb39437b8f4d59ec Mon Sep 17 00:00:00 2001 From: Andreas Rossberg Date: Fri, 9 Oct 2015 11:25:46 +0200 Subject: [PATCH 5/5] Resolve shift/reduce conflict the right way round --- ml-proto/host/parser.mly | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/ml-proto/host/parser.mly b/ml-proto/host/parser.mly index edfa8a5eee..cb10da7fa2 100644 --- a/ml-proto/host/parser.mly +++ b/ml-proto/host/parser.mly @@ -119,8 +119,8 @@ let anon_label c = {c with labels = VarMap.map ((+) 1) c.labels} %token LOADEXTEND %token STOREWRAP -%nonassoc VAR %nonassoc LOW +%nonassoc VAR %start script %type script