diff --git a/src/passes/1-parser/pascaligo/AST.ml b/src/passes/1-parser/pascaligo/AST.ml index 345976e3b..857661f07 100644 --- a/src/passes/1-parser/pascaligo/AST.ml +++ b/src/passes/1-parser/pascaligo/AST.ml @@ -198,7 +198,7 @@ and cartesian = (type_expr, times) nsepseq reg and variant = { constr : constr; - args : (kwd_of * cartesian) option + args : (kwd_of * type_expr) option } and field_decl = { @@ -573,16 +573,13 @@ and selection = FieldName of field_name | Component of (Lexer.lexeme * Z.t) reg -and tuple_expr = - TupleInj of tuple_injection - -and tuple_injection = (expr, comma) nsepseq par reg +and tuple_expr = (expr, comma) nsepseq par reg and none_expr = c_None and fun_call = (fun_name * arguments) reg -and arguments = tuple_injection +and arguments = tuple_expr (* Patterns *) @@ -592,6 +589,7 @@ and pattern = | PVar of Lexer.lexeme reg | PWild of wild | PInt of (Lexer.lexeme * Z.t) reg +| PNat of (Lexer.lexeme * Z.t) reg | PBytes of (Lexer.lexeme * Hex.t) reg | PString of Lexer.lexeme reg | PUnit of c_Unit @@ -641,8 +639,7 @@ let rec expr_to_region = function | ECase {region;_} | EPar {region; _} -> region -and tuple_expr_to_region = function - TupleInj {region; _} -> region +and tuple_expr_to_region {region; _} = region and map_expr_to_region = function MapLookUp {region; _} @@ -729,6 +726,7 @@ let pattern_to_region = function | PVar {region; _} | PWild region | PInt {region; _} +| PNat {region; _} | PBytes {region; _} | PString {region; _} | PUnit region diff --git a/src/passes/1-parser/pascaligo/AST.mli b/src/passes/1-parser/pascaligo/AST.mli index 0174b0efc..66452c32a 100644 --- a/src/passes/1-parser/pascaligo/AST.mli +++ b/src/passes/1-parser/pascaligo/AST.mli @@ -182,7 +182,7 @@ and cartesian = (type_expr, times) nsepseq reg and variant = { constr : constr; - args : (kwd_of * cartesian) option + args : (kwd_of * type_expr) option } and field_decl = { @@ -557,16 +557,13 @@ and selection = FieldName of field_name | Component of (Lexer.lexeme * Z.t) reg -and tuple_expr = - TupleInj of tuple_injection - -and tuple_injection = (expr, comma) nsepseq par reg +and tuple_expr = (expr, comma) nsepseq par reg and none_expr = c_None and fun_call = (fun_name * arguments) reg -and arguments = tuple_injection +and arguments = tuple_expr (* Patterns *) @@ -576,6 +573,7 @@ and pattern = | PVar of Lexer.lexeme reg | PWild of wild | PInt of (Lexer.lexeme * Z.t) reg +| PNat of (Lexer.lexeme * Z.t) reg | PBytes of (Lexer.lexeme * Hex.t) reg | PString of Lexer.lexeme reg | PUnit of c_Unit diff --git a/src/passes/1-parser/pascaligo/Parser.mly b/src/passes/1-parser/pascaligo/Parser.mly index 2da4b14c1..42ee659d3 100644 --- a/src/passes/1-parser/pascaligo/Parser.mly +++ b/src/passes/1-parser/pascaligo/Parser.mly @@ -137,23 +137,27 @@ type_decl: } type_expr: - cartesian { TProd $1 } -| sum_type { TSum $1 } + sum_type { TSum $1 } | record_type { TRecord $1 } +| cartesian { $1 } cartesian: - nsepseq(function_type,TIMES) { - let region = nsepseq_to_region type_expr_to_region $1 - in {region; value=$1}} + function_type TIMES nsepseq(function_type,TIMES) { + let value = Utils.nsepseq_cons $1 $2 $3 in + let region = nsepseq_to_region type_expr_to_region value + in TProd {region; value} + } +| function_type { ($1 : type_expr) } function_type: core_type { $1 } | core_type ARROW function_type { - let region = cover (type_expr_to_region $1) - (type_expr_to_region $3) - in TFun {region; value = ($1, $2, $3)} } + let start = type_expr_to_region $1 + and stop = type_expr_to_region $3 in + let region = cover start stop in + TFun {region; value = $1,$2,$3} } core_type: type_name { @@ -200,7 +204,7 @@ sum_type: variant: Constr Of cartesian { - let region = cover $1.region $3.region + let region = cover $1.region (type_expr_to_region $3) and value = {constr = $1; args = Some ($2, $3)} in {region; value} } @@ -310,7 +314,7 @@ param_decl: in ParamConst {region; value}} param_type: - cartesian { TProd $1 } + cartesian { $1 } block: Begin sep_or_term_list(statement,SEMI) End { @@ -821,6 +825,7 @@ core_expr: | C_Unit { EUnit $1 } | annot_expr { EAnnot $1 } | tuple_expr { ETuple $1 } +| par(expr) { EPar $1 } | list_expr { EList $1 } | C_None { EConstr (NoneExpr $1) } | fun_call { ECall $1 } @@ -915,13 +920,14 @@ fun_call: in {region; value = $1,$2}} tuple_expr: - tuple_inj { TupleInj $1 } + par(tuple_comp) { $1 } -tuple_inj: - par(nsepseq(expr,COMMA)) { $1 } +tuple_comp: + expr COMMA nsepseq(expr,COMMA) { + Utils.nsepseq_cons $1 $2 $3} arguments: - tuple_inj { $1 } + par(nsepseq(expr,COMMA)) { $1 } list_expr: injection(List,expr) { List $1 } @@ -940,6 +946,7 @@ core_pattern: var { PVar $1 } | WILD { PWild $1 } | Int { PInt $1 } +| Nat { PNat $1 } | Bytes { PBytes $1 } | String { PString $1 } | C_Unit { PUnit $1 } diff --git a/src/passes/1-parser/pascaligo/ParserLog.ml b/src/passes/1-parser/pascaligo/ParserLog.ml index ed01c6379..0d7d61536 100644 --- a/src/passes/1-parser/pascaligo/ParserLog.ml +++ b/src/passes/1-parser/pascaligo/ParserLog.ml @@ -62,6 +62,11 @@ let print_int buffer {region; value = lexeme, abstract} = (Z.to_string abstract) in Buffer.add_string buffer line +let print_nat buffer {region; value = lexeme, abstract} = + let line = sprintf "%s: Nat (\"%s\", %s)\n" + (compact region) lexeme + (Z.to_string abstract) + in Buffer.add_string buffer line (* Main printing function *) @@ -107,14 +112,14 @@ and print_type_expr buffer = function and print_cartesian buffer {value; _} = print_nsepseq buffer "*" print_type_expr value -and print_variant buffer {value; _} = +and print_variant buffer ({value; _}: variant reg) = let {constr; args} = value in print_constr buffer constr; match args with None -> () - | Some (kwd_of, product) -> + | Some (kwd_of, t_expr) -> print_token buffer kwd_of "of"; - print_cartesian buffer product + print_type_expr buffer t_expr and print_sum_type buffer {value; _} = print_nsepseq buffer "|" print_variant value @@ -619,10 +624,7 @@ and print_binding buffer {value; _} = print_token buffer arrow "->"; print_expr buffer image -and print_tuple_expr buffer = function - TupleInj inj -> print_tuple_inj buffer inj - -and print_tuple_inj buffer {value; _} = +and print_tuple_expr buffer {value; _} = let {lpar; inside; rpar} = value in print_token buffer lpar "("; print_nsepseq buffer "," print_expr inside; @@ -634,20 +636,20 @@ and print_none_expr buffer value = print_token buffer value "None" and print_fun_call buffer {value; _} = let fun_name, arguments = value in - print_var buffer fun_name; - print_tuple_inj buffer arguments + print_var buffer fun_name; + print_tuple_expr buffer arguments and print_constr_app buffer {value; _} = let constr, arguments = value in print_constr buffer constr; match arguments with None -> () - | Some args -> print_tuple_inj buffer args + | Some args -> print_tuple_expr buffer args and print_some_app buffer {value; _} = let c_Some, arguments = value in - print_token buffer c_Some "Some"; - print_tuple_inj buffer arguments + print_token buffer c_Some "Some"; + print_tuple_expr buffer arguments and print_par_expr buffer {value; _} = let {lpar; inside; rpar} = value in @@ -660,6 +662,7 @@ and print_pattern buffer = function | PVar var -> print_var buffer var | PWild wild -> print_token buffer wild "_" | PInt i -> print_int buffer i +| PNat n -> print_nat buffer n | PBytes b -> print_bytes buffer b | PString s -> print_string buffer s | PUnit region -> print_token buffer region "Unit" @@ -823,7 +826,7 @@ and pp_variant buffer ~pad:(pd,_ as pad) {constr; args} = Buffer.add_string buffer node; match args with None -> () - | Some (_,c) -> pp_cartesian buffer ~pad c + | Some (_,c) -> pp_type_expr buffer ~pad c and pp_field_decl buffer ~pad:(pd,pc) decl = let node = sprintf "%s%s\n" pd decl.field_name.value in @@ -944,7 +947,7 @@ and pp_single_instr buffer ~pad:(pd,pc as pad) = function | ProcCall {value; _} -> let node = sprintf "%sProcCall\n" pd in Buffer.add_string buffer node; - pp_fun_call buffer ~pad:(mk_pad 1 0 pc) value + pp_fun_call buffer ~pad value | Skip _ -> let node = sprintf "%sSkip\n" pd in Buffer.add_string buffer node @@ -998,19 +1001,26 @@ and pp_if_clause buffer ~pad:(pd,pc as pad) = function Buffer.add_string buffer node; pp_statements buffer ~pad statements -and pp_case printer buffer ~pad:(_,pc) case = - let clauses = Utils.nsepseq_to_list case.cases.value in - let length = List.length clauses in - let apply len rank = - pp_case_clause printer buffer ~pad:(mk_pad len rank pc) - in pp_expr buffer ~pad:(mk_pad length 0 pc) case.expr; - List.iteri (apply length) clauses +and pp_case : + 'a.(Buffer.t -> pad:(string*string) -> 'a -> unit) + -> Buffer.t -> pad:(string*string) -> 'a case -> unit = + fun printer buffer ~pad:(_,pc) case -> + let clauses = Utils.nsepseq_to_list case.cases.value in + let clauses = List.map (fun {value; _} -> value) clauses in + let length = List.length clauses in + let apply len rank = + pp_case_clause printer buffer ~pad:(mk_pad len rank pc) + in pp_expr buffer ~pad:(mk_pad length 0 pc) case.expr; + List.iteri (apply length) clauses -and pp_case_clause printer buffer ~pad:(pd,pc) {value; _} = - let node = sprintf "%s\n" pd in - Buffer.add_string buffer node; - pp_pattern buffer ~pad:(mk_pad 2 0 pc) value.pattern; - printer buffer ~pad:(mk_pad 2 1 pc) value.rhs +and pp_case_clause : + 'a.(Buffer.t -> pad:(string*string) -> 'a -> unit) + -> Buffer.t -> pad:(string*string) -> 'a case_clause -> unit = + fun printer buffer ~pad:(pd,pc) clause -> + let node = sprintf "%s\n" pd in + Buffer.add_string buffer node; + pp_pattern buffer ~pad:(mk_pad 2 0 pc) clause.pattern; + printer buffer ~pad:(mk_pad 2 1 pc) clause.rhs and pp_pattern buffer ~pad:(pd,pc as pad) = function PNone _ -> @@ -1026,15 +1036,15 @@ and pp_pattern buffer ~pad:(pd,pc as pad) = function | PConstr {value; _} -> let node = sprintf "%sPConstr\n" pd in Buffer.add_string buffer node; - pp_constr buffer ~pad:(mk_pad 1 0 pc) value + pp_constr_pattern buffer ~pad:(mk_pad 1 0 pc) value | PCons {value; _} -> - let node = sprintf "%sPCons\n" pd in - let patterns = Utils.nsepseq_to_list value in - let length = List.length patterns in - let apply len rank = - pp_pattern buffer ~pad:(mk_pad len rank pc) in - Buffer.add_string buffer node; - List.iteri (apply length) patterns + let node = sprintf "%sPCons\n" pd in + let patterns = Utils.nsepseq_to_list value in + let length = List.length patterns in + let apply len rank = + pp_pattern buffer ~pad:(mk_pad len rank pc) in + Buffer.add_string buffer node; + List.iteri (apply length) patterns | PVar {value; _} -> let node = sprintf "%sPVar\n" pd in Buffer.add_string buffer node; @@ -1043,6 +1053,10 @@ and pp_pattern buffer ~pad:(pd,pc as pad) = function let node = sprintf "%sPInt\n" pd in Buffer.add_string buffer node; pp_int buffer ~pad value +| PNat {value; _} -> + let node = sprintf "%sPNat\n" pd in + Buffer.add_string buffer node; + pp_int buffer ~pad value | PBytes {value; _} -> let node = sprintf "%sPBytes\n" pd in Buffer.add_string buffer node; @@ -1077,7 +1091,7 @@ and pp_int buffer ~pad:(_,pc) (lexeme, z) = pp_string buffer ~pad:(mk_pad 2 0 pc) lexeme; pp_string buffer ~pad:(mk_pad 2 1 pc) (Z.to_string z) -and pp_constr buffer ~pad = function +and pp_constr_pattern buffer ~pad = function {value; _}, None -> pp_ident buffer ~pad value | {value=id; _}, Some {value=ptuple; _} -> @@ -1107,8 +1121,7 @@ and pp_injection : fun printer buffer ~pad:(_,pc) inj -> let elements = Utils.sepseq_to_list inj.elements in let length = List.length elements in - let apply len rank = - printer buffer ~pad:(mk_pad len rank pc) + let apply len rank = printer buffer ~pad:(mk_pad len rank pc) in List.iteri (apply length) elements and pp_tuple_pattern buffer ~pad:(_,pc) tuple = @@ -1256,13 +1269,13 @@ and pp_var_binding buffer ~pad:(pd,pc) (source, image) = pp_ident buffer ~pad:(mk_pad 2 0 pc) source.value; pp_ident buffer ~pad:(mk_pad 2 1 pc) image.value -and pp_fun_call buffer ~pad:(_,pc as pad) (name, args) = - pp_ident buffer ~pad name.value; +and pp_fun_call buffer ~pad:(_,pc) (name, args) = let args = Utils.nsepseq_to_list args.value.inside in let arity = List.length args in let apply len rank = pp_expr buffer ~pad:(mk_pad len rank pc) - in List.iteri (apply arity) args + in pp_ident buffer ~pad:(mk_pad (1+arity) 0 pc) name.value; + List.iteri (apply arity) args and pp_record_patch buffer ~pad:(_,pc as pad) patch = pp_path buffer ~pad:(mk_pad 2 0 pc) patch.path; @@ -1329,9 +1342,9 @@ and pp_data_decl buffer ~pad = function pp_var_decl buffer ~pad value and pp_var_decl buffer ~pad:(_,pc) decl = - pp_ident buffer ~pad:(mk_pad 3 0 pc) decl.name.value; + pp_ident buffer ~pad:(mk_pad 3 0 pc) decl.name.value; pp_type_expr buffer ~pad:(mk_pad 3 1 pc) decl.var_type; - pp_expr buffer ~pad:(mk_pad 3 2 pc) decl.init + pp_expr buffer ~pad:(mk_pad 3 2 pc) decl.init and pp_proc_decl buffer ~pad:(pd,_pc) _decl = let node = sprintf "%sPP_PROC_DECL\n" pd in @@ -1341,70 +1354,252 @@ and pp_expr buffer ~pad:(pd,pc as pad) = function ECase {value; _} -> let node = sprintf "%sECase\n" pd in Buffer.add_string buffer node; - ignore value + pp_case pp_expr buffer ~pad value | EAnnot {value; _} -> let node = sprintf "%sEAnnot\n" pd in Buffer.add_string buffer node; - ignore value + pp_annotated buffer ~pad value | ELogic e_logic -> let node = sprintf "%sELogic\n" pd in Buffer.add_string buffer node; - ignore e_logic + pp_e_logic buffer ~pad:(mk_pad 1 0 pc) e_logic | EArith e_arith -> let node = sprintf "%sEArith\n" pd in Buffer.add_string buffer node; - ignore e_arith + pp_arith_expr buffer ~pad:(mk_pad 1 0 pc) e_arith | EString e_string -> let node = sprintf "%sEString\n" pd in Buffer.add_string buffer node; - ignore e_string + pp_string_expr buffer ~pad:(mk_pad 1 0 pc) e_string | EList e_list -> let node = sprintf "%sEList\n" pd in Buffer.add_string buffer node; - ignore e_list + pp_list_expr buffer ~pad:(mk_pad 1 0 pc) e_list | ESet e_set -> let node = sprintf "%sESet\n" pd in Buffer.add_string buffer node; - ignore e_set + pp_set_expr buffer ~pad:(mk_pad 1 0 pc) e_set | EConstr e_constr -> let node = sprintf "%sEConstr\n" pd in Buffer.add_string buffer node; - ignore e_constr -| ERecord e_record -> + pp_constr_expr buffer ~pad:(mk_pad 1 0 pc) e_constr +| ERecord {value; _} -> let node = sprintf "%sERecord\n" pd in Buffer.add_string buffer node; - ignore e_record + pp_injection pp_field_assign buffer ~pad value | EProj {value; _} -> let node = sprintf "%sEProj\n" pd in Buffer.add_string buffer node; - ignore value + pp_projection buffer ~pad value | EMap e_map -> let node = sprintf "%sEMap\n" pd in Buffer.add_string buffer node; - ignore e_map + pp_map_expr buffer ~pad:(mk_pad 1 0 pc) e_map | EVar {value; _} -> let node = sprintf "%sEVar\n" pd in Buffer.add_string buffer node; pp_ident buffer ~pad:(mk_pad 1 0 pc) value -| ECall fun_call -> +| ECall {value; _} -> let node = sprintf "%sECall\n" pd in Buffer.add_string buffer node; - ignore fun_call + pp_fun_call buffer ~pad value | EBytes {value; _} -> let node = sprintf "%sEBytes\n" pd in Buffer.add_string buffer node; - pp_bytes buffer ~pad value; - ignore value + pp_bytes buffer ~pad value | EUnit _ -> let node = sprintf "%sEUnit\n" pd in Buffer.add_string buffer node | ETuple e_tuple -> let node = sprintf "%sETuple\n" pd in Buffer.add_string buffer node; - ignore e_tuple + pp_tuple_expr buffer ~pad e_tuple | EPar {value; _} -> - let node = sprintf "%sEpar\n" pd in + let node = sprintf "%sEPar\n" pd in Buffer.add_string buffer node; pp_expr buffer ~pad:(mk_pad 1 0 pc) value.inside +and pp_list_expr buffer ~pad:(pd,pc as pad) = function + Cons {value; _} -> + let node = sprintf "%sCons\n" pd in + Buffer.add_string buffer node; + pp_expr buffer ~pad:(mk_pad 2 0 pc) value.arg1; + pp_expr buffer ~pad:(mk_pad 2 1 pc) value.arg2 +| List {value; _} -> + let node = sprintf "%sList\n" pd in + Buffer.add_string buffer node; + pp_injection pp_expr buffer ~pad value +| Nil _ -> + let node = sprintf "%sNil\n" pd in + Buffer.add_string buffer node + +and pp_arith_expr buffer ~pad:(pd,pc as pad) = function + Add {value; _} -> + let node = sprintf "%sAdd\n" pd in + Buffer.add_string buffer node; + pp_expr buffer ~pad:(mk_pad 2 0 pc) value.arg1; + pp_expr buffer ~pad:(mk_pad 2 1 pc) value.arg2 +| Sub {value; _} -> + let node = sprintf "%sSub\n" pd in + Buffer.add_string buffer node; + pp_expr buffer ~pad:(mk_pad 2 0 pc) value.arg1; + pp_expr buffer ~pad:(mk_pad 2 1 pc) value.arg2 +| Mult {value; _} -> + let node = sprintf "%sMult\n" pd in + Buffer.add_string buffer node; + pp_expr buffer ~pad:(mk_pad 2 0 pc) value.arg1; + pp_expr buffer ~pad:(mk_pad 2 1 pc) value.arg2 +| Div {value; _} -> + let node = sprintf "%sDiv\n" pd in + Buffer.add_string buffer node; + pp_expr buffer ~pad:(mk_pad 2 0 pc) value.arg1; + pp_expr buffer ~pad:(mk_pad 2 1 pc) value.arg2 +| Mod {value; _} -> + let node = sprintf "%sMod\n" pd in + Buffer.add_string buffer node; + pp_expr buffer ~pad:(mk_pad 2 0 pc) value.arg1; + pp_expr buffer ~pad:(mk_pad 2 1 pc) value.arg2 +| Neg {value; _} -> + let node = sprintf "%sNeg\n" pd in + Buffer.add_string buffer node; + pp_expr buffer ~pad:(mk_pad 1 0 pc) value.arg; +| Int {value; _} -> + let node = sprintf "%sInt\n" pd in + Buffer.add_string buffer node; + pp_int buffer ~pad value +| Nat {value; _} -> + let node = sprintf "%sNat\n" pd in + Buffer.add_string buffer node; + pp_int buffer ~pad value +| Mtz {value; _} -> + let node = sprintf "%sMtz\n" pd in + Buffer.add_string buffer node; + pp_int buffer ~pad value + +and pp_set_expr buffer ~pad:(pd,pc as pad) = function + SetInj {value; _} -> + let node = sprintf "%sSetInj\n" pd in + Buffer.add_string buffer node; + pp_injection pp_expr buffer ~pad value +| SetMem {value; _} -> + let node = sprintf "%sSetMem\n" pd in + Buffer.add_string buffer node; + pp_expr buffer ~pad:(mk_pad 2 0 pc) value.set; + pp_expr buffer ~pad:(mk_pad 2 1 pc) value.element + +and pp_e_logic buffer ~pad:(pd,pc) = function + BoolExpr e -> + let node = sprintf "%sBoolExpr\n" pd in + Buffer.add_string buffer node; + pp_bool_expr buffer ~pad:(mk_pad 1 0 pc) e +| CompExpr e -> + let node = sprintf "%sCompExpr\n" pd in + Buffer.add_string buffer node; + pp_comp_expr buffer ~pad:(mk_pad 1 0 pc) e + +and pp_bool_expr buffer ~pad:(pd,pc) = function + Or {value; _} -> + let node = sprintf "%sOr\n" pd in + Buffer.add_string buffer node; + pp_expr buffer ~pad:(mk_pad 2 0 pc) value.arg1; + pp_expr buffer ~pad:(mk_pad 2 1 pc) value.arg2 +| And {value; _} -> + let node = sprintf "%sAnd\n" pd in + Buffer.add_string buffer node; + pp_expr buffer ~pad:(mk_pad 2 0 pc) value.arg1; + pp_expr buffer ~pad:(mk_pad 2 1 pc) value.arg2; +| Not {value; _} -> + let node = sprintf "%sNot\n" pd in + Buffer.add_string buffer node; + pp_expr buffer ~pad:(mk_pad 1 0 pc) value.arg +| False _ -> + let node = sprintf "%sFalse\n" pd in + Buffer.add_string buffer node +| True _ -> + let node = sprintf "%sTrue\n" pd in + Buffer.add_string buffer node + +and pp_comp_expr buffer ~pad:(pd,_ as pad) = function + Lt {value; _} -> + let node = sprintf "%sLt\n" pd in + Buffer.add_string buffer node; + pp_bin_op "<" buffer ~pad value +| Leq {value; _} -> + let node = sprintf "%sLeq\n" pd in + Buffer.add_string buffer node; + pp_bin_op "<=" buffer ~pad value +| Gt {value; _} -> + let node = sprintf "%sGt\n" pd in + Buffer.add_string buffer node; + pp_bin_op ">" buffer ~pad value +| Geq {value; _} -> + let node = sprintf "%sGeq\n" pd in + Buffer.add_string buffer node; + pp_bin_op ">=" buffer ~pad value +| Equal {value; _} -> + let node = sprintf "%sEqual\n" pd in + Buffer.add_string buffer node; + pp_bin_op "=" buffer ~pad value +| Neq {value; _} -> + let node = sprintf "%sNeq\n" pd in + Buffer.add_string buffer node; + pp_bin_op "=/=" buffer ~pad value + +and pp_constr_expr buffer ~pad:(pd, pc as pad) = function + SomeApp {value=some_region,args; _} -> + let node = sprintf "%sSomeApp\n" pd in + Buffer.add_string buffer node; + let constr = {value="Some"; region=some_region} in + let app = constr, Some args in + pp_constr_app buffer ~pad app +| NoneExpr _ -> + let node = sprintf "%sNoneExpr\n" pd in + Buffer.add_string buffer node +| ConstrApp {value; _} -> + let node = sprintf "%sConstrApp\n" pd in + Buffer.add_string buffer node; + pp_constr_app buffer ~pad:(mk_pad 1 0 pc) value + +and pp_constr_app buffer ~pad (constr, args_opt) = + pp_ident buffer ~pad constr.value; + match args_opt with + None -> () + | Some args -> pp_tuple_expr buffer ~pad args + +and pp_map_expr buffer ~pad:(pd,_ as pad) = function + MapLookUp {value; _} -> + let node = sprintf "%sMapLookUp\n" pd in + Buffer.add_string buffer node; + pp_map_lookup buffer ~pad value +| MapInj {value; _} -> + let node = sprintf "%sMapInj\n" pd in + Buffer.add_string buffer node; + pp_injection pp_binding buffer ~pad value + +and pp_tuple_expr buffer ~pad:(_,pc) {value; _} = + let exprs = Utils.nsepseq_to_list value.inside in + let length = List.length exprs in + let apply len rank = + pp_expr buffer ~pad:(mk_pad len rank pc) + in List.iteri (apply length) exprs + +and pp_string_expr buffer ~pad:(pd,pc as pad) = function + Cat {value; _} -> + let node = sprintf "%sCat\n" pd in + Buffer.add_string buffer node; + pp_bin_op "^" buffer ~pad value +| String {value; _} -> + let node = sprintf "%sString\n" pd in + Buffer.add_string buffer node; + pp_string buffer ~pad:(mk_pad 1 0 pc) value + +and pp_annotated buffer ~pad:(_,pc) (expr, t_expr) = + pp_expr buffer ~pad:(mk_pad 2 0 pc) expr; + pp_type_expr buffer ~pad:(mk_pad 2 1 pc) t_expr + +and pp_bin_op lexeme buffer ~pad:(_,pc) op = + pp_expr buffer ~pad:(mk_pad 3 0 pc) op.arg1; + pp_string buffer ~pad:(mk_pad 3 1 pc) lexeme; + pp_expr buffer ~pad:(mk_pad 3 2 pc) op.arg2 + let pp_ast buffer = pp_ast buffer ~pad:("","") diff --git a/src/passes/1-parser/pascaligo/ParserMain.ml b/src/passes/1-parser/pascaligo/ParserMain.ml index b1f43c0ac..5fa99ab76 100644 --- a/src/passes/1-parser/pascaligo/ParserMain.ml +++ b/src/passes/1-parser/pascaligo/ParserMain.ml @@ -107,10 +107,17 @@ let () = begin ParserLog.offsets := options.offsets; ParserLog.mode := options.mode; - (* ParserLog.print_tokens buffer ast;*) ParserLog.pp_ast buffer ast; Buffer.output_buffer stdout buffer end + else if Utils.String.Set.mem "ast-tokens" options.verbose + then let buffer = Buffer.create 131 in + begin + ParserLog.offsets := options.offsets; + ParserLog.mode := options.mode; + ParserLog.print_tokens buffer ast; + Buffer.output_buffer stdout buffer + end with Lexer.Error err -> close_all (); diff --git a/src/passes/1-parser/shared/EvalOpt.ml b/src/passes/1-parser/shared/EvalOpt.ml index 44bb9adc8..a4508ab30 100644 --- a/src/passes/1-parser/shared/EvalOpt.ml +++ b/src/passes/1-parser/shared/EvalOpt.ml @@ -39,7 +39,7 @@ let help language extension () = print " -q, --quiet No output, except errors (default)"; print " --columns Columns for source locations"; print " --bytes Bytes for source locations"; - print " --verbose= cmdline, cpp, ast (colon-separated)"; + print " --verbose= cmdline, cpp, ast-tokens, ast (colon-separated)"; print " --version Commit hash on stdout"; print " -h, --help This help"; exit 0 diff --git a/src/passes/2-simplify/pascaligo.ml b/src/passes/2-simplify/pascaligo.ml index 5a9ed3f58..ee2e8eea1 100644 --- a/src/passes/2-simplify/pascaligo.ml +++ b/src/passes/2-simplify/pascaligo.ml @@ -317,10 +317,11 @@ let rec simpl_type_expression (t:Raw.type_expr) : type_expression result = let args = match v.value.args with None -> [] - | Some (_, product) -> - npseq_to_list product.value in - let%bind te = simpl_list_type_expression - @@ args in + | Some (_, t_expr) -> + match t_expr with + TProd product -> npseq_to_list product.value + | _ -> [t_expr] in + let%bind te = simpl_list_type_expression @@ args in ok (v.value.constr.value, te) in let%bind lst = bind_list @@ -389,8 +390,7 @@ let rec simpl_expression (t:Raw.expr) : expr result = let (x' , loc) = r_split x in return @@ e_literal ~loc (Literal_bytes (Bytes.of_string @@ fst x')) | ETuple tpl -> - let (Raw.TupleInj tpl') = tpl in - let (tpl' , loc) = r_split tpl' in + let (tpl' , loc) = r_split tpl in simpl_tuple_expression ~loc @@ npseq_to_list tpl'.inside | ERecord r -> let%bind fields = bind_list