diff --git a/AST.ml b/AST.ml index a57d2e47d..0a7e0c3fc 100644 --- a/AST.ml +++ b/AST.ml @@ -41,6 +41,7 @@ let sepseq_to_region to_region = function type kwd_and = Region.t type kwd_begin = Region.t +type kwd_block = Region.t type kwd_case = Region.t type kwd_const = Region.t type kwd_contains = Region.t @@ -204,7 +205,7 @@ and record_type = { opening : kwd_record; field_decls : field_decls; terminator : semi option; - close : kwd_end + closing : kwd_end } and field_decls = (field_decl reg, semi) nsepseq @@ -297,12 +298,20 @@ and param_var = { } and block = { - opening : kwd_begin; + opening : block_opening; instr : instructions; terminator : semi option; - close : kwd_end + closing : block_closing } +and block_opening = + Block of kwd_block * lbrace +| Begin of kwd_begin + +and block_closing = + Block of rbrace +| End of kwd_end + and local_decl = LocalLam of lambda_decl | LocalConst of const_decl reg @@ -372,7 +381,7 @@ and map_injection = { opening : kwd_map; bindings : (binding reg, semi) nsepseq; terminator : semi option; - close : kwd_end + closing : kwd_end } and binding = { @@ -508,7 +517,7 @@ and set_injection = { opening : kwd_set; elements : (expr, semi) nsepseq; terminator : semi option; - close : kwd_end + closing : kwd_end } and map_expr = @@ -585,7 +594,7 @@ and record_injection = { opening : kwd_record; fields : (field_assign reg, semi) nsepseq; terminator : semi option; - close : kwd_end + closing : kwd_end } and field_assign = { @@ -875,11 +884,11 @@ and print_sum_type {value; _} = print_nsepseq "|" print_variant value and print_record_type {value; _} = - let {opening; field_decls; terminator; close} = value in + let {opening; field_decls; terminator; closing} = value in print_token opening "record"; print_field_decls field_decls; print_terminator terminator; - print_token close "end" + print_token closing "end" and print_type_app {value; _} = let type_name, type_tuple = value in @@ -998,11 +1007,20 @@ and print_param_var {value; _} = print_type_expr param_type and print_block {value; _} = - let {opening; instr; terminator; close} = value in - print_token opening "begin"; - print_instructions instr; - print_terminator terminator; - print_token close "end" + let {opening; instr; terminator; closing} = value in + print_block_opening opening; + print_instructions instr; + print_terminator terminator; + print_block_closing closing + +and print_block_opening = function + Block (kwd_block, lbrace) -> print_token kwd_block "block"; + print_token lbrace "{" +| Begin kwd_begin -> print_token kwd_begin "begin" + +and print_block_closing = function + Block rbrace -> print_token rbrace "}" +| End kwd_end -> print_token kwd_end "end" and print_local_decls sequence = List.iter print_local_decl sequence @@ -1260,11 +1278,11 @@ and print_record_expr = function | RecordProj e -> print_record_projection e and print_record_injection {value; _} = - let {opening; fields; terminator; close} = value in + let {opening; fields; terminator; closing} = value in print_token opening "record"; print_nsepseq ";" print_field_assign fields; print_terminator terminator; - print_token close "end" + print_token closing "end" and print_field_assign {value; _} = let {field_name; equal; field_expr} = value in @@ -1319,18 +1337,18 @@ and print_set_remove node = print_path set and print_map_injection {value; _} = - let {opening; bindings; terminator; close} = value in + let {opening; bindings; terminator; closing} = value in print_token opening "map"; print_nsepseq ";" print_binding bindings; print_terminator terminator; - print_token close "end" + print_token closing "end" and print_set_injection {value; _} = - let {opening; elements; terminator; close} = value in + let {opening; elements; terminator; closing} = value in print_token opening "set"; print_nsepseq ";" print_expr elements; print_terminator terminator; - print_token close "end" + print_token closing "end" and print_binding {value; _} = let {source; arrow; image} = value in diff --git a/AST.mli b/AST.mli index fbf7545d9..45086b17b 100644 --- a/AST.mli +++ b/AST.mli @@ -25,6 +25,7 @@ val sepseq_to_region : ('a -> Region.t) -> ('a,'sep) sepseq -> Region.t type kwd_and = Region.t type kwd_begin = Region.t +type kwd_block = Region.t type kwd_case = Region.t type kwd_const = Region.t type kwd_contains = Region.t @@ -188,7 +189,7 @@ and record_type = { opening : kwd_record; field_decls : field_decls; terminator : semi option; - close : kwd_end + closing : kwd_end } and field_decls = (field_decl reg, semi) nsepseq @@ -281,12 +282,20 @@ and param_var = { } and block = { - opening : kwd_begin; + opening : block_opening; instr : instructions; terminator : semi option; - close : kwd_end + closing : block_closing } +and block_opening = + Block of kwd_block * lbrace +| Begin of kwd_begin + +and block_closing = + Block of rbrace +| End of kwd_end + and local_decl = LocalLam of lambda_decl | LocalConst of const_decl reg @@ -356,7 +365,7 @@ and map_injection = { opening : kwd_map; bindings : (binding reg, semi) nsepseq; terminator : semi option; - close : kwd_end + closing : kwd_end } and binding = { @@ -492,7 +501,7 @@ and set_injection = { opening : kwd_set; elements : (expr, semi) nsepseq; terminator : semi option; - close : kwd_end + closing : kwd_end } and map_expr = @@ -569,7 +578,7 @@ and record_injection = { opening : kwd_record; fields : (field_assign reg, semi) nsepseq; terminator : semi option; - close : kwd_end + closing : kwd_end } and field_assign = { diff --git a/LexToken.mli b/LexToken.mli index b051120ae..e9d8a7f9a 100644 --- a/LexToken.mli +++ b/LexToken.mli @@ -67,6 +67,7 @@ type t = | And of Region.t (* "and" *) | Begin of Region.t (* "begin" *) +| Block of Region.t (* "block" *) | Case of Region.t (* "case" *) | Const of Region.t (* "const" *) | Contains of Region.t (* "contains" *) diff --git a/LexToken.mll b/LexToken.mll index ee2d663e3..bd7dc49ac 100644 --- a/LexToken.mll +++ b/LexToken.mll @@ -66,6 +66,7 @@ type t = | And of Region.t (* "and" *) | Begin of Region.t (* "begin" *) +| Block of Region.t (* "block" *) | Case of Region.t (* "case" *) | Const of Region.t (* "const" *) | Contains of Region.t (* "contains" *) @@ -190,6 +191,7 @@ let proj_token = function | And region -> region, "And" | Begin region -> region, "Begin" +| Block region -> region, "Block" | Case region -> region, "Case" | Const region -> region, "Const" | Contains region -> region, "Contains" @@ -279,6 +281,7 @@ let to_lexeme = function | And _ -> "and" | Begin _ -> "begin" +| Block _ -> "block" | Case _ -> "case" | Const _ -> "const" | Contains _ -> "contains" @@ -338,6 +341,7 @@ let to_region token = proj_token token |> fst let keywords = [ (fun reg -> And reg); (fun reg -> Begin reg); + (fun reg -> Block reg); (fun reg -> Case reg); (fun reg -> Const reg); (fun reg -> Contains reg); @@ -565,6 +569,7 @@ let is_ident = function let is_kwd = function And _ | Begin _ +| Block _ | Case _ | Const _ | Contains _ diff --git a/Lexer.mll b/Lexer.mll index 125dff093..c96bcf7bd 100644 --- a/Lexer.mll +++ b/Lexer.mll @@ -459,7 +459,7 @@ let byte_seq = byte | byte (byte | '_')* byte let bytes = "0x" (byte_seq? as seq) let esc = "\\n" | "\\\"" | "\\\\" | "\\b" | "\\r" | "\\t" | "\\x" byte -let symbol = ';' | ',' | '(' | ')'| '[' | ']' +let symbol = ';' | ',' | '(' | ')'| '[' | ']' | '{' | '}' | '#' | '|' | "->" | ":=" | '=' | ':' | '<' | "<=" | '>' | ">=" | "=/=" | '+' | '-' | '*' | '.' | '_' | '^' diff --git a/ParToken.mly b/ParToken.mly index cfa0b913b..ee5697457 100644 --- a/ParToken.mly +++ b/ParToken.mly @@ -17,6 +17,8 @@ %token COMMA (* "," *) %token LPAR (* "(" *) %token RPAR (* ")" *) +%token LBRACE (* "{" *) +%token RBRACE (* "}" *) %token LBRACKET (* "[" *) %token RBRACKET (* "]" *) %token CONS (* "#" *) @@ -42,6 +44,7 @@ %token And (* "and" *) %token Begin (* "begin" *) +%token Block (* "block" *) %token Case (* "case" *) %token Const (* "const" *) %token Contains (* "contains" *) diff --git a/Parser.mly b/Parser.mly index 9889ddf9c..2bbffd9d3 100644 --- a/Parser.mly +++ b/Parser.mly @@ -21,32 +21,32 @@ open AST (* RULES *) -(* The rule [series(Item)] parses a list of [Item] separated by - semi-colons and optionally terminated by a semi-colon, then the - keyword [End]. *) +(* The rule [series(Item,TERM)] parses a list of [Item] separated by + semicolons and optionally terminated by a semicolon, then the + terminal TERM. *) -series(Item): - Item after_item(Item) { $1,$2 } +series(Item,TERM): + Item after_item(Item,TERM) { $1,$2 } -after_item(Item): - SEMI item_or_end(Item) { +after_item(Item,TERM): + SEMI item_or_closing(Item,TERM) { match $2 with - `Some (item, items, term, close) -> - ($1, item)::items, term, close - | `End close -> - [], Some $1, close + `Some (item, items, term, closing) -> + ($1, item)::items, term, closing + | `Closing closing -> + [], Some $1, closing } -| End { +| TERM { [], None, $1 } -item_or_end(Item): - End { - `End $1 +item_or_closing(Item,TERM): + TERM { + `Closing $1 } -| series(Item) { - let item, (items, term, close) = $1 - in `Some (item, items, term, close) +| series(Item,TERM) { + let item, (items, term, closing) = $1 + in `Some (item, items, term, closing) } (* Compound constructs *) @@ -198,14 +198,14 @@ variant: } record_type: - Record series(field_decl) { - let first, (others, terminator, close) = $2 in - let region = cover $1 close + Record series(field_decl,End) { + let first, (others, terminator, closing) = $2 in + let region = cover $1 closing and value = { opening = $1; field_decls = first, others; terminator; - close} + closing} in {region; value} } @@ -356,14 +356,24 @@ core_param_type: } block: - Begin series(instruction) { - let first, (others, terminator, close) = $2 in - let region = cover $1 close + Begin series(instruction,End) { + let first, (others, terminator, closing) = $2 in + let region = cover $1 closing and value = { - opening = $1; + opening = Begin $1; instr = first, others; terminator; - close} + closing = End closing} + in {region; value} + } +| Block LBRACE series(instruction,RBRACE) { + let first, (others, terminator, closing) = $3 in + let region = cover $1 closing + and value = { + opening = Block ($1,$2); + instr = first, others; + terminator; + closing = Block closing} in {region; value} } @@ -449,10 +459,9 @@ extended_expr: | map_injection { {region = $1.region; value = `EMap $1} } | set_injection { {region = $1.region; value = `ESet $1} } - instruction: single_instr { Single $1 } -| block { Block $1 } +| block { Block $1 : instruction } single_instr: conditional { Cond $1 } @@ -515,26 +524,26 @@ map_patch: } set_injection: - Set series(expr) { - let first, (others, terminator, close) = $2 in - let region = cover $1 close + Set series(expr,End) { + let first, (others, terminator, closing) = $2 in + let region = cover $1 closing and value = { opening = $1; elements = first, others; terminator; - close} + closing} in {region; value} } map_injection: - Map series(binding) { - let first, (others, terminator, close) = $2 in - let region = cover $1 close + Map series(binding,End) { + let first, (others, terminator, closing) = $2 in + let region = cover $1 closing and value = { opening = $1; bindings = first, others; terminator; - close} + closing} in {region; value} } @@ -885,14 +894,14 @@ record_expr: | record_projection { RecordProj $1 } record_injection: - Record series(field_assignment) { - let first, (others, terminator, close) = $2 in - let region = cover $1 close + Record series(field_assignment,End) { + let first, (others, terminator, closing) = $2 in + let region = cover $1 closing and value = { opening = $1; fields = first, others; terminator; - close} + closing} in {region; value} } diff --git a/Tests/crowdfunding.ligo b/Tests/crowdfunding.ligo index cd1f76f3b..1d00168a0 100644 --- a/Tests/crowdfunding.ligo +++ b/Tests/crowdfunding.ligo @@ -11,7 +11,7 @@ entrypoint contribute (storage store : store; const amount : mutez) : store * list (operation) is var operations : list (operation) := [] - begin + block { if now > store.deadline then fail "Deadline passed"; else @@ -20,14 +20,14 @@ entrypoint contribute (storage store : store; // None -> patch store.backers with map sender -> amount end | _ -> skip end - end with (store, operations) + } with (store, operations) entrypoint withdraw (storage store : store; const sender : address) : store * list (operation) is var operations : list (operation) := [] begin if sender = owner then - if now >= store.deadline then + if now (Unit) >= store.deadline then if balance >= store.goal then begin store.funded := True;