From 36d9858e97d1f0a29cebf91af48ff2b8501e0bae Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Thu, 17 Oct 2019 18:33:58 +0200 Subject: [PATCH 1/2] Removed sub-blocks from PascaLIGO. --- src/passes/1-parser/pascaligo/AST.ml | 47 ++++++++++++---------- src/passes/1-parser/pascaligo/AST.mli | 10 ++--- src/passes/1-parser/pascaligo/Parser.mly | 25 ++++++------ src/passes/1-parser/pascaligo/ParserLog.ml | 31 +++++++------- src/passes/2-simplify/pascaligo.ml | 45 +++++++++------------ 5 files changed, 77 insertions(+), 81 deletions(-) diff --git a/src/passes/1-parser/pascaligo/AST.ml b/src/passes/1-parser/pascaligo/AST.ml index 537901bab..36cbdf637 100644 --- a/src/passes/1-parser/pascaligo/AST.ml +++ b/src/passes/1-parser/pascaligo/AST.ml @@ -284,10 +284,6 @@ and var_decl = { } and instruction = - Single of single_instr -| Block of block reg - -and single_instr = Cond of conditional reg | CaseInstr of instruction case reg | Assign of assignment reg @@ -355,7 +351,11 @@ and conditional = { and if_clause = ClauseInstr of instruction -| ClauseBlock of (statements * semi option) braces reg +| ClauseBlock of clause_block + +and clause_block = + LongBlock of block reg +| ShortBlock of (statements * semi option) braces reg and set_membership = { set : expr; @@ -661,7 +661,7 @@ and comp_expr_to_region = function | Neq {region; _} -> region and arith_expr_to_region = function -| Add {region; _} + Add {region; _} | Sub {region; _} | Mult {region; _} | Div {region; _} @@ -675,7 +675,7 @@ and string_expr_to_region = function Cat {region; _} | String {region; _} -> region -and annot_expr_to_region ({region; _}) = region +and annot_expr_to_region {region; _} = region and list_expr_to_region = function Cons {region; _} @@ -694,24 +694,27 @@ let path_to_region = function | Path {region; _} -> region let instr_to_region = function - Single Cond {region; _} -| Single CaseInstr {region; _} -| Single Assign {region; _} -| Single Loop While {region; _} -| Single Loop For ForInt {region; _} -| Single Loop For ForCollect {region; _} -| Single ProcCall {region; _} -| Single Skip region -| Single RecordPatch {region; _} -| Single MapPatch {region; _} -| Single SetPatch {region; _} -| Single MapRemove {region; _} -| Single SetRemove {region; _} -| Block {region; _} -> region + Cond {region; _} +| CaseInstr {region; _} +| Assign {region; _} +| Loop While {region; _} +| Loop For ForInt {region; _} +| Loop For ForCollect {region; _} +| ProcCall {region; _} +| Skip region +| RecordPatch {region; _} +| MapPatch {region; _} +| SetPatch {region; _} +| MapRemove {region; _} +| SetRemove {region; _} -> region + +let clause_block_to_region = function + LongBlock {region; _} +| ShortBlock {region; _} -> region let if_clause_to_region = function ClauseInstr instr -> instr_to_region instr -| ClauseBlock {region; _} -> region +| ClauseBlock clause_block -> clause_block_to_region clause_block let pattern_to_region = function PCons {region; _} diff --git a/src/passes/1-parser/pascaligo/AST.mli b/src/passes/1-parser/pascaligo/AST.mli index 8bda1d76e..e18903f55 100644 --- a/src/passes/1-parser/pascaligo/AST.mli +++ b/src/passes/1-parser/pascaligo/AST.mli @@ -275,10 +275,6 @@ and var_decl = { } and instruction = - Single of single_instr -| Block of block reg - -and single_instr = Cond of conditional reg | CaseInstr of instruction case reg | Assign of assignment reg @@ -346,7 +342,11 @@ and conditional = { and if_clause = ClauseInstr of instruction -| ClauseBlock of (statements * semi option) braces reg +| ClauseBlock of clause_block + +and clause_block = + LongBlock of block reg +| ShortBlock of (statements * semi option) braces reg and set_membership = { set : expr; diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index dfb401942..bd9f63174 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -377,10 +377,6 @@ var_decl: | open_var_decl { $1 } instruction: - single_instr { Single $1 } -| block { Block $1 } - -single_instr: conditional { Cond $1 } | case_instr { CaseInstr $1 } | assignment { Assign $1 } @@ -512,16 +508,19 @@ conditional: in {region; value} } if_clause: - instruction { - ClauseInstr $1 - } + instruction { ClauseInstr $1 } +| clause_block { ClauseBlock $1 } + +clause_block: + block { + LongBlock $1 } | LBRACE sep_or_term_list(statement,SEMI) RBRACE { - let region = cover $1 $3 in - let value = { - lbrace = $1; - inside = $2; - rbrace = $3} in - ClauseBlock {value; region} } + let region = cover $1 $3 in + let value = { + lbrace = $1; + inside = $2; + rbrace = $3} in + ShortBlock {value; region} } case_instr: case(instruction) { $1 instr_to_region } diff --git a/src/passes/1-parser/pascaligo/ParserLog.ml b/src/passes/1-parser/pascaligo/ParserLog.ml index be363e4b2..de4b683c2 100644 --- a/src/passes/1-parser/pascaligo/ParserLog.ml +++ b/src/passes/1-parser/pascaligo/ParserLog.ml @@ -244,10 +244,6 @@ and print_statement buffer = function | Data data -> print_data_decl buffer data and print_instruction buffer = function - Single instr -> print_single_instr buffer instr -| Block block -> print_block buffer block - -and print_single_instr buffer = function Cond {value; _} -> print_conditional buffer value | CaseInstr {value; _} -> print_case_instr buffer value | Assign assign -> print_assignment buffer assign @@ -273,7 +269,12 @@ and print_conditional buffer node = and print_if_clause buffer = function ClauseInstr instr -> print_instruction buffer instr -| ClauseBlock {value; _} -> +| ClauseBlock block -> print_clause_block buffer block + +and print_clause_block buffer = function + LongBlock block -> + print_block buffer block +| ShortBlock {value; _} -> let {lbrace; inside; rbrace} = value in let statements, terminator = inside in print_token buffer lbrace "{"; @@ -885,14 +886,6 @@ and pp_statement buffer ~pad:(_,pc as pad) = function pp_data_decl buffer ~pad:(mk_pad 1 0 pc) data_decl and pp_instruction buffer ~pad:(_,pc as pad) = function - Single single_instr -> - pp_node buffer ~pad "Single"; - pp_single_instr buffer ~pad:(mk_pad 1 0 pc) single_instr -| Block {value; _} -> - pp_node buffer ~pad "Block"; - pp_statements buffer ~pad value.statements - -and pp_single_instr buffer ~pad:(_,pc as pad) = function Cond {value; _} -> pp_node buffer ~pad "Cond"; pp_conditional buffer ~pad value @@ -945,9 +938,17 @@ and pp_if_clause buffer ~pad:(_,pc as pad) = function ClauseInstr instr -> pp_node buffer ~pad "ClauseInstr"; pp_instruction buffer ~pad:(mk_pad 1 0 pc) instr -| ClauseBlock {value; _} -> +| ClauseBlock block -> pp_node buffer ~pad "ClauseBlock"; - let statements, _ = value.inside in + pp_clause_block buffer ~pad:(mk_pad 1 0 pc) block + +and pp_clause_block buffer ~pad = function + LongBlock {value; _} -> + pp_node buffer ~pad "LongBlock"; + pp_statements buffer ~pad value.statements +| ShortBlock {value; _} -> + pp_node buffer ~pad "ShortBlock"; + let statements = fst value.inside in pp_statements buffer ~pad statements and pp_case : diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 919976d1f..1a2bd6227 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -147,16 +147,6 @@ module Errors = struct ] in error ~data title message - let unsupported_sub_blocks b = - let title () = "block instructions" in - let message () = - Format.asprintf "Sub-blocks are not supported yet" in - let data = [ - ("block_loc", - fun () -> Format.asprintf "%a" Location.pp_lift @@ b.Region.region) - ] in - error ~data title message - (* Logging *) let simplifying_instruction t = @@ -640,7 +630,7 @@ and simpl_statement : Raw.statement -> (_ -> expression result) result = | Instr i -> simpl_instruction i | Data d -> simpl_data_declaration d -and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) result = +and simpl_single_instruction : Raw.instruction -> (_ -> expression result) result = fun t -> match t with | ProcCall x -> ( @@ -672,11 +662,23 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu let (c , loc) = r_split c in let%bind expr = simpl_expression c.test in let%bind match_true = match c.ifso with - | ClauseInstr i -> simpl_instruction_block i - | ClauseBlock b -> simpl_statements @@ fst b.value.inside in + ClauseInstr i -> + simpl_single_instruction i + | ClauseBlock b -> + match b with + LongBlock {value; _} -> + simpl_block value + | ShortBlock {value; _} -> + simpl_statements @@ fst value.inside in let%bind match_false = match c.ifnot with - | ClauseInstr i -> simpl_instruction_block i - | ClauseBlock b -> simpl_statements @@ fst b.value.inside in + ClauseInstr i -> + simpl_single_instruction i + | ClauseBlock b -> + match b with + LongBlock {value; _} -> + simpl_block value + | ShortBlock {value; _} -> + simpl_statements @@ fst value.inside in let%bind match_true = match_true None in let%bind match_false = match_false None in return_statement @@ e_matching expr ~loc (Match_bool {match_true; match_false}) @@ -708,7 +710,7 @@ and simpl_single_instruction : Raw.single_instr -> (_ -> expression result) resu 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_block x.value.rhs in + let%bind i = simpl_instruction x.value.rhs in let%bind i = i None in ok (x.value.pattern, i) in bind_list @@ -914,18 +916,9 @@ and simpl_cases : type a . (Raw.pattern * a) list -> a matching result = fun t - bind_map_list aux lst in ok @@ Match_variant constrs -and simpl_instruction_block : Raw.instruction -> (_ -> expression result) result = - fun t -> - match t with - | Single s -> simpl_single_instruction s - | Block b -> simpl_block b.value - and simpl_instruction : Raw.instruction -> (_ -> expression result) result = fun t -> - trace (simplifying_instruction t) @@ - match t with - | Single s -> simpl_single_instruction s - | Block b -> fail @@ unsupported_sub_blocks b + trace (simplifying_instruction t) @@ simpl_single_instruction t and simpl_statements : Raw.statements -> (_ -> expression result) result = fun ss -> From e53d4035d0b8cb72331edad8e3d142fee615f60d Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Thu, 17 Oct 2019 18:46:40 +0200 Subject: [PATCH 2/2] Removed corner case that could not be triggered in PascaLIGO simplifier. --- src/passes/2-simplify/pascaligo.ml | 8 +++----- 1 file changed, 3 insertions(+), 5 deletions(-) diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 1a2bd6227..e9195e8a5 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -545,11 +545,8 @@ and simpl_fun_declaration : fun ~loc x -> let open! Raw in let {name;param;ret_type;local_decls;block;return} : fun_decl = x in - (match npseq_to_list param.value.inside with - | [] -> - fail @@ - corner_case ~loc:__LOC__ "parameter-less function should not exist" - | [a] -> ( + (match param.value.inside with + a, [] -> ( let%bind input = simpl_param a in let name = name.value in let (binder , input_type) = input in @@ -570,6 +567,7 @@ and simpl_fun_declaration : ok ((name , type_annotation) , expression) ) | lst -> ( + let lst = npseq_to_list lst in let arguments_name = "arguments" in let%bind params = bind_map_list simpl_param lst in let (binder , input_type) =