Removed last dependency on EvalOpt from AST.
This commit is contained in:
Christian Rinderknecht
parent
73b6c58aa5
commit
6bf9dc9003
@ -810,708 +810,3 @@ let rhs_to_region = function
|
||||
let selection_to_region = function
|
||||
FieldName {region; _}
|
||||
| Component {region; _} -> region
|
||||
|
||||
(* Printing the tokens with their source regions *)
|
||||
|
||||
let printf = Printf.printf
|
||||
|
||||
let compact (region: Region.t) =
|
||||
region#compact ~offsets:EvalOpt.offsets EvalOpt.mode
|
||||
|
||||
let print_nsepseq :
|
||||
string -> ('a -> unit) -> ('a, Region.t) nsepseq -> unit =
|
||||
fun sep visit (head, tail) ->
|
||||
let print_aux (sep_reg, item) =
|
||||
printf "%s: %s\n" (compact sep_reg) sep;
|
||||
visit item
|
||||
in visit head; List.iter print_aux tail
|
||||
|
||||
let print_sepseq :
|
||||
string -> ('a -> unit) -> ('a, Region.t) sepseq -> unit =
|
||||
fun sep visit -> function
|
||||
None -> ()
|
||||
| Some seq -> print_nsepseq sep visit seq
|
||||
|
||||
let print_token region lexeme =
|
||||
printf "%s: %s\n"(compact region) lexeme
|
||||
|
||||
let print_var {region; value=lexeme} =
|
||||
printf "%s: Ident \"%s\"\n" (compact region) lexeme
|
||||
|
||||
let print_constr {region; value=lexeme} =
|
||||
printf "%s: Constr \"%s\"\n"
|
||||
(compact region) lexeme
|
||||
|
||||
let print_string {region; value=lexeme} =
|
||||
printf "%s: String %s\n"
|
||||
(compact region) lexeme
|
||||
|
||||
let print_bytes {region; value = lexeme, abstract} =
|
||||
printf "%s: Bytes (\"%s\", \"0x%s\")\n"
|
||||
(compact region) lexeme
|
||||
(Hex.to_string abstract)
|
||||
|
||||
let print_int {region; value = lexeme, abstract} =
|
||||
printf "%s: Int (\"%s\", %s)\n"
|
||||
(compact region) lexeme
|
||||
(Z.to_string abstract)
|
||||
|
||||
(* Main printing function *)
|
||||
|
||||
let rec print_tokens ast =
|
||||
let {decl; eof} = ast in
|
||||
Utils.nseq_iter print_decl decl;
|
||||
print_token eof "EOF"
|
||||
|
||||
and print_decl = function
|
||||
TypeDecl decl -> print_type_decl decl
|
||||
| ConstDecl decl -> print_const_decl decl
|
||||
| LambdaDecl decl -> print_lambda_decl decl
|
||||
|
||||
and print_const_decl {value; _} =
|
||||
let {kwd_const; name; colon; const_type;
|
||||
equal; init; terminator} = value in
|
||||
print_token kwd_const "const";
|
||||
print_var name;
|
||||
print_token colon ":";
|
||||
print_type_expr const_type;
|
||||
print_token equal "=";
|
||||
print_expr init;
|
||||
print_terminator terminator
|
||||
|
||||
and print_type_decl {value; _} =
|
||||
let {kwd_type; name; kwd_is;
|
||||
type_expr; terminator} = value in
|
||||
print_token kwd_type "type";
|
||||
print_var name;
|
||||
print_token kwd_is "is";
|
||||
print_type_expr type_expr;
|
||||
print_terminator terminator
|
||||
|
||||
and print_type_expr = function
|
||||
TProd cartesian -> print_cartesian cartesian
|
||||
| TSum sum_type -> print_sum_type sum_type
|
||||
| TRecord record_type -> print_record_type record_type
|
||||
| TApp type_app -> print_type_app type_app
|
||||
| TPar par_type -> print_par_type par_type
|
||||
| TAlias type_alias -> print_var type_alias
|
||||
|
||||
and print_cartesian {value; _} =
|
||||
print_nsepseq "*" print_type_expr value
|
||||
|
||||
and print_variant {value; _} =
|
||||
let {constr; kwd_of; product} = value in
|
||||
print_constr constr;
|
||||
print_token kwd_of "of";
|
||||
print_cartesian product
|
||||
|
||||
and print_sum_type {value; _} =
|
||||
print_nsepseq "|" print_variant value
|
||||
|
||||
and print_record_type record_type =
|
||||
print_injection "record" print_field_decl record_type
|
||||
|
||||
and print_type_app {value; _} =
|
||||
let type_name, type_tuple = value in
|
||||
print_var type_name;
|
||||
print_type_tuple type_tuple
|
||||
|
||||
and print_par_type {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
print_token lpar "(";
|
||||
print_type_expr inside;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_field_decl {value; _} =
|
||||
let {field_name; colon; field_type} = value in
|
||||
print_var field_name;
|
||||
print_token colon ":";
|
||||
print_type_expr field_type
|
||||
|
||||
and print_type_tuple {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
print_token lpar "(";
|
||||
print_nsepseq "," print_type_expr inside;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_lambda_decl = function
|
||||
FunDecl fun_decl -> print_fun_decl fun_decl
|
||||
| ProcDecl proc_decl -> print_proc_decl proc_decl
|
||||
| EntryDecl entry_decl -> print_entry_decl entry_decl
|
||||
|
||||
and print_fun_decl {value; _} =
|
||||
let {kwd_function; name; param; colon;
|
||||
ret_type; kwd_is; local_decls;
|
||||
block; kwd_with; return; terminator} = value in
|
||||
print_token kwd_function "function";
|
||||
print_var name;
|
||||
print_parameters param;
|
||||
print_token colon ":";
|
||||
print_type_expr ret_type;
|
||||
print_token kwd_is "is";
|
||||
print_local_decls local_decls;
|
||||
print_block block;
|
||||
print_token kwd_with "with";
|
||||
print_expr return;
|
||||
print_terminator terminator
|
||||
|
||||
and print_proc_decl {value; _} =
|
||||
let {kwd_procedure; name; param; kwd_is;
|
||||
local_decls; block; terminator} = value in
|
||||
print_token kwd_procedure "procedure";
|
||||
print_var name;
|
||||
print_parameters param;
|
||||
print_token kwd_is "is";
|
||||
print_local_decls local_decls;
|
||||
print_block block;
|
||||
print_terminator terminator
|
||||
|
||||
and print_entry_decl {value; _} =
|
||||
let {kwd_entrypoint; name; param; colon;
|
||||
ret_type; kwd_is; local_decls;
|
||||
block; kwd_with; return; terminator} = value in
|
||||
print_token kwd_entrypoint "entrypoint";
|
||||
print_var name;
|
||||
print_entry_params param;
|
||||
print_token colon ":";
|
||||
print_type_expr ret_type;
|
||||
print_token kwd_is "is";
|
||||
print_local_decls local_decls;
|
||||
print_block block;
|
||||
print_token kwd_with "with";
|
||||
print_expr return;
|
||||
print_terminator terminator
|
||||
|
||||
and print_entry_params {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
print_token lpar "(";
|
||||
print_nsepseq ";" print_entry_param_decl inside;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_entry_param_decl = function
|
||||
EntryConst param_const -> print_param_const param_const
|
||||
| EntryVar param_var -> print_param_var param_var
|
||||
| EntryStore param_store -> print_storage param_store
|
||||
|
||||
and print_storage {value; _} =
|
||||
let {kwd_storage; var; colon; storage_type} = value in
|
||||
print_token kwd_storage "storage";
|
||||
print_var var;
|
||||
print_token colon ":";
|
||||
print_type_expr storage_type
|
||||
|
||||
and print_parameters {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
print_token lpar "(";
|
||||
print_nsepseq ";" print_param_decl inside;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_param_decl = function
|
||||
ParamConst param_const -> print_param_const param_const
|
||||
| ParamVar param_var -> print_param_var param_var
|
||||
|
||||
and print_param_const {value; _} =
|
||||
let {kwd_const; var; colon; param_type} = value in
|
||||
print_token kwd_const "const";
|
||||
print_var var;
|
||||
print_token colon ":";
|
||||
print_type_expr param_type
|
||||
|
||||
and print_param_var {value; _} =
|
||||
let {kwd_var; var; colon; param_type} = value in
|
||||
print_token kwd_var "var";
|
||||
print_var var;
|
||||
print_token colon ":";
|
||||
print_type_expr param_type
|
||||
|
||||
and print_block {value; _} =
|
||||
let {opening; statements; terminator; closing} = value in
|
||||
print_block_opening opening;
|
||||
print_statements statements;
|
||||
print_terminator terminator;
|
||||
print_block_closing closing
|
||||
|
||||
and print_block_opening = function
|
||||
Block (kwd_block, lbrace) -> print_token kwd_block "block";
|
||||
print_token lbrace "{"
|
||||
| Begin kwd_begin -> print_token kwd_begin "begin"
|
||||
|
||||
and print_block_closing = function
|
||||
Block rbrace -> print_token rbrace "}"
|
||||
| End kwd_end -> print_token kwd_end "end"
|
||||
|
||||
and print_local_decls sequence =
|
||||
List.iter print_local_decl sequence
|
||||
|
||||
and print_local_decl = function
|
||||
LocalLam decl -> print_lambda_decl decl
|
||||
| LocalData decl -> print_data_decl decl
|
||||
|
||||
and print_data_decl = function
|
||||
LocalConst decl -> print_const_decl decl
|
||||
| LocalVar decl -> print_var_decl decl
|
||||
|
||||
and print_var_decl {value; _} =
|
||||
let {kwd_var; name; colon; var_type;
|
||||
assign; init; terminator} = value in
|
||||
print_token kwd_var "var";
|
||||
print_var name;
|
||||
print_token colon ":";
|
||||
print_type_expr var_type;
|
||||
print_token assign ":=";
|
||||
print_expr init;
|
||||
print_terminator terminator
|
||||
|
||||
and print_statements sequence =
|
||||
print_nsepseq ";" print_statement sequence
|
||||
|
||||
and print_statement = function
|
||||
Instr instr -> print_instruction instr
|
||||
| Data data -> print_data_decl data
|
||||
|
||||
and print_instruction = function
|
||||
Single instr -> print_single_instr instr
|
||||
| Block block -> print_block block
|
||||
|
||||
and print_single_instr = function
|
||||
Cond {value; _} -> print_conditional value
|
||||
| CaseInstr {value; _} -> print_case_instr value
|
||||
| Assign assign -> print_assignment assign
|
||||
| Loop loop -> print_loop loop
|
||||
| ProcCall fun_call -> print_fun_call fun_call
|
||||
| Fail {value; _} -> print_fail value
|
||||
| Skip kwd_skip -> print_token kwd_skip "skip"
|
||||
| RecordPatch {value; _} -> print_record_patch value
|
||||
| MapPatch {value; _} -> print_map_patch value
|
||||
| SetPatch {value; _} -> print_set_patch value
|
||||
| MapRemove {value; _} -> print_map_remove value
|
||||
| SetRemove {value; _} -> print_set_remove value
|
||||
|
||||
and print_fail {kwd_fail; fail_expr} =
|
||||
print_token kwd_fail "fail";
|
||||
print_expr fail_expr
|
||||
|
||||
and print_conditional node =
|
||||
let {kwd_if; test; kwd_then; ifso; terminator;
|
||||
kwd_else; ifnot} = node in
|
||||
print_token kwd_if "if";
|
||||
print_expr test;
|
||||
print_token kwd_then "then";
|
||||
print_if_clause ifso;
|
||||
print_terminator terminator;
|
||||
print_token kwd_else "else";
|
||||
print_if_clause ifnot
|
||||
|
||||
and print_if_clause = function
|
||||
ClauseInstr instr -> print_instruction instr
|
||||
| ClauseBlock {value; _} ->
|
||||
let {lbrace; inside; rbrace} = value in
|
||||
let statements, terminator = inside in
|
||||
print_token lbrace "{";
|
||||
print_statements statements;
|
||||
print_terminator terminator;
|
||||
print_token rbrace "}"
|
||||
|
||||
and print_case_instr (node : instruction case) =
|
||||
let {kwd_case; expr; opening;
|
||||
lead_vbar; cases; closing} = node in
|
||||
print_token kwd_case "case";
|
||||
print_expr expr;
|
||||
print_opening "of" opening;
|
||||
print_token_opt lead_vbar "|";
|
||||
print_cases_instr cases;
|
||||
print_closing closing
|
||||
|
||||
and print_token_opt = function
|
||||
None -> fun _ -> ()
|
||||
| Some region -> print_token region
|
||||
|
||||
and print_cases_instr {value; _} =
|
||||
print_nsepseq "|" print_case_clause_instr value
|
||||
|
||||
and print_case_clause_instr {value; _} =
|
||||
let {pattern; arrow; rhs} = value in
|
||||
print_pattern pattern;
|
||||
print_token arrow "->";
|
||||
print_instruction rhs
|
||||
|
||||
and print_assignment {value; _} =
|
||||
let {lhs; assign; rhs} = value in
|
||||
print_lhs lhs;
|
||||
print_token assign ":=";
|
||||
print_rhs rhs
|
||||
|
||||
and print_rhs = function
|
||||
Expr e -> print_expr e
|
||||
| NoneExpr r -> print_token r "None"
|
||||
|
||||
and print_lhs = function
|
||||
Path path -> print_path path
|
||||
| MapPath {value; _} -> print_map_lookup value
|
||||
|
||||
and print_loop = function
|
||||
While {value; _} -> print_while_loop value
|
||||
| For for_loop -> print_for_loop for_loop
|
||||
|
||||
and print_while_loop value =
|
||||
let {kwd_while; cond; block} = value in
|
||||
print_token kwd_while "while";
|
||||
print_expr cond;
|
||||
print_block block
|
||||
|
||||
and print_for_loop = function
|
||||
ForInt for_int -> print_for_int for_int
|
||||
| ForCollect for_collect -> print_for_collect for_collect
|
||||
|
||||
and print_for_int ({value; _} : for_int reg) =
|
||||
let {kwd_for; assign; down; kwd_to;
|
||||
bound; step; block} = value in
|
||||
print_token kwd_for "for";
|
||||
print_var_assign assign;
|
||||
print_down down;
|
||||
print_token kwd_to "to";
|
||||
print_expr bound;
|
||||
print_step step;
|
||||
print_block block
|
||||
|
||||
and print_var_assign {value; _} =
|
||||
let {name; assign; expr} = value in
|
||||
print_var name;
|
||||
print_token assign ":=";
|
||||
print_expr expr
|
||||
|
||||
and print_down = function
|
||||
Some kwd_down -> print_token kwd_down "down"
|
||||
| None -> ()
|
||||
|
||||
and print_step = function
|
||||
Some (kwd_step, expr) ->
|
||||
print_token kwd_step "step";
|
||||
print_expr expr
|
||||
| None -> ()
|
||||
|
||||
and print_for_collect ({value; _} : for_collect reg) =
|
||||
let {kwd_for; var; bind_to; kwd_in; expr; block} = value in
|
||||
print_token kwd_for "for";
|
||||
print_var var;
|
||||
print_bind_to bind_to;
|
||||
print_token kwd_in "in";
|
||||
print_expr expr;
|
||||
print_block block
|
||||
|
||||
and print_bind_to = function
|
||||
Some (arrow, variable) ->
|
||||
print_token arrow "->";
|
||||
print_var variable
|
||||
| None -> ()
|
||||
|
||||
and print_expr = function
|
||||
ECase {value;_} -> print_case_expr value
|
||||
| ELogic e -> print_logic_expr e
|
||||
| EArith e -> print_arith_expr e
|
||||
| EString e -> print_string_expr e
|
||||
| EList e -> print_list_expr e
|
||||
| ESet e -> print_set_expr e
|
||||
| EConstr e -> print_constr_expr e
|
||||
| ERecord e -> print_record_expr e
|
||||
| EProj e -> print_projection e
|
||||
| EMap e -> print_map_expr e
|
||||
| EVar v -> print_var v
|
||||
| ECall e -> print_fun_call e
|
||||
| EBytes b -> print_bytes b
|
||||
| EUnit r -> print_token r "Unit"
|
||||
| ETuple e -> print_tuple_expr e
|
||||
| EPar e -> print_par_expr e
|
||||
|
||||
and print_case_expr (node : expr case) =
|
||||
let {kwd_case; expr; opening;
|
||||
lead_vbar; cases; closing} = node in
|
||||
print_token kwd_case "case";
|
||||
print_expr expr;
|
||||
print_opening "of" opening;
|
||||
print_token_opt lead_vbar "|";
|
||||
print_cases_expr cases;
|
||||
print_closing closing
|
||||
|
||||
and print_cases_expr {value; _} =
|
||||
print_nsepseq "|" print_case_clause_expr value
|
||||
|
||||
and print_case_clause_expr {value; _} =
|
||||
let {pattern; arrow; rhs} = value in
|
||||
print_pattern pattern;
|
||||
print_token arrow "->";
|
||||
print_expr rhs
|
||||
|
||||
and print_map_expr = function
|
||||
MapLookUp {value; _} -> print_map_lookup value
|
||||
| MapInj inj -> print_injection "map" print_binding inj
|
||||
|
||||
and print_set_expr = function
|
||||
SetInj inj -> print_injection "set" print_expr inj
|
||||
| SetMem mem -> print_set_membership mem
|
||||
|
||||
and print_set_membership {value; _} =
|
||||
let {set; kwd_contains; element} = value in
|
||||
print_expr set;
|
||||
print_token kwd_contains "contains";
|
||||
print_expr element
|
||||
|
||||
and print_map_lookup {path; index} =
|
||||
let {lbracket; inside; rbracket} = index.value in
|
||||
print_path path;
|
||||
print_token lbracket "[";
|
||||
print_expr inside;
|
||||
print_token rbracket "]"
|
||||
|
||||
and print_path = function
|
||||
Name var -> print_var var
|
||||
| Path path -> print_projection path
|
||||
|
||||
and print_logic_expr = function
|
||||
BoolExpr e -> print_bool_expr e
|
||||
| CompExpr e -> print_comp_expr e
|
||||
|
||||
and print_bool_expr = function
|
||||
Or {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "||"; print_expr arg2
|
||||
| And {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "&&"; print_expr arg2
|
||||
| Not {value = {op; arg}; _} ->
|
||||
print_token op "not"; print_expr arg
|
||||
| False region -> print_token region "False"
|
||||
| True region -> print_token region "True"
|
||||
|
||||
and print_comp_expr = function
|
||||
Lt {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "<"; print_expr arg2
|
||||
| Leq {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "<="; print_expr arg2
|
||||
| Gt {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op ">"; print_expr arg2
|
||||
| Geq {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op ">="; print_expr arg2
|
||||
| Equal {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "="; print_expr arg2
|
||||
| Neq {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "=/="; print_expr arg2
|
||||
|
||||
and print_arith_expr = function
|
||||
Add {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "+"; print_expr arg2
|
||||
| Sub {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "-"; print_expr arg2
|
||||
| Mult {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "*"; print_expr arg2
|
||||
| Div {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "/"; print_expr arg2
|
||||
| Mod {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "mod"; print_expr arg2
|
||||
| Neg {value = {op; arg}; _} ->
|
||||
print_token op "-"; print_expr arg
|
||||
| Int i -> print_int i
|
||||
| Nat i -> print_int i
|
||||
|
||||
and print_string_expr = function
|
||||
Cat {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "^"; print_expr arg2
|
||||
| String s -> print_string s
|
||||
|
||||
and print_list_expr = function
|
||||
Cons {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "#"; print_expr arg2
|
||||
| List e -> print_injection "list" print_expr e
|
||||
| Nil e -> print_nil e
|
||||
|
||||
and print_constr_expr = function
|
||||
SomeApp e -> print_some_app e
|
||||
| NoneExpr e -> print_none_expr e
|
||||
| ConstrApp e -> print_constr_app e
|
||||
|
||||
and print_record_expr = function
|
||||
RecordInj e -> print_record_injection e
|
||||
|
||||
and print_record_injection {value; _} =
|
||||
let {opening; fields; terminator; closing} = value in
|
||||
print_token opening "record";
|
||||
print_nsepseq ";" print_field_assign fields;
|
||||
print_terminator terminator;
|
||||
print_token closing "end"
|
||||
|
||||
and print_field_assign {value; _} =
|
||||
let {field_name; equal; field_expr} = value in
|
||||
print_var field_name;
|
||||
print_token equal "=";
|
||||
print_expr field_expr
|
||||
|
||||
and print_projection {value; _} =
|
||||
let {struct_name; selector; field_path} = value in
|
||||
print_var struct_name;
|
||||
print_token selector ".";
|
||||
print_field_path field_path
|
||||
|
||||
and print_field_path sequence =
|
||||
print_nsepseq "." print_selection sequence
|
||||
|
||||
and print_selection = function
|
||||
FieldName name -> print_var name
|
||||
| Component int -> print_int int
|
||||
|
||||
and print_record_patch node =
|
||||
let {kwd_patch; path; kwd_with; record_inj} = node in
|
||||
print_token kwd_patch "patch";
|
||||
print_path path;
|
||||
print_token kwd_with "with";
|
||||
print_record_injection record_inj
|
||||
|
||||
and print_set_patch node =
|
||||
let {kwd_patch; path; kwd_with; set_inj} = node in
|
||||
print_token kwd_patch "patch";
|
||||
print_path path;
|
||||
print_token kwd_with "with";
|
||||
print_injection "set" print_expr set_inj
|
||||
|
||||
and print_map_patch node =
|
||||
let {kwd_patch; path; kwd_with; map_inj} = node in
|
||||
print_token kwd_patch "patch";
|
||||
print_path path;
|
||||
print_token kwd_with "with";
|
||||
print_injection "map" print_binding map_inj
|
||||
|
||||
and print_map_remove node =
|
||||
let {kwd_remove; key; kwd_from; kwd_map; map} = node in
|
||||
print_token kwd_remove "remove";
|
||||
print_expr key;
|
||||
print_token kwd_from "from";
|
||||
print_token kwd_map "map";
|
||||
print_path map
|
||||
|
||||
and print_set_remove node =
|
||||
let {kwd_remove; element; kwd_from; kwd_set; set} = node in
|
||||
print_token kwd_remove "remove";
|
||||
print_expr element;
|
||||
print_token kwd_from "from";
|
||||
print_token kwd_set "set";
|
||||
print_path set
|
||||
|
||||
and print_injection :
|
||||
'a.string -> ('a -> unit) -> 'a injection reg -> unit =
|
||||
fun kwd print {value; _} ->
|
||||
let {opening; elements; terminator; closing} = value in
|
||||
print_opening kwd opening;
|
||||
print_sepseq ";" print elements;
|
||||
print_terminator terminator;
|
||||
print_closing closing
|
||||
|
||||
and print_opening lexeme = function
|
||||
Kwd kwd -> print_token kwd lexeme
|
||||
| KwdBracket (kwd, lbracket) ->
|
||||
print_token kwd lexeme;
|
||||
print_token lbracket "{"
|
||||
|
||||
and print_closing = function
|
||||
RBracket rbracket -> print_token rbracket "}"
|
||||
| End kwd_end -> print_token kwd_end "end"
|
||||
|
||||
and print_binding {value; _} =
|
||||
let {source; arrow; image} = value in
|
||||
print_expr source;
|
||||
print_token arrow "->";
|
||||
print_expr image
|
||||
|
||||
and print_tuple_expr = function
|
||||
TupleInj inj -> print_tuple_inj inj
|
||||
|
||||
and print_tuple_inj {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
print_token lpar "(";
|
||||
print_nsepseq "," print_expr inside;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_nil {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
let {nil; colon; list_type} = inside in
|
||||
print_token lpar "(";
|
||||
print_token nil "nil";
|
||||
print_token colon ":";
|
||||
print_type_expr list_type;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_none_expr {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
let {c_None; colon; opt_type} = inside in
|
||||
print_token lpar "(";
|
||||
print_token c_None "None";
|
||||
print_token colon ":";
|
||||
print_type_expr opt_type;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_fun_call {value; _} =
|
||||
let fun_name, arguments = value in
|
||||
print_var fun_name;
|
||||
print_tuple_inj arguments
|
||||
|
||||
and print_constr_app {value; _} =
|
||||
let constr, arguments = value in
|
||||
print_constr constr;
|
||||
print_tuple_inj arguments
|
||||
|
||||
and print_some_app {value; _} =
|
||||
let c_Some, arguments = value in
|
||||
print_token c_Some "Some";
|
||||
print_tuple_inj arguments
|
||||
|
||||
and print_par_expr {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
print_token lpar "(";
|
||||
print_expr inside;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_pattern = function
|
||||
PCons {value; _} -> print_nsepseq "#" print_pattern value
|
||||
| PVar var -> print_var var
|
||||
| PWild wild -> print_token wild "_"
|
||||
| PInt i -> print_int i
|
||||
| PBytes b -> print_bytes b
|
||||
| PString s -> print_string s
|
||||
| PUnit region -> print_token region "Unit"
|
||||
| PFalse region -> print_token region "False"
|
||||
| PTrue region -> print_token region "True"
|
||||
| PNone region -> print_token region "None"
|
||||
| PSome psome -> print_psome psome
|
||||
| PList pattern -> print_list_pattern pattern
|
||||
| PTuple ptuple -> print_ptuple ptuple
|
||||
|
||||
and print_psome {value; _} =
|
||||
let c_Some, patterns = value in
|
||||
print_token c_Some "Some";
|
||||
print_patterns patterns
|
||||
|
||||
and print_patterns {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
print_token lpar "(";
|
||||
print_pattern inside;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_list_pattern = function
|
||||
Sugar sugar -> print_injection "list" print_pattern sugar
|
||||
| PNil kwd_nil -> print_token kwd_nil "nil"
|
||||
| Raw raw -> print_raw raw
|
||||
|
||||
and print_raw {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
let head, cons, tail = inside in
|
||||
print_token lpar "(";
|
||||
print_pattern head;
|
||||
print_token cons "#";
|
||||
print_pattern tail;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_ptuple {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
print_token lpar "(";
|
||||
print_nsepseq "," print_pattern inside;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_terminator = function
|
||||
Some semi -> print_token semi ";"
|
||||
| None -> ()
|
||||
|
||||
@ -659,8 +659,3 @@ val lhs_to_region : lhs -> Region.t
|
||||
val rhs_to_region : rhs -> Region.t
|
||||
val if_clause_to_region : if_clause -> Region.t
|
||||
val selection_to_region : selection -> Region.t
|
||||
|
||||
(* Printing *)
|
||||
|
||||
val print_tokens : t -> unit
|
||||
val print_path : path -> unit
|
||||
|
||||
708
src/ligo/ligo_parser/ParserLog.ml
Normal file
708
src/ligo/ligo_parser/ParserLog.ml
Normal file
@ -0,0 +1,708 @@
|
||||
open Utils
|
||||
open AST
|
||||
open! Region
|
||||
|
||||
(* Printing the tokens with their source regions *)
|
||||
|
||||
let printf = Printf.printf
|
||||
|
||||
let compact (region: Region.t) =
|
||||
region#compact ~offsets:EvalOpt.offsets EvalOpt.mode
|
||||
|
||||
let print_nsepseq :
|
||||
string -> ('a -> unit) -> ('a, Region.t) nsepseq -> unit =
|
||||
fun sep visit (head, tail) ->
|
||||
let print_aux (sep_reg, item) =
|
||||
printf "%s: %s\n" (compact sep_reg) sep;
|
||||
visit item
|
||||
in visit head; List.iter print_aux tail
|
||||
|
||||
let print_sepseq :
|
||||
string -> ('a -> unit) -> ('a, Region.t) sepseq -> unit =
|
||||
fun sep visit -> function
|
||||
None -> ()
|
||||
| Some seq -> print_nsepseq sep visit seq
|
||||
|
||||
let print_token region lexeme =
|
||||
printf "%s: %s\n"(compact region) lexeme
|
||||
|
||||
let print_var {region; value=lexeme} =
|
||||
printf "%s: Ident \"%s\"\n" (compact region) lexeme
|
||||
|
||||
let print_constr {region; value=lexeme} =
|
||||
printf "%s: Constr \"%s\"\n"
|
||||
(compact region) lexeme
|
||||
|
||||
let print_string {region; value=lexeme} =
|
||||
printf "%s: String %s\n"
|
||||
(compact region) lexeme
|
||||
|
||||
let print_bytes {region; value = lexeme, abstract} =
|
||||
printf "%s: Bytes (\"%s\", \"0x%s\")\n"
|
||||
(compact region) lexeme
|
||||
(Hex.to_string abstract)
|
||||
|
||||
let print_int {region; value = lexeme, abstract} =
|
||||
printf "%s: Int (\"%s\", %s)\n"
|
||||
(compact region) lexeme
|
||||
(Z.to_string abstract)
|
||||
|
||||
(* Main printing function *)
|
||||
|
||||
let rec print_tokens ast =
|
||||
let {decl; eof} = ast in
|
||||
Utils.nseq_iter print_decl decl;
|
||||
print_token eof "EOF"
|
||||
|
||||
and print_decl = function
|
||||
TypeDecl decl -> print_type_decl decl
|
||||
| ConstDecl decl -> print_const_decl decl
|
||||
| LambdaDecl decl -> print_lambda_decl decl
|
||||
|
||||
and print_const_decl {value; _} =
|
||||
let {kwd_const; name; colon; const_type;
|
||||
equal; init; terminator} = value in
|
||||
print_token kwd_const "const";
|
||||
print_var name;
|
||||
print_token colon ":";
|
||||
print_type_expr const_type;
|
||||
print_token equal "=";
|
||||
print_expr init;
|
||||
print_terminator terminator
|
||||
|
||||
and print_type_decl {value; _} =
|
||||
let {kwd_type; name; kwd_is;
|
||||
type_expr; terminator} = value in
|
||||
print_token kwd_type "type";
|
||||
print_var name;
|
||||
print_token kwd_is "is";
|
||||
print_type_expr type_expr;
|
||||
print_terminator terminator
|
||||
|
||||
and print_type_expr = function
|
||||
TProd cartesian -> print_cartesian cartesian
|
||||
| TSum sum_type -> print_sum_type sum_type
|
||||
| TRecord record_type -> print_record_type record_type
|
||||
| TApp type_app -> print_type_app type_app
|
||||
| TPar par_type -> print_par_type par_type
|
||||
| TAlias type_alias -> print_var type_alias
|
||||
|
||||
and print_cartesian {value; _} =
|
||||
print_nsepseq "*" print_type_expr value
|
||||
|
||||
and print_variant {value; _} =
|
||||
let {constr; kwd_of; product} = value in
|
||||
print_constr constr;
|
||||
print_token kwd_of "of";
|
||||
print_cartesian product
|
||||
|
||||
and print_sum_type {value; _} =
|
||||
print_nsepseq "|" print_variant value
|
||||
|
||||
and print_record_type record_type =
|
||||
print_injection "record" print_field_decl record_type
|
||||
|
||||
and print_type_app {value; _} =
|
||||
let type_name, type_tuple = value in
|
||||
print_var type_name;
|
||||
print_type_tuple type_tuple
|
||||
|
||||
and print_par_type {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
print_token lpar "(";
|
||||
print_type_expr inside;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_field_decl {value; _} =
|
||||
let {field_name; colon; field_type} = value in
|
||||
print_var field_name;
|
||||
print_token colon ":";
|
||||
print_type_expr field_type
|
||||
|
||||
and print_type_tuple {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
print_token lpar "(";
|
||||
print_nsepseq "," print_type_expr inside;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_lambda_decl = function
|
||||
FunDecl fun_decl -> print_fun_decl fun_decl
|
||||
| ProcDecl proc_decl -> print_proc_decl proc_decl
|
||||
| EntryDecl entry_decl -> print_entry_decl entry_decl
|
||||
|
||||
and print_fun_decl {value; _} =
|
||||
let {kwd_function; name; param; colon;
|
||||
ret_type; kwd_is; local_decls;
|
||||
block; kwd_with; return; terminator} = value in
|
||||
print_token kwd_function "function";
|
||||
print_var name;
|
||||
print_parameters param;
|
||||
print_token colon ":";
|
||||
print_type_expr ret_type;
|
||||
print_token kwd_is "is";
|
||||
print_local_decls local_decls;
|
||||
print_block block;
|
||||
print_token kwd_with "with";
|
||||
print_expr return;
|
||||
print_terminator terminator
|
||||
|
||||
and print_proc_decl {value; _} =
|
||||
let {kwd_procedure; name; param; kwd_is;
|
||||
local_decls; block; terminator} = value in
|
||||
print_token kwd_procedure "procedure";
|
||||
print_var name;
|
||||
print_parameters param;
|
||||
print_token kwd_is "is";
|
||||
print_local_decls local_decls;
|
||||
print_block block;
|
||||
print_terminator terminator
|
||||
|
||||
and print_entry_decl {value; _} =
|
||||
let {kwd_entrypoint; name; param; colon;
|
||||
ret_type; kwd_is; local_decls;
|
||||
block; kwd_with; return; terminator} = value in
|
||||
print_token kwd_entrypoint "entrypoint";
|
||||
print_var name;
|
||||
print_entry_params param;
|
||||
print_token colon ":";
|
||||
print_type_expr ret_type;
|
||||
print_token kwd_is "is";
|
||||
print_local_decls local_decls;
|
||||
print_block block;
|
||||
print_token kwd_with "with";
|
||||
print_expr return;
|
||||
print_terminator terminator
|
||||
|
||||
and print_entry_params {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
print_token lpar "(";
|
||||
print_nsepseq ";" print_entry_param_decl inside;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_entry_param_decl = function
|
||||
EntryConst param_const -> print_param_const param_const
|
||||
| EntryVar param_var -> print_param_var param_var
|
||||
| EntryStore param_store -> print_storage param_store
|
||||
|
||||
and print_storage {value; _} =
|
||||
let {kwd_storage; var; colon; storage_type} = value in
|
||||
print_token kwd_storage "storage";
|
||||
print_var var;
|
||||
print_token colon ":";
|
||||
print_type_expr storage_type
|
||||
|
||||
and print_parameters {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
print_token lpar "(";
|
||||
print_nsepseq ";" print_param_decl inside;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_param_decl = function
|
||||
ParamConst param_const -> print_param_const param_const
|
||||
| ParamVar param_var -> print_param_var param_var
|
||||
|
||||
and print_param_const {value; _} =
|
||||
let {kwd_const; var; colon; param_type} = value in
|
||||
print_token kwd_const "const";
|
||||
print_var var;
|
||||
print_token colon ":";
|
||||
print_type_expr param_type
|
||||
|
||||
and print_param_var {value; _} =
|
||||
let {kwd_var; var; colon; param_type} = value in
|
||||
print_token kwd_var "var";
|
||||
print_var var;
|
||||
print_token colon ":";
|
||||
print_type_expr param_type
|
||||
|
||||
and print_block {value; _} =
|
||||
let {opening; statements; terminator; closing} = value in
|
||||
print_block_opening opening;
|
||||
print_statements statements;
|
||||
print_terminator terminator;
|
||||
print_block_closing closing
|
||||
|
||||
and print_block_opening = function
|
||||
Block (kwd_block, lbrace) -> print_token kwd_block "block";
|
||||
print_token lbrace "{"
|
||||
| Begin kwd_begin -> print_token kwd_begin "begin"
|
||||
|
||||
and print_block_closing = function
|
||||
Block rbrace -> print_token rbrace "}"
|
||||
| End kwd_end -> print_token kwd_end "end"
|
||||
|
||||
and print_local_decls sequence =
|
||||
List.iter print_local_decl sequence
|
||||
|
||||
and print_local_decl = function
|
||||
LocalLam decl -> print_lambda_decl decl
|
||||
| LocalData decl -> print_data_decl decl
|
||||
|
||||
and print_data_decl = function
|
||||
LocalConst decl -> print_const_decl decl
|
||||
| LocalVar decl -> print_var_decl decl
|
||||
|
||||
and print_var_decl {value; _} =
|
||||
let {kwd_var; name; colon; var_type;
|
||||
assign; init; terminator} = value in
|
||||
print_token kwd_var "var";
|
||||
print_var name;
|
||||
print_token colon ":";
|
||||
print_type_expr var_type;
|
||||
print_token assign ":=";
|
||||
print_expr init;
|
||||
print_terminator terminator
|
||||
|
||||
and print_statements sequence =
|
||||
print_nsepseq ";" print_statement sequence
|
||||
|
||||
and print_statement = function
|
||||
Instr instr -> print_instruction instr
|
||||
| Data data -> print_data_decl data
|
||||
|
||||
and print_instruction = function
|
||||
Single instr -> print_single_instr instr
|
||||
| Block block -> print_block block
|
||||
|
||||
and print_single_instr = function
|
||||
Cond {value; _} -> print_conditional value
|
||||
| CaseInstr {value; _} -> print_case_instr value
|
||||
| Assign assign -> print_assignment assign
|
||||
| Loop loop -> print_loop loop
|
||||
| ProcCall fun_call -> print_fun_call fun_call
|
||||
| Fail {value; _} -> print_fail value
|
||||
| Skip kwd_skip -> print_token kwd_skip "skip"
|
||||
| RecordPatch {value; _} -> print_record_patch value
|
||||
| MapPatch {value; _} -> print_map_patch value
|
||||
| SetPatch {value; _} -> print_set_patch value
|
||||
| MapRemove {value; _} -> print_map_remove value
|
||||
| SetRemove {value; _} -> print_set_remove value
|
||||
|
||||
and print_fail {kwd_fail; fail_expr} =
|
||||
print_token kwd_fail "fail";
|
||||
print_expr fail_expr
|
||||
|
||||
and print_conditional node =
|
||||
let {kwd_if; test; kwd_then; ifso; terminator;
|
||||
kwd_else; ifnot} = node in
|
||||
print_token kwd_if "if";
|
||||
print_expr test;
|
||||
print_token kwd_then "then";
|
||||
print_if_clause ifso;
|
||||
print_terminator terminator;
|
||||
print_token kwd_else "else";
|
||||
print_if_clause ifnot
|
||||
|
||||
and print_if_clause = function
|
||||
ClauseInstr instr -> print_instruction instr
|
||||
| ClauseBlock {value; _} ->
|
||||
let {lbrace; inside; rbrace} = value in
|
||||
let statements, terminator = inside in
|
||||
print_token lbrace "{";
|
||||
print_statements statements;
|
||||
print_terminator terminator;
|
||||
print_token rbrace "}"
|
||||
|
||||
and print_case_instr (node : instruction case) =
|
||||
let {kwd_case; expr; opening;
|
||||
lead_vbar; cases; closing} = node in
|
||||
print_token kwd_case "case";
|
||||
print_expr expr;
|
||||
print_opening "of" opening;
|
||||
print_token_opt lead_vbar "|";
|
||||
print_cases_instr cases;
|
||||
print_closing closing
|
||||
|
||||
and print_token_opt = function
|
||||
None -> fun _ -> ()
|
||||
| Some region -> print_token region
|
||||
|
||||
and print_cases_instr {value; _} =
|
||||
print_nsepseq "|" print_case_clause_instr value
|
||||
|
||||
and print_case_clause_instr {value; _} =
|
||||
let {pattern; arrow; rhs} = value in
|
||||
print_pattern pattern;
|
||||
print_token arrow "->";
|
||||
print_instruction rhs
|
||||
|
||||
and print_assignment {value; _} =
|
||||
let {lhs; assign; rhs} = value in
|
||||
print_lhs lhs;
|
||||
print_token assign ":=";
|
||||
print_rhs rhs
|
||||
|
||||
and print_rhs = function
|
||||
Expr e -> print_expr e
|
||||
| NoneExpr r -> print_token r "None"
|
||||
|
||||
and print_lhs = function
|
||||
Path path -> print_path path
|
||||
| MapPath {value; _} -> print_map_lookup value
|
||||
|
||||
and print_loop = function
|
||||
While {value; _} -> print_while_loop value
|
||||
| For for_loop -> print_for_loop for_loop
|
||||
|
||||
and print_while_loop value =
|
||||
let {kwd_while; cond; block} = value in
|
||||
print_token kwd_while "while";
|
||||
print_expr cond;
|
||||
print_block block
|
||||
|
||||
and print_for_loop = function
|
||||
ForInt for_int -> print_for_int for_int
|
||||
| ForCollect for_collect -> print_for_collect for_collect
|
||||
|
||||
and print_for_int ({value; _} : for_int reg) =
|
||||
let {kwd_for; assign; down; kwd_to;
|
||||
bound; step; block} = value in
|
||||
print_token kwd_for "for";
|
||||
print_var_assign assign;
|
||||
print_down down;
|
||||
print_token kwd_to "to";
|
||||
print_expr bound;
|
||||
print_step step;
|
||||
print_block block
|
||||
|
||||
and print_var_assign {value; _} =
|
||||
let {name; assign; expr} = value in
|
||||
print_var name;
|
||||
print_token assign ":=";
|
||||
print_expr expr
|
||||
|
||||
and print_down = function
|
||||
Some kwd_down -> print_token kwd_down "down"
|
||||
| None -> ()
|
||||
|
||||
and print_step = function
|
||||
Some (kwd_step, expr) ->
|
||||
print_token kwd_step "step";
|
||||
print_expr expr
|
||||
| None -> ()
|
||||
|
||||
and print_for_collect ({value; _} : for_collect reg) =
|
||||
let {kwd_for; var; bind_to; kwd_in; expr; block} = value in
|
||||
print_token kwd_for "for";
|
||||
print_var var;
|
||||
print_bind_to bind_to;
|
||||
print_token kwd_in "in";
|
||||
print_expr expr;
|
||||
print_block block
|
||||
|
||||
and print_bind_to = function
|
||||
Some (arrow, variable) ->
|
||||
print_token arrow "->";
|
||||
print_var variable
|
||||
| None -> ()
|
||||
|
||||
and print_expr = function
|
||||
ECase {value;_} -> print_case_expr value
|
||||
| ELogic e -> print_logic_expr e
|
||||
| EArith e -> print_arith_expr e
|
||||
| EString e -> print_string_expr e
|
||||
| EList e -> print_list_expr e
|
||||
| ESet e -> print_set_expr e
|
||||
| EConstr e -> print_constr_expr e
|
||||
| ERecord e -> print_record_expr e
|
||||
| EProj e -> print_projection e
|
||||
| EMap e -> print_map_expr e
|
||||
| EVar v -> print_var v
|
||||
| ECall e -> print_fun_call e
|
||||
| EBytes b -> print_bytes b
|
||||
| EUnit r -> print_token r "Unit"
|
||||
| ETuple e -> print_tuple_expr e
|
||||
| EPar e -> print_par_expr e
|
||||
|
||||
and print_case_expr (node : expr case) =
|
||||
let {kwd_case; expr; opening;
|
||||
lead_vbar; cases; closing} = node in
|
||||
print_token kwd_case "case";
|
||||
print_expr expr;
|
||||
print_opening "of" opening;
|
||||
print_token_opt lead_vbar "|";
|
||||
print_cases_expr cases;
|
||||
print_closing closing
|
||||
|
||||
and print_cases_expr {value; _} =
|
||||
print_nsepseq "|" print_case_clause_expr value
|
||||
|
||||
and print_case_clause_expr {value; _} =
|
||||
let {pattern; arrow; rhs} = value in
|
||||
print_pattern pattern;
|
||||
print_token arrow "->";
|
||||
print_expr rhs
|
||||
|
||||
and print_map_expr = function
|
||||
MapLookUp {value; _} -> print_map_lookup value
|
||||
| MapInj inj -> print_injection "map" print_binding inj
|
||||
|
||||
and print_set_expr = function
|
||||
SetInj inj -> print_injection "set" print_expr inj
|
||||
| SetMem mem -> print_set_membership mem
|
||||
|
||||
and print_set_membership {value; _} =
|
||||
let {set; kwd_contains; element} = value in
|
||||
print_expr set;
|
||||
print_token kwd_contains "contains";
|
||||
print_expr element
|
||||
|
||||
and print_map_lookup {path; index} =
|
||||
let {lbracket; inside; rbracket} = index.value in
|
||||
print_path path;
|
||||
print_token lbracket "[";
|
||||
print_expr inside;
|
||||
print_token rbracket "]"
|
||||
|
||||
and print_path = function
|
||||
Name var -> print_var var
|
||||
| Path path -> print_projection path
|
||||
|
||||
and print_logic_expr = function
|
||||
BoolExpr e -> print_bool_expr e
|
||||
| CompExpr e -> print_comp_expr e
|
||||
|
||||
and print_bool_expr = function
|
||||
Or {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "||"; print_expr arg2
|
||||
| And {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "&&"; print_expr arg2
|
||||
| Not {value = {op; arg}; _} ->
|
||||
print_token op "not"; print_expr arg
|
||||
| False region -> print_token region "False"
|
||||
| True region -> print_token region "True"
|
||||
|
||||
and print_comp_expr = function
|
||||
Lt {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "<"; print_expr arg2
|
||||
| Leq {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "<="; print_expr arg2
|
||||
| Gt {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op ">"; print_expr arg2
|
||||
| Geq {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op ">="; print_expr arg2
|
||||
| Equal {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "="; print_expr arg2
|
||||
| Neq {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "=/="; print_expr arg2
|
||||
|
||||
and print_arith_expr = function
|
||||
Add {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "+"; print_expr arg2
|
||||
| Sub {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "-"; print_expr arg2
|
||||
| Mult {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "*"; print_expr arg2
|
||||
| Div {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "/"; print_expr arg2
|
||||
| Mod {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "mod"; print_expr arg2
|
||||
| Neg {value = {op; arg}; _} ->
|
||||
print_token op "-"; print_expr arg
|
||||
| Int i -> print_int i
|
||||
| Nat i -> print_int i
|
||||
|
||||
and print_string_expr = function
|
||||
Cat {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "^"; print_expr arg2
|
||||
| String s -> print_string s
|
||||
|
||||
and print_list_expr = function
|
||||
Cons {value = {arg1; op; arg2}; _} ->
|
||||
print_expr arg1; print_token op "#"; print_expr arg2
|
||||
| List e -> print_injection "list" print_expr e
|
||||
| Nil e -> print_nil e
|
||||
|
||||
and print_constr_expr = function
|
||||
SomeApp e -> print_some_app e
|
||||
| NoneExpr e -> print_none_expr e
|
||||
| ConstrApp e -> print_constr_app e
|
||||
|
||||
and print_record_expr = function
|
||||
RecordInj e -> print_record_injection e
|
||||
|
||||
and print_record_injection {value; _} =
|
||||
let {opening; fields; terminator; closing} = value in
|
||||
print_token opening "record";
|
||||
print_nsepseq ";" print_field_assign fields;
|
||||
print_terminator terminator;
|
||||
print_token closing "end"
|
||||
|
||||
and print_field_assign {value; _} =
|
||||
let {field_name; equal; field_expr} = value in
|
||||
print_var field_name;
|
||||
print_token equal "=";
|
||||
print_expr field_expr
|
||||
|
||||
and print_projection {value; _} =
|
||||
let {struct_name; selector; field_path} = value in
|
||||
print_var struct_name;
|
||||
print_token selector ".";
|
||||
print_field_path field_path
|
||||
|
||||
and print_field_path sequence =
|
||||
print_nsepseq "." print_selection sequence
|
||||
|
||||
and print_selection = function
|
||||
FieldName name -> print_var name
|
||||
| Component int -> print_int int
|
||||
|
||||
and print_record_patch node =
|
||||
let {kwd_patch; path; kwd_with; record_inj} = node in
|
||||
print_token kwd_patch "patch";
|
||||
print_path path;
|
||||
print_token kwd_with "with";
|
||||
print_record_injection record_inj
|
||||
|
||||
and print_set_patch node =
|
||||
let {kwd_patch; path; kwd_with; set_inj} = node in
|
||||
print_token kwd_patch "patch";
|
||||
print_path path;
|
||||
print_token kwd_with "with";
|
||||
print_injection "set" print_expr set_inj
|
||||
|
||||
and print_map_patch node =
|
||||
let {kwd_patch; path; kwd_with; map_inj} = node in
|
||||
print_token kwd_patch "patch";
|
||||
print_path path;
|
||||
print_token kwd_with "with";
|
||||
print_injection "map" print_binding map_inj
|
||||
|
||||
and print_map_remove node =
|
||||
let {kwd_remove; key; kwd_from; kwd_map; map} = node in
|
||||
print_token kwd_remove "remove";
|
||||
print_expr key;
|
||||
print_token kwd_from "from";
|
||||
print_token kwd_map "map";
|
||||
print_path map
|
||||
|
||||
and print_set_remove node =
|
||||
let {kwd_remove; element; kwd_from; kwd_set; set} = node in
|
||||
print_token kwd_remove "remove";
|
||||
print_expr element;
|
||||
print_token kwd_from "from";
|
||||
print_token kwd_set "set";
|
||||
print_path set
|
||||
|
||||
and print_injection :
|
||||
'a.string -> ('a -> unit) -> 'a injection reg -> unit =
|
||||
fun kwd print {value; _} ->
|
||||
let {opening; elements; terminator; closing} = value in
|
||||
print_opening kwd opening;
|
||||
print_sepseq ";" print elements;
|
||||
print_terminator terminator;
|
||||
print_closing closing
|
||||
|
||||
and print_opening lexeme = function
|
||||
Kwd kwd -> print_token kwd lexeme
|
||||
| KwdBracket (kwd, lbracket) ->
|
||||
print_token kwd lexeme;
|
||||
print_token lbracket "{"
|
||||
|
||||
and print_closing = function
|
||||
RBracket rbracket -> print_token rbracket "}"
|
||||
| End kwd_end -> print_token kwd_end "end"
|
||||
|
||||
and print_binding {value; _} =
|
||||
let {source; arrow; image} = value in
|
||||
print_expr source;
|
||||
print_token arrow "->";
|
||||
print_expr image
|
||||
|
||||
and print_tuple_expr = function
|
||||
TupleInj inj -> print_tuple_inj inj
|
||||
|
||||
and print_tuple_inj {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
print_token lpar "(";
|
||||
print_nsepseq "," print_expr inside;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_nil {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
let {nil; colon; list_type} = inside in
|
||||
print_token lpar "(";
|
||||
print_token nil "nil";
|
||||
print_token colon ":";
|
||||
print_type_expr list_type;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_none_expr {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
let {c_None; colon; opt_type} = inside in
|
||||
print_token lpar "(";
|
||||
print_token c_None "None";
|
||||
print_token colon ":";
|
||||
print_type_expr opt_type;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_fun_call {value; _} =
|
||||
let fun_name, arguments = value in
|
||||
print_var fun_name;
|
||||
print_tuple_inj arguments
|
||||
|
||||
and print_constr_app {value; _} =
|
||||
let constr, arguments = value in
|
||||
print_constr constr;
|
||||
print_tuple_inj arguments
|
||||
|
||||
and print_some_app {value; _} =
|
||||
let c_Some, arguments = value in
|
||||
print_token c_Some "Some";
|
||||
print_tuple_inj arguments
|
||||
|
||||
and print_par_expr {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
print_token lpar "(";
|
||||
print_expr inside;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_pattern = function
|
||||
PCons {value; _} -> print_nsepseq "#" print_pattern value
|
||||
| PVar var -> print_var var
|
||||
| PWild wild -> print_token wild "_"
|
||||
| PInt i -> print_int i
|
||||
| PBytes b -> print_bytes b
|
||||
| PString s -> print_string s
|
||||
| PUnit region -> print_token region "Unit"
|
||||
| PFalse region -> print_token region "False"
|
||||
| PTrue region -> print_token region "True"
|
||||
| PNone region -> print_token region "None"
|
||||
| PSome psome -> print_psome psome
|
||||
| PList pattern -> print_list_pattern pattern
|
||||
| PTuple ptuple -> print_ptuple ptuple
|
||||
|
||||
and print_psome {value; _} =
|
||||
let c_Some, patterns = value in
|
||||
print_token c_Some "Some";
|
||||
print_patterns patterns
|
||||
|
||||
and print_patterns {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
print_token lpar "(";
|
||||
print_pattern inside;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_list_pattern = function
|
||||
Sugar sugar -> print_injection "list" print_pattern sugar
|
||||
| PNil kwd_nil -> print_token kwd_nil "nil"
|
||||
| Raw raw -> print_raw raw
|
||||
|
||||
and print_raw {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
let head, cons, tail = inside in
|
||||
print_token lpar "(";
|
||||
print_pattern head;
|
||||
print_token cons "#";
|
||||
print_pattern tail;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_ptuple {value; _} =
|
||||
let {lpar; inside; rpar} = value in
|
||||
print_token lpar "(";
|
||||
print_nsepseq "," print_pattern inside;
|
||||
print_token rpar ")"
|
||||
|
||||
and print_terminator = function
|
||||
Some semi -> print_token semi ";"
|
||||
| None -> ()
|
||||
3
src/ligo/ligo_parser/ParserLog.mli
Normal file
3
src/ligo/ligo_parser/ParserLog.mli
Normal file
@ -0,0 +1,3 @@
|
||||
(* Printing the AST *)
|
||||
|
||||
val print_tokens : AST.t -> unit
|
||||
@ -91,7 +91,7 @@ let () =
|
||||
try
|
||||
let ast = Parser.contract tokeniser buffer in
|
||||
if Utils.String.Set.mem "ast" EvalOpt.verbose
|
||||
then AST.print_tokens ast
|
||||
then ParserLog.print_tokens ast
|
||||
with
|
||||
Lexer.Error err ->
|
||||
close_all ();
|
||||
|
||||
Loading…
Reference in New Issue
Block a user