ligo/AST.ml

(* 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 ())