Renamed the extensibility type parameter to 'x so that it can easily be grepped for.

Review this commit with:

    git diff --color-words=.
This commit is contained in:
Your Name 2019-03-05 18:16:21 +01:00
parent 40377a80df
commit fb85ea1f18
3 changed files with 523 additions and 523 deletions

450
AST.ml
View File

@ -113,12 +113,12 @@ type eof = Region.t
(* Literals *) (* Literals *)
type 'a variable = string reg type 'x variable = string reg
type 'a fun_name = string reg type 'x fun_name = string reg
type 'a type_name = string reg type 'x type_name = string reg
type 'a field_name = string reg type 'x field_name = string reg
type 'a map_name = string reg type 'x map_name = string reg
type 'a constr = string reg type 'x constr = string reg
(* Comma-separated non-empty lists *) (* Comma-separated non-empty lists *)
@ -144,227 +144,227 @@ type 'a braces = (lbrace * 'a * rbrace) reg
type t = < ty: unit > ast type t = < ty: unit > ast
and 'a ast = { and 'x ast = {
types : 'a type_decl reg list; types : 'x type_decl reg list;
constants : 'a const_decl reg list; constants : 'x const_decl reg list;
parameter : 'a parameter_decl reg; parameter : 'x parameter_decl reg;
storage : 'a storage_decl reg; storage : 'x storage_decl reg;
operations : 'a operations_decl reg; operations : 'x operations_decl reg;
lambdas : 'a lambda_decl list; lambdas : 'x lambda_decl list;
block : 'a block reg; block : 'x block reg;
eof : eof eof : eof
} }
and 'a parameter_decl = { and 'x parameter_decl = {
kwd_parameter : kwd_parameter; kwd_parameter : kwd_parameter;
name : 'a variable; name : 'x variable;
colon : colon; colon : colon;
param_type : 'a type_expr; param_type : 'x type_expr;
terminator : semi option terminator : semi option
} }
and 'a storage_decl = { and 'x storage_decl = {
kwd_storage : kwd_storage; kwd_storage : kwd_storage;
store_type : 'a type_expr; store_type : 'x type_expr;
terminator : semi option terminator : semi option
} }
and 'a operations_decl = { and 'x operations_decl = {
kwd_operations : kwd_operations; kwd_operations : kwd_operations;
op_type : 'a type_expr; op_type : 'x type_expr;
terminator : semi option terminator : semi option
} }
(* Type declarations *) (* Type declarations *)
and 'a type_decl = { and 'x type_decl = {
kwd_type : kwd_type; kwd_type : kwd_type;
name : 'a type_name; name : 'x type_name;
kwd_is : kwd_is; kwd_is : kwd_is;
type_expr : 'a type_expr; type_expr : 'x type_expr;
terminator : semi option terminator : semi option
} }
and 'a type_expr = and 'x type_expr =
Prod of 'a cartesian Prod of 'x cartesian
| Sum of ('a variant, vbar) nsepseq reg | Sum of ('x variant, vbar) nsepseq reg
| Record of 'a record_type | Record of 'x record_type
| TypeApp of ('a type_name * 'a type_tuple) reg | TypeApp of ('x type_name * 'x type_tuple) reg
| ParType of 'a type_expr par | ParType of 'x type_expr par
| TAlias of 'a variable | TAlias of 'x variable
and 'a cartesian = ('a type_expr, times) nsepseq reg and 'x cartesian = ('x type_expr, times) nsepseq reg
and 'a variant = ('a constr * kwd_of * 'a cartesian) reg and 'x variant = ('x constr * kwd_of * 'x cartesian) reg
and 'a record_type = (kwd_record * 'a field_decls * kwd_end) reg and 'x record_type = (kwd_record * 'x field_decls * kwd_end) reg
and 'a field_decls = ('a field_decl, semi) nsepseq and 'x field_decls = ('x field_decl, semi) nsepseq
and 'a field_decl = ('a variable * colon * 'a type_expr) reg and 'x field_decl = ('x variable * colon * 'x type_expr) reg
and 'a type_tuple = ('a type_name, comma) nsepseq par and 'x type_tuple = ('x type_name, comma) nsepseq par
(* Function and procedure declarations *) (* Function and procedure declarations *)
and 'a lambda_decl = and 'x lambda_decl =
FunDecl of 'a fun_decl reg FunDecl of 'x fun_decl reg
| ProcDecl of 'a proc_decl reg | ProcDecl of 'x proc_decl reg
and 'a fun_decl = { and 'x fun_decl = {
kwd_function : kwd_function; kwd_function : kwd_function;
name : 'a variable; name : 'x variable;
param : 'a parameters; param : 'x parameters;
colon : colon; colon : colon;
ret_type : 'a type_expr; ret_type : 'x type_expr;
kwd_is : kwd_is; kwd_is : kwd_is;
local_decls : 'a local_decl list; local_decls : 'x local_decl list;
block : 'a block reg; block : 'x block reg;
kwd_with : kwd_with; kwd_with : kwd_with;
return : 'a expr; return : 'x expr;
terminator : semi option terminator : semi option
} }
and 'a proc_decl = { and 'x proc_decl = {
kwd_procedure : kwd_procedure; kwd_procedure : kwd_procedure;
name : 'a variable; name : 'x variable;
param : 'a parameters; param : 'x parameters;
kwd_is : kwd_is; kwd_is : kwd_is;
local_decls : 'a local_decl list; local_decls : 'x local_decl list;
block : 'a block reg; block : 'x block reg;
terminator : semi option terminator : semi option
} }
and 'a parameters = ('a param_decl, semi) nsepseq par and 'x parameters = ('x param_decl, semi) nsepseq par
and 'a param_decl = and 'x param_decl =
ParamConst of 'a param_const ParamConst of 'x param_const
| ParamVar of 'a param_var | ParamVar of 'x param_var
and 'a param_const = (kwd_const * 'a variable * colon * 'a type_expr) reg and 'x param_const = (kwd_const * 'x variable * colon * 'x type_expr) reg
and 'a param_var = (kwd_var * 'a variable * colon * 'a type_expr) reg and 'x param_var = (kwd_var * 'x variable * colon * 'x type_expr) reg
and 'a block = { and 'x block = {
opening : kwd_begin; opening : kwd_begin;
instr : 'a instructions; instr : 'x instructions;
terminator : semi option; terminator : semi option;
close : kwd_end close : kwd_end
} }
and 'a local_decl = and 'x local_decl =
LocalLam of 'a lambda_decl LocalLam of 'x lambda_decl
| LocalConst of 'a const_decl reg | LocalConst of 'x const_decl reg
| LocalVar of 'a var_decl reg | LocalVar of 'x var_decl reg
and 'a const_decl = { and 'x const_decl = {
kwd_const : kwd_const; kwd_const : kwd_const;
name : 'a variable; name : 'x variable;
colon : colon; colon : colon;
vtype : 'a type_expr; vtype : 'x type_expr;
equal : equal; equal : equal;
init : 'a expr; init : 'x expr;
terminator : semi option terminator : semi option
} }
and 'a var_decl = { and 'x var_decl = {
kwd_var : kwd_var; kwd_var : kwd_var;
name : 'a variable; name : 'x variable;
colon : colon; colon : colon;
vtype : 'a type_expr; vtype : 'x type_expr;
ass : ass; ass : ass;
init : 'a expr; init : 'x expr;
terminator : semi option terminator : semi option
} }
and 'a instructions = ('a instruction, semi) nsepseq reg and 'x instructions = ('x instruction, semi) nsepseq reg
and 'a instruction = and 'x instruction =
Single of 'a single_instr Single of 'x single_instr
| Block of 'a block reg | Block of 'x block reg
and 'a single_instr = and 'x single_instr =
Cond of 'a conditional reg Cond of 'x conditional reg
| Match of 'a match_instr reg | Match of 'x match_instr reg
| Ass of 'a ass_instr | Ass of 'x ass_instr
| Loop of 'a loop | Loop of 'x loop
| ProcCall of 'a fun_call | ProcCall of 'x fun_call
| Null of kwd_null | Null of kwd_null
| Fail of (kwd_fail * 'a expr) reg | Fail of (kwd_fail * 'x expr) reg
and 'a conditional = { and 'x conditional = {
kwd_if : kwd_if; kwd_if : kwd_if;
test : 'a expr; test : 'x expr;
kwd_then : kwd_then; kwd_then : kwd_then;
ifso : 'a instruction; ifso : 'x instruction;
kwd_else : kwd_else; kwd_else : kwd_else;
ifnot : 'a instruction ifnot : 'x instruction
} }
and 'a match_instr = { and 'x match_instr = {
kwd_match : kwd_match; kwd_match : kwd_match;
expr : 'a expr; expr : 'x expr;
kwd_with : kwd_with; kwd_with : kwd_with;
lead_vbar : vbar option; lead_vbar : vbar option;
cases : 'a cases; cases : 'x cases;
kwd_end : kwd_end kwd_end : kwd_end
} }
and 'a cases = ('a case, vbar) nsepseq reg and 'x cases = ('x case, vbar) nsepseq reg
and 'a case = ('a pattern * arrow * 'a instruction) reg and 'x case = ('x pattern * arrow * 'x instruction) reg
and 'a ass_instr = ('a variable * ass * 'a expr) reg and 'x ass_instr = ('x variable * ass * 'x expr) reg
and 'a loop = and 'x loop =
While of 'a while_loop While of 'x while_loop
| For of 'a for_loop | For of 'x for_loop
and 'a while_loop = (kwd_while * 'a expr * 'a block reg) reg and 'x while_loop = (kwd_while * 'x expr * 'x block reg) reg
and 'a for_loop = and 'x for_loop =
ForInt of 'a for_int reg ForInt of 'x for_int reg
| ForCollect of 'a for_collect reg | ForCollect of 'x for_collect reg
and 'a for_int = { and 'x for_int = {
kwd_for : kwd_for; kwd_for : kwd_for;
ass : 'a ass_instr; ass : 'x ass_instr;
down : kwd_down option; down : kwd_down option;
kwd_to : kwd_to; kwd_to : kwd_to;
bound : 'a expr; bound : 'x expr;
step : (kwd_step * 'a expr) option; step : (kwd_step * 'x expr) option;
block : 'a block reg block : 'x block reg
} }
and 'a for_collect = { and 'x for_collect = {
kwd_for : kwd_for; kwd_for : kwd_for;
var : 'a variable; var : 'x variable;
bind_to : (arrow * 'a variable) option; bind_to : (arrow * 'x variable) option;
kwd_in : kwd_in; kwd_in : kwd_in;
expr : 'a expr; expr : 'x expr;
block : 'a block reg block : 'x block reg
} }
(* Expressions *) (* Expressions *)
and 'a expr = and 'x expr =
Or of ('a expr * bool_or * 'a expr) reg Or of ('x expr * bool_or * 'x expr) reg
| And of ('a expr * bool_and * 'a expr) reg | And of ('x expr * bool_and * 'x expr) reg
| Lt of ('a expr * lt * 'a expr) reg | Lt of ('x expr * lt * 'x expr) reg
| Leq of ('a expr * leq * 'a expr) reg | Leq of ('x expr * leq * 'x expr) reg
| Gt of ('a expr * gt * 'a expr) reg | Gt of ('x expr * gt * 'x expr) reg
| Geq of ('a expr * geq * 'a expr) reg | Geq of ('x expr * geq * 'x expr) reg
| Equal of ('a expr * equal * 'a expr) reg | Equal of ('x expr * equal * 'x expr) reg
| Neq of ('a expr * neq * 'a expr) reg | Neq of ('x expr * neq * 'x expr) reg
| Cat of ('a expr * cat * 'a expr) reg | Cat of ('x expr * cat * 'x expr) reg
| Cons of ('a expr * cons * 'a expr) reg | Cons of ('x expr * cons * 'x expr) reg
| Add of ('a expr * plus * 'a expr) reg | Add of ('x expr * plus * 'x expr) reg
| Sub of ('a expr * minus * 'a expr) reg | Sub of ('x expr * minus * 'x expr) reg
| Mult of ('a expr * times * 'a expr) reg | Mult of ('x expr * times * 'x expr) reg
| Div of ('a expr * slash * 'a expr) reg | Div of ('x expr * slash * 'x expr) reg
| Mod of ('a expr * kwd_mod * 'a expr) reg | Mod of ('x expr * kwd_mod * 'x expr) reg
| Neg of (minus * 'a expr) reg | Neg of (minus * 'x expr) reg
| Not of (kwd_not * 'a expr) reg | Not of (kwd_not * 'x expr) reg
| Int of (Lexer.lexeme * Z.t) reg | Int of (Lexer.lexeme * Z.t) reg
| Var of Lexer.lexeme reg | Var of Lexer.lexeme reg
| String of Lexer.lexeme reg | String of Lexer.lexeme reg
@ -372,46 +372,46 @@ and 'a expr =
| False of c_False | False of c_False
| True of c_True | True of c_True
| Unit of c_Unit | Unit of c_Unit
| Tuple of 'a tuple | Tuple of 'x tuple
| List of ('a expr, comma) nsepseq brackets | List of ('x expr, comma) nsepseq brackets
| EmptyList of 'a empty_list | EmptyList of 'x empty_list
| Set of ('a expr, comma) nsepseq braces | Set of ('x expr, comma) nsepseq braces
| EmptySet of 'a empty_set | EmptySet of 'x empty_set
| NoneExpr of 'a none_expr | NoneExpr of 'x none_expr
| FunCall of 'a fun_call | FunCall of 'x fun_call
| ConstrApp of 'a constr_app | ConstrApp of 'x constr_app
| SomeApp of (c_Some * 'a arguments) reg | SomeApp of (c_Some * 'x arguments) reg
| MapLookUp of 'a map_lookup reg | MapLookUp of 'x map_lookup reg
| ParExpr of 'a expr par | ParExpr of 'x expr par
and 'a tuple = ('a expr, comma) nsepseq par and 'x tuple = ('x expr, comma) nsepseq par
and 'a empty_list = and 'x empty_list =
(lbracket * rbracket * colon * 'a type_expr) par (lbracket * rbracket * colon * 'x type_expr) par
and 'a empty_set = and 'x empty_set =
(lbrace * rbrace * colon * 'a type_expr) par (lbrace * rbrace * colon * 'x type_expr) par
and 'a none_expr = and 'x none_expr =
(c_None * colon * 'a type_expr) par (c_None * colon * 'x type_expr) par
and 'a fun_call = ('a fun_name * 'a arguments) reg and 'x fun_call = ('x fun_name * 'x arguments) reg
and 'a arguments = 'a tuple and 'x arguments = 'x tuple
and 'a constr_app = ('a constr * 'a arguments) reg and 'x constr_app = ('x constr * 'x arguments) reg
and 'a map_lookup = { and 'x map_lookup = {
map_name : 'a variable; map_name : 'x variable;
selector : dot; selector : dot;
index : 'a expr brackets index : 'x expr brackets
} }
(* Patterns *) (* Patterns *)
and 'a pattern = ('a core_pattern, cons) nsepseq reg and 'x pattern = ('x core_pattern, cons) nsepseq reg
and 'a core_pattern = and 'x core_pattern =
PVar of Lexer.lexeme reg PVar of Lexer.lexeme reg
| PWild of wild | PWild of wild
| PInt of (Lexer.lexeme * Z.t) reg | PInt of (Lexer.lexeme * Z.t) reg
@ -421,13 +421,13 @@ and 'a core_pattern =
| PFalse of c_False | PFalse of c_False
| PTrue of c_True | PTrue of c_True
| PNone of c_None | PNone of c_None
| PSome of (c_Some * 'a core_pattern par) reg | PSome of (c_Some * 'x core_pattern par) reg
| PList of 'a list_pattern | PList of 'x list_pattern
| PTuple of ('a core_pattern, comma) nsepseq par | PTuple of ('x core_pattern, comma) nsepseq par
and 'a list_pattern = and 'x list_pattern =
Sugar of ('a core_pattern, comma) sepseq brackets Sugar of ('x core_pattern, comma) sepseq brackets
| Raw of ('a core_pattern * cons * 'a pattern) par | Raw of ('x core_pattern * cons * 'x pattern) par
(* Projecting regions *) (* Projecting regions *)
@ -513,77 +513,77 @@ let local_decl_to_region = function
(* Printing the tokens with their source regions *) (* Printing the tokens with their source regions *)
type 'a visitor = { type 'x visitor = {
ass_instr : 'a ass_instr -> unit; ass_instr : 'x ass_instr -> unit;
bind_to : (region * 'a variable) option -> unit; bind_to : (region * 'x variable) option -> unit;
block : 'a block reg -> unit; block : 'x block reg -> unit;
bytes : (string * MBytes.t) reg -> unit; bytes : (string * MBytes.t) reg -> unit;
cartesian : 'a cartesian -> unit; cartesian : 'x cartesian -> unit;
case : 'a case -> unit; case : 'x case -> unit;
cases : 'a cases -> unit; cases : 'x cases -> unit;
conditional : 'a conditional -> unit; conditional : 'x conditional -> unit;
const_decl : 'a const_decl reg -> unit; const_decl : 'x const_decl reg -> unit;
constr : 'a constr -> unit; constr : 'x constr -> unit;
constr_app : 'a constr_app -> unit; constr_app : 'x constr_app -> unit;
core_pattern : 'a core_pattern -> unit; core_pattern : 'x core_pattern -> unit;
down : region option -> unit; down : region option -> unit;
empty_list : 'a empty_list -> unit; empty_list : 'x empty_list -> unit;
empty_set : 'a empty_set -> unit; empty_set : 'x empty_set -> unit;
expr : 'a expr -> unit; expr : 'x expr -> unit;
fail : (kwd_fail * 'a expr) -> unit; fail : (kwd_fail * 'x expr) -> unit;
field_decl : 'a field_decl -> unit; field_decl : 'x field_decl -> unit;
field_decls : 'a field_decls -> unit; field_decls : 'x field_decls -> unit;
for_collect : 'a for_collect reg -> unit; for_collect : 'x for_collect reg -> unit;
for_int : 'a for_int reg -> unit; for_int : 'x for_int reg -> unit;
for_loop : 'a for_loop -> unit; for_loop : 'x for_loop -> unit;
fun_call : 'a fun_call -> unit; fun_call : 'x fun_call -> unit;
fun_decl : 'a fun_decl reg -> unit; fun_decl : 'x fun_decl reg -> unit;
instruction : 'a instruction -> unit; instruction : 'x instruction -> unit;
instructions : 'a instructions -> unit; instructions : 'x instructions -> unit;
int : (string * Z.t) reg -> unit; int : (string * Z.t) reg -> unit;
lambda_decl : 'a lambda_decl -> unit; lambda_decl : 'x lambda_decl -> unit;
list : ('a expr, region) nsepseq brackets -> unit; list : ('x expr, region) nsepseq brackets -> unit;
list_pattern : 'a list_pattern -> unit; list_pattern : 'x list_pattern -> unit;
loop : 'a loop -> unit; loop : 'x loop -> unit;
map_lookup : 'a map_lookup reg -> unit; map_lookup : 'x map_lookup reg -> unit;
match_instr : 'a match_instr -> unit; match_instr : 'x match_instr -> unit;
none_expr : 'a none_expr -> unit; none_expr : 'x none_expr -> unit;
nsepseq : 'a.string -> ('a -> unit) -> ('a, region) nsepseq -> unit; nsepseq : 'a.string -> ('a -> unit) -> ('a, region) nsepseq -> unit;
operations_decl : 'a operations_decl reg -> unit; operations_decl : 'x operations_decl reg -> unit;
par_expr : 'a expr par -> unit; par_expr : 'x expr par -> unit;
par_type : 'a type_expr par -> unit; par_type : 'x type_expr par -> unit;
param_decl : 'a param_decl -> unit; param_decl : 'x param_decl -> unit;
parameter_decl : 'a parameter_decl reg -> unit; parameter_decl : 'x parameter_decl reg -> unit;
parameters : 'a parameters -> unit; parameters : 'x parameters -> unit;
param_const : 'a param_const -> unit; param_const : 'x param_const -> unit;
param_var : 'a param_var -> unit; param_var : 'x param_var -> unit;
pattern : 'a pattern -> unit; pattern : 'x pattern -> unit;
patterns : 'a core_pattern par -> unit; patterns : 'x core_pattern par -> unit;
proc_decl : 'a proc_decl reg -> unit; proc_decl : 'x proc_decl reg -> unit;
psome : (region * 'a core_pattern par) reg -> unit; psome : (region * 'x core_pattern par) reg -> unit;
ptuple : ('a core_pattern, region) nsepseq par -> unit; ptuple : ('x core_pattern, region) nsepseq par -> unit;
raw : ('a core_pattern * region * 'a pattern) par -> unit; raw : ('x core_pattern * region * 'x pattern) par -> unit;
record_type : 'a record_type -> unit; record_type : 'x record_type -> unit;
sepseq : 'a.string -> ('a -> unit) -> ('a, region) sepseq -> unit; sepseq : 'a.string -> ('a -> unit) -> ('a, region) sepseq -> unit;
set : ('a expr, region) nsepseq braces -> unit; set : ('x expr, region) nsepseq braces -> unit;
single_instr : 'a single_instr -> unit; single_instr : 'x single_instr -> unit;
some_app : (region * 'a arguments) reg -> unit; some_app : (region * 'x arguments) reg -> unit;
step : (region * 'a expr) option -> unit; step : (region * 'x expr) option -> unit;
storage_decl : 'a storage_decl reg -> unit; storage_decl : 'x storage_decl reg -> unit;
string : string reg -> unit; string : string reg -> unit;
sugar : ('a core_pattern, region) sepseq brackets -> unit; sugar : ('x core_pattern, region) sepseq brackets -> unit;
sum_type : ('a variant, region) nsepseq reg -> unit; sum_type : ('x variant, region) nsepseq reg -> unit;
terminator : semi option -> unit; terminator : semi option -> unit;
token : region -> string -> unit; token : region -> string -> unit;
tuple : 'a arguments -> unit; tuple : 'x arguments -> unit;
type_app : ('a type_name * 'a type_tuple) reg -> unit; type_app : ('x type_name * 'x type_tuple) reg -> unit;
type_decl : 'a type_decl reg -> unit; type_decl : 'x type_decl reg -> unit;
type_expr : 'a type_expr -> unit; type_expr : 'x type_expr -> unit;
type_tuple : 'a type_tuple -> unit; type_tuple : 'x type_tuple -> unit;
local_decl : 'a local_decl -> unit; local_decl : 'x local_decl -> unit;
local_decls : 'a local_decl list -> unit; local_decls : 'x local_decl list -> unit;
var : 'a variable -> unit; var : 'x variable -> unit;
var_decl : 'a var_decl reg -> unit; var_decl : 'x var_decl reg -> unit;
variant : 'a variant -> unit; variant : 'x variant -> unit;
while_loop : 'a while_loop -> unit while_loop : 'x while_loop -> unit
} }

