balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Refactorings for PascaLIGO.

Browse Source 
- 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.
This commit is contained in:
Christian Rinderknecht 2019-10-13 19:51:01 +02:00
parent f795f1216a
commit f634d36b76
8 changed files with 290 additions and 147 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

90
src/passes/1-parser/ligodity/LexToken.mll
View File

@ -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)

2
src/passes/1-parser/pascaligo/AST.ml
View File

@ -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
}

4
src/passes/1-parser/pascaligo/AST.mli
View File

@ -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

8
src/passes/1-parser/pascaligo/LexToken.mli
View File

@ -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 (* "/" *)

40
src/passes/1-parser/pascaligo/LexToken.mll
View File

@ -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 _

10
src/passes/1-parser/pascaligo/ParToken.mly
View File

@ -27,13 +27,13 @@
%token <Region.t> VBAR (* "|" *)
%token <Region.t> ARROW (* "->" *)
%token <Region.t> ASS (* ":=" *)
%token <Region.t> EQUAL (* "=" *)
%token <Region.t> EQ (* "=" *)
%token <Region.t> COLON (* ":" *)
%token <Region.t> LT (* "<" *)
%token <Region.t> LEQ (* "<=" *)
%token <Region.t> LE (* "<=" *)
%token <Region.t> GT (* ">" *)
%token <Region.t> GEQ (* ">=" *)
%token <Region.t> NEQ (* "=/=" *)
%token <Region.t> GE (* ">=" *)
%token <Region.t> NE (* "=/=" *)
%token <Region.t> PLUS (* "+" *)
%token <Region.t> MINUS (* "-" *)
%token <Region.t> SLASH (* "/" *)
@ -51,7 +51,6 @@
%token <Region.t> Case (* "case" *)
%token <Region.t> Const (* "const" *)
%token <Region.t> Contains (* "contains" *)
%token <Region.t> Down (* "down" *)
%token <Region.t> Else (* "else" *)
%token <Region.t> End (* "end" *)
%token <Region.t> For (* "for" *)
@ -73,7 +72,6 @@
%token <Region.t> Remove (* "remove" *)
%token <Region.t> Set (* "set" *)
%token <Region.t> Skip (* "skip" *)
%token <Region.t> Step (* "step" *)
%token <Region.t> Then (* "then" *)
%token <Region.t> To (* "to" *)
%token <Region.t> Type (* "type" *)

27
src/passes/1-parser/pascaligo/Parser.mly
View File

@ -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;

256
src/passes/1-parser/pascaligo/ParserLog.ml
View File

@ -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<false>\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<while>\n" pd in
Buffer.add_string buffer node;
let () =
let pd, pc = mk_pad 2 0 pc in
let node = sprintf "%s<condition>\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<statements>\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<for>\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<init>\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<bound>\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<statements>\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<collection>\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<statements>\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<binding>\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<field assignment>\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<binding>\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:("","")