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

Bug fixes and finished AST pretty-printer.

Browse Source 
ParserLog: Finished the AST pretty-printer.
ParserMain: The CLI "ast" is now "ast-tokens" and the new "ast"
calls the AST pretty-printer.
Bug: Added nat literals as patterns.
AST: Removed unary constructor TupleInj.
Parser and simplifier:
  - The rule "cartesian" is now properly stratified.
  - Parenthesised expressions now correctly create EPar nodes.
This commit is contained in:
Christian Rinderknecht 2019-10-15 21:03:46 +02:00
parent 89971f31d0
commit 27564426da
7 changed files with 301 additions and 96 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

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

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

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

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

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

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

@ -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<clause>\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<clause>\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:("","")

9
src/passes/1-parser/pascaligo/ParserMain.ml
View File

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

2
src/passes/1-parser/shared/EvalOpt.ml
View File

@ -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=<stages> cmdline, cpp, ast (colon-separated)";
print " --verbose=<stages> cmdline, cpp, ast-tokens, ast (colon-separated)";
print " --version Commit hash on stdout";
print " -h, --help This help";
exit 0

12
src/passes/2-simplify/pascaligo.ml
View File

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