464
AST.mli
View File

@ -97,12 +97,12 @@ type eof = Region.t
(* Literals *) (* Literals *)
type 'a variable = string reg type 'x variable = string reg
type 'a fun_name = string reg type 'x fun_name = string reg
type 'a type_name = string reg type 'x type_name = string reg
type 'a field_name = string reg type 'x field_name = string reg
type 'a map_name = string reg type 'x map_name = string reg
type 'a constr = string reg type 'x constr = string reg
(* Comma-separated non-empty lists *) (* Comma-separated non-empty lists *)
@ -128,227 +128,227 @@ type 'a braces = (lbrace * 'a * rbrace) reg
type t = < ty:unit > ast type t = < ty:unit > ast
and 'a ast = { and 'x ast = {
types : 'a type_decl reg list; types : 'x type_decl reg list;
constants : 'a const_decl reg list; constants : 'x const_decl reg list;
parameter : 'a parameter_decl reg; parameter : 'x parameter_decl reg;
storage : 'a storage_decl reg; storage : 'x storage_decl reg;
operations : 'a operations_decl reg; operations : 'x operations_decl reg;
lambdas : 'a lambda_decl list; lambdas : 'x lambda_decl list;
block : 'a block reg; block : 'x block reg;
eof : eof eof : eof
} }
and 'a parameter_decl = { and 'x parameter_decl = {
kwd_parameter : kwd_parameter; kwd_parameter : kwd_parameter;
name : 'a variable; name : 'x variable;
colon : colon; colon : colon;
param_type : 'a type_expr; param_type : 'x type_expr;
terminator : semi option terminator : semi option
} }
and 'a storage_decl = { and 'x storage_decl = {
kwd_storage : kwd_storage; kwd_storage : kwd_storage;
store_type : 'a type_expr; store_type : 'x type_expr;
terminator : semi option terminator : semi option
} }
and 'a operations_decl = { and 'x operations_decl = {
kwd_operations : kwd_operations; kwd_operations : kwd_operations;
op_type : 'a type_expr; op_type : 'x type_expr;
terminator : semi option terminator : semi option
} }
(* Type declarations *) (* Type declarations *)
and 'a type_decl = { and 'x type_decl = {
kwd_type : kwd_type; kwd_type : kwd_type;
name : 'a type_name; name : 'x type_name;
kwd_is : kwd_is; kwd_is : kwd_is;
type_expr : 'a type_expr; type_expr : 'x type_expr;
terminator : semi option terminator : semi option
} }
and 'a type_expr = and 'x type_expr =
Prod of 'a cartesian Prod of 'x cartesian
| Sum of ('a variant, vbar) nsepseq reg | Sum of ('x variant, vbar) nsepseq reg
| Record of 'a record_type | Record of 'x record_type
| TypeApp of ('a type_name * 'a type_tuple) reg | TypeApp of ('x type_name * 'x type_tuple) reg
| ParType of 'a type_expr par | ParType of 'x type_expr par
| TAlias of 'a variable | TAlias of 'x variable
and 'a cartesian = ('a type_expr, times) nsepseq reg and 'x cartesian = ('x type_expr, times) nsepseq reg
and 'a variant = ('a constr * kwd_of * 'a cartesian) reg and 'x variant = ('x constr * kwd_of * 'x cartesian) reg
and 'a record_type = (kwd_record * 'a field_decls * kwd_end) reg and 'x record_type = (kwd_record * 'x field_decls * kwd_end) reg
and 'a field_decls = ('a field_decl, semi) nsepseq and 'x field_decls = ('x field_decl, semi) nsepseq
and 'a field_decl = ('a variable * colon * 'a type_expr) reg and 'x field_decl = ('x variable * colon * 'x type_expr) reg
and 'a type_tuple = ('a type_name, comma) nsepseq par and 'x type_tuple = ('x type_name, comma) nsepseq par
(* Function and procedure declarations *) (* Function and procedure declarations *)
and 'a lambda_decl = and 'x lambda_decl =
FunDecl of 'a fun_decl reg FunDecl of 'x fun_decl reg
| ProcDecl of 'a proc_decl reg | ProcDecl of 'x proc_decl reg
and 'a fun_decl = { and 'x fun_decl = {
kwd_function : kwd_function; kwd_function : kwd_function;
name : 'a variable; name : 'x variable;
param : 'a parameters; param : 'x parameters;
colon : colon; colon : colon;
ret_type : 'a type_expr; ret_type : 'x type_expr;
kwd_is : kwd_is; kwd_is : kwd_is;
local_decls : 'a local_decl list; local_decls : 'x local_decl list;
block : 'a block reg; block : 'x block reg;
kwd_with : kwd_with; kwd_with : kwd_with;
return : 'a expr; return : 'x expr;
terminator : semi option terminator : semi option
} }
and 'a proc_decl = { and 'x proc_decl = {
kwd_procedure : kwd_procedure; kwd_procedure : kwd_procedure;
name : 'a variable; name : 'x variable;
param : 'a parameters; param : 'x parameters;
kwd_is : kwd_is; kwd_is : kwd_is;
local_decls : 'a local_decl list; local_decls : 'x local_decl list;
block : 'a block reg; block : 'x block reg;
terminator : semi option terminator : semi option
} }
and 'a parameters = ('a param_decl, semi) nsepseq par and 'x parameters = ('x param_decl, semi) nsepseq par
and 'a param_decl = and 'x param_decl =
ParamConst of 'a param_const ParamConst of 'x param_const
| ParamVar of 'a param_var | ParamVar of 'x param_var
and 'a param_const = (kwd_const * 'a variable * colon * 'a type_expr) reg and 'x param_const = (kwd_const * 'x variable * colon * 'x type_expr) reg
and 'a param_var = (kwd_var * 'a variable * colon * 'a type_expr) reg and 'x param_var = (kwd_var * 'x variable * colon * 'x type_expr) reg
and 'a block = { and 'x block = {
opening : kwd_begin; opening : kwd_begin;
instr : 'a instructions; instr : 'x instructions;
terminator : semi option; terminator : semi option;
close : kwd_end close : kwd_end
} }
and 'a local_decl = and 'x local_decl =
LocalLam of 'a lambda_decl LocalLam of 'x lambda_decl
| LocalConst of 'a const_decl reg | LocalConst of 'x const_decl reg
| LocalVar of 'a var_decl reg | LocalVar of 'x var_decl reg
and 'a const_decl = { and 'x const_decl = {
kwd_const : kwd_const; kwd_const : kwd_const;
name : 'a variable; name : 'x variable;
colon : colon; colon : colon;
vtype : 'a type_expr; vtype : 'x type_expr;
equal : equal; equal : equal;
init : 'a expr; init : 'x expr;
terminator : semi option terminator : semi option
} }
and 'a var_decl = { and 'x var_decl = {
kwd_var : kwd_var; kwd_var : kwd_var;
name : 'a variable; name : 'x variable;
colon : colon; colon : colon;
vtype : 'a type_expr; vtype : 'x type_expr;
ass : ass; ass : ass;
init : 'a expr; init : 'x expr;
terminator : semi option terminator : semi option
} }
and 'a instructions = ('a instruction, semi) nsepseq reg and 'x instructions = ('x instruction, semi) nsepseq reg
and 'a instruction = and 'x instruction =
Single of 'a single_instr Single of 'x single_instr
| Block of 'a block reg | Block of 'x block reg
and 'a single_instr = and 'x single_instr =
Cond of 'a conditional reg Cond of 'x conditional reg
| Match of 'a match_instr reg | Match of 'x match_instr reg
| Ass of 'a ass_instr | Ass of 'x ass_instr
| Loop of 'a loop | Loop of 'x loop
| ProcCall of 'a fun_call | ProcCall of 'x fun_call
| Null of kwd_null | Null of kwd_null
| Fail of (kwd_fail * 'a expr) reg | Fail of (kwd_fail * 'x expr) reg
and 'a conditional = { and 'x conditional = {
kwd_if : kwd_if; kwd_if : kwd_if;
test : 'a expr; test : 'x expr;
kwd_then : kwd_then; kwd_then : kwd_then;
ifso : 'a instruction; ifso : 'x instruction;
kwd_else : kwd_else; kwd_else : kwd_else;
ifnot : 'a instruction ifnot : 'x instruction
} }
and 'a match_instr = { and 'x match_instr = {
kwd_match : kwd_match; kwd_match : kwd_match;
expr : 'a expr; expr : 'x expr;
kwd_with : kwd_with; kwd_with : kwd_with;
lead_vbar : vbar option; lead_vbar : vbar option;
cases : 'a cases; cases : 'x cases;
kwd_end : kwd_end kwd_end : kwd_end
} }
and 'a cases = ('a case, vbar) nsepseq reg and 'x cases = ('x case, vbar) nsepseq reg
and 'a case = ('a pattern * arrow * 'a instruction) reg and 'x case = ('x pattern * arrow * 'x instruction) reg
and 'a ass_instr = ('a variable * ass * 'a expr) reg and 'x ass_instr = ('x variable * ass * 'x expr) reg
and 'a loop = and 'x loop =
While of 'a while_loop While of 'x while_loop
| For of 'a for_loop | For of 'x for_loop
and 'a while_loop = (kwd_while * 'a expr * 'a block reg) reg and 'x while_loop = (kwd_while * 'x expr * 'x block reg) reg
and 'a for_loop = and 'x for_loop =
ForInt of 'a for_int reg ForInt of 'x for_int reg
| ForCollect of 'a for_collect reg | ForCollect of 'x for_collect reg
and 'a for_int = { and 'x for_int = {
kwd_for : kwd_for; kwd_for : kwd_for;
ass : 'a ass_instr; ass : 'x ass_instr;
down : kwd_down option; down : kwd_down option;
kwd_to : kwd_to; kwd_to : kwd_to;
bound : 'a expr; bound : 'x expr;
step : (kwd_step * 'a expr) option; step : (kwd_step * 'x expr) option;
block : 'a block reg block : 'x block reg
} }
and 'a for_collect = { and 'x for_collect = {
kwd_for : kwd_for; kwd_for : kwd_for;
var : 'a variable; var : 'x variable;
bind_to : (arrow * 'a variable) option; bind_to : (arrow * 'x variable) option;
kwd_in : kwd_in; kwd_in : kwd_in;
expr : 'a expr; expr : 'x expr;
block : 'a block reg block : 'x block reg
} }
(* Expressions *) (* Expressions *)
and 'a expr = and 'x expr =
Or of ('a expr * bool_or * 'a expr) reg Or of ('x expr * bool_or * 'x expr) reg
| And of ('a expr * bool_and * 'a expr) reg | And of ('x expr * bool_and * 'x expr) reg
| Lt of ('a expr * lt * 'a expr) reg | Lt of ('x expr * lt * 'x expr) reg
| Leq of ('a expr * leq * 'a expr) reg | Leq of ('x expr * leq * 'x expr) reg
| Gt of ('a expr * gt * 'a expr) reg | Gt of ('x expr * gt * 'x expr) reg
| Geq of ('a expr * geq * 'a expr) reg | Geq of ('x expr * geq * 'x expr) reg
| Equal of ('a expr * equal * 'a expr) reg | Equal of ('x expr * equal * 'x expr) reg
| Neq of ('a expr * neq * 'a expr) reg | Neq of ('x expr * neq * 'x expr) reg
| Cat of ('a expr * cat * 'a expr) reg | Cat of ('x expr * cat * 'x expr) reg
| Cons of ('a expr * cons * 'a expr) reg | Cons of ('x expr * cons * 'x expr) reg
| Add of ('a expr * plus * 'a expr) reg | Add of ('x expr * plus * 'x expr) reg
| Sub of ('a expr * minus * 'a expr) reg | Sub of ('x expr * minus * 'x expr) reg
| Mult of ('a expr * times * 'a expr) reg | Mult of ('x expr * times * 'x expr) reg
| Div of ('a expr * slash * 'a expr) reg | Div of ('x expr * slash * 'x expr) reg
| Mod of ('a expr * kwd_mod * 'a expr) reg | Mod of ('x expr * kwd_mod * 'x expr) reg
| Neg of (minus * 'a expr) reg | Neg of (minus * 'x expr) reg
| Not of (kwd_not * 'a expr) reg | Not of (kwd_not * 'x expr) reg
| Int of (Lexer.lexeme * Z.t) reg | Int of (Lexer.lexeme * Z.t) reg
| Var of Lexer.lexeme reg | Var of Lexer.lexeme reg
| String of Lexer.lexeme reg | String of Lexer.lexeme reg
@ -356,46 +356,46 @@ and 'a expr =
| False of c_False | False of c_False
| True of c_True | True of c_True
| Unit of c_Unit | Unit of c_Unit
| Tuple of 'a tuple | Tuple of 'x tuple
| List of ('a expr, comma) nsepseq brackets | List of ('x expr, comma) nsepseq brackets
| EmptyList of 'a empty_list | EmptyList of 'x empty_list
| Set of ('a expr, comma) nsepseq braces | Set of ('x expr, comma) nsepseq braces
| EmptySet of 'a empty_set | EmptySet of 'x empty_set
| NoneExpr of 'a none_expr | NoneExpr of 'x none_expr
| FunCall of 'a fun_call | FunCall of 'x fun_call
| ConstrApp of 'a constr_app | ConstrApp of 'x constr_app
| SomeApp of (c_Some * 'a arguments) reg | SomeApp of (c_Some * 'x arguments) reg
| MapLookUp of 'a map_lookup reg | MapLookUp of 'x map_lookup reg
| ParExpr of 'a expr par | ParExpr of 'x expr par
and 'a tuple = ('a expr, comma) nsepseq par and 'x tuple = ('x expr, comma) nsepseq par
and 'a empty_list = and 'x empty_list =
(lbracket * rbracket * colon * 'a type_expr) par (lbracket * rbracket * colon * 'x type_expr) par
and 'a empty_set = and 'x empty_set =
(lbrace * rbrace * colon * 'a type_expr) par (lbrace * rbrace * colon * 'x type_expr) par
and 'a none_expr = and 'x none_expr =
(c_None * colon * 'a type_expr) par (c_None * colon * 'x type_expr) par
and 'a fun_call = ('a fun_name * 'a arguments) reg and 'x fun_call = ('x fun_name * 'x arguments) reg
and 'a arguments = 'a tuple and 'x arguments = 'x tuple
and 'a constr_app = ('a constr * 'a arguments) reg and 'x constr_app = ('x constr * 'x arguments) reg
and 'a map_lookup = { and 'x map_lookup = {
map_name : 'a variable; map_name : 'x variable;
selector : dot; selector : dot;
index : 'a expr brackets index : 'x expr brackets
} }
(* Patterns *) (* Patterns *)
and 'a pattern = ('a core_pattern, cons) nsepseq reg and 'x pattern = ('x core_pattern, cons) nsepseq reg
and 'a core_pattern = and 'x core_pattern =
PVar of Lexer.lexeme reg PVar of Lexer.lexeme reg
| PWild of wild | PWild of wild
| PInt of (Lexer.lexeme * Z.t) reg | PInt of (Lexer.lexeme * Z.t) reg
@ -405,97 +405,97 @@ and 'a core_pattern =
| PFalse of c_False | PFalse of c_False
| PTrue of c_True | PTrue of c_True
| PNone of c_None | PNone of c_None
| PSome of (c_Some * 'a core_pattern par) reg | PSome of (c_Some * 'x core_pattern par) reg
| PList of 'a list_pattern | PList of 'x list_pattern
| PTuple of ('a core_pattern, comma) nsepseq par | PTuple of ('x core_pattern, comma) nsepseq par
and 'a list_pattern = and 'x list_pattern =
Sugar of ('a core_pattern, comma) sepseq brackets Sugar of ('x core_pattern, comma) sepseq brackets
| Raw of ('a core_pattern * cons * 'a pattern) par | Raw of ('x core_pattern * cons * 'x pattern) par
(* Projecting regions *) (* Projecting regions *)
val type_expr_to_region : 'a type_expr -> Region.t val type_expr_to_region : 'x type_expr -> Region.t
val expr_to_region : 'a expr -> Region.t val expr_to_region : 'x expr -> Region.t
val instr_to_region : 'a instruction -> Region.t val instr_to_region : 'x instruction -> Region.t
val core_pattern_to_region : 'a core_pattern -> Region.t val core_pattern_to_region : 'x core_pattern -> Region.t
val local_decl_to_region : 'a local_decl -> Region.t val local_decl_to_region : 'x local_decl -> Region.t
type 'a visitor = { type 'x visitor = {
ass_instr : 'a ass_instr -> unit; ass_instr : 'x ass_instr -> unit;
bind_to : (Region.t * 'a variable) option -> unit; bind_to : (Region.t * 'x variable) option -> unit;
block : 'a block reg -> unit; block : 'x block reg -> unit;
bytes : (string * MBytes.t) reg -> unit; bytes : (string * MBytes.t) reg -> unit;
cartesian : 'a cartesian -> unit; cartesian : 'x cartesian -> unit;
case : 'a case -> unit; case : 'x case -> unit;
cases : 'a cases -> unit; cases : 'x cases -> unit;
conditional : 'a conditional -> unit; conditional : 'x conditional -> unit;
const_decl : 'a const_decl reg -> unit; const_decl : 'x const_decl reg -> unit;
constr : 'a constr -> unit; constr : 'x constr -> unit;
constr_app : 'a constr_app -> unit; constr_app : 'x constr_app -> unit;
core_pattern : 'a core_pattern -> unit; core_pattern : 'x core_pattern -> unit;
down : Region.t option -> unit; down : Region.t option -> unit;
empty_list : 'a empty_list -> unit; empty_list : 'x empty_list -> unit;
empty_set : 'a empty_set -> unit; empty_set : 'x empty_set -> unit;
expr : 'a expr -> unit; expr : 'x expr -> unit;
fail : (kwd_fail * 'a expr) -> unit; fail : (kwd_fail * 'x expr) -> unit;
field_decl : 'a field_decl -> unit; field_decl : 'x field_decl -> unit;
field_decls : 'a field_decls -> unit; field_decls : 'x field_decls -> unit;
for_collect : 'a for_collect reg -> unit; for_collect : 'x for_collect reg -> unit;
for_int : 'a for_int reg -> unit; for_int : 'x for_int reg -> unit;
for_loop : 'a for_loop -> unit; for_loop : 'x for_loop -> unit;
fun_call : 'a fun_call -> unit; fun_call : 'x fun_call -> unit;
fun_decl : 'a fun_decl reg -> unit; fun_decl : 'x fun_decl reg -> unit;
instruction : 'a instruction -> unit; instruction : 'x instruction -> unit;
instructions : 'a instructions -> unit; instructions : 'x instructions -> unit;
int : (string * Z.t) reg -> unit; int : (string * Z.t) reg -> unit;
lambda_decl : 'a lambda_decl -> unit; lambda_decl : 'x lambda_decl -> unit;
list : ('a expr, Region.t) nsepseq brackets -> unit; list : ('x expr, Region.t) nsepseq brackets -> unit;
list_pattern : 'a list_pattern -> unit; list_pattern : 'x list_pattern -> unit;
loop : 'a loop -> unit; loop : 'x loop -> unit;
map_lookup : 'a map_lookup reg -> unit; map_lookup : 'x map_lookup reg -> unit;
match_instr : 'a match_instr -> unit; match_instr : 'x match_instr -> unit;
none_expr : 'a none_expr -> unit; none_expr : 'x none_expr -> unit;
nsepseq : 'a.string -> ('a -> unit) -> ('a, Region.t) nsepseq -> unit; nsepseq : 'x.string -> ('x -> unit) -> ('x, Region.t) nsepseq -> unit;
operations_decl : 'a operations_decl reg -> unit; operations_decl : 'x operations_decl reg -> unit;
par_expr : 'a expr par -> unit; par_expr : 'x expr par -> unit;
par_type : 'a type_expr par -> unit; par_type : 'x type_expr par -> unit;
param_decl : 'a param_decl -> unit; param_decl : 'x param_decl -> unit;
parameter_decl : 'a parameter_decl reg -> unit; parameter_decl : 'x parameter_decl reg -> unit;
parameters : 'a parameters -> unit; parameters : 'x parameters -> unit;
param_const : 'a param_const -> unit; param_const : 'x param_const -> unit;
param_var : 'a param_var -> unit; param_var : 'x param_var -> unit;
pattern : 'a pattern -> unit; pattern : 'x pattern -> unit;
patterns : 'a core_pattern par -> unit; patterns : 'x core_pattern par -> unit;
proc_decl : 'a proc_decl reg -> unit; proc_decl : 'x proc_decl reg -> unit;
psome : (Region.t * 'a core_pattern par) reg -> unit; psome : (Region.t * 'x core_pattern par) reg -> unit;
ptuple : ('a core_pattern, Region.t) nsepseq par -> unit; ptuple : ('x core_pattern, Region.t) nsepseq par -> unit;
raw : ('a core_pattern * Region.t * 'a pattern) par -> unit; raw : ('x core_pattern * Region.t * 'x pattern) par -> unit;
record_type : 'a record_type -> unit; record_type : 'x record_type -> unit;
sepseq : 'a.string -> ('a -> unit) -> ('a, Region.t) sepseq -> unit; sepseq : 'x.string -> ('x -> unit) -> ('x, Region.t) sepseq -> unit;
set : ('a expr, Region.t) nsepseq braces -> unit; set : ('x expr, Region.t) nsepseq braces -> unit;
single_instr : 'a single_instr -> unit; single_instr : 'x single_instr -> unit;
some_app : (Region.t * 'a arguments) reg -> unit; some_app : (Region.t * 'x arguments) reg -> unit;
step : (Region.t * 'a expr) option -> unit; step : (Region.t * 'x expr) option -> unit;
storage_decl : 'a storage_decl reg -> unit; storage_decl : 'x storage_decl reg -> unit;
string : string reg -> unit; string : string reg -> unit;
sugar : ('a core_pattern, Region.t) sepseq brackets -> unit; sugar : ('x core_pattern, Region.t) sepseq brackets -> unit;
sum_type : ('a variant, Region.t) nsepseq reg -> unit; sum_type : ('x variant, Region.t) nsepseq reg -> unit;
terminator : semi option -> unit; terminator : semi option -> unit;
token : Region.t -> string -> unit; token : Region.t -> string -> unit;
tuple : 'a arguments -> unit; tuple : 'x arguments -> unit;
type_app : ('a type_name * 'a type_tuple) reg -> unit; type_app : ('x type_name * 'x type_tuple) reg -> unit;
type_decl : 'a type_decl reg -> unit; type_decl : 'x type_decl reg -> unit;
type_expr : 'a type_expr -> unit; type_expr : 'x type_expr -> unit;
type_tuple : 'a type_tuple -> unit; type_tuple : 'x type_tuple -> unit;
local_decl : 'a local_decl -> unit; local_decl : 'x local_decl -> unit;
local_decls : 'a local_decl list -> unit; local_decls : 'x local_decl list -> unit;
var : 'a variable -> unit; var : 'x variable -> unit;
var_decl : 'a var_decl reg -> unit; var_decl : 'x var_decl reg -> unit;
variant : 'a variant -> unit; variant : 'x variant -> unit;
while_loop : 'a while_loop -> unit while_loop : 'x while_loop -> unit
} }

