(* Abstract Syntax Tree (AST) for Ligo *)

(* To disable warning about multiply-defined record labels. *)

[@@@warning "-30-42"]

(* Utilities *)

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_fail       = 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 ass      = 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 reg list;
  constants  : const_decl reg list;
  parameter  : parameter_decl reg;
  storage    : storage_decl reg;
  operations : operations_decl reg;
  lambdas    : lambda_decl list;
  block      : block reg;
  eof        : eof
}

and ast = t

and parameter_decl = {
  kwd_parameter : kwd_parameter;
  name          : variable;
  colon         : colon;
  param_type    : type_expr;
  terminator    : semi option
}

and storage_decl = {
  kwd_storage : kwd_storage;
  store_type  : type_expr;
  terminator  : semi option
}

and operations_decl = {
  kwd_operations : kwd_operations;
  op_type        : type_expr;
  terminator     : semi option
}

(* Type declarations *)

and type_decl = {
  kwd_type   : kwd_type;
  name       : type_name;
  kwd_is     : kwd_is;
  type_expr  : type_expr;
  terminator : semi option
}

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;
  name         : variable;
  param        : parameters;
  colon        : colon;
  ret_type     : type_expr;
  kwd_is       : kwd_is;
  local_decls  : local_decl list;
  block        : block reg;
  kwd_with     : kwd_with;
  return       : expr;
  terminator   : semi option
}

and proc_decl = {
  kwd_procedure : kwd_procedure;
  name          : variable;
  param         : parameters;
  kwd_is        : kwd_is;
  local_decls   : local_decl list;
  block         : block reg;
  terminator    : semi option
}

and parameters = (param_decl, semi) nsepseq par

and param_decl =
  ParamConst of param_const
| ParamVar   of param_var

and param_const = (kwd_const * variable * colon * type_expr) reg

and param_var = (kwd_var * variable * colon * type_expr) reg

and block = {
  opening    : kwd_begin;
  instr      : instructions;
  terminator : semi option;
  close      : kwd_end
}

and local_decl =
  LocalLam   of lambda_decl
| LocalConst of const_decl reg
| LocalVar   of var_decl reg

and const_decl = {
  kwd_const  : kwd_const;
  name       : variable;
  colon      : colon;
  vtype      : type_expr;
  equal      : equal;
  init       : expr;
  terminator : semi option
}

and var_decl = {
  kwd_var    : kwd_var;
  name       : variable;
  colon      : colon;
  vtype      : type_expr;
  ass        : ass;
  init       : expr;
  terminator : semi option
}

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
| Ass      of ass_instr
| Loop     of loop
| ProcCall of fun_call
| Null     of kwd_null
| Fail     of (kwd_fail * expr) reg

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;
  lead_vbar : vbar option;
  cases     : cases;
  kwd_end   : kwd_end
}

and cases = (case, vbar) nsepseq reg

and case = (pattern * arrow * instruction) reg

