From f634d36b7638d6e551b42835905a23e4d542c8aa Mon Sep 17 00:00:00 2001 From: Christian Rinderknecht Date: Sun, 13 Oct 2019 19:51:01 +0200 Subject: [PATCH] Refactorings for PascaLIGO. - I aligned the names of the tokens in common with Ligodity. - I removed the "down" and "step" clauses in loops. - Note: the stratification of the rule "pattern" in the previous commit has the pleasant effect to remove a call to "corner_case" in function "simpl_case" of the file "2-simplify/pascaligo.ml". - Added more cases to the pretty-printer of the AST. --- src/passes/1-parser/ligodity/LexToken.mll | 90 ++++---- src/passes/1-parser/pascaligo/AST.ml | 2 - src/passes/1-parser/pascaligo/AST.mli | 4 +- src/passes/1-parser/pascaligo/LexToken.mli | 8 +- src/passes/1-parser/pascaligo/LexToken.mll | 40 ++-- src/passes/1-parser/pascaligo/ParToken.mly | 10 +- src/passes/1-parser/pascaligo/Parser.mly | 27 +-- src/passes/1-parser/pascaligo/ParserLog.ml | 256 +++++++++++++++++---- 8 files changed, 290 insertions(+), 147 deletions(-) diff --git a/src/passes/1-parser/ligodity/LexToken.mll b/src/passes/1-parser/ligodity/LexToken.mll index dd70fd58c..2c437d15c 100644 --- a/src/passes/1-parser/ligodity/LexToken.mll +++ b/src/passes/1-parser/ligodity/LexToken.mll @@ -13,50 +13,50 @@ module SSet = Utils.String.Set type t = (* Symbols *) - ARROW of Region.t (* "->" *) -| CONS of Region.t (* "::" *) -| CAT of Region.t (* "^" *) - (*| APPEND (* "@" *)*) + ARROW of Region.t (* "->" *) +| CONS of Region.t (* "::" *) +| CAT of Region.t (* "^" *) +(*| APPEND (* "@" *)*) (* Arithmetics *) -| MINUS of Region.t (* "-" *) -| PLUS of Region.t (* "+" *) -| SLASH of Region.t (* "/" *) -| TIMES of Region.t (* "*" *) +| MINUS of Region.t (* "-" *) +| PLUS of Region.t (* "+" *) +| SLASH of Region.t (* "/" *) +| TIMES of Region.t (* "*" *) (* Compounds *) -| LPAR of Region.t (* "(" *) -| RPAR of Region.t (* ")" *) +| LPAR of Region.t (* "(" *) +| RPAR of Region.t (* ")" *) | LBRACKET of Region.t (* "[" *) | RBRACKET of Region.t (* "]" *) -| LBRACE of Region.t (* "{" *) -| RBRACE of Region.t (* "}" *) +| LBRACE of Region.t (* "{" *) +| RBRACE of Region.t (* "}" *) (* Separators *) -| COMMA of Region.t (* "," *) -| SEMI of Region.t (* ";" *) -| VBAR of Region.t (* "|" *) -| COLON of Region.t (* ":" *) -| DOT of Region.t (* "." *) +| COMMA of Region.t (* "," *) +| SEMI of Region.t (* ";" *) +| VBAR of Region.t (* "|" *) +| COLON of Region.t (* ":" *) +| DOT of Region.t (* "." *) (* Wildcard *) -| WILD of Region.t (* "_" *) +| WILD of Region.t (* "_" *) (* Comparisons *) -| EQ of Region.t (* "=" *) -| NE of Region.t (* "<>" *) -| LT of Region.t (* "<" *) -| GT of Region.t (* ">" *) -| LE of Region.t (* "=<" *) -| GE of Region.t (* ">=" *) +| EQ of Region.t (* "=" *) +| NE of Region.t (* "<>" *) +| LT of Region.t (* "<" *) +| GT of Region.t (* ">" *) +| LE of Region.t (* "=<" *) +| GE of Region.t (* ">=" *) -| BOOL_OR of Region.t (* "||" *) -| BOOL_AND of Region.t (* "&&" *) +| BOOL_OR of Region.t (* "||" *) +| BOOL_AND of Region.t (* "&&" *) (* Identifiers, labels, numbers and strings *) @@ -72,24 +72,24 @@ type t = (*| And*) | Begin of Region.t -| Else of Region.t -| End of Region.t +| Else of Region.t +| End of Region.t | False of Region.t -| Fun of Region.t -| If of Region.t -| In of Region.t -| Let of Region.t +| Fun of Region.t +| If of Region.t +| In of Region.t +| Let of Region.t | Match of Region.t -| Mod of Region.t -| Not of Region.t -| Of of Region.t -| Or of Region.t -| Then of Region.t -| True of Region.t -| Type of Region.t -| With of Region.t +| Mod of Region.t +| Not of Region.t +| Of of Region.t +| Or of Region.t +| Then of Region.t +| True of Region.t +| Type of Region.t +| With of Region.t - (* Liquidity specific *) + (* Liquidity-specific *) | LetEntry of Region.t | MatchNat of Region.t @@ -99,7 +99,7 @@ type t = | Struct *) -(* Virtual tokens *) + (* Virtual tokens *) | EOF of Region.t (* End of file *) @@ -420,7 +420,7 @@ let mk_sym lexeme region = | "]" -> Ok (RBRACKET region) | "{" -> Ok (LBRACE region) | "}" -> Ok (RBRACE region) - | "=" -> Ok (EQUAL region) + | "=" -> Ok (EQ region) | ":" -> Ok (COLON region) | "|" -> Ok (VBAR region) | "->" -> Ok (ARROW region) @@ -432,9 +432,9 @@ let mk_sym lexeme region = | "*" -> Ok (TIMES region) | "/" -> Ok (SLASH region) | "<" -> Ok (LT region) - | "<=" -> Ok (LEQ region) + | "<=" -> Ok (LE region) | ">" -> Ok (GT region) - | ">=" -> Ok (GEQ region) + | ">=" -> Ok (GE region) | "<>" -> Ok (NE region) diff --git a/src/passes/1-parser/pascaligo/AST.ml b/src/passes/1-parser/pascaligo/AST.ml index cf0cb2014..345976e3b 100644 --- a/src/passes/1-parser/pascaligo/AST.ml +++ b/src/passes/1-parser/pascaligo/AST.ml @@ -423,10 +423,8 @@ and for_loop = and for_int = { kwd_for : kwd_for; assign : var_assign reg; - down : kwd_down option; kwd_to : kwd_to; bound : expr; - step : (kwd_step * expr) option; block : block reg } diff --git a/src/passes/1-parser/pascaligo/AST.mli b/src/passes/1-parser/pascaligo/AST.mli index ee4d1982c..0174b0efc 100644 --- a/src/passes/1-parser/pascaligo/AST.mli +++ b/src/passes/1-parser/pascaligo/AST.mli @@ -407,10 +407,8 @@ and for_loop = and for_int = { kwd_for : kwd_for; assign : var_assign reg; - down : kwd_down option; kwd_to : kwd_to; bound : expr; - step : (kwd_step * expr) option; block : block reg } @@ -432,7 +430,7 @@ and for_collect = { (* Expressions *) and expr = -| ECase of expr case reg + ECase of expr case reg | EAnnot of annot_expr reg | ELogic of logic_expr | EArith of arith_expr diff --git a/src/passes/1-parser/pascaligo/LexToken.mli b/src/passes/1-parser/pascaligo/LexToken.mli index 07138aa3f..d9c19e762 100644 --- a/src/passes/1-parser/pascaligo/LexToken.mli +++ b/src/passes/1-parser/pascaligo/LexToken.mli @@ -53,13 +53,13 @@ type t = | VBAR of Region.t (* "|" *) | ARROW of Region.t (* "->" *) | ASS of Region.t (* ":=" *) -| EQUAL of Region.t (* "=" *) +| EQ of Region.t (* "=" *) | COLON of Region.t (* ":" *) | LT of Region.t (* "<" *) -| LEQ of Region.t (* "<=" *) +| LE of Region.t (* "<=" *) | GT of Region.t (* ">" *) -| GEQ of Region.t (* ">=" *) -| NEQ of Region.t (* "=/=" *) +| GE of Region.t (* ">=" *) +| NE of Region.t (* "=/=" *) | PLUS of Region.t (* "+" *) | MINUS of Region.t (* "-" *) | SLASH of Region.t (* "/" *) diff --git a/src/passes/1-parser/pascaligo/LexToken.mll b/src/passes/1-parser/pascaligo/LexToken.mll index f0bd96bc8..c27abbb12 100644 --- a/src/passes/1-parser/pascaligo/LexToken.mll +++ b/src/passes/1-parser/pascaligo/LexToken.mll @@ -51,13 +51,13 @@ type t = | VBAR of Region.t | ARROW of Region.t | ASS of Region.t -| EQUAL of Region.t +| EQ of Region.t | COLON of Region.t | LT of Region.t -| LEQ of Region.t +| LE of Region.t | GT of Region.t -| GEQ of Region.t -| NEQ of Region.t +| GE of Region.t +| NE of Region.t | PLUS of Region.t | MINUS of Region.t | SLASH of Region.t @@ -183,13 +183,13 @@ let proj_token = function | VBAR region -> region, "VBAR" | ARROW region -> region, "ARROW" | ASS region -> region, "ASS" -| EQUAL region -> region, "EQUAL" +| EQ region -> region, "EQ" | COLON region -> region, "COLON" | LT region -> region, "LT" -| LEQ region -> region, "LEQ" +| LE region -> region, "LE" | GT region -> region, "GT" -| GEQ region -> region, "GEQ" -| NEQ region -> region, "NEQ" +| GE region -> region, "GE" +| NE region -> region, "NE" | PLUS region -> region, "PLUS" | MINUS region -> region, "MINUS" | SLASH region -> region, "SLASH" @@ -276,13 +276,13 @@ let to_lexeme = function | VBAR _ -> "|" | ARROW _ -> "->" | ASS _ -> ":=" -| EQUAL _ -> "=" +| EQ _ -> "=" | COLON _ -> ":" | LT _ -> "<" -| LEQ _ -> "<=" +| LE _ -> "<=" | GT _ -> ">" -| GEQ _ -> ">=" -| NEQ _ -> "=/=" +| GE _ -> ">=" +| NE _ -> "=/=" | PLUS _ -> "+" | MINUS _ -> "-" | SLASH _ -> "/" @@ -521,7 +521,7 @@ let mk_sym lexeme region = | "]" -> Ok (RBRACKET region) | "{" -> Ok (LBRACE region) | "}" -> Ok (RBRACE region) - | "=" -> Ok (EQUAL region) + | "=" -> Ok (EQ region) | ":" -> Ok (COLON region) | "|" -> Ok (VBAR region) | "->" -> Ok (ARROW region) @@ -533,12 +533,12 @@ let mk_sym lexeme region = | "*" -> Ok (TIMES region) | "/" -> Ok (SLASH region) | "<" -> Ok (LT region) - | "<=" -> Ok (LEQ region) + | "<=" -> Ok (LE region) | ">" -> Ok (GT region) - | ">=" -> Ok (GEQ region) + | ">=" -> Ok (GE region) (* Lexemes specific to PascaLIGO *) - | "=/=" -> Ok (NEQ region) + | "=/=" -> Ok (NE region) | "#" -> Ok (CONS region) | ":=" -> Ok (ASS region) @@ -639,13 +639,13 @@ let is_sym = function | VBAR _ | ARROW _ | ASS _ -| EQUAL _ +| EQ _ | COLON _ | LT _ -| LEQ _ +| LE _ | GT _ -| GEQ _ -| NEQ _ +| GE _ +| NE _ | PLUS _ | MINUS _ | SLASH _ diff --git a/src/passes/1-parser/pascaligo/ParToken.mly b/src/passes/1-parser/pascaligo/ParToken.mly index 49f77b8d3..538a48448 100644 --- a/src/passes/1-parser/pascaligo/ParToken.mly +++ b/src/passes/1-parser/pascaligo/ParToken.mly @@ -27,13 +27,13 @@ %token VBAR (* "|" *) %token ARROW (* "->" *) %token ASS (* ":=" *) -%token EQUAL (* "=" *) +%token EQ (* "=" *) %token COLON (* ":" *) %token LT (* "<" *) -%token LEQ (* "<=" *) +%token LE (* "<=" *) %token GT (* ">" *) -%token GEQ (* ">=" *) -%token NEQ (* "=/=" *) +%token GE (* ">=" *) +%token NE (* "=/=" *) %token PLUS (* "+" *) %token MINUS (* "-" *) %token SLASH (* "/" *) @@ -51,7 +51,6 @@ %token Case (* "case" *) %token Const (* "const" *) %token Contains (* "contains" *) -%token Down (* "down" *) %token Else (* "else" *) %token End (* "end" *) %token For (* "for" *) @@ -73,7 +72,6 @@ %token Remove (* "remove" *) %token Set (* "set" *) %token Skip (* "skip" *) -%token Step (* "step" *) %token Then (* "then" *) %token To (* "to" *) %token Type (* "type" *) diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index f69822446..2da4b14c1 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -342,7 +342,7 @@ open_data_decl: | open_var_decl { LocalVar $1 } open_const_decl: - Const unqualified_decl(EQUAL) { + Const unqualified_decl(EQ) { let name, colon, const_type, equal, init, stop = $2 in let region = cover $1 stop and value = { @@ -616,16 +616,14 @@ while_loop: in While {region; value}} for_loop: - For var_assign Down? To expr option(step_clause) block { - let region = cover $1 $7.region in + For var_assign To expr block { + let region = cover $1 $5.region in let value = { kwd_for = $1; assign = $2; - down = $3; - kwd_to = $4; - bound = $5; - step = $6; - block = $7} + kwd_to = $3; + bound = $4; + block = $5} in For (ForInt {region; value}) } | For var option(arrow_clause) In expr block { @@ -645,9 +643,6 @@ var_assign: and value = {name = $1; assign = $2; expr = $3} in {region; value}} -step_clause: - Step expr { $1,$2 } - arrow_clause: ARROW var { $1,$2 } @@ -701,7 +696,7 @@ comp_expr: and value = {arg1 = $1; op = $2; arg2 = $3} in ELogic (CompExpr (Lt {region; value})) } -| comp_expr LEQ cat_expr { +| comp_expr LE cat_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop @@ -715,21 +710,21 @@ comp_expr: and value = {arg1 = $1; op = $2; arg2 = $3} in ELogic (CompExpr (Gt {region; value})) } -| comp_expr GEQ cat_expr { +| comp_expr GE cat_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop and value = {arg1 = $1; op = $2; arg2 = $3} in ELogic (CompExpr (Geq {region; value})) } -| comp_expr EQUAL cat_expr { +| comp_expr EQ cat_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop and value = {arg1 = $1; op = $2; arg2 = $3} in ELogic (CompExpr (Equal {region; value})) } -| comp_expr NEQ cat_expr { +| comp_expr NE cat_expr { let start = expr_to_region $1 and stop = expr_to_region $3 in let region = cover start stop @@ -906,7 +901,7 @@ record_expr: in {region; value} } field_assignment: - field_name EQUAL expr { + field_name EQ expr { let region = cover $1.region (expr_to_region $3) and value = { field_name = $1; diff --git a/src/passes/1-parser/pascaligo/ParserLog.ml b/src/passes/1-parser/pascaligo/ParserLog.ml index 32aa4fcff..ed01c6379 100644 --- a/src/passes/1-parser/pascaligo/ParserLog.ml +++ b/src/passes/1-parser/pascaligo/ParserLog.ml @@ -342,14 +342,11 @@ and print_for_loop buffer = function | ForCollect for_collect -> print_for_collect buffer for_collect and print_for_int buffer ({value; _} : for_int reg) = - let {kwd_for; assign; down; kwd_to; - bound; step; block} = value in + let {kwd_for; assign; kwd_to; bound; block} = value in print_token buffer kwd_for "for"; print_var_assign buffer assign; - print_down buffer down; print_token buffer kwd_to "to"; print_expr buffer bound; - print_step buffer step; print_block buffer block and print_var_assign buffer {value; _} = @@ -358,16 +355,6 @@ and print_var_assign buffer {value; _} = print_token buffer assign ":="; print_expr buffer expr -and print_down buffer = function - Some kwd_down -> print_token buffer kwd_down "down" -| None -> () - -and print_step buffer = function - Some (kwd_step, expr) -> - print_token buffer kwd_step "step"; - print_expr buffer expr -| None -> () - and print_for_collect buffer ({value; _} : for_collect reg) = let {kwd_for; var; bind_to; kwd_in; expr; block} = value in print_token buffer kwd_for "for"; @@ -954,33 +941,33 @@ and pp_single_instr buffer ~pad:(pd,pc as pad) = function let node = sprintf "%sLoop\n" pd in Buffer.add_string buffer node; pp_loop buffer ~pad:(mk_pad 1 0 pc) loop -| ProcCall call -> +| ProcCall {value; _} -> let node = sprintf "%sProcCall\n" pd in Buffer.add_string buffer node; - pp_fun_call buffer ~pad:(mk_pad 1 0 pc) call + pp_fun_call buffer ~pad:(mk_pad 1 0 pc) value | Skip _ -> let node = sprintf "%sSkip\n" pd in Buffer.add_string buffer node | RecordPatch {value; _} -> let node = sprintf "%sRecordPatch\n" pd in Buffer.add_string buffer node; - pp_record_patch buffer ~pad:(mk_pad 1 0 pc) value + pp_record_patch buffer ~pad value | MapPatch {value; _} -> let node = sprintf "%sMapPatch\n" pd in Buffer.add_string buffer node; - pp_map_patch buffer ~pad:(mk_pad 1 0 pc) value + pp_map_patch buffer ~pad value | SetPatch {value; _} -> - let node = sprintf "%SetPatch\n" pd in + let node = sprintf "%sSetPatch\n" pd in Buffer.add_string buffer node; - pp_set_patch buffer ~pad:(mk_pad 1 0 pc) value + pp_set_patch buffer ~pad value | MapRemove {value; _} -> let node = sprintf "%sMapRemove\n" pd in Buffer.add_string buffer node; - pp_map_remove buffer ~pad:(mk_pad 1 0 pc) value + pp_map_remove buffer ~pad value | SetRemove {value; _} -> let node = sprintf "%sSetRemove\n" pd in Buffer.add_string buffer node; - pp_set_remove buffer ~pad:(mk_pad 1 0 pc) value + pp_set_remove buffer ~pad value and pp_conditional buffer ~pad:(_,pc) cond = let () = @@ -997,10 +984,10 @@ and pp_conditional buffer ~pad:(_,pc) cond = let pd, pc = mk_pad 3 2 pc in let node = sprintf "%s\n" pd in Buffer.add_string buffer node; - pp_if_clause buffer ~pad:(mk_pad 2 1 pc) cond.ifnot + pp_if_clause buffer ~pad:(mk_pad 1 0 pc) cond.ifnot in () -and pp_if_clause buffer ~pad:(pd,pc) = function +and pp_if_clause buffer ~pad:(pd,pc as pad) = function ClauseInstr instr -> let node = sprintf "%sClauseInstr\n" pd in Buffer.add_string buffer node; @@ -1009,7 +996,7 @@ and pp_if_clause buffer ~pad:(pd,pc) = function let node = sprintf "%sClauseBlock\n" pd in let statements, _ = value.inside in Buffer.add_string buffer node; - pp_statements buffer ~pad:(mk_pad 1 0 pc) statements + pp_statements buffer ~pad statements and pp_case printer buffer ~pad:(_,pc) case = let clauses = Utils.nsepseq_to_list case.cases.value in @@ -1114,7 +1101,10 @@ and pp_raw buffer ~pad:(_,pc) (head, _, tail) = pp_pattern buffer ~pad:(mk_pad 2 0 pc) head; pp_pattern buffer ~pad:(mk_pad 2 1 pc) tail -and pp_injection printer buffer ~pad:(_,pc) inj = +and pp_injection : + 'a.(Buffer.t -> pad:(string*string) -> 'a -> unit) + -> Buffer.t -> pad:(string*string) -> 'a injection -> unit = + fun printer buffer ~pad:(_,pc) inj -> let elements = Utils.sepseq_to_list inj.elements in let length = List.length elements in let apply len rank = @@ -1183,33 +1173,131 @@ and pp_map_lookup buffer ~pad:(_,pc) lookup = pp_path buffer ~pad:(mk_pad 2 0 pc) lookup.path; pp_expr buffer ~pad:(mk_pad 2 1 pc) lookup.index.value.inside -and pp_loop buffer ~pad:(pd,pc) loop = - let node = sprintf "%sPP_LOOP\n" pd in - Buffer.add_string buffer node +and pp_loop buffer ~pad:(pd,pc) = function + While {value; _} -> + let node = sprintf "%s\n" pd in + Buffer.add_string buffer node; + let () = + let pd, pc = mk_pad 2 0 pc in + let node = sprintf "%s\n" pd in + Buffer.add_string buffer node; + pp_expr buffer ~pad:(mk_pad 1 0 pc) value.cond in + let () = + let pd, _ as pad = mk_pad 2 1 pc in + let node = sprintf "%s\n" pd in + let statements = value.block.value.statements in + Buffer.add_string buffer node; + pp_statements buffer ~pad statements + in () +| For for_loop -> + let node = sprintf "%s\n" pd in + Buffer.add_string buffer node; + pp_for_loop buffer ~pad:(mk_pad 1 0 pc) for_loop -and pp_fun_call buffer ~pad:(pd,pc) call = - let node = sprintf "%sPP_FUN_CALL\n" pd in - Buffer.add_string buffer node +and pp_for_loop buffer ~pad:(pd,_ as pad) = function + ForInt {value; _} -> + let node = sprintf "%sForInt\n" pd in + Buffer.add_string buffer node; + pp_for_int buffer ~pad value +| ForCollect {value; _} -> + let node = sprintf "%sForCollect\n" pd in + Buffer.add_string buffer node; + pp_for_collect buffer ~pad value -and pp_record_patch buffer ~pad:(pd,pc) patch = - let node = sprintf "%sPP_RECORD_PATCH\n" pd in - Buffer.add_string buffer node +and pp_for_int buffer ~pad:(_,pc) for_int = + let () = + let pd, _ as pad = mk_pad 3 0 pc in + let node = sprintf "%s\n" pd in + Buffer.add_string buffer node; + pp_var_assign buffer ~pad for_int.assign.value in + let () = + let pd, pc = mk_pad 3 1 pc in + let node = sprintf "%s\n" pd in + Buffer.add_string buffer node; + pp_expr buffer ~pad:(mk_pad 1 0 pc) for_int.bound in + let () = + let pd, _ as pad = mk_pad 3 2 pc in + let node = sprintf "%s\n" pd in + let statements = for_int.block.value.statements in + Buffer.add_string buffer node; + pp_statements buffer ~pad statements + in () -and pp_map_patch buffer ~pad:(pd,pc) patch = - let node = sprintf "%sPP_MAP_PATCH\n" pd in - Buffer.add_string buffer node +and pp_var_assign buffer ~pad:(_,pc) asgn = + let pad = mk_pad 2 0 pc in + pp_ident buffer ~pad asgn.name.value; + let pad = mk_pad 2 1 pc in + pp_expr buffer ~pad asgn.expr -and pp_set_patch buffer ~pad:(pd,pc) patch = - let node = sprintf "%sPP_SET_PATCH\n" pd in - Buffer.add_string buffer node +and pp_for_collect buffer ~pad:(_,pc) collect = + let () = + let pad = mk_pad 3 0 pc in + match collect.bind_to with + None -> + pp_ident buffer ~pad collect.var.value + | Some (_, var) -> + pp_var_binding buffer ~pad (collect.var, var) in + let () = + let pd, pc = mk_pad 3 1 pc in + let node = sprintf "%s\n" pd in + Buffer.add_string buffer node; + pp_expr buffer ~pad:(mk_pad 1 0 pc) collect.expr in + let () = + let pd, _ as pad = mk_pad 3 2 pc in + let node = sprintf "%s\n" pd in + let statements = collect.block.value.statements in + Buffer.add_string buffer node; + pp_statements buffer ~pad statements + in () -and pp_map_remove buffer ~pad:(pd,pc) rem = - let node = sprintf "%sPP_MAP_REMOVE\n" pd in - Buffer.add_string buffer node +and pp_var_binding buffer ~pad:(pd,pc) (source, image) = + let node = sprintf "%s\n" pd in + Buffer.add_string buffer node; + pp_ident buffer ~pad:(mk_pad 2 0 pc) source.value; + pp_ident buffer ~pad:(mk_pad 2 1 pc) image.value -and pp_set_remove buffer ~pad:(pd,pc) rem = - let node = sprintf "%sPP_SET_REMOVE\n" pd in - Buffer.add_string buffer node +and pp_fun_call buffer ~pad:(_,pc as pad) (name, args) = + pp_ident buffer ~pad name.value; + let args = Utils.nsepseq_to_list args.value.inside in + let arity = List.length args in + let apply len rank = + pp_expr buffer ~pad:(mk_pad len rank pc) + in List.iteri (apply arity) args + +and pp_record_patch buffer ~pad:(_,pc as pad) patch = + pp_path buffer ~pad:(mk_pad 2 0 pc) patch.path; + pp_injection pp_field_assign buffer + ~pad patch.record_inj.value + +and pp_field_assign buffer ~pad:(pd,pc) {value; _} = + let node = sprintf "%s\n" pd in + Buffer.add_string buffer node; + pp_ident buffer ~pad:(mk_pad 2 0 pc) value.field_name.value; + pp_expr buffer ~pad:(mk_pad 2 1 pc) value.field_expr + +and pp_map_patch buffer ~pad:(_,pc as pad) patch = + pp_path buffer ~pad:(mk_pad 2 0 pc) patch.path; + pp_injection pp_binding buffer + ~pad patch.map_inj.value + +and pp_binding buffer ~pad:(pd,pc) {value; _} = + let source, image = value.source, value.image in + let node = sprintf "%s\n" pd in + Buffer.add_string buffer node; + pp_expr buffer ~pad:(mk_pad 2 0 pc) source; + pp_expr buffer ~pad:(mk_pad 2 1 pc) image + +and pp_set_patch buffer ~pad:(_,pc as pad) patch = + pp_path buffer ~pad:(mk_pad 2 0 pc) patch.path; + pp_injection pp_expr buffer ~pad patch.set_inj.value + +and pp_map_remove buffer ~pad:(_,pc) rem = + pp_expr buffer ~pad:(mk_pad 2 0 pc) rem.key; + pp_path buffer ~pad:(mk_pad 2 1 pc) rem.map + +and pp_set_remove buffer ~pad:(_,pc) rem = + pp_expr buffer ~pad:(mk_pad 2 0 pc) rem.element; + pp_path buffer ~pad:(mk_pad 2 1 pc) rem.set and pp_local_decls buffer ~pad:(_,pc) decls = let apply len rank = @@ -1245,12 +1333,78 @@ and pp_var_decl buffer ~pad:(_,pc) decl = pp_type_expr buffer ~pad:(mk_pad 3 1 pc) decl.var_type; pp_expr buffer ~pad:(mk_pad 3 2 pc) decl.init -and pp_proc_decl buffer ~pad:(pd,pc) decl = +and pp_proc_decl buffer ~pad:(pd,_pc) _decl = let node = sprintf "%sPP_PROC_DECL\n" pd in Buffer.add_string buffer node -and pp_expr buffer ~pad:(pd,pc) decl = - let node = sprintf "%sPP_EXPR\n" pd in - Buffer.add_string buffer node +and pp_expr buffer ~pad:(pd,pc as pad) = function + ECase {value; _} -> + let node = sprintf "%sECase\n" pd in + Buffer.add_string buffer node; + ignore value +| EAnnot {value; _} -> + let node = sprintf "%sEAnnot\n" pd in + Buffer.add_string buffer node; + ignore value +| ELogic e_logic -> + let node = sprintf "%sELogic\n" pd in + Buffer.add_string buffer node; + ignore e_logic +| EArith e_arith -> + let node = sprintf "%sEArith\n" pd in + Buffer.add_string buffer node; + ignore e_arith +| EString e_string -> + let node = sprintf "%sEString\n" pd in + Buffer.add_string buffer node; + ignore e_string +| EList e_list -> + let node = sprintf "%sEList\n" pd in + Buffer.add_string buffer node; + ignore e_list +| ESet e_set -> + let node = sprintf "%sESet\n" pd in + Buffer.add_string buffer node; + ignore e_set +| EConstr e_constr -> + let node = sprintf "%sEConstr\n" pd in + Buffer.add_string buffer node; + ignore e_constr +| ERecord e_record -> + let node = sprintf "%sERecord\n" pd in + Buffer.add_string buffer node; + ignore e_record +| EProj {value; _} -> + let node = sprintf "%sEProj\n" pd in + Buffer.add_string buffer node; + ignore value +| EMap e_map -> + let node = sprintf "%sEMap\n" pd in + Buffer.add_string buffer node; + ignore e_map +| EVar {value; _} -> + let node = sprintf "%sEVar\n" pd in + Buffer.add_string buffer node; + pp_ident buffer ~pad:(mk_pad 1 0 pc) value +| ECall fun_call -> + let node = sprintf "%sECall\n" pd in + Buffer.add_string buffer node; + ignore fun_call +| EBytes {value; _} -> + let node = sprintf "%sEBytes\n" pd in + Buffer.add_string buffer node; + pp_bytes buffer ~pad value; + ignore value +| EUnit _ -> + let node = sprintf "%sEUnit\n" pd + in Buffer.add_string buffer node +| ETuple e_tuple -> + let node = sprintf "%sETuple\n" pd + in Buffer.add_string buffer node; + ignore e_tuple +| EPar {value; _} -> + let node = sprintf "%sEpar\n" pd in + Buffer.add_string buffer node; + pp_expr buffer ~pad:(mk_pad 1 0 pc) value.inside let pp_ast buffer = pp_ast buffer ~pad:("","")