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.
This commit is contained in:
Christian Rinderknecht
parent
f795f1216a
commit
f634d36b76
@ -16,7 +16,7 @@ type t =
|
||||
ARROW of Region.t (* "->" *)
|
||||
| CONS of Region.t (* "::" *)
|
||||
| CAT of Region.t (* "^" *)
|
||||
(*| APPEND (* "@" *)*)
|
||||
(*| APPEND (* "@" *)*)
|
||||
|
||||
(* Arithmetics *)
|
||||
|
||||
@ -89,7 +89,7 @@ type 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)
|
||||
|
||||
@ -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
|
||||
}
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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 (* "/" *)
|
||||
|
||||
@ -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 _
|
||||
|
||||
@ -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" *)
|
||||
|
||||
@ -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;
|
||||
|
||||
@ -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:("","")
|
||||
|
||||
Loading…
Reference in New Issue
Block a user