diff --git a/src/ligo/ligo_parser/AST.ml b/src/ligo/ligo_parser/AST.ml index 5362beabc..3961a7f93 100644 --- a/src/ligo/ligo_parser/AST.ml +++ b/src/ligo/ligo_parser/AST.ml @@ -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 -> () diff --git a/src/ligo/ligo_parser/AST.mli b/src/ligo/ligo_parser/AST.mli index d7567501b..0cf938adb 100644 --- a/src/ligo/ligo_parser/AST.mli +++ b/src/ligo/ligo_parser/AST.mli @@ -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 diff --git a/src/ligo/ligo_parser/ParserLog.ml b/src/ligo/ligo_parser/ParserLog.ml new file mode 100644 index 000000000..0f61abc13 --- /dev/null +++ b/src/ligo/ligo_parser/ParserLog.ml @@ -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 -> () diff --git a/src/ligo/ligo_parser/ParserLog.mli b/src/ligo/ligo_parser/ParserLog.mli new file mode 100644 index 000000000..ea3d9c687 --- /dev/null +++ b/src/ligo/ligo_parser/ParserLog.mli @@ -0,0 +1,3 @@ +(* Printing the AST *) + +val print_tokens : AST.t -> unit diff --git a/src/ligo/ligo_parser/ParserMain.ml b/src/ligo/ligo_parser/ParserMain.ml index ed6cbbccc..9d685691e 100644 --- a/src/ligo/ligo_parser/ParserMain.ml +++ b/src/ligo/ligo_parser/ParserMain.ml @@ -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 ();