and ass_instr = (variable * ass * 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;
  ass     : ass_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 instr_to_region = function
  Single Cond                {region;_}
| Single Match               {region; _}
| Single Ass                 {region; _}
| Single Loop While          {region; _}
| Single Loop For ForInt     {region; _}
| Single Loop For ForCollect {region; _}
| Single ProcCall            {region; _}
| Single Null                 region
| Single Fail                {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

let local_decl_to_region = function
  LocalLam FunDecl  {region; _}
| LocalLam ProcDecl {region; _}
| LocalConst        {region; _}
| LocalVar          {region; _} -> region

(* Printing the tokens with their source regions *)

let printf = Printf.printf

let compact (region: Region.t) =
  region#compact ~offsets:EvalOpt.offsets EvalOpt.mode

let print_nsepseq :
  string -> ('a -> unit) -> ('a, Region.t) nsepseq -> 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

let print_sepseq :
  string -> ('a -> unit) -> ('a, Region.t) sepseq -> unit =
  fun sep visit -> function
        None -> ()
  | Some seq -> print_nsepseq sep visit seq

let print_token region lexeme =
  printf "%s: %s\n"(compact region) lexeme

let print_var {region; value=lexeme} =
  printf "%s: Ident \"%s\"\n" (compact region) lexeme

let print_constr {region; value=lexeme} =
  printf "%s: Constr \"%s\"\n"
         (compact region) lexeme

let print_string {region; value=lexeme} =
  printf "%s: String \"%s\"\n"
         (compact region) lexeme

let print_bytes {region; value = lexeme, abstract} =
  printf "%s: Bytes (\"%s\", \"0x%s\")\n"
         (compact region) lexeme
         (MBytes.to_hex abstract |> Hex.to_string)

let print_int {region; value = lexeme, abstract} =
  printf "%s: Int (\"%s\", %s)\n"
         (compact region) lexeme
         (Z.to_string abstract)

(* Main printing function *)

let rec print_tokens ast =
  List.iter print_type_decl   ast.types;
  print_parameter_decl        ast.parameter; (* TODO: Constants *)
  print_storage_decl          ast.storage;
  print_operations_decl       ast.operations;
  List.iter print_lambda_decl ast.lambdas;
  print_block                 ast.block;
  print_token                 ast.eof "EOF"

and print_parameter_decl {value=node; _} =
  print_token      node.kwd_parameter "parameter";
  print_var        node.name;
  print_token      node.colon ":";
  print_type_expr  node.param_type;
  print_terminator node.terminator

and print_storage_decl {value=node; _} =
  print_token      node.kwd_storage "storage";
  print_type_expr  node.store_type;
  print_terminator node.terminator

and print_operations_decl {value=node; _} =
  print_token      node.kwd_operations "operations";
  print_type_expr  node.op_type;
  print_terminator node.terminator

and print_type_decl {value=node; _} =
  print_token      node.kwd_type "type";
  print_var        node.name;
  print_token      node.kwd_is "is";
  print_type_expr  node.type_expr;
  print_terminator node.terminator

and print_type_expr = function
  Prod    cartesian   -> print_cartesian   cartesian
| Sum     sum_type    -> print_sum_type    sum_type
| Record  record_type -> print_record_type record_type
| TypeApp type_app    -> print_type_app    type_app
| ParType par_type    -> print_par_type    par_type
| TAlias  type_alias  -> print_var         type_alias

and print_cartesian {value=sequence; _} =
  print_nsepseq "*" print_type_expr sequence

and print_variant {value=node; _} =
  let constr, kwd_of, cartesian = node in
  print_constr    constr;
  print_token     kwd_of "of";
  print_cartesian cartesian

and print_sum_type {value=sequence; _} =
  print_nsepseq "|" print_variant sequence

and print_record_type {value=node; _} =
  let kwd_record, field_decls, kwd_end = node in
  print_token       kwd_record "record";
  print_field_decls field_decls;
  print_token       kwd_end "end"

and print_type_app {value=node; _} =
  let type_name, type_tuple = node in
  print_var        type_name;
  print_type_tuple type_tuple

and print_par_type {value=node; _} =
  let lpar, type_expr, rpar = node in
  print_token     lpar "(";
  print_type_expr type_expr;
  print_token     rpar ")"

and print_field_decls sequence =
  print_nsepseq ";" print_field_decl sequence

and print_field_decl {value=node; _} =
  let var, colon, type_expr = node in
  print_var       var;
  print_token     colon ":";
  print_type_expr type_expr

and print_type_tuple {value=node; _} =
  let lpar, sequence, rpar = node in
  print_token lpar "(";
  print_nsepseq "," print_var sequence;
  print_token rpar ")"

and print_lambda_decl = function
  FunDecl   fun_decl -> print_fun_decl fun_decl
| ProcDecl proc_decl -> print_proc_decl proc_decl

and print_fun_decl {value=node; _} =
  print_token       node.kwd_function "function";
  print_var         node.name;
  print_parameters  node.param;
  print_token       node.colon ":";
  print_type_expr   node.ret_type;
  print_token       node.kwd_is "is";
  print_local_decls node.local_decls;
  print_block       node.block;
  print_token       node.kwd_with "with";
  print_expr        node.return;
  print_terminator  node.terminator

and print_proc_decl {value=node; _} =
  print_token       node.kwd_procedure "procedure";
  print_var         node.name;
  print_parameters  node.param;
  print_token       node.kwd_is "is";
  print_local_decls node.local_decls;
  print_block       node.block;
  print_terminator  node.terminator

and print_parameters {value=node; _} =
  let lpar, sequence, rpar = node in
  print_token lpar "(";
  print_nsepseq ";" print_param_decl sequence;
  print_token rpar ")"

and print_param_decl = function
  ParamConst param_const -> print_param_const param_const
| ParamVar   param_var   -> print_param_var   param_var

and print_param_const {value=node; _} =
  let kwd_const, variable, colon, type_expr = node in
  print_token     kwd_const "const";
  print_var       variable;
  print_token     colon ":";
  print_type_expr type_expr

and print_param_var {value=node; _} =
  let kwd_var, variable, colon, type_expr = node in
  print_token     kwd_var "var";
  print_var       variable;
  print_token     colon ":";
  print_type_expr type_expr

and print_block {value=node; _} =
  print_token        node.opening "begin";
  print_instructions node.instr;
  print_terminator   node.terminator;
  print_token        node.close "end"

and print_local_decls sequence =
  List.iter print_local_decl sequence

and print_local_decl = function
  LocalLam   decl -> print_lambda_decl decl
| LocalConst decl -> print_const_decl  decl
| LocalVar   decl -> print_var_decl    decl

and print_const_decl {value=node; _} =
  print_token      node.kwd_const "const";
  print_var        node.name;
  print_token      node.colon ":";
  print_type_expr  node.vtype;
  print_token      node.equal "=";
  print_expr       node.init;
  print_terminator node.terminator

and print_var_decl {value=node; _} =
  print_token      node.kwd_var "var";
  print_var        node.name;
  print_token      node.colon ":";
  print_type_expr  node.vtype;
  print_token      node.ass ":=";
  print_expr       node.init;
  print_terminator node.terminator

and print_instructions {value=sequence; _} =
  print_nsepseq ";" print_instruction sequence

and print_instruction = function
  Single instr -> print_single_instr instr
|  Block block -> print_block block

and print_single_instr = function
  Cond     {value; _} -> print_conditional value
| Match    {value; _} -> print_match_instr value
| Ass      instr      -> print_ass_instr instr
| Loop     loop       -> print_loop loop
| ProcCall fun_call   -> print_fun_call fun_call
| Null     kwd_null   -> print_token kwd_null "null"
| Fail     {value; _} -> print_fail value

and print_fail (kwd_fail, expr) =
  print_token kwd_fail "fail";
  print_expr expr

and print_conditional node =
  print_token       node.kwd_if "if";
  print_expr        node.test;
  print_token       node.kwd_then "then";
  print_instruction node.ifso;
  print_token       node.kwd_else "else";
  print_instruction node.ifnot

and print_match_instr node =
  print_token node.kwd_match "match";
  print_expr  node.expr;
  print_token node.kwd_with "with";
  print_cases node.cases;
  print_token node.kwd_end "end"

and print_cases {value=sequence; _} =
  print_nsepseq "|" print_case sequence

and print_case {value=node; _} =
  let pattern, arrow, instruction = node in
  print_pattern pattern;
  print_token arrow "->";
  print_instruction instruction

and print_ass_instr {value=node; _} =
  let variable, ass, expr = node in
  print_var variable;
  print_token ass ":=";
  print_expr expr

and print_loop = function
  While while_loop -> print_while_loop while_loop
| For     for_loop -> print_for_loop for_loop

and print_while_loop {value=node; _} =
  let kwd_while, expr, block = node in
  print_token kwd_while "while";
  print_expr expr;
  print_block block

and print_for_loop = function
  ForInt     for_int     -> print_for_int for_int
| ForCollect for_collect -> print_for_collect for_collect

and print_for_int ({value=node; _} : for_int reg) =
  print_token     node.kwd_for "for";
  print_ass_instr node.ass;
  print_down      node.down;
  print_token     node.kwd_to "to";
  print_expr      node.bound;
  print_step      node.step;
  print_block     node.block

and print_down = function
  Some kwd_down -> print_token kwd_down "down"
| None -> ()

and print_step = function
  Some (kwd_step, expr) ->
    print_token kwd_step "step";
    print_expr expr
| None -> ()

and print_for_collect ({value=node; _} : for_collect reg) =
  print_token   node.kwd_for "for";
  print_var     node.var;
  print_bind_to node.bind_to;
  print_token   node.kwd_in "in";
  print_expr    node.expr;
  print_block   node.block

and print_bind_to = function
  Some (arrow, variable) ->
    print_token arrow "->";
    print_var   variable
| None -> ()

and print_expr = function
  Or {value = expr1, bool_or, expr2; _} ->
    print_expr expr1; print_token bool_or "||"; print_expr expr2
| And {value = expr1, bool_and, expr2; _} ->
    print_expr expr1; print_token bool_and "&&"; print_expr expr2
| Lt {value = expr1, lt, expr2; _} ->
    print_expr expr1; print_token lt "<"; print_expr expr2
| Leq {value = expr1, leq, expr2; _} ->
    print_expr expr1; print_token leq "<="; print_expr expr2
| Gt {value = expr1, gt, expr2; _} ->
    print_expr expr1; print_token gt ">"; print_expr expr2
| Geq {value = expr1, geq, expr2; _} ->
    print_expr expr1; print_token geq ">="; print_expr expr2
| Equal {value = expr1, equal, expr2; _} ->
    print_expr expr1; print_token equal "="; print_expr expr2
| Neq {value = expr1, neq, expr2; _} ->
    print_expr expr1; print_token neq "=/="; print_expr expr2
| Cat {value = expr1, cat, expr2; _} ->
    print_expr expr1; print_token cat "^"; print_expr expr2
| Cons {value = expr1, cons, expr2; _} ->
    print_expr expr1; print_token cons "<:"; print_expr expr2
| Add {value = expr1, add, expr2; _} ->
    print_expr expr1; print_token add "+"; print_expr expr2
| Sub {value = expr1, sub, expr2; _} ->
    print_expr expr1; print_token sub "-"; print_expr expr2
| Mult {value = expr1, mult, expr2; _} ->
    print_expr expr1; print_token mult "*"; print_expr expr2
| Div {value = expr1, div, expr2; _} ->
    print_expr expr1; print_token div "/"; print_expr expr2
| Mod {value = expr1, kwd_mod, expr2; _} ->
    print_expr expr1; print_token kwd_mod "mod"; print_expr expr2
| Neg {value = minus, expr; _} ->
    print_token minus "-"; print_expr expr
| Not {value = kwd_not, expr; _} ->
    print_token kwd_not "not"; print_expr expr
| Int i            -> print_int i
| Var var          -> print_var var
| String s         -> print_string s
| Bytes b          -> print_bytes b
| False region     -> print_token region "False"
| True region      -> print_token region "True"
| Unit region      -> print_token region "Unit"
| Tuple tuple      -> print_tuple tuple
| List list        -> print_list list
| EmptyList elist  -> print_empty_list elist
| Set set          -> print_set set
| EmptySet eset    -> print_empty_set eset
| NoneExpr nexpr   -> print_none_expr nexpr
| FunCall fun_call -> print_fun_call fun_call
| ConstrApp capp   -> print_constr_app capp
| SomeApp sapp     -> print_some_app sapp
| MapLookUp lookup -> print_map_lookup lookup
| ParExpr pexpr    -> print_par_expr pexpr

and print_tuple {value=node; _} =
  let lpar, sequence, rpar = node in
  print_token lpar "(";
  print_nsepseq "," print_expr sequence;
  print_token rpar ")"

and print_list {value=node; _} =
  let lbra, sequence, rbra = node in
  print_token lbra "[";
  print_nsepseq "," print_expr sequence;
  print_token rbra "]"

and print_empty_list {value=node; _} =
  let lpar, (lbracket, rbracket, colon, type_expr), rpar = node in
  print_token     lpar "(";
  print_token     lbracket "[";
  print_token     rbracket "]";
  print_token     colon ":";
  print_type_expr type_expr;
  print_token     rpar ")"

and print_set {value=node; _} =
  let lbrace, sequence, rbrace = node in
  print_token lbrace "{";
  print_nsepseq "," print_expr sequence;
  print_token rbrace "}"

and print_empty_set {value=node; _} =
  let lpar, (lbrace, rbrace, colon, type_expr), rpar = node in
  print_token     lpar "(";
  print_token     lbrace "{";
  print_token     rbrace "}";
  print_token     colon ":";
  print_type_expr type_expr;
  print_token     rpar ")"

and print_none_expr {value=node; _} =
  let lpar, (c_None, colon, type_expr), rpar = node in
  print_token     lpar "(";
  print_token     c_None "None";
  print_token     colon ":";
  print_type_expr type_expr;
  print_token     rpar ")"

and print_fun_call {value=node; _} =
  let fun_name, arguments = node in
  print_var   fun_name;
  print_tuple arguments

and print_constr_app {value=node; _} =
  let constr, arguments = node in
  print_constr constr;
  print_tuple  arguments

and print_some_app {value=node; _} =
  let c_Some, arguments = node in
  print_token c_Some "Some";
  print_tuple arguments

and print_map_lookup {value=node; _} =
  let {value = lbracket, expr, rbracket; _} = node.index in
  print_var   node.map_name;
  print_token node.selector ".";
  print_token lbracket "[";
  print_expr  expr;
  print_token rbracket "]"

and print_par_expr {value=node; _} =
  let lpar, expr, rpar = node in
  print_token lpar "(";
  print_expr  expr;
  print_token rpar ")"

and print_pattern {value=sequence; _} =
  print_nsepseq "<:" print_core_pattern sequence

and print_core_pattern = function
  PVar var      -> print_var var
| PWild wild    -> print_token wild "_"
| PInt i        -> print_int i
| PBytes b      -> print_bytes b
| PString s     -> print_string s
| PUnit region  -> print_token region "Unit"
| PFalse region -> print_token region "False"
| PTrue region  -> print_token region "True"
| PNone region  -> print_token region "None"
| PSome psome   -> print_psome psome
| PList pattern -> print_list_pattern pattern
| PTuple ptuple -> print_ptuple ptuple

and print_psome {value=node; _} =
  let c_Some, patterns = node in
  print_token    c_Some "Some";
  print_patterns patterns

and print_patterns {value=node; _} =
  let lpar, core_pattern, rpar = node in
  print_token lpar "(";
  print_core_pattern core_pattern;
  print_token rpar ")"

and print_list_pattern = function
  Sugar sugar -> print_sugar sugar
| Raw     raw -> print_raw raw

and print_sugar {value=node; _} =
  let lbracket, sequence, rbracket = node in
  print_token lbracket "[";
  print_sepseq "," print_core_pattern sequence;
  print_token rbracket "]"

and print_raw {value=node; _} =
  let lpar, (core_pattern, cons, pattern), rpar = node in
  print_token        lpar "(";
  print_core_pattern core_pattern;
  print_token        cons "<:";
  print_pattern      pattern;
  print_token        rpar ")"

and print_ptuple {value=node; _} =
  let lpar, sequence, rpar = node in
  print_token lpar "(";
  print_nsepseq "," print_core_pattern sequence;
  print_token rpar ")"

and print_terminator = function
  Some semi -> print_token semi ";"
| None -> ()