diff --git a/src/passes/01-parser/pascaligo/AST.ml b/src/passes/01-parser/pascaligo/AST.ml index 631704d47..5625b250c 100644 --- a/src/passes/01-parser/pascaligo/AST.ml +++ b/src/passes/01-parser/pascaligo/AST.ml @@ -412,13 +412,12 @@ and for_loop = | ForCollect of for_collect reg and for_int = { - kwd_for : kwd_for; - assign : var_assign reg; - kwd_to : kwd_to; - bound : expr; - kwd_step : kwd_step option; - step : expr option; - block : block reg + kwd_for : kwd_for; + assign : var_assign reg; + kwd_to : kwd_to; + bound : expr; + step : (kwd_step * expr) option; + block : block reg } and var_assign = { diff --git a/src/passes/01-parser/pascaligo/Parser.mly b/src/passes/01-parser/pascaligo/Parser.mly index 64a12eb78..d5cc773fe 100644 --- a/src/passes/01-parser/pascaligo/Parser.mly +++ b/src/passes/01-parser/pascaligo/Parser.mly @@ -622,7 +622,6 @@ for_loop: assign = $2; kwd_to = $3; bound = $4; - kwd_step = None; step = None; block = $5} in For (ForInt {region; value}) @@ -633,8 +632,7 @@ for_loop: assign = $2; kwd_to = $3; bound = $4; - kwd_step = Some $5; - step = Some $6; + step = Some ($5, $6); block = $7} in For (ForInt {region; value}) } diff --git a/src/passes/01-parser/pascaligo/ParserLog.ml b/src/passes/01-parser/pascaligo/ParserLog.ml index 414b27d0f..0d28c2705 100644 --- a/src/passes/01-parser/pascaligo/ParserLog.ml +++ b/src/passes/01-parser/pascaligo/ParserLog.ml @@ -395,19 +395,16 @@ and print_for_loop state = function | ForCollect for_collect -> print_for_collect state for_collect and print_for_int state ({value; _} : for_int reg) = - let {kwd_for; assign; kwd_to; bound; kwd_step; step; block} = value in + let {kwd_for; assign; kwd_to; bound; step; block} = value in print_token state kwd_for "for"; print_var_assign state assign; print_token state kwd_to "to"; print_expr state bound; - match kwd_step with - | None -> (); - | Some kwd_step -> - print_token state kwd_step "step"; - match step with - | None -> (); - | Some step -> - print_expr state step; + (match step with + None -> (); + | Some (kwd_step, expr) -> + print_token state kwd_step "step"; + print_expr state expr); print_block state block and print_var_assign state {value; _} = @@ -1274,7 +1271,7 @@ and pp_projection state proj = List.iteri (apply len) selections and pp_update state update = - pp_path state update.record; + pp_path (state#pad 2 0) update.record; pp_ne_injection pp_field_path_assign state update.updates.value and pp_selection state = function @@ -1315,17 +1312,27 @@ and pp_for_loop state = function pp_for_collect state value and pp_for_int state for_int = + let {assign; bound; step; block; _} = for_int in + let arity = + match step with None -> 3 | Some _ -> 4 in let () = - let state = state#pad 3 0 in + let state = state#pad arity 0 in pp_node state ""; - pp_var_assign state for_int.assign.value in + pp_var_assign state assign.value in let () = - let state = state#pad 3 1 in + let state = state#pad arity 1 in pp_node state ""; - pp_expr (state#pad 1 0) for_int.bound in + pp_expr (state#pad 1 0) bound in let () = - let state = state#pad 3 2 in - let statements = for_int.block.value.statements in + match step with + None -> () + | Some (_, expr) -> + let state = state#pad arity 2 in + pp_node state ""; + pp_expr (state#pad 1 0) expr in + let () = + let state = state#pad arity (arity-1) in + let statements = block.value.statements in pp_node state ""; pp_statements state statements in () @@ -1348,10 +1355,10 @@ and pp_for_collect state collect = pp_collection (state#pad 2 0) collect.collection; pp_expr (state#pad 1 0) collect.expr in let () = - let state = state#pad 3 2 in - let statements = collect.block.value.statements in - pp_node state ""; - pp_statements state statements + let state = state#pad 3 2 in + let statements = collect.block.value.statements in + pp_node state ""; + pp_statements state statements in () and pp_collection state = function @@ -1381,10 +1388,10 @@ and pp_field_assign state {value; _} = pp_expr (state#pad 2 1) value.field_expr and pp_field_path_assign state {value; _} = - pp_node state ""; + pp_node state ""; let path = Utils.nsepseq_to_list value.field_path in List.iter (pp_ident (state#pad 2 0)) path; - pp_expr (state#pad 2 1) value.field_expr + pp_expr (state#pad 2 1) value.field_expr and pp_map_patch state patch = pp_path (state#pad 2 0) patch.path; diff --git a/src/passes/01-parser/pascaligo/Pretty.ml b/src/passes/01-parser/pascaligo/Pretty.ml index 089763655..69ca98130 100644 --- a/src/passes/01-parser/pascaligo/Pretty.ml +++ b/src/passes/01-parser/pascaligo/Pretty.ml @@ -141,13 +141,12 @@ and pp_fun_decl {value; _} = let body = match block_with with None -> group (nest 2 (break 1 ^^ expr)) - | Some (b,_) -> hardline ^^ string "block [" - ^^ nest 2 (hardline ^^ pp_block b) - ^^ hardline - ^^ group (string "] with" ^^ nest 4 (break 1 ^^ expr)) - and attr = match attributes with - None -> empty - | Some a -> hardline ^^ pp_attr_decl a in + | Some (b,_) -> hardline ^^ pp_block b ^^ string " with" + ^^ group (nest 4 (break 1 ^^ expr)) + and attr = + match attributes with + None -> empty + | Some a -> hardline ^^ pp_attr_decl a in prefix 2 1 start parameters ^^ group (nest 2 (break 1 ^^ string ": " ^^ return_t ^^ string " is")) ^^ body ^^ attr @@ -170,7 +169,10 @@ and pp_param_var {value; _} = let t_expr = pp_type_expr param_type in prefix 2 1 (name ^^ string " :") t_expr -and pp_block {value; _} = pp_statements value.statements +and pp_block {value; _} = + string "block {" + ^^ nest 2 (hardline ^^ pp_statements value.statements) + ^^ hardline ^^ string "}" and pp_statements s = pp_nsepseq ";" pp_statement s @@ -207,28 +209,43 @@ and pp_instruction = function and pp_set_remove {value; _} = let {element; set; _} : set_remove = value in string "remove" ^^ group (nest 2 (break 1 ^^ pp_expr element)) - ^/^ string "from set" ^^ group (nest 2 (break 1 ^^ pp_path set)) + ^^ group (break 1 ^^ prefix 2 1 (string "from set") (pp_path set)) and pp_map_remove {value; _} = let {key; map; _} = value in string "remove" ^^ group (nest 2 (break 1 ^^ pp_expr key)) - ^/^ string "from map" ^^ group (nest 2 (break 1 ^^ pp_path map)) + ^^ group (break 1 ^^ prefix 2 1 (string "from map") (pp_path map)) -and pp_set_patch {value; _} = string "TODO:pp_set_patch" +and pp_set_patch {value; _} = + let {path; set_inj; _} = value in + let inj = pp_ne_injection pp_expr set_inj in + string "patch" + ^^ group (nest 2 (break 1 ^^ pp_path path) ^/^ string "with") + ^^ group (nest 2 (break 1 ^^ inj)) -and pp_map_patch {value; _} = string "TODO:pp_map_patch" +and pp_map_patch {value; _} = + let {path; map_inj; _} = value in + let inj = pp_ne_injection pp_binding map_inj in + string "patch" + ^^ group (nest 2 (break 1 ^^ pp_path path) ^/^ string "with") + ^^ group (nest 2 (break 1 ^^ inj)) and pp_binding {value; _} = let {source; image; _} = value in - pp_expr source ^^ string " ->" - ^^ group (nest 2 (break 1 ^^ pp_expr image)) + pp_expr source + ^^ string " ->" ^^ group (nest 2 (break 1 ^^ pp_expr image)) -and pp_record_patch {value; _} = string "TODO:pp_record_patch" +and pp_record_patch {value; _} = + let {path; record_inj; _} = value in + let inj = pp_record record_inj in + string "patch" + ^^ group (nest 2 (break 1 ^^ pp_path path) ^/^ string "with") + ^^ group (nest 2 (break 1 ^^ inj)) and pp_cond_expr {value; _} = let {test; ifso; kwd_else; ifnot; _} : cond_expr = value in - let test = string "if " ^^ group (nest 3 (pp_expr test)) - and ifso = string "then" ^^ group (nest 2 (break 1 ^^ pp_expr ifso)) + let test = string "if " ^^ group (nest 3 (pp_expr test)) + and ifso = string "then" ^^ group (nest 2 (break 1 ^^ pp_expr ifso)) and ifnot = string "else" ^^ group (nest 2 (break 1 ^^ pp_expr ifnot)) in test ^/^ ifso ^/^ ifnot @@ -237,12 +254,12 @@ and pp_conditional {value; _} = let test = string "if " ^^ group (nest 3 (pp_expr test)) and ifso = string "then" ^^ group (nest 2 (break 1 ^^ pp_if_clause ifso)) and ifnot = match ifnot with - ClauseInstr i -> + ClauseInstr _ | ClauseBlock LongBlock _ -> string "else" - ^^ group (nest 2 (break 1 ^^ pp_instruction i)) - | ClauseBlock b -> + ^^ group (nest 2 (break 1 ^^ pp_if_clause ifnot)) + | ClauseBlock ShortBlock _ -> string "else {" - ^^ group (nest 2 (hardline ^^ pp_clause_block b)) + ^^ group (nest 2 (hardline ^^ pp_if_clause ifnot)) ^^ hardline ^^ string "}" in test ^/^ ifso ^/^ ifnot @@ -252,21 +269,23 @@ and pp_if_clause = function and pp_clause_block = function LongBlock b -> pp_block b -| ShortBlock {value; _} -> Utils.(pp_statements <@ fst) value.inside +| ShortBlock b -> Utils.(pp_statements <@ fst) b.value.inside -and pp_set_membership {value; _} = string "TODO:pp_set_membership" +and pp_set_membership {value; _} = + let {set; element; _} = value in + pp_expr set ^/^ string "contains" ^/^ pp_expr element -and pp_case : - 'a.('a -> document) -> 'a case Region.reg -> document = +and pp_case : 'a.('a -> document) -> 'a case Region.reg -> document = fun printer {value; _} -> - let {expr; cases; _} = value in - group (string "case " ^^ nest 5 (pp_expr expr) ^/^ string "of [") - ^^ hardline ^^ pp_cases printer cases - ^^ hardline ^^ string "]" + let {expr; cases; _} = value in + group (string "case " ^^ nest 5 (pp_expr expr) ^/^ string "of [") + ^^ hardline ^^ pp_cases printer cases + ^^ hardline ^^ string "]" and pp_cases : 'a.('a -> document) -> - ('a case_clause reg, vbar) Utils.nsepseq Region.reg -> document = + ('a case_clause reg, vbar) Utils.nsepseq Region.reg -> + document = fun printer {value; _} -> let head, tail = value in let head = pp_case_clause printer head in @@ -296,12 +315,22 @@ and pp_loop = function and pp_while_loop {value; _} = string "TODO:pp_while_loop" and pp_for_loop = function - ForInt l -> pp_for_int l + ForInt l -> pp_for_int l | ForCollect l -> pp_for_collect l -and pp_for_int {value; _} = string "TODO:pp_for_int" +and pp_for_int {value; _} = + let {assign; bound; step; block; _} = value in + let step = + match step with + None -> empty + | Some (_, e) -> prefix 2 1 (string " step") (pp_expr e) in + prefix 2 1 (string "for") (pp_var_assign assign) + ^^ prefix 2 1 (string " to") (pp_expr bound) + ^^ step ^^ hardline ^^ pp_block block -and pp_var_assign {value; _} = string "TODO:pp_var_assign" +and pp_var_assign {value; _} = + let {name; expr; _} = value in + prefix 2 1 (pp_ident name ^^ string " :=") (pp_expr expr) and pp_for_collect {value; _} = string "TODO:pp_for_collect" @@ -336,12 +365,12 @@ and pp_expr = function and pp_annot_expr {value; _} = let expr, _, type_expr = value.inside in - group (string "(" ^^ nest 1 (pp_expr expr ^/^ string ": " - ^^ pp_type_expr type_expr ^^ string ")")) + group (string "(" ^^ nest 1 (pp_expr expr ^/^ string ": " + ^^ pp_type_expr type_expr ^^ string ")")) and pp_set_expr = function - SetInj inj -> string "TODO:pp_set_expr:SetInj" -| SetMem mem -> string "TODO:pp_set_expr:SetMem" + SetInj inj -> pp_injection pp_expr inj +| SetMem mem -> pp_set_membership mem and pp_map_expr = function MapLookUp fetch -> pp_map_lookup fetch @@ -397,8 +426,8 @@ and pp_mutez {value; _} = Z.to_string (snd value) ^ "mutez" |> string and pp_string_expr = function - Cat e -> pp_bin_op "^" e -| String e -> pp_string e + Cat e -> pp_bin_op "^" e +| String e -> pp_string e | Verbatim e -> pp_verbatim e and pp_ident {value; _} = string value @@ -408,13 +437,13 @@ and pp_string s = string "\"" ^^ pp_ident s ^^ string "\"" and pp_verbatim s = string "{|" ^^ pp_ident s ^^ string "|}" and pp_list_expr = function - ECons e -> pp_bin_op "#" e + ECons e -> pp_bin_op "#" e | EListComp e -> group (pp_injection pp_expr e) -| ENil _ -> string "nil" +| ENil _ -> string "nil" and pp_constr_expr = function - SomeApp a -> pp_some_app a -| NoneExpr _ -> string "None" + SomeApp a -> pp_some_app a +| NoneExpr _ -> string "None" | ConstrApp a -> pp_constr_app a and pp_some_app {value; _} = string "TODO:pp_some_app" @@ -488,9 +517,9 @@ and pp_ne_injection : let elements = pp_nsepseq ";" printer ne_elements in let kwd = pp_ne_injection_kwd kind in let offset = String.length kwd + 2 in - string (kwd ^ " [") - ^^ group (nest 2 (break 0 ^^ elements )) - ^^ break 0 ^^ string "]" + group (string (kwd ^ " [") + ^^ group (nest 2 (break 0 ^^ elements )) + ^^ break 0 ^^ string "]") and pp_ne_injection_kwd = function NEInjAttr _ -> "attributes" @@ -500,9 +529,9 @@ and pp_ne_injection_kwd = function and pp_nsepseq : 'a.string -> - ('a -> document) -> - ('a, t) Utils.nsepseq -> - document = + ('a -> document) -> + ('a, t) Utils.nsepseq -> + document = fun sep printer elements -> let elems = Utils.nsepseq_to_list elements and sep = string sep ^^ break 1