balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity
0cb43cff8b
ligo/AST.ml

1039 lines
33 KiB
OCaml
Raw Blame History

(* Abstract Syntax Tree (AST) for Ligo *)
open Utils
(* Regions
The AST carries all the regions where tokens have been found by the
lexer, plus additional regions corresponding to whole subtrees
(like entire expressions, patterns etc.). These regions are needed
for error reporting and source-to-source transformations. To make
these pervasive regions more legible, we define singleton types for
the symbols, keywords etc. with suggestive names like "kwd_and"
denoting the _region_ of the occurrence of the keyword "and".
*)
type 'a reg = 'a Region.reg
let rec last to_region = function
[] -> Region.ghost
| [x] -> to_region x
| _::t -> last to_region t
let nseq_to_region to_region (hd,tl) =
Region.cover (to_region hd) (last to_region tl)
let nsepseq_to_region to_region (hd,tl) =
let reg (_,item) = to_region item in
Region.cover (to_region hd) (last reg tl)
let sepseq_to_region to_region = function
None -> Region.ghost
| Some seq -> nsepseq_to_region to_region seq
(* Keywords of Ligo *)
type kwd_begin = Region.t
type kwd_const = Region.t
type kwd_down = Region.t
type kwd_if = Region.t
type kwd_in = Region.t
type kwd_is = Region.t
type kwd_for = Region.t
type kwd_function = Region.t
type kwd_parameter = Region.t
type kwd_storage = Region.t
type kwd_type = Region.t
type kwd_of = Region.t
type kwd_operations = Region.t
type kwd_var = Region.t
type kwd_end = Region.t
type kwd_then = Region.t
type kwd_else = Region.t
type kwd_match = Region.t
type kwd_procedure = Region.t
type kwd_null = Region.t
type kwd_record = Region.t
type kwd_step = Region.t
type kwd_to = Region.t
type kwd_mod = Region.t
type kwd_not = Region.t
type kwd_while = Region.t
type kwd_with = Region.t
(* Data constructors *)
type c_False = Region.t
type c_None = Region.t
type c_Some = Region.t
type c_True = Region.t
type c_Unit = Region.t
(* Symbols *)
type semi = Region.t
type comma = Region.t
type lpar = Region.t
type rpar = Region.t
type lbrace = Region.t
type rbrace = Region.t
type lbracket = Region.t
type rbracket = Region.t
type cons = Region.t
type vbar = Region.t
type arrow = Region.t
type asgnmnt = Region.t
type equal = Region.t
type colon = Region.t
type bool_or = Region.t
type bool_and = Region.t
type lt = Region.t
type leq = Region.t
type gt = Region.t
type geq = Region.t
type neq = Region.t
type plus = Region.t
type minus = Region.t
type slash = Region.t
type times = Region.t
type dot = Region.t
type wild = Region.t
type cat = Region.t
(* Virtual tokens *)
type eof = Region.t
(* Literals *)
type variable = string reg
type fun_name = string reg
type type_name = string reg
type field_name = string reg
type map_name = string reg
type constr = string reg
(* Comma-separated non-empty lists *)
type 'a csv = ('a, comma) nsepseq
(* Bar-separated non-empty lists *)
type 'a bsv = ('a, vbar) nsepseq
(* Parentheses *)
type 'a par = (lpar * 'a * rpar) reg
(* Brackets compounds *)
type 'a brackets = (lbracket * 'a * rbracket) reg
(* Braced compounds *)
type 'a braces = (lbrace * 'a * rbrace) reg
(* The Abstract Syntax Tree *)
type t = <
types : type_decl list;
parameter : parameter_decl;
storage : storage_decl;
operations : operations_decl;
lambdas : lambda_decl list;
block : block reg;
eof : eof
>
and ast = t
and parameter_decl = (kwd_parameter * variable * colon * type_expr) reg
and storage_decl = (kwd_storage * type_expr) reg
and operations_decl = (kwd_operations * type_expr) reg
(* Type declarations *)
and type_decl = (kwd_type * type_name * kwd_is * type_expr) reg
and type_expr =
Prod of cartesian
| Sum of (variant, vbar) nsepseq reg
| Record of record_type
| TypeApp of (type_name * type_tuple) reg
| ParType of type_expr par
| TAlias of variable
and cartesian = (type_expr, times) nsepseq reg
and variant = (constr * kwd_of * cartesian) reg
and record_type = (kwd_record * field_decls * kwd_end) reg
and field_decls = (field_decl, semi) nsepseq
and field_decl = (variable * colon * type_expr) reg
and type_tuple = (type_name, comma) nsepseq par
(* Function and procedure declarations *)
and lambda_decl =
FunDecl of fun_decl reg
| ProcDecl of proc_decl reg
and fun_decl = <
kwd_function : kwd_function;
var : variable;
param : parameters;
colon : colon;
ret_type : type_expr;
kwd_is : kwd_is;
body : block reg;
kwd_with : kwd_with;
return : expr
>
and proc_decl = <
kwd_procedure : kwd_procedure;
var : variable;
param : parameters;
kwd_is : kwd_is;
body : block reg
>
and parameters = (param_decl, semi) nsepseq par
and param_decl = (var_kind * variable * colon * type_expr) reg
and var_kind =
Mutable of kwd_var
| Const of kwd_const
and block = <
decls : value_decls;
opening : kwd_begin;
instr : instructions;
close : kwd_end
>
and value_decls = (var_decl reg, semi) sepseq reg
and var_decl = <
kind : var_kind;
var : variable;
colon : colon;
vtype : type_expr;
setter : Region.t; (* "=" or ":=" *)
init : expr
>
and instructions = (instruction, semi) nsepseq reg
and instruction =
Single of single_instr
| Block of block reg
and single_instr =
Cond of conditional reg
| Match of match_instr reg
| Asgnmnt of asgnmnt_instr
| Loop of loop
| ProcCall of fun_call
| Null of kwd_null
and conditional = <
kwd_if : kwd_if;
test : expr;
kwd_then : kwd_then;
ifso : instruction;
kwd_else : kwd_else;
ifnot : instruction
>
and match_instr = <
kwd_match : kwd_match;
expr : expr;
kwd_with : kwd_with;
cases : cases;
kwd_end : kwd_end
>
and cases = (case, vbar) nsepseq reg
and case = (pattern * arrow * instruction) reg
and asgnmnt_instr = (variable * asgnmnt * expr) reg
and loop =
While of while_loop
| For of for_loop
and while_loop = (kwd_while * expr * block reg) reg
and for_loop =
ForInt of for_int reg
| ForCollect of for_collect reg
and for_int = <
kwd_for : kwd_for;
asgnmnt : asgnmnt_instr;
down : kwd_down option;
kwd_to : kwd_to;
bound : expr;
step : (kwd_step * expr) option;
block : block reg
>
and for_collect = <
kwd_for : kwd_for;
var : variable;
bind_to : (arrow * variable) option;
kwd_in : kwd_in;
expr : expr;
block : block reg
>
(* Expressions *)
and expr =
Or of (expr * bool_or * expr) reg
| And of (expr * bool_and * expr) reg
| Lt of (expr * lt * expr) reg
| Leq of (expr * leq * expr) reg
| Gt of (expr * gt * expr) reg
| Geq of (expr * geq * expr) reg
| Equal of (expr * equal * expr) reg
| Neq of (expr * neq * expr) reg
| Cat of (expr * cat * expr) reg
| Cons of (expr * cons * expr) reg
| Add of (expr * plus * expr) reg
| Sub of (expr * minus * expr) reg
| Mult of (expr * times * expr) reg
| Div of (expr * slash * expr) reg
| Mod of (expr * kwd_mod * expr) reg
| Neg of (minus * expr) reg
| Not of (kwd_not * expr) reg
| Int of (Lexer.lexeme * Z.t) reg
| Var of Lexer.lexeme reg
| String of Lexer.lexeme reg
| Bytes of (Lexer.lexeme * MBytes.t) reg
| False of c_False
| True of c_True
| Unit of c_Unit
| Tuple of tuple
| List of (expr, comma) nsepseq brackets
| EmptyList of empty_list
| Set of (expr, comma) nsepseq braces
| EmptySet of empty_set
| NoneExpr of none_expr
| FunCall of fun_call
| ConstrApp of constr_app
| SomeApp of (c_Some * arguments) reg
| MapLookUp of map_lookup reg
| ParExpr of expr par
and tuple = (expr, comma) nsepseq par
and empty_list =
(lbracket * rbracket * colon * type_expr) par
and empty_set =
(lbrace * rbrace * colon * type_expr) par
and none_expr =
(c_None * colon * type_expr) par
and fun_call = (fun_name * arguments) reg
and arguments = tuple
and constr_app = (constr * arguments) reg
and map_lookup = <
map_name : variable;
selector : dot;
index : expr brackets
>
(* Patterns *)
and pattern = (core_pattern, cons) nsepseq reg
and core_pattern =
PVar of Lexer.lexeme reg
| PWild of wild
| PInt of (Lexer.lexeme * Z.t) reg
| PBytes of (Lexer.lexeme * MBytes.t) reg
| PString of Lexer.lexeme reg
| PUnit of c_Unit
| PFalse of c_False
| PTrue of c_True
| PNone of c_None
| PSome of (c_Some * core_pattern par) reg
| PList of list_pattern
| PTuple of (core_pattern, comma) nsepseq par
and list_pattern =
Sugar of (core_pattern, comma) sepseq brackets
| Raw of (core_pattern * cons * pattern) par
(* Projecting regions *)
open Region
let type_expr_to_region = function
Prod node -> node.region
| Sum node -> node.region
| Record node -> node.region
| TypeApp node -> node.region
| ParType node -> node.region
| TAlias node -> node.region
let expr_to_region = function
Or {region; _}
| And {region; _}
| Lt {region; _}
| Leq {region; _}
| Gt {region; _}
| Geq {region; _}
| Equal {region; _}
| Neq {region; _}
| Cat {region; _}
| Cons {region; _}
| Add {region; _}
| Sub {region; _}
| Mult {region; _}
| Div {region; _}
| Mod {region; _}
| Neg {region; _}
| Not {region; _}
| Int {region; _}
| Var {region; _}
| String {region; _}
| Bytes {region; _}
| False region
| True region
| Unit region
| Tuple {region; _}
| List {region; _}
| EmptyList {region; _}
| Set {region; _}
| EmptySet {region; _}
| NoneExpr {region; _}
| FunCall {region; _}
| ConstrApp {region; _}
| SomeApp {region; _}
| MapLookUp {region; _}
| ParExpr {region; _} -> region
let var_kind_to_region = function
Mutable region
| Const region -> region
let instr_to_region = function
Single Cond {region;_}
| Single Match {region; _}
| Single Asgnmnt {region; _}
| Single Loop While {region; _}
| Single Loop For ForInt {region; _}
| Single Loop For ForCollect {region; _}
| Single ProcCall {region; _}
| Single Null region
| Block {region; _} -> region
let core_pattern_to_region = function
PVar {region; _}
| PWild region
| PInt {region; _}
| PBytes {region; _}
| PString {region; _}
| PUnit region
| PFalse region
| PTrue region
| PNone region
| PSome {region; _}
| PList Sugar {region; _}
| PList Raw {region; _}
| PTuple {region; _} -> region
(* Printing the tokens with their source regions *)
type xyz =
< asgnmnt_instr : asgnmnt_instr -> unit;
bind_to : (region * variable) option -> unit; block : block reg -> unit;
bytes : (string * MBytes.t) reg -> unit; cartesian : cartesian -> unit;
case : case -> unit; cases : cases -> unit;
conditional : conditional -> unit; constr : constr -> unit;
constr_app : constr_app -> unit; core_pattern : core_pattern -> unit;
down : region option -> unit; empty_list : empty_list -> unit;
empty_set : empty_set -> unit; expr : expr -> unit;
field_decl : field_decl -> unit; field_decls : field_decls -> unit;
for_collect : for_collect reg -> unit; for_int : for_int reg -> unit;
for_loop : for_loop -> unit; fun_call : fun_call -> unit;
fun_decl : fun_decl reg -> unit; instruction : instruction -> unit;
instructions : instructions -> unit; int : (string * Z.t) reg -> unit;
lambda_decl : lambda_decl -> unit;
list : (expr, region) nsepseq brackets -> unit;
list_pattern : list_pattern -> unit; loop : loop -> unit;
map_lookup : map_lookup reg -> unit; match_instr : match_instr -> unit;
none_expr : none_expr -> unit;
nsepseq : 'a. string -> ('a -> unit) -> 'a * (region * 'a) list -> unit;
operations_decl : (region * type_expr) reg -> unit;
par_expr : expr par -> unit; par_type : type_expr par -> unit;
param_decl : param_decl -> unit;
parameter_decl : (region * variable * region * type_expr) reg -> unit;
parameters : parameters -> unit; pattern : pattern -> unit;
patterns : core_pattern par -> unit; proc_decl : proc_decl reg -> unit;
psome : (region * core_pattern par) reg -> unit;
ptuple : (core_pattern, region) nsepseq par -> unit;
raw : (core_pattern * region * pattern) par -> unit;
record_type : record_type -> unit;
sepseq : 'a.
string ->
('a -> unit) -> ('a * (region * 'a) list) option -> unit;
set : (expr, region) nsepseq braces -> unit;
single_instr : single_instr -> unit;
some_app : (region * arguments) reg -> unit;
step : (region * expr) option -> unit;
storage_decl : (region * type_expr) reg -> unit;
string : string reg -> unit;
sugar : (core_pattern, region) sepseq brackets -> unit;
sum_type : (variant, region) nsepseq reg -> unit;
token : region -> string -> unit;
tuple : arguments -> unit; type_app : (type_name * type_tuple) reg -> unit;
type_decl : (region * variable * region * type_expr) reg -> unit;
type_expr : type_expr -> unit; type_tuple : type_tuple -> unit;
value_decls : value_decls -> unit; var : variable -> unit;
var_decl : var_decl reg -> unit; var_kind : var_kind -> unit;
variant : variant -> unit; while_loop : while_loop -> unit > ;;
let printf = Printf.printf
let compact (region: Region.t) =
region#compact ~offsets:EvalOpt.offsets EvalOpt.mode
let rec print_nsepseq : 'a . string -> ('a -> unit) -> ('a * (Region.t * 'a) list) -> unit = fun sep visit (head,tail) ->
let print_aux (sep_reg, item) =
printf "%s: %s\n" (compact sep_reg) sep;
visit item
in visit head; List.iter print_aux tail
and print_sepseq : 'a . string -> ('a -> unit) -> ('a * (Region.t * 'a) list) option -> unit = fun sep visit -> function
None -> ()
| Some seq -> print_nsepseq sep visit seq
and print_token (_visitor : xyz) region lexeme =
printf "%s: %s\n"(compact region) lexeme
and print_var (_visitor : xyz) {region; value=lexeme} =
printf "%s: Ident \"%s\"\n" (compact region) lexeme
and print_constr (_visitor : xyz) {region; value=lexeme} =
printf "%s: Constr \"%s\"\n"
(compact region) lexeme
and print_string (_visitor : xyz) {region; value=lexeme} =
printf "%s: String \"%s\"\n"
(compact region) lexeme
and print_bytes (_visitor : xyz) {region; value = lexeme, abstract} =
printf "%s: Bytes (\"%s\", \"0x%s\")\n"
(compact region) lexeme
(MBytes.to_hex abstract |> Hex.to_string)
and print_int (_visitor : xyz) {region; value = lexeme, abstract} =
printf "%s: Int (\"%s\", %s)\n"
(compact region) lexeme
(Z.to_string abstract)
(* main print function *)
and print_tokens (visitor : xyz) ast =
List.iter visitor#type_decl ast#types;
visitor#parameter_decl ast#parameter;
visitor#storage_decl ast#storage;
visitor#operations_decl ast#operations;
List.iter visitor#lambda_decl ast#lambdas;
visitor#block ast#block;
visitor#token ast#eof "EOF"
and print_parameter_decl (visitor : xyz) {value=node; _} =
let kwd_parameter, variable, colon, type_expr = node in
visitor#token kwd_parameter "parameter";
visitor#var variable;
visitor#token colon ":";
visitor#type_expr type_expr
and print_storage_decl (visitor : xyz) {value=node; _} =
let kwd_storage, type_expr = node in
visitor#token kwd_storage "storage";
visitor#type_expr type_expr
and print_operations_decl (visitor : xyz) {value=node; _} =
let kwd_operations, type_expr = node in
visitor#token kwd_operations "operations";
visitor#type_expr type_expr
and print_type_decl (visitor : xyz) {value=node; _} =
let kwd_type, type_name, kwd_is, type_expr = node in
visitor#token kwd_type "type";
visitor#var type_name;
visitor#token kwd_is "is";
visitor#type_expr type_expr
and print_type_expr (visitor : xyz) = function
Prod cartesian -> visitor#cartesian cartesian
| Sum sum_type -> visitor#sum_type sum_type
| Record record_type -> visitor#record_type record_type
| TypeApp type_app -> visitor#type_app type_app
| ParType par_type -> visitor#par_type par_type
| TAlias type_alias -> visitor#var type_alias
and print_cartesian (visitor : xyz) {value=sequence; _} =
visitor#nsepseq "*" visitor#type_expr sequence
and print_variant (visitor : xyz) {value=node; _} =
let constr, kwd_of, cartesian = node in
visitor#constr constr;
visitor#token kwd_of "of";
visitor#cartesian cartesian
and print_sum_type (visitor : xyz) {value=sequence; _} =
visitor#nsepseq "|" visitor#variant sequence
and print_record_type (visitor : xyz) {value=node; _} =
let kwd_record, field_decls, kwd_end = node in
visitor#token kwd_record "record";
visitor#field_decls field_decls;
visitor#token kwd_end "end"
and print_type_app (visitor : xyz) {value=node; _} =
let type_name, type_tuple = node in
visitor#var type_name;
visitor#type_tuple type_tuple
and print_par_type (visitor : xyz) {value=node; _} =
let lpar, type_expr, rpar = node in
visitor#token lpar "(";
visitor#type_expr type_expr;
visitor#token rpar ")"
and print_field_decls (visitor : xyz) sequence =
visitor#nsepseq ";" visitor#field_decl sequence
and print_field_decl (visitor : xyz) {value=node; _} =
let var, colon, type_expr = node in
visitor#var var;
visitor#token colon ":";
visitor#type_expr type_expr
and print_type_tuple (visitor : xyz) {value=node; _} =
let lpar, sequence, rpar = node in
visitor#token lpar "(";
visitor#nsepseq "," visitor#var sequence;
visitor#token rpar ")"
and print_lambda_decl (visitor : xyz) = function
FunDecl fun_decl -> visitor#fun_decl fun_decl
| ProcDecl proc_decl -> visitor#proc_decl proc_decl
and print_fun_decl (visitor : xyz) {value=node; _} =
visitor#token node#kwd_function "function";
visitor#var node#var;
visitor#parameters node#param;
visitor#token node#colon ":";
visitor#type_expr node#ret_type;
visitor#token node#kwd_is "is";
visitor#block node#body;
visitor#token node#kwd_with "with";
visitor#expr node#return
and print_proc_decl (visitor : xyz) {value=node; _} =
visitor#token node#kwd_procedure "procedure";
visitor#var node#var;
visitor#parameters node#param;
visitor#token node#kwd_is "is";
visitor#block node#body
and print_parameters (visitor : xyz) {value=node; _} =
let lpar, sequence, rpar = node in
visitor#token lpar "(";
visitor#nsepseq ";" visitor#param_decl sequence;
visitor#token rpar ")"
and print_param_decl (visitor : xyz) {value=node; _} =
let var_kind, variable, colon, type_expr = node in
visitor#var_kind var_kind;
visitor#var variable;
visitor#token colon ":";
visitor#type_expr type_expr
and print_var_kind (visitor : xyz) = function
Mutable kwd_var -> visitor#token kwd_var "var"
| Const kwd_const -> visitor#token kwd_const "const"
and print_block (visitor : xyz) {value=node; _} =
visitor#value_decls node#decls;
visitor#token node#opening "begin";
visitor#instructions node#instr;
visitor#token node#close "end"
and print_value_decls (visitor : xyz) {value=sequence; _} =
visitor#sepseq ";" visitor#var_decl sequence
and print_var_decl (visitor : xyz) {value=node; _} =
let setter =
match node#kind with
Mutable _ -> ":="
| Const _ -> "=" in
visitor#var_kind node#kind;
visitor#var node#var;
visitor#token node#colon ":";
visitor#type_expr node#vtype;
visitor#token node#setter setter;
visitor#expr node#init
and print_instructions (visitor : xyz) {value=sequence; _} =
visitor#nsepseq ";" visitor#instruction sequence
and print_instruction (visitor : xyz) = function
Single instr -> visitor#single_instr instr
| Block block -> visitor#block block
and print_single_instr (visitor : xyz) = function
Cond {value; _} -> visitor#conditional value
| Match {value; _} -> visitor#match_instr value
| Asgnmnt instr -> visitor#asgnmnt_instr instr
| Loop loop -> visitor#loop loop
| ProcCall fun_call -> visitor#fun_call fun_call
| Null kwd_null -> visitor#token kwd_null "null"
and print_conditional (visitor : xyz) node =
visitor#token node#kwd_if "if";
visitor#expr node#test;
visitor#token node#kwd_then "then";
visitor#instruction node#ifso;
visitor#token node#kwd_else "else";
visitor#instruction node#ifnot
and print_match_instr (visitor : xyz) node =
visitor#token node#kwd_match "match";
visitor#expr node#expr;
visitor#token node#kwd_with "with";
visitor#cases node#cases;
visitor#token node#kwd_end "end"
and print_cases (visitor : xyz) {value=sequence; _} =
visitor#nsepseq "|" visitor#case sequence
and print_case (visitor : xyz) {value=node; _} =
let pattern, arrow, instruction = node in
visitor#pattern pattern;
visitor#token arrow "->";
visitor#instruction instruction
and print_asgnmnt_instr (visitor : xyz) {value=node; _} =
let variable, asgnmnt, expr = node in
visitor#var variable;
visitor#token asgnmnt ":=";
visitor#expr expr
and print_loop (visitor : xyz) = function
While while_loop -> visitor#while_loop while_loop
| For for_loop -> visitor#for_loop for_loop
and print_while_loop (visitor : xyz) {value=node; _} =
let kwd_while, expr, block = node in
visitor#token kwd_while "while";
visitor#expr expr;
visitor#block block
and print_for_loop (visitor : xyz) = function
ForInt for_int -> visitor#for_int for_int
| ForCollect for_collect -> visitor#for_collect for_collect
and print_for_int (visitor : xyz) {value=node; _} =
visitor#token node#kwd_for "for";
visitor#asgnmnt_instr node#asgnmnt;
visitor#down node#down;
visitor#token node#kwd_to "to";
visitor#expr node#bound;
visitor#step node#step;
visitor#block node#block
and print_down (visitor : xyz) = function
Some kwd_down -> visitor#token kwd_down "down"
| None -> ()
and print_step (visitor : xyz) = function
Some (kwd_step, expr) ->
visitor#token kwd_step "step";
visitor#expr expr
| None -> ()
and print_for_collect (visitor : xyz) {value=node; _} =
visitor#token node#kwd_for "for";
visitor#var node#var;
visitor#bind_to node#bind_to;
visitor#token node#kwd_in "in";
visitor#expr node#expr;
visitor#block node#block
and print_bind_to (visitor : xyz) = function
Some (arrow, variable) ->
visitor#token arrow "->";
visitor#var variable
| None -> ()
and print_expr (visitor : xyz) = function
Or {value = expr1, bool_or, expr2; _} ->
visitor#expr expr1; visitor#token bool_or "||"; visitor#expr expr2
| And {value = expr1, bool_and, expr2; _} ->
visitor#expr expr1; visitor#token bool_and "&&"; visitor#expr expr2
| Lt {value = expr1, lt, expr2; _} ->
visitor#expr expr1; visitor#token lt "<"; visitor#expr expr2
| Leq {value = expr1, leq, expr2; _} ->
visitor#expr expr1; visitor#token leq "<="; visitor#expr expr2
| Gt {value = expr1, gt, expr2; _} ->
visitor#expr expr1; visitor#token gt ">"; visitor#expr expr2
| Geq {value = expr1, geq, expr2; _} ->
visitor#expr expr1; visitor#token geq ">="; visitor#expr expr2
| Equal {value = expr1, equal, expr2; _} ->
visitor#expr expr1; visitor#token equal "="; visitor#expr expr2
| Neq {value = expr1, neq, expr2; _} ->
visitor#expr expr1; visitor#token neq "=/="; visitor#expr expr2
| Cat {value = expr1, cat, expr2; _} ->
visitor#expr expr1; visitor#token cat "^"; visitor#expr expr2
| Cons {value = expr1, cons, expr2; _} ->
visitor#expr expr1; visitor#token cons "<:"; visitor#expr expr2
| Add {value = expr1, add, expr2; _} ->
visitor#expr expr1; visitor#token add "+"; visitor#expr expr2
| Sub {value = expr1, sub, expr2; _} ->
visitor#expr expr1; visitor#token sub "-"; visitor#expr expr2
| Mult {value = expr1, mult, expr2; _} ->
visitor#expr expr1; visitor#token mult "*"; visitor#expr expr2
| Div {value = expr1, div, expr2; _} ->
visitor#expr expr1; visitor#token div "/"; visitor#expr expr2
| Mod {value = expr1, kwd_mod, expr2; _} ->
visitor#expr expr1; visitor#token kwd_mod "mod"; visitor#expr expr2
| Neg {value = minus, expr; _} ->
visitor#token minus "-"; visitor#expr expr
| Not {value = kwd_not, expr; _} ->
visitor#token kwd_not "not"; visitor#expr expr
| Int i -> visitor#int i
| Var v -> visitor#var v
| String s -> visitor#string s
| Bytes b -> visitor#bytes b
| False region -> visitor#token region "False"
| True region -> visitor#token region "True"
| Unit region -> visitor#token region "Unit"
| Tuple tuple -> visitor#tuple tuple
| List list -> visitor#list list
| EmptyList elist -> visitor#empty_list elist
| Set set -> visitor#set set
| EmptySet eset -> visitor#empty_set eset
| NoneExpr nexpr -> visitor#none_expr nexpr
| FunCall fun_call -> visitor#fun_call fun_call
| ConstrApp capp -> visitor#constr_app capp
| SomeApp sapp -> visitor#some_app sapp
| MapLookUp lookup -> visitor#map_lookup lookup
| ParExpr pexpr -> visitor#par_expr pexpr
and print_tuple (visitor : xyz) {value=node; _} =
let lpar, sequence, rpar = node in
visitor#token lpar "(";
visitor#nsepseq "," visitor#expr sequence;
visitor#token rpar ")"
and print_list (visitor : xyz) {value=node; _} =
let lbra, sequence, rbra = node in
visitor#token lbra "[";
visitor#nsepseq "," visitor#expr sequence;
visitor#token rbra "]"
and print_empty_list (visitor : xyz) {value=node; _} =
let lpar, (lbracket, rbracket, colon, type_expr), rpar = node in
visitor#token lpar "(";
visitor#token lbracket "[";
visitor#token rbracket "]";
visitor#token colon ":";
visitor#type_expr type_expr;
visitor#token rpar ")"
and print_set (visitor : xyz) {value=node; _} =
let lbrace, sequence, rbrace = node in
visitor#token lbrace "{";
visitor#nsepseq "," visitor#expr sequence;
visitor#token rbrace "}"
and print_empty_set (visitor : xyz) {value=node; _} =
let lpar, (lbrace, rbrace, colon, type_expr), rpar = node in
visitor#token lpar "(";
visitor#token lbrace "{";
visitor#token rbrace "}";
visitor#token colon ":";
visitor#type_expr type_expr;
visitor#token rpar ")"
and print_none_expr (visitor : xyz) {value=node; _} =
let lpar, (c_None, colon, type_expr), rpar = node in
visitor#token lpar "(";
visitor#token c_None "None";
visitor#token colon ":";
visitor#type_expr type_expr;
visitor#token rpar ")"
and print_fun_call (visitor : xyz) {value=node; _} =
let fun_name, arguments = node in
visitor#var fun_name;
visitor#tuple arguments
and print_constr_app (visitor : xyz) {value=node; _} =
let constr, arguments = node in
visitor#constr constr;
visitor#tuple arguments
and print_some_app (visitor : xyz) {value=node; _} =
let c_Some, arguments = node in
visitor#token c_Some "Some";
visitor#tuple arguments
and print_map_lookup (visitor : xyz) {value=node; _} =
let {value = lbracket, expr, rbracket; _} = node#index in
visitor#var node#map_name;
visitor#token node#selector ".";
visitor#token lbracket "[";
visitor#expr expr;
visitor#token rbracket "]"
and print_par_expr (visitor : xyz) {value=node; _} =
let lpar, expr, rpar = node in
visitor#token lpar "(";
visitor#expr expr;
visitor#token rpar ")"
and print_pattern (visitor : xyz) {value=sequence; _} =
visitor#nsepseq "<:" visitor#core_pattern sequence
and print_core_pattern (visitor : xyz) = function
PVar var -> visitor#var var
| PWild wild -> visitor#token wild "_"
| PInt i -> visitor#int i
| PBytes b -> visitor#bytes b
| PString s -> visitor#string s
| PUnit region -> visitor#token region "Unit"
| PFalse region -> visitor#token region "False"
| PTrue region -> visitor#token region "True"
| PNone region -> visitor#token region "None"
| PSome psome -> visitor#psome psome
| PList pattern -> visitor#list_pattern pattern
| PTuple ptuple -> visitor#ptuple ptuple
and print_psome (visitor : xyz) {value=node; _} =
let c_Some, patterns = node in
visitor#token c_Some "Some";
visitor#patterns patterns
and print_patterns (visitor : xyz) {value=node; _} =
let lpar, core_pattern, rpar = node in
visitor#token lpar "(";
visitor#core_pattern core_pattern;
visitor#token rpar ")"
and print_list_pattern (visitor : xyz) = function
Sugar sugar -> visitor#sugar sugar
| Raw raw -> visitor#raw raw
and print_sugar (visitor : xyz) {value=node; _} =
let lbracket, sequence, rbracket = node in
visitor#token lbracket "[";
visitor#sepseq "," visitor#core_pattern sequence;
visitor#token rbracket "]"
and print_raw (visitor : xyz) {value=node; _} =
let lpar, (core_pattern, cons, pattern), rpar = node in
visitor#token lpar "(";
visitor#core_pattern core_pattern;
visitor#token cons "<:";
visitor#pattern pattern;
visitor#token rpar ")"
and print_ptuple (visitor : xyz) {value=node; _} =
let lpar, sequence, rpar = node in
visitor#token lpar "(";
visitor#nsepseq "," visitor#core_pattern sequence;
visitor#token rpar ")"
let rec visitor : unit -> xyz = fun () -> object
method nsepseq : 'a . string -> ('a -> unit) -> ('a * (Region.t * 'a) list) -> unit = print_nsepseq
method sepseq : 'a . string -> ('a -> unit) -> ('a * (Region.t * 'a) list) option -> unit = print_sepseq
method token = print_token (visitor ())
method var = print_var (visitor ())
method constr = print_constr (visitor ())
method string = print_string (visitor ())
method bytes = print_bytes (visitor ())
method int = print_int (visitor ())
method parameter_decl = print_parameter_decl (visitor ())
method storage_decl = print_storage_decl (visitor ())
method operations_decl = print_operations_decl (visitor ())
method type_decl = print_type_decl (visitor ())
method type_expr = print_type_expr (visitor ())
method cartesian = print_cartesian (visitor ())
method variant = print_variant (visitor ())
method sum_type = print_sum_type (visitor ())
method record_type = print_record_type (visitor ())
method type_app = print_type_app (visitor ())
method par_type = print_par_type (visitor ())
method field_decls = print_field_decls (visitor ())
method field_decl = print_field_decl (visitor ())
method type_tuple = print_type_tuple (visitor ())
method lambda_decl = print_lambda_decl (visitor ())
method fun_decl = print_fun_decl (visitor ())
method proc_decl = print_proc_decl (visitor ())
method parameters = print_parameters (visitor ())
method param_decl = print_param_decl (visitor ())
method var_kind = print_var_kind (visitor ())
method block = print_block (visitor ())
method value_decls = print_value_decls (visitor ())
method var_decl = print_var_decl (visitor ())
method instructions = print_instructions (visitor ())
method instruction = print_instruction (visitor ())
method single_instr = print_single_instr (visitor ())
method conditional = print_conditional (visitor ())
method match_instr = print_match_instr (visitor ())
method cases = print_cases (visitor ())
method case = print_case (visitor ())
method asgnmnt_instr = print_asgnmnt_instr (visitor ())
method loop = print_loop (visitor ())
method while_loop = print_while_loop (visitor ())
method for_loop = print_for_loop (visitor ())
method for_int = print_for_int (visitor ())
method down = print_down (visitor ())
method step = print_step (visitor ())
method for_collect = print_for_collect (visitor ())
method bind_to = print_bind_to (visitor ())
method expr = print_expr (visitor ())
method tuple = print_tuple (visitor ())
method list = print_list (visitor ())
method empty_list = print_empty_list (visitor ())
method set = print_set (visitor ())
method empty_set = print_empty_set (visitor ())
method none_expr = print_none_expr (visitor ())
method fun_call = print_fun_call (visitor ())
method constr_app = print_constr_app (visitor ())
method some_app = print_some_app (visitor ())
method map_lookup = print_map_lookup (visitor ())
method par_expr = print_par_expr (visitor ())
method pattern = print_pattern (visitor ())
method core_pattern = print_core_pattern (visitor ())
method psome = print_psome (visitor ())
method patterns = print_patterns (visitor ())
method list_pattern = print_list_pattern (visitor ())
method sugar = print_sugar (visitor ())
method raw = print_raw (visitor ())
method ptuple = print_ptuple (visitor ())
end
let print_tokens = print_tokens (visitor ())
Reference in New Issue View Git Blame Copy Permalink