Bug fixes and finished AST pretty-printer.
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:
parent
89971f31d0
commit
27564426da
@ -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
|
||||
|
@ -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
|
||||
|
@ -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 }
|
||||
|
@ -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;
|
||||
@ -635,19 +637,19 @@ 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_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_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 =
|
||||
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; _} =
|
||||
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) value.pattern;
|
||||
printer buffer ~pad:(mk_pad 2 1 pc) value.rhs
|
||||
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,7 +1036,7 @@ 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
|
||||
@ -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;
|
||||
@ -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:("","")
|
||||
|
@ -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 ();
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user