From 4a9150f5601b95043707851c54e84f75c125ccf2 Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Thu, 24 Oct 2019 09:58:33 +0200 Subject: [PATCH 1/2] WIP: Fixing a regression (blocks in case clauses as intructions). --- src/passes/1-parser/pascaligo/AST.ml | 2 +- src/passes/1-parser/pascaligo/AST.mli | 2 +- src/passes/1-parser/pascaligo/Parser.mly | 2 +- src/passes/1-parser/pascaligo/ParserLog.ml | 10 +++++----- src/passes/2-simplify/pascaligo.ml | 19 ++++++++++++++----- 5 files changed, 22 insertions(+), 13 deletions(-) diff --git a/src/passes/1-parser/pascaligo/AST.ml b/src/passes/1-parser/pascaligo/AST.ml index 35726f15b..177d654df 100644 --- a/src/passes/1-parser/pascaligo/AST.ml +++ b/src/passes/1-parser/pascaligo/AST.ml @@ -284,7 +284,7 @@ and var_decl = { and instruction = Cond of conditional reg -| CaseInstr of instruction case reg +| CaseInstr of if_clause case reg | Assign of assignment reg | Loop of loop | ProcCall of fun_call diff --git a/src/passes/1-parser/pascaligo/AST.mli b/src/passes/1-parser/pascaligo/AST.mli index a682a9cd1..520674a4b 100644 --- a/src/passes/1-parser/pascaligo/AST.mli +++ b/src/passes/1-parser/pascaligo/AST.mli @@ -275,7 +275,7 @@ and var_decl = { and instruction = Cond of conditional reg -| CaseInstr of instruction case reg +| CaseInstr of if_clause case reg | Assign of assignment reg | Loop of loop | ProcCall of fun_call diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index 77abea723..d6ef4bdae 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -566,7 +566,7 @@ clause_block: ShortBlock {value; region} } case_instr: - case(instruction) { $1 instr_to_region } + case(if_clause) { $1 if_clause_to_region } case(rhs): Case expr Of option(VBAR) cases(rhs) End { diff --git a/src/passes/1-parser/pascaligo/ParserLog.ml b/src/passes/1-parser/pascaligo/ParserLog.ml index 3941cbb79..d47e0065e 100644 --- a/src/passes/1-parser/pascaligo/ParserLog.ml +++ b/src/passes/1-parser/pascaligo/ParserLog.ml @@ -295,7 +295,7 @@ and print_clause_block buffer = function print_terminator buffer terminator; print_token buffer rbrace "}" -and print_case_instr buffer (node : instruction case) = +and print_case_instr buffer (node : if_clause case) = let {kwd_case; expr; opening; lead_vbar; cases; closing} = node in print_token buffer kwd_case "case"; @@ -314,9 +314,9 @@ and print_cases_instr buffer {value; _} = and print_case_clause_instr buffer {value; _} = let {pattern; arrow; rhs} = value in - print_pattern buffer pattern; - print_token buffer arrow "->"; - print_instruction buffer rhs + print_pattern buffer pattern; + print_token buffer arrow "->"; + print_if_clause buffer rhs and print_assignment buffer {value; _} = let {lhs; assign; rhs} = value in @@ -921,7 +921,7 @@ and pp_instruction buffer ~pad:(_,pc as pad) = function pp_conditional buffer ~pad value | CaseInstr {value; _} -> pp_node buffer ~pad "CaseInstr"; - pp_case pp_instruction buffer ~pad value + pp_case pp_if_clause buffer ~pad value | Assign {value; _} -> pp_node buffer ~pad "Assign"; pp_assignment buffer ~pad value diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 742c22eb7..1821627a4 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -708,15 +708,24 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul let (c , loc) = r_split c in let%bind expr = simpl_expression c.expr in let%bind cases = - let aux (x : Raw.instruction Raw.case_clause Raw.reg) = - let%bind i = simpl_instruction x.value.rhs in - let%bind i = i None in - ok (x.value.pattern, i) in + let aux (x : Raw.if_clause Raw.case_clause Raw.reg) = + let%bind case_clause = + match x.value.rhs with + ClauseInstr i -> + simpl_single_instruction i + | ClauseBlock b -> + match b with + LongBlock {value; _} -> + simpl_block value + | ShortBlock {value; _} -> + simpl_statements @@ fst value.inside in + ok (x.value.pattern, case_clause None) in bind_list @@ List.map aux @@ npseq_to_list c.cases.value in let%bind m = simpl_cases cases in - return_statement @@ e_matching ~loc expr m + let%bind toto = ok @@ e_matching ~loc expr m in + return_statement @@ toto ) | RecordPatch r -> ( let r = r.value in From c0f4aaf0c7f61605dfe4d30390c4105a0c42608b Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Thu, 24 Oct 2019 10:29:41 +0200 Subject: [PATCH 2/2] Fixed the regression on case clauses (blocks were removed). --- src/passes/2-simplify/pascaligo.ml | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 1821627a4..64816920c 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -718,14 +718,14 @@ and simpl_single_instruction : Raw.instruction -> (_ -> expression result) resul LongBlock {value; _} -> simpl_block value | ShortBlock {value; _} -> - simpl_statements @@ fst value.inside in - ok (x.value.pattern, case_clause None) in + simpl_statements @@ fst value.inside in + let%bind case_clause = case_clause None in + ok (x.value.pattern, case_clause) in bind_list @@ List.map aux @@ npseq_to_list c.cases.value in let%bind m = simpl_cases cases in - let%bind toto = ok @@ e_matching ~loc expr m in - return_statement @@ toto + return_statement @@ e_matching ~loc expr m ) | RecordPatch r -> ( let r = r.value in