132
Print.ml
View File

@ -47,7 +47,7 @@ and print_int _visitor {region; value = lexeme, abstract} =
(* Main printing function *) (* Main printing function *)
and print_tokens (v: 'a visitor) ast = and print_tokens (v: 'x visitor) ast =
List.iter v.type_decl ast.types; List.iter v.type_decl ast.types;
v.parameter_decl ast.parameter; v.parameter_decl ast.parameter;
v.storage_decl ast.storage; v.storage_decl ast.storage;
@ -56,31 +56,31 @@ and print_tokens (v: 'a visitor) ast =
v.block ast.block; v.block ast.block;
v.token ast.eof "EOF" v.token ast.eof "EOF"
and print_parameter_decl (v: 'a visitor) {value=node; _} = and print_parameter_decl (v: 'x visitor) {value=node; _} =
v.token node.kwd_parameter "parameter"; v.token node.kwd_parameter "parameter";
v.var node.name; v.var node.name;
v.token node.colon ":"; v.token node.colon ":";
v.type_expr node.param_type; v.type_expr node.param_type;
v.terminator node.terminator v.terminator node.terminator
and print_storage_decl (v: 'a visitor) {value=node; _} = and print_storage_decl (v: 'x visitor) {value=node; _} =
v.token node.kwd_storage "storage"; v.token node.kwd_storage "storage";
v.type_expr node.store_type; v.type_expr node.store_type;
v.terminator node.terminator v.terminator node.terminator
and print_operations_decl (v: 'a visitor) {value=node; _} = and print_operations_decl (v: 'x visitor) {value=node; _} =
v.token node.kwd_operations "operations"; v.token node.kwd_operations "operations";
v.type_expr node.op_type; v.type_expr node.op_type;
v.terminator node.terminator v.terminator node.terminator
and print_type_decl (v: 'a visitor) {value=node; _} = and print_type_decl (v: 'x visitor) {value=node; _} =
v.token node.kwd_type "type"; v.token node.kwd_type "type";
v.var node.name; v.var node.name;
v.token node.kwd_is "is"; v.token node.kwd_is "is";
v.type_expr node.type_expr; v.type_expr node.type_expr;
v.terminator node.terminator v.terminator node.terminator
and print_type_expr (v: 'a visitor) = function and print_type_expr (v: 'x visitor) = function
Prod cartesian -> v.cartesian cartesian Prod cartesian -> v.cartesian cartesian
| Sum sum_type -> v.sum_type sum_type | Sum sum_type -> v.sum_type sum_type
| Record record_type -> v.record_type record_type | Record record_type -> v.record_type record_type
@ -88,55 +88,55 @@ and print_type_expr (v: 'a visitor) = function
| ParType par_type -> v.par_type par_type | ParType par_type -> v.par_type par_type
| TAlias type_alias -> v.var type_alias | TAlias type_alias -> v.var type_alias
and print_cartesian (v: 'a visitor) {value=sequence; _} = and print_cartesian (v: 'x visitor) {value=sequence; _} =
v.nsepseq "*" v.type_expr sequence v.nsepseq "*" v.type_expr sequence
and print_variant (v: 'a visitor) {value=node; _} = and print_variant (v: 'x visitor) {value=node; _} =
let constr, kwd_of, cartesian = node in let constr, kwd_of, cartesian = node in
v.constr constr; v.constr constr;
v.token kwd_of "of"; v.token kwd_of "of";
v.cartesian cartesian v.cartesian cartesian
and print_sum_type (v: 'a visitor) {value=sequence; _} = and print_sum_type (v: 'x visitor) {value=sequence; _} =
v.nsepseq "|" v.variant sequence v.nsepseq "|" v.variant sequence
and print_record_type (v: 'a visitor) {value=node; _} = and print_record_type (v: 'x visitor) {value=node; _} =
let kwd_record, field_decls, kwd_end = node in let kwd_record, field_decls, kwd_end = node in
v.token kwd_record "record"; v.token kwd_record "record";
v.field_decls field_decls; v.field_decls field_decls;
v.token kwd_end "end" v.token kwd_end "end"
and print_type_app (v: 'a visitor) {value=node; _} = and print_type_app (v: 'x visitor) {value=node; _} =
let type_name, type_tuple = node in let type_name, type_tuple = node in
v.var type_name; v.var type_name;
v.type_tuple type_tuple v.type_tuple type_tuple
and print_par_type (v: 'a visitor) {value=node; _} = and print_par_type (v: 'x visitor) {value=node; _} =
let lpar, type_expr, rpar = node in let lpar, type_expr, rpar = node in
v.token lpar "("; v.token lpar "(";
v.type_expr type_expr; v.type_expr type_expr;
v.token rpar ")" v.token rpar ")"
and print_field_decls (v: 'a visitor) sequence = and print_field_decls (v: 'x visitor) sequence =
v.nsepseq ";" v.field_decl sequence v.nsepseq ";" v.field_decl sequence
and print_field_decl (v: 'a visitor) {value=node; _} = and print_field_decl (v: 'x visitor) {value=node; _} =
let var, colon, type_expr = node in let var, colon, type_expr = node in
v.var var; v.var var;
v.token colon ":"; v.token colon ":";
v.type_expr type_expr v.type_expr type_expr
and print_type_tuple (v: 'a visitor) {value=node; _} = and print_type_tuple (v: 'x visitor) {value=node; _} =
let lpar, sequence, rpar = node in let lpar, sequence, rpar = node in
v.token lpar "("; v.token lpar "(";
v.nsepseq "," v.var sequence; v.nsepseq "," v.var sequence;
v.token rpar ")" v.token rpar ")"
and print_lambda_decl (v: 'a visitor) = function and print_lambda_decl (v: 'x visitor) = function
FunDecl fun_decl -> v.fun_decl fun_decl FunDecl fun_decl -> v.fun_decl fun_decl
| ProcDecl proc_decl -> v.proc_decl proc_decl | ProcDecl proc_decl -> v.proc_decl proc_decl
and print_fun_decl (v: 'a visitor) {value=node; _} = and print_fun_decl (v: 'x visitor) {value=node; _} =
v.token node.kwd_function "function"; v.token node.kwd_function "function";
v.var node.name; v.var node.name;
v.parameters node.param; v.parameters node.param;
@ -149,7 +149,7 @@ and print_fun_decl (v: 'a visitor) {value=node; _} =
v.expr node.return; v.expr node.return;
v.terminator node.terminator v.terminator node.terminator
and print_proc_decl (v: 'a visitor) {value=node; _} = and print_proc_decl (v: 'x visitor) {value=node; _} =
v.token node.kwd_procedure "procedure"; v.token node.kwd_procedure "procedure";
v.var node.name; v.var node.name;
v.parameters node.param; v.parameters node.param;
@ -158,45 +158,45 @@ and print_proc_decl (v: 'a visitor) {value=node; _} =
v.block node.block; v.block node.block;
v.terminator node.terminator v.terminator node.terminator
and print_parameters (v: 'a visitor) {value=node; _} = and print_parameters (v: 'x visitor) {value=node; _} =
let lpar, sequence, rpar = node in let lpar, sequence, rpar = node in
v.token lpar "("; v.token lpar "(";
v.nsepseq ";" v.param_decl sequence; v.nsepseq ";" v.param_decl sequence;
v.token rpar ")" v.token rpar ")"
and print_param_decl (v: 'a visitor) = function and print_param_decl (v: 'x visitor) = function
ParamConst param_const -> v.param_const param_const ParamConst param_const -> v.param_const param_const
| ParamVar param_var -> v.param_var param_var | ParamVar param_var -> v.param_var param_var
and print_param_const (v: 'a visitor) {value=node; _} = and print_param_const (v: 'x visitor) {value=node; _} =
let kwd_const, variable, colon, type_expr = node in let kwd_const, variable, colon, type_expr = node in
v.token kwd_const "const"; v.token kwd_const "const";
v.var variable; v.var variable;
v.token colon ":"; v.token colon ":";
v.type_expr type_expr v.type_expr type_expr
and print_param_var (v: 'a visitor) {value=node; _} = and print_param_var (v: 'x visitor) {value=node; _} =
let kwd_var, variable, colon, type_expr = node in let kwd_var, variable, colon, type_expr = node in
v.token kwd_var "var"; v.token kwd_var "var";
v.var variable; v.var variable;
v.token colon ":"; v.token colon ":";
v.type_expr type_expr v.type_expr type_expr
and print_block (v: 'a visitor) {value=node; _} = and print_block (v: 'x visitor) {value=node; _} =
v.token node.opening "begin"; v.token node.opening "begin";
v.instructions node.instr; v.instructions node.instr;
v.terminator node.terminator; v.terminator node.terminator;
v.token node.close "end" v.token node.close "end"
and print_local_decls (v: 'a visitor) sequence = and print_local_decls (v: 'x visitor) sequence =
List.iter v.local_decl sequence List.iter v.local_decl sequence
and print_local_decl (v: 'a visitor) = function and print_local_decl (v: 'x visitor) = function
LocalLam decl -> v.lambda_decl decl LocalLam decl -> v.lambda_decl decl
| LocalConst decl -> v.const_decl decl | LocalConst decl -> v.const_decl decl
| LocalVar decl -> v.var_decl decl | LocalVar decl -> v.var_decl decl
and print_const_decl (v: 'a visitor) {value=node; _} = and print_const_decl (v: 'x visitor) {value=node; _} =
v.token node.kwd_const "const"; v.token node.kwd_const "const";
v.var node.name; v.var node.name;
v.token node.colon ":"; v.token node.colon ":";
@ -205,7 +205,7 @@ and print_const_decl (v: 'a visitor) {value=node; _} =
v.expr node.init; v.expr node.init;
v.terminator node.terminator v.terminator node.terminator
and print_var_decl (v: 'a visitor) {value=node; _} = and print_var_decl (v: 'x visitor) {value=node; _} =
v.token node.kwd_var "var"; v.token node.kwd_var "var";
v.var node.name; v.var node.name;
v.token node.colon ":"; v.token node.colon ":";
@ -214,14 +214,14 @@ and print_var_decl (v: 'a visitor) {value=node; _} =
v.expr node.init; v.expr node.init;
v.terminator node.terminator v.terminator node.terminator
and print_instructions (v: 'a visitor) {value=sequence; _} = and print_instructions (v: 'x visitor) {value=sequence; _} =
v.nsepseq ";" v.instruction sequence v.nsepseq ";" v.instruction sequence
and print_instruction (v: 'a visitor) = function and print_instruction (v: 'x visitor) = function
Single instr -> v.single_instr instr Single instr -> v.single_instr instr
| Block block -> v.block block | Block block -> v.block block
and print_single_instr (v: 'a visitor) = function and print_single_instr (v: 'x visitor) = function
Cond {value; _} -> v.conditional value Cond {value; _} -> v.conditional value
| Match {value; _} -> v.match_instr value | Match {value; _} -> v.match_instr value
| Ass instr -> v.ass_instr instr | Ass instr -> v.ass_instr instr
@ -230,11 +230,11 @@ and print_single_instr (v: 'a visitor) = function
| Null kwd_null -> v.token kwd_null "null" | Null kwd_null -> v.token kwd_null "null"
| Fail {value; _} -> v.fail value | Fail {value; _} -> v.fail value
and print_fail (v: 'a visitor) (kwd_fail, expr) = and print_fail (v: 'x visitor) (kwd_fail, expr) =
v.token kwd_fail "fail"; v.token kwd_fail "fail";
v.expr expr v.expr expr
and print_conditional (v: 'a visitor) node = and print_conditional (v: 'x visitor) node =
v.token node.kwd_if "if"; v.token node.kwd_if "if";
v.expr node.test; v.expr node.test;
v.token node.kwd_then "then"; v.token node.kwd_then "then";
@ -242,43 +242,43 @@ and print_conditional (v: 'a visitor) node =
v.token node.kwd_else "else"; v.token node.kwd_else "else";
v.instruction node.ifnot v.instruction node.ifnot
and print_match_instr (v: 'a visitor) node = and print_match_instr (v: 'x visitor) node =
v.token node.kwd_match "match"; v.token node.kwd_match "match";
v.expr node.expr; v.expr node.expr;
v.token node.kwd_with "with"; v.token node.kwd_with "with";
v.cases node.cases; v.cases node.cases;
v.token node.kwd_end "end" v.token node.kwd_end "end"
and print_cases (v: 'a visitor) {value=sequence; _} = and print_cases (v: 'x visitor) {value=sequence; _} =
v.nsepseq "|" v.case sequence v.nsepseq "|" v.case sequence
and print_case (v: 'a visitor) {value=node; _} = and print_case (v: 'x visitor) {value=node; _} =
let pattern, arrow, instruction = node in let pattern, arrow, instruction = node in
v.pattern pattern; v.pattern pattern;
v.token arrow "->"; v.token arrow "->";
v.instruction instruction v.instruction instruction
and print_ass_instr (v: 'a visitor) {value=node; _} = and print_ass_instr (v: 'x visitor) {value=node; _} =
let variable, ass, expr = node in let variable, ass, expr = node in
v.var variable; v.var variable;
v.token ass ":="; v.token ass ":=";
v.expr expr v.expr expr
and print_loop (v: 'a visitor) = function and print_loop (v: 'x visitor) = function
While while_loop -> v.while_loop while_loop While while_loop -> v.while_loop while_loop
| For for_loop -> v.for_loop for_loop | For for_loop -> v.for_loop for_loop
and print_while_loop (v: 'a visitor) {value=node; _} = and print_while_loop (v: 'x visitor) {value=node; _} =
let kwd_while, expr, block = node in let kwd_while, expr, block = node in
v.token kwd_while "while"; v.token kwd_while "while";
v.expr expr; v.expr expr;
v.block block v.block block
and print_for_loop (v: 'a visitor) = function and print_for_loop (v: 'x visitor) = function
ForInt for_int -> v.for_int for_int ForInt for_int -> v.for_int for_int
| ForCollect for_collect -> v.for_collect for_collect | ForCollect for_collect -> v.for_collect for_collect
and print_for_int (v: 'a visitor) ({value=node; _} : 'a for_int reg) = and print_for_int (v: 'x visitor) ({value=node; _} : 'x for_int reg) =
v.token node.kwd_for "for"; v.token node.kwd_for "for";
v.ass_instr node.ass; v.ass_instr node.ass;
v.down node.down; v.down node.down;
@ -287,17 +287,17 @@ and print_for_int (v: 'a visitor) ({value=node; _} : 'a for_int reg) =
v.step node.step; v.step node.step;
v.block node.block v.block node.block
and print_down (v: 'a visitor) = function and print_down (v: 'x visitor) = function
Some kwd_down -> v.token kwd_down "down" Some kwd_down -> v.token kwd_down "down"
| None -> () | None -> ()
and print_step (v: 'a visitor) = function and print_step (v: 'x visitor) = function
Some (kwd_step, expr) -> Some (kwd_step, expr) ->
v.token kwd_step "step"; v.token kwd_step "step";
v.expr expr v.expr expr
| None -> () | None -> ()
and print_for_collect (v: 'a visitor) ({value=node; _} : 'a for_collect reg) = and print_for_collect (v: 'x visitor) ({value=node; _} : 'x for_collect reg) =
v.token node.kwd_for "for"; v.token node.kwd_for "for";
v.var node.var; v.var node.var;
v.bind_to node.bind_to; v.bind_to node.bind_to;
@ -305,13 +305,13 @@ and print_for_collect (v: 'a visitor) ({value=node; _} : 'a for_collect reg) =
v.expr node.expr; v.expr node.expr;
v.block node.block v.block node.block
and print_bind_to (v: 'a visitor) = function and print_bind_to (v: 'x visitor) = function
Some (arrow, variable) -> Some (arrow, variable) ->
v.token arrow "->"; v.token arrow "->";
v.var variable v.var variable
| None -> () | None -> ()
and print_expr (v: 'a visitor) = function and print_expr (v: 'x visitor) = function
Or {value = expr1, bool_or, expr2; _} -> Or {value = expr1, bool_or, expr2; _} ->
v.expr expr1; v.token bool_or "||"; v.expr expr2 v.expr expr1; v.token bool_or "||"; v.expr expr2
| And {value = expr1, bool_and, expr2; _} -> | And {value = expr1, bool_and, expr2; _} ->
@ -365,19 +365,19 @@ and print_expr (v: 'a visitor) = function
| MapLookUp lookup -> v.map_lookup lookup | MapLookUp lookup -> v.map_lookup lookup
| ParExpr pexpr -> v.par_expr pexpr | ParExpr pexpr -> v.par_expr pexpr
and print_tuple (v: 'a visitor) {value=node; _} = and print_tuple (v: 'x visitor) {value=node; _} =
let lpar, sequence, rpar = node in let lpar, sequence, rpar = node in
v.token lpar "("; v.token lpar "(";
v.nsepseq "," v.expr sequence; v.nsepseq "," v.expr sequence;
v.token rpar ")" v.token rpar ")"
and print_list (v: 'a visitor) {value=node; _} = and print_list (v: 'x visitor) {value=node; _} =
let lbra, sequence, rbra = node in let lbra, sequence, rbra = node in
v.token lbra "["; v.token lbra "[";
v.nsepseq "," v.expr sequence; v.nsepseq "," v.expr sequence;
v.token rbra "]" v.token rbra "]"
and print_empty_list (v: 'a visitor) {value=node; _} = and print_empty_list (v: 'x visitor) {value=node; _} =
let lpar, (lbracket, rbracket, colon, type_expr), rpar = node in let lpar, (lbracket, rbracket, colon, type_expr), rpar = node in
v.token lpar "("; v.token lpar "(";
v.token lbracket "["; v.token lbracket "[";
@ -386,13 +386,13 @@ and print_empty_list (v: 'a visitor) {value=node; _} =
v.type_expr type_expr; v.type_expr type_expr;
v.token rpar ")" v.token rpar ")"
and print_set (v: 'a visitor) {value=node; _} = and print_set (v: 'x visitor) {value=node; _} =
let lbrace, sequence, rbrace = node in let lbrace, sequence, rbrace = node in
v.token lbrace "{"; v.token lbrace "{";
v.nsepseq "," v.expr sequence; v.nsepseq "," v.expr sequence;
v.token rbrace "}" v.token rbrace "}"
and print_empty_set (v: 'a visitor) {value=node; _} = and print_empty_set (v: 'x visitor) {value=node; _} =
let lpar, (lbrace, rbrace, colon, type_expr), rpar = node in let lpar, (lbrace, rbrace, colon, type_expr), rpar = node in
v.token lpar "("; v.token lpar "(";
v.token lbrace "{"; v.token lbrace "{";
@ -401,7 +401,7 @@ and print_empty_set (v: 'a visitor) {value=node; _} =
v.type_expr type_expr; v.type_expr type_expr;
v.token rpar ")" v.token rpar ")"
and print_none_expr (v: 'a visitor) {value=node; _} = and print_none_expr (v: 'x visitor) {value=node; _} =
let lpar, (c_None, colon, type_expr), rpar = node in let lpar, (c_None, colon, type_expr), rpar = node in
v.token lpar "("; v.token lpar "(";
v.token c_None "None"; v.token c_None "None";
@ -409,22 +409,22 @@ and print_none_expr (v: 'a visitor) {value=node; _} =
v.type_expr type_expr; v.type_expr type_expr;
v.token rpar ")" v.token rpar ")"
and print_fun_call (v: 'a visitor) {value=node; _} = and print_fun_call (v: 'x visitor) {value=node; _} =
let fun_name, arguments = node in let fun_name, arguments = node in
v.var fun_name; v.var fun_name;
v.tuple arguments v.tuple arguments
and print_constr_app (v: 'a visitor) {value=node; _} = and print_constr_app (v: 'x visitor) {value=node; _} =
let constr, arguments = node in let constr, arguments = node in
v.constr constr; v.constr constr;
v.tuple arguments v.tuple arguments
and print_some_app (v: 'a visitor) {value=node; _} = and print_some_app (v: 'x visitor) {value=node; _} =
let c_Some, arguments = node in let c_Some, arguments = node in
v.token c_Some "Some"; v.token c_Some "Some";
v.tuple arguments v.tuple arguments
and print_map_lookup (v: 'a visitor) {value=node; _} = and print_map_lookup (v: 'x visitor) {value=node; _} =
let {value = lbracket, expr, rbracket; _} = node.index in let {value = lbracket, expr, rbracket; _} = node.index in
v.var node.map_name; v.var node.map_name;
v.token node.selector "."; v.token node.selector ".";
@ -432,16 +432,16 @@ and print_map_lookup (v: 'a visitor) {value=node; _} =
v.expr expr; v.expr expr;
v.token rbracket "]" v.token rbracket "]"
and print_par_expr (v: 'a visitor) {value=node; _} = and print_par_expr (v: 'x visitor) {value=node; _} =
let lpar, expr, rpar = node in let lpar, expr, rpar = node in
v.token lpar "("; v.token lpar "(";
v.expr expr; v.expr expr;
v.token rpar ")" v.token rpar ")"
and print_pattern (v: 'a visitor) {value=sequence; _} = and print_pattern (v: 'x visitor) {value=sequence; _} =
v.nsepseq "<:" v.core_pattern sequence v.nsepseq "<:" v.core_pattern sequence
and print_core_pattern (v: 'a visitor) = function and print_core_pattern (v: 'x visitor) = function
PVar var -> v.var var PVar var -> v.var var
| PWild wild -> v.token wild "_" | PWild wild -> v.token wild "_"
| PInt i -> v.int i | PInt i -> v.int i
@ -455,28 +455,28 @@ and print_core_pattern (v: 'a visitor) = function
| PList pattern -> v.list_pattern pattern | PList pattern -> v.list_pattern pattern
| PTuple ptuple -> v.ptuple ptuple | PTuple ptuple -> v.ptuple ptuple
and print_psome (v: 'a visitor) {value=node; _} = and print_psome (v: 'x visitor) {value=node; _} =
let c_Some, patterns = node in let c_Some, patterns = node in
v.token c_Some "Some"; v.token c_Some "Some";
v.patterns patterns v.patterns patterns
and print_patterns (v: 'a visitor) {value=node; _} = and print_patterns (v: 'x visitor) {value=node; _} =
let lpar, core_pattern, rpar = node in let lpar, core_pattern, rpar = node in
v.token lpar "("; v.token lpar "(";
v.core_pattern core_pattern; v.core_pattern core_pattern;
v.token rpar ")" v.token rpar ")"
and print_list_pattern (v: 'a visitor) = function and print_list_pattern (v: 'x visitor) = function
Sugar sugar -> v.sugar sugar Sugar sugar -> v.sugar sugar
| Raw raw -> v.raw raw | Raw raw -> v.raw raw
and print_sugar (v: 'a visitor) {value=node; _} = and print_sugar (v: 'x visitor) {value=node; _} =
let lbracket, sequence, rbracket = node in let lbracket, sequence, rbracket = node in
v.token lbracket "["; v.token lbracket "[";
v.sepseq "," v.core_pattern sequence; v.sepseq "," v.core_pattern sequence;
v.token rbracket "]" v.token rbracket "]"
and print_raw (v: 'a visitor) {value=node; _} = and print_raw (v: 'x visitor) {value=node; _} =
let lpar, (core_pattern, cons, pattern), rpar = node in let lpar, (core_pattern, cons, pattern), rpar = node in
v.token lpar "("; v.token lpar "(";
v.core_pattern core_pattern; v.core_pattern core_pattern;
@ -484,17 +484,17 @@ and print_raw (v: 'a visitor) {value=node; _} =
v.pattern pattern; v.pattern pattern;
v.token rpar ")" v.token rpar ")"
and print_ptuple (v: 'a visitor) {value=node; _} = and print_ptuple (v: 'x visitor) {value=node; _} =
let lpar, sequence, rpar = node in let lpar, sequence, rpar = node in
v.token lpar "("; v.token lpar "(";
v.nsepseq "," v.core_pattern sequence; v.nsepseq "," v.core_pattern sequence;
v.token rpar ")" v.token rpar ")"
and print_terminator (v: 'a visitor) = function and print_terminator (v: 'x visitor) = function
Some semi -> v.token semi ";" Some semi -> v.token semi ";"
| None -> () | None -> ()
let rec visitor () : 'a visitor = { let rec visitor () : 'x visitor = {
nsepseq = print_nsepseq; nsepseq = print_nsepseq;
sepseq = print_sepseq; sepseq = print_sepseq;
token = print_token (visitor ()); token = print_token (visitor ());