diff --git a/src/ligo/ligo-parser/.gitignore b/src/ligo/ligo-parser/.gitignore index 5d8b6a914..5bb749771 100644 --- a/src/ligo/ligo-parser/.gitignore +++ b/src/ligo/ligo-parser/.gitignore @@ -6,3 +6,7 @@ _build/* *.install /Version.ml /dune-project +/Parser.mli +/Parser.ml +/Lexer.ml +/LexToken.ml diff --git a/src/ligo/ligo-parser/AST.ml b/src/ligo/ligo-parser/AST.ml index 9c1952551..cf2de7662 100644 --- a/src/ligo/ligo-parser/AST.ml +++ b/src/ligo/ligo-parser/AST.ml @@ -338,7 +338,7 @@ and instruction = and single_instr = Cond of conditional reg -| Case_instr of case_instr reg +| CaseInstr of instruction case reg | Assign of assignment reg | Loop of loop | ProcCall of fun_call @@ -418,38 +418,19 @@ and set_membership = { element : expr } -and case_instr = { - kwd_case : kwd_case; - expr : expr; - kwd_of : kwd_of; - lead_vbar : vbar option; - cases_instr : cases_instr; - kwd_end : kwd_end +and 'a case = { + kwd_case : kwd_case; + expr : expr; + kwd_of : kwd_of; + lead_vbar : vbar option; + cases : ('a case_clause reg, vbar) nsepseq reg; + kwd_end : kwd_end } -and cases_instr = (case_clause_instr reg, vbar) nsepseq reg - -and case_clause_instr = { +and 'a case_clause = { pattern : pattern; arrow : arrow; - instr : instruction -} - -and case_expr = { - kwd_case : kwd_case; - expr : expr; - kwd_of : kwd_of; - lead_vbar : vbar option; - cases_expr: cases_expr; - kwd_end : kwd_end -} - -and cases_expr = (case_clause_expr reg, vbar) nsepseq reg - -and case_clause_expr = { - pattern : pattern; - arrow : arrow; - expr : expr; + rhs : 'a } and assignment = { @@ -508,7 +489,7 @@ and for_collect = { (* Expressions *) and expr = -| ECase of case_expr reg +| ECase of expr case reg | ELogic of logic_expr | EArith of arith_expr | EString of string_expr @@ -773,7 +754,7 @@ let path_to_region = function let instr_to_region = function Single Cond {region; _} -| Single Case_instr {region; _} +| Single CaseInstr {region; _} | Single Assign {region; _} | Single Loop While {region; _} | Single Loop For ForInt {region; _} @@ -1092,7 +1073,7 @@ and print_instruction = function and print_single_instr = function Cond {value; _} -> print_conditional value -| Case_instr {value; _} -> print_case_instr value +| CaseInstr {value; _} -> print_case_instr value | Assign assign -> print_assignment assign | Loop loop -> print_loop loop | ProcCall fun_call -> print_fun_call fun_call @@ -1129,14 +1110,14 @@ and print_if_clause = function print_terminator terminator; print_token rbrace "}" -and print_case_instr (node : case_instr) = +and print_case_instr (node : instruction case) = let {kwd_case; expr; kwd_of; - lead_vbar; cases_instr; kwd_end} = node in + lead_vbar; cases; kwd_end} = node in print_token kwd_case "case"; print_expr expr; print_token kwd_of "of"; print_token_opt lead_vbar "|"; - print_cases_instr cases_instr; + print_cases_instr cases; print_token kwd_end "end" and print_token_opt = function @@ -1147,10 +1128,10 @@ and print_cases_instr {value; _} = print_nsepseq "|" print_case_clause_instr value and print_case_clause_instr {value; _} = - let {pattern; arrow; instr} = value in + let {pattern; arrow; rhs} = value in print_pattern pattern; print_token arrow "->"; - print_instruction instr + print_instruction rhs and print_assignment {value; _} = let {lhs; assign; rhs} = value in @@ -1240,24 +1221,24 @@ and print_expr = function | ETuple e -> print_tuple_expr e | EPar e -> print_par_expr e -and print_case_expr (node : case_expr) = +and print_case_expr (node : expr case) = let {kwd_case; expr; kwd_of; - lead_vbar; cases_expr; kwd_end} = node in + lead_vbar; cases; kwd_end} = node in print_token kwd_case "case"; print_expr expr; print_token kwd_of "of"; print_token_opt lead_vbar "|"; - print_cases_expr cases_expr; + print_cases_expr cases; print_token kwd_end "end" and print_cases_expr {value; _} = print_nsepseq "|" print_case_clause_expr value and print_case_clause_expr {value; _} = - let {pattern; arrow; expr} = value in + let {pattern; arrow; rhs} = value in print_pattern pattern; print_token arrow "->"; - print_expr expr + print_expr rhs and print_map_expr = function MapLookUp {value; _} -> print_map_lookup value diff --git a/src/ligo/ligo-parser/AST.mli b/src/ligo/ligo-parser/AST.mli index fa319c035..cf8ac5ddc 100644 --- a/src/ligo/ligo-parser/AST.mli +++ b/src/ligo/ligo-parser/AST.mli @@ -322,7 +322,7 @@ and instruction = and single_instr = Cond of conditional reg -| Case_instr of case_instr reg +| CaseInstr of instruction case reg | Assign of assignment reg | Loop of loop | ProcCall of fun_call @@ -402,38 +402,19 @@ and set_membership = { element : expr } -and case_instr = { +and 'a case = { kwd_case : kwd_case; expr : expr; kwd_of : kwd_of; lead_vbar : vbar option; - cases_instr : cases_instr; + cases : ('a case_clause reg, vbar) nsepseq reg; kwd_end : kwd_end } -and cases_instr = (case_clause_instr reg, vbar) nsepseq reg - -and case_clause_instr = { +and 'a case_clause = { pattern : pattern; arrow : arrow; - instr : instruction -} - -and case_expr = { - kwd_case : kwd_case; - expr : expr; - kwd_of : kwd_of; - lead_vbar : vbar option; - cases_expr: cases_expr; - kwd_end : kwd_end -} - -and cases_expr = (case_clause_expr reg, vbar) nsepseq reg - -and case_clause_expr = { - pattern : pattern; - arrow : arrow; - expr : expr; + rhs : 'a } and assignment = { @@ -492,7 +473,7 @@ and for_collect = { (* Expressions *) and expr = - ECase of case_expr reg + ECase of expr case reg | ELogic of logic_expr | EArith of arith_expr | EString of string_expr diff --git a/src/ligo/ligo-parser/Parser.mly b/src/ligo/ligo-parser/Parser.mly index 75bea0049..ca79c8934 100644 --- a/src/ligo/ligo-parser/Parser.mly +++ b/src/ligo/ligo-parser/Parser.mly @@ -21,9 +21,9 @@ open AST (* RULES *) -(* The rule [series(Item,TERM)] parses a list of [Item] separated by - semicolons and optionally terminated by a semicolon, then the - terminal TERM. *) +(* The rule [series(Item,TERM)] parses a non-empty list of [Item] + separated by semicolons and optionally terminated by a semicolon, + then the terminal TERM. *) series(Item,TERM): Item after_item(Item,TERM) { $1,$2 } @@ -492,7 +492,7 @@ instruction: single_instr: conditional { Cond $1 } -| case_instr { Case_instr $1 } +| case_instr { CaseInstr $1 } | assignment { Assign $1 } | loop { Loop $1 } | proc_call { ProcCall $1 } @@ -683,14 +683,21 @@ if_clause: case_instr: Case expr Of option(VBAR) cases_instr End { let region = cover $1 $6 in - let value = { + let value = { kwd_case = $1; expr = $2; kwd_of = $3; lead_vbar = $4; - cases_instr = $5; + cases = $5; kwd_end = $6} in {region; value}} +(*| Case expr LBRACKET option(VBAR) case_instr RBRACKET { + let region = cover $1 $6 in + let value = { + k + } + } + *) cases_instr: nsepseq(case_clause_instr,VBAR) { @@ -699,8 +706,9 @@ cases_instr: case_clause_instr: pattern ARROW instruction { - let region = cover (pattern_to_region $1) (instr_to_region $3) - and value = {pattern = $1; arrow = $2; instr = $3} + let start = pattern_to_region $1 in + let region = cover start (instr_to_region $3) + and value = {pattern=$1; arrow=$2; rhs=$3} in {region; value}} assignment: @@ -779,12 +787,12 @@ expr: case_expr: Case expr Of option(VBAR) cases_expr End { let region = cover $1 $6 in - let value = { + let value : expr case = { kwd_case = $1; expr = $2; kwd_of = $3; lead_vbar = $4; - cases_expr = $5; + cases = $5; kwd_end = $6} in ECase {region; value}} @@ -795,8 +803,9 @@ cases_expr: case_clause_expr: pattern ARROW expr { - let region = cover (pattern_to_region $1) (expr_to_region $3) - and value = {pattern = $1; arrow = $2; expr = $3} + let start = pattern_to_region $1 in + let region = cover start (expr_to_region $3) + and value = {pattern=$1; arrow=$2; rhs=$3} in {region; value}} disj_expr: diff --git a/src/ligo/simplify.ml b/src/ligo/simplify.ml index 611b4d7b8..0e57dd2a0 100644 --- a/src/ligo/simplify.ml +++ b/src/ligo/simplify.ml @@ -163,13 +163,13 @@ let rec simpl_expression (t:Raw.expr) : ae result = | ECase c -> let%bind e = simpl_expression c.value.expr in let%bind lst = - let aux (x:Raw.case_clause_expr) = - let%bind expr = simpl_expression x.expr in + let aux (x : Raw.expr Raw.case_clause) = + let%bind expr = simpl_expression x.rhs in ok (x.pattern, expr) in bind_list @@ List.map aux @@ List.map get_value - @@ npseq_to_list c.value.cases_expr.value in + @@ npseq_to_list c.value.cases.value in let%bind cases = simpl_cases lst in ok @@ ae @@ E_matching (e, cases) | EMap (MapInj mi) -> @@ -393,16 +393,16 @@ and simpl_single_instruction : Raw.single_instr -> instruction result = fun t -> | _ -> simple_fail "no weird assignments yet" in ok @@ I_assignment {name ; annotated_expression} - | Case_instr c -> + | CaseInstr c -> let c = c.value in let%bind expr = simpl_expression c.expr in let%bind cases = - let aux (x : Raw.case_clause_instr Raw.reg) = - let%bind i = simpl_instruction_block x.value.instr in + let aux (x : Raw.instruction Raw.case_clause Raw.reg) = + let%bind i = simpl_instruction_block x.value.rhs in ok (x.value.pattern, i) in bind_list @@ List.map aux - @@ npseq_to_list c.cases_instr.value in + @@ npseq_to_list c.cases.value in let%bind m = simpl_cases cases in ok @@ I_matching (expr, m) | RecordPatch r ->