[@@@warning "-42"]
[@@@coverage exclude_file]

open AST

module Region = Simple_utils.Region
open! Region

let sprintf = Printf.sprintf

type state = <
  offsets  : bool;
  mode     : [`Point | `Byte];
  buffer   : Buffer.t;
  pad_path : string;
  pad_node : string;
  pad      : int -> int -> state
>

let mk_state ~offsets ~mode ~buffer =
  object
    method offsets  = offsets;
    method mode     = mode;
    method buffer   = buffer
    val pad_path    = ""
    method pad_path = pad_path
    val pad_node    = ""
    method pad_node = pad_node

    (** The method [pad] updates the current padding, which is
        comprised of two components: the padding to reach the new node
        (space before reaching a subtree, then a vertical bar for it)
        and the padding for the new node itself (Is it the last child
        of its parent?).
     *)
    method pad arity rank =
      {< pad_path =
           pad_node ^ (if rank = arity-1 then "`-- " else "|-- ");
         pad_node =
           pad_node ^ (if rank = arity-1 then "    " else "|   ")
      >}
  end

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

(** {1 Printing the tokens with their source regions} *)

let print_nsepseq :
  state -> string -> (state -> 'a -> unit) ->
  ('a, Region.t) Utils.nsepseq -> unit =
  fun state sep print (head, tail) ->
    let print_aux (sep_reg, item) =
      let sep_line =
        sprintf "%s: %s\n" (compact state sep_reg) sep in
      Buffer.add_string state#buffer sep_line;
      print state item
    in print state head; List.iter print_aux tail

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

let print_token state region lexeme =
  let line =
    sprintf "%s: %s\n"(compact state region) lexeme
  in Buffer.add_string state#buffer line

let print_var state {region; value} =
  let line =
    sprintf "%s: Ident \"%s\"\n"
            (compact state region) value
  in Buffer.add_string state#buffer line

let print_constr state {region; value} =
  let line =
    sprintf "%s: Constr \"%s\"\n"
            (compact state region) value
  in Buffer.add_string state#buffer line

let print_string state {region; value} =
  let line =
    sprintf "%s: String %s\n"
            (compact state region) value
  in Buffer.add_string state#buffer line

let print_bytes state {region; value} =
  let lexeme, abstract = value in
  let line =
    sprintf "%s: Bytes (\"%s\", \"0x%s\")\n"
            (compact state region) lexeme
            (Hex.show abstract)
  in Buffer.add_string state#buffer line

let print_int state {region; value} =
  let lexeme, abstract = value in
  let line =
    sprintf "%s: Int (\"%s\", %s)\n"
            (compact state region) lexeme
            (Z.to_string abstract)
  in Buffer.add_string state#buffer line

let print_nat state {region; value} =
  let lexeme, abstract = value in
  let line =
    sprintf "%s: Nat (\"%s\", %s)\n"
            (compact state region) lexeme
            (Z.to_string abstract)
  in Buffer.add_string state#buffer line

let rec print_tokens state ast =
  let {decl; eof} = ast in
  Utils.nseq_iter (print_decl state) decl;
  print_token state eof "EOF"

and print_attr_decl state =
  print_ne_injection state "attributes" print_string

and print_decl state = function
  TypeDecl  decl -> print_type_decl  state decl
| ConstDecl decl -> print_const_decl state decl
| FunDecl   decl -> print_fun_decl   state decl
| AttrDecl  decl -> print_attr_decl  state decl

and print_const_decl state {value; _} =
  let {kwd_const; name; colon; const_type;
       equal; init; terminator; _} = value in
  print_token      state kwd_const "const";
  print_var        state name;
  print_token      state colon ":";
  print_type_expr  state const_type;
  print_token      state equal "=";
  print_expr       state init;
  print_terminator state terminator

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

and print_type_expr state = function
  TProd   cartesian   -> print_cartesian   state cartesian
| TSum    sum_type    -> print_sum_type    state sum_type
| TRecord record_type -> print_record_type state record_type
| TApp    type_app    -> print_type_app    state type_app
| TFun    type_fun    -> print_type_fun    state type_fun
| TPar    par_type    -> print_par_type    state par_type
| TVar    type_var    -> print_var         state type_var
| TStringLiteral s -> print_string state s

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

and print_variant state ({value; _}: variant reg) =
  let {constr; arg} = value in
  print_constr state constr;
  match arg with
    None -> ()
  | Some (kwd_of, t_expr) ->
      print_token     state kwd_of "of";
      print_type_expr state t_expr

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

and print_record_type state record_type =
  print_ne_injection state "record" print_field_decl record_type

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

and print_type_fun state {value; _} =
  let type_expr_a, arrow, type_expr_b = value in
  print_type_expr  state type_expr_a;
  print_token      state arrow "->";
  print_type_expr  state type_expr_b

and print_par_type state {value; _} =
  let {lpar; inside; rpar} = value in
  print_token     state lpar "(";
  print_type_expr state inside;
  print_token     state rpar ")"

and print_field_decl state {value; _} =
  let {field_name; colon; field_type} = value in
  print_var       state field_name;
  print_token     state colon ":";
  print_type_expr state field_type

and print_type_tuple state {value; _} =
  let {lpar; inside; rpar} = value in
  print_token state lpar "(";
  print_nsepseq state "," print_type_expr inside;
  print_token state rpar ")"

and print_fun_decl state {value; _} =
  let {kwd_function; fun_name; param; colon;
       ret_type; kwd_is; block_with;
       return; terminator; _} = value in
  print_token       state kwd_function "function";
  print_var         state fun_name;
  print_parameters  state param;
  print_token       state colon ":";
  print_type_expr   state ret_type;
  print_token       state kwd_is "is";
  (match block_with with
    None -> ()
  | Some (block, kwd_with) ->
     print_block state block;
     print_token state kwd_with "with");
  print_expr state return;
  print_terminator state terminator;

and print_fun_expr state {value; _} =
  let {kwd_recursive; kwd_function; param; colon;
       ret_type; kwd_is; return} : fun_expr = value in
  print_token_opt   state kwd_recursive "recursive";
  print_token       state kwd_function "function";
  print_parameters  state param;
  print_token       state colon ":";
  print_type_expr   state ret_type;
  print_token       state kwd_is "is";
  print_expr        state return

and print_parameters state {value; _} =
  let {lpar; inside; rpar} = value in
  print_token state lpar "(";
  print_nsepseq state ";" print_param_decl inside;
  print_token state rpar ")"

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

and print_param_const state {value; _} =
  let {kwd_const; var; colon; param_type} = value in
  print_token     state kwd_const "const";
  print_var       state var;
  print_token     state colon ":";
  print_type_expr state param_type

and print_param_var state {value; _} =
  let {kwd_var; var; colon; param_type} = value in
  print_token     state kwd_var "var";
  print_var       state var;
  print_token     state colon ":";
  print_type_expr state param_type

and print_block state block =
  let {opening; statements; terminator; closing} = block.value in
  print_block_opening state opening;
  print_statements    state statements;
  print_terminator    state terminator;
  print_block_closing state closing

and print_block_opening state = function
  Block (kwd_block, lbrace) ->
    print_token state kwd_block "block";
    print_token state lbrace    "{"
| Begin kwd_begin ->
    print_token state kwd_begin "begin"

and print_block_closing state = function
  Block rbrace -> print_token state rbrace  "}"
| End kwd_end  -> print_token state kwd_end "end"

and print_data_decl state = function
  LocalConst decl -> print_const_decl state decl
| LocalVar   decl -> print_var_decl   state decl
| LocalFun  decl -> print_fun_decl  state decl

and print_var_decl state {value; _} =
  let {kwd_var; name; colon; var_type;
       assign; init; terminator} = value in
  print_token      state kwd_var "var";
  print_var        state name;
  print_token      state colon ":";
  print_type_expr  state var_type;
  print_token      state assign ":=";
  print_expr       state init;
  print_terminator state terminator

and print_statements state sequence =
  print_nsepseq state ";" print_statement sequence

and print_statement state = function
  Instr instr -> print_instruction state instr
| Data  data  -> print_data_decl   state data
| Attr  attr  -> print_attr_decl   state attr

and print_instruction state = function
  Cond        {value; _} -> print_conditional state value
| CaseInstr   {value; _} -> print_case_instr state value
| Assign      assign     -> print_assignment state assign
| Loop        loop       -> print_loop state loop
| ProcCall    fun_call   -> print_fun_call state fun_call
| Skip        kwd_skip   -> print_token state kwd_skip "skip"
| RecordPatch {value; _} -> print_record_patch state value
| MapPatch    {value; _} -> print_map_patch state value
| SetPatch    {value; _} -> print_set_patch state value
| MapRemove   {value; _} -> print_map_remove state value
| SetRemove   {value; _} -> print_set_remove state value

and print_cond_expr state (node: cond_expr) =
  print_token      state node.kwd_if "if";
  print_expr       state node.test;
  print_token      state node.kwd_then "then";
  print_expr       state node.ifso;
  print_terminator state node.terminator;
  print_token      state node.kwd_else "else";
  print_expr       state node.ifnot

and print_conditional state (node: conditional) =
  print_token      state node.kwd_if "if";
  print_expr       state node.test;
  print_token      state node.kwd_then "then";
  print_if_clause  state node.ifso;
  print_terminator state node.terminator;
  print_token      state node.kwd_else "else";
  print_if_clause  state node.ifnot

and print_if_clause state = function
  ClauseInstr instr -> print_instruction state instr
| ClauseBlock block -> print_clause_block state block

and print_clause_block state = function
  LongBlock block ->
    print_block state block
| ShortBlock {value; _} ->
    let {lbrace; inside; rbrace} = value in
    let statements, terminator = inside in
    print_token      state lbrace "{";
    print_statements state statements;
    print_terminator state terminator;
    print_token      state rbrace "}"

and print_case_instr state (node : if_clause case) =
  let {kwd_case; expr; opening;
       lead_vbar; cases; closing} = node in
  print_token       state kwd_case "case";
  print_expr        state expr;
  print_opening     state "of" opening;
  print_token_opt   state lead_vbar "|";
  print_cases_instr state cases;
  print_closing     state closing

and print_token_opt state = function
         None -> fun _ -> ()
| Some region -> print_token state region

and print_cases_instr state {value; _} =
  print_nsepseq state "|" print_case_clause_instr value

and print_case_clause_instr state {value; _} =
  let {pattern; arrow; rhs} = value in
  print_pattern   state pattern;
  print_token     state arrow "->";
  print_if_clause state rhs

and print_assignment state {value; _} =
  let {lhs; assign; rhs} = value in
  print_lhs   state lhs;
  print_token state assign ":=";
  print_rhs   state rhs

and print_rhs state e = print_expr state e

and print_lhs state = function
  Path path          -> print_path state path
| MapPath {value; _} -> print_map_lookup state value

and print_loop state = function
  While {value; _} -> print_while_loop state value
| For     for_loop -> print_for_loop   state for_loop

and print_while_loop state value =
  let {kwd_while; cond; block} = value in
  print_token state kwd_while "while";
  print_expr  state cond;
  print_block state block

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

and print_for_int state ({value; _} : for_int reg) =
  let {kwd_for; assign; kwd_to; bound; kwd_step; step; block} = value in
  print_token      state kwd_for "for";
  print_var_assign state assign;
  print_token      state kwd_to "to";
  print_expr       state bound;
  match kwd_step with 
  | None -> ();
  | Some kwd_step -> 
  print_token      state kwd_step "step";
  match step with
  | None -> ();
  | Some step ->
  print_expr       state step;
  print_block      state block

and print_var_assign state {value; _} =
  let {name; assign; expr} = value in
  print_var   state name;
  print_token state assign ":=";
  print_expr  state expr

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

and print_collection state = function
  Map kwd_map ->
    print_token state kwd_map "map"
| Set kwd_set ->
    print_token state kwd_set "set"
| List kwd_list ->
    print_token state kwd_list "list"

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

and print_expr state = function
  ECase   {value;_} -> print_case_expr state value
| ECond   {value;_} -> print_cond_expr state value
| EAnnot  {value;_} -> print_annot_expr state value
| ELogic  e -> print_logic_expr state e
| EArith  e -> print_arith_expr state e
| EString e -> print_string_expr state e
| EList   e -> print_list_expr state e
| ESet    e -> print_set_expr state e
| EConstr e -> print_constr_expr state e
| ERecord e -> print_record_expr state e
| EUpdate e -> print_update_expr state e
| EProj   e -> print_projection state e
| EMap    e -> print_map_expr state e
| EVar    v -> print_var state v
| ECall   e -> print_fun_call state e
| EBytes  b -> print_bytes state b
| EUnit   r -> print_token state r "Unit"
| ETuple  e -> print_tuple_expr state e
| EPar    e -> print_par_expr state e
| EFun    e -> print_fun_expr state e

and print_annot_expr state (expr , type_expr) =
  print_expr state expr;
  print_type_expr state type_expr

and print_case_expr state (node : expr case) =
  let {kwd_case; expr; opening;
       lead_vbar; cases; closing} = node in
  print_token      state kwd_case "case";
  print_expr       state expr;
  print_opening    state "of" opening;
  print_token_opt  state lead_vbar "|";
  print_cases_expr state cases;
  print_closing    state closing

and print_cases_expr state {value; _} =
  print_nsepseq state "|" print_case_clause_expr value

and print_case_clause_expr state {value; _} =
  let {pattern; arrow; rhs} = value in
  print_pattern state pattern;
  print_token   state arrow "->";
  print_expr    state rhs

and print_map_expr state = function
  MapLookUp {value; _} -> print_map_lookup state value
| MapInj inj           -> print_injection  state "map" print_binding inj
| BigMapInj inj        -> print_injection  state "big_map" print_binding inj

and print_set_expr state = function
  SetInj inj -> print_injection state "set" print_expr inj
| SetMem mem -> print_set_membership state mem

and print_set_membership state {value; _} =
  let {set; kwd_contains; element} = value in
  print_expr  state set;
  print_token state kwd_contains "contains";
  print_expr  state element

and print_map_lookup state {path; index} =
  let {lbracket; inside; rbracket} = index.value in
  print_path  state path;
  print_token state lbracket "[";
  print_expr  state inside;
  print_token state rbracket "]"

and print_path state = function
  Name var  -> print_var        state var
| Path path -> print_projection state path

and print_logic_expr state = function
  BoolExpr e -> print_bool_expr state e
| CompExpr e -> print_comp_expr state e

and print_bool_expr state = function
  Or {value = {arg1; op; arg2}; _} ->
    print_expr  state arg1;
    print_token state op "||";
    print_expr  state arg2
| And {value = {arg1; op; arg2}; _} ->
    print_expr  state arg1;
    print_token state op "&&";
    print_expr  state arg2
| Not {value = {op; arg}; _} ->
    print_token state op "not";
    print_expr  state arg
| False region ->
    print_token state region "False"
| True region ->
    print_token state region "True"

and print_comp_expr state = function
  Lt {value = {arg1; op; arg2}; _} ->
    print_expr  state arg1;
    print_token state op "<";
    print_expr  state arg2
| Leq {value = {arg1; op; arg2}; _} ->
    print_expr  state arg1;
    print_token state op "<=";
    print_expr  state arg2
| Gt {value = {arg1; op; arg2}; _} ->
    print_expr  state arg1;
    print_token state op ">";
    print_expr  state arg2
| Geq {value = {arg1; op; arg2}; _} ->
    print_expr  state arg1;
    print_token state op ">=";
    print_expr  state arg2
| Equal {value = {arg1; op; arg2}; _} ->
    print_expr  state arg1;
    print_token state op "=";
    print_expr  state arg2
| Neq {value = {arg1; op; arg2}; _} ->
    print_expr  state arg1;
    print_token state op "=/=";
    print_expr  state arg2

and print_arith_expr state = function
  Add {value = {arg1; op; arg2}; _} ->
    print_expr  state arg1;
    print_token state op "+";
    print_expr  state arg2
| Sub {value = {arg1; op; arg2}; _} ->
    print_expr  state arg1;
    print_token state op "-";
    print_expr  state arg2
| Mult {value = {arg1; op; arg2}; _} ->
    print_expr  state arg1;
    print_token state op "*";
    print_expr  state arg2
| Div {value = {arg1; op; arg2}; _} ->
    print_expr  state arg1;
    print_token state op "/";
    print_expr  state arg2
| Mod {value = {arg1; op; arg2}; _} ->
    print_expr  state arg1;
    print_token state op "mod";
    print_expr  state arg2
| Neg {value = {op; arg}; _} ->
    print_token state op "-";
    print_expr  state arg
| Int i
| Nat i
| Mutez i -> print_int state i

and print_string_expr state = function
  Cat {value = {arg1; op; arg2}; _} ->
    print_expr  state arg1;
    print_token state op "^";
    print_expr  state arg2
| String s ->
    print_string state s

and print_list_expr state = function
  ECons {value = {arg1; op; arg2}; _} ->
    print_expr  state arg1;
    print_token state op "#";
    print_expr  state arg2
| EListComp e -> print_injection state "list" print_expr e
| ENil e -> print_nil state e

and print_constr_expr state = function
  SomeApp e   -> print_some_app   state e
| NoneExpr e  -> print_none_expr  state e
| ConstrApp e -> print_constr_app state e

and print_record_expr state e =
  print_ne_injection state "record" print_field_assign e

and print_field_assign state {value; _} =
  let {field_name; equal; field_expr} = value in
  print_var   state field_name;
  print_token state equal "=";
  print_expr  state field_expr

and print_field_path_assign state {value; _} =
  let {field_path; equal; field_expr} = value in
  print_nsepseq state "field_path" print_var field_path;
  print_token state equal "=";
  print_expr  state field_expr

and print_update_expr state {value; _} =
  let {record; kwd_with; updates} = value in
  print_path state record;
  print_token state kwd_with "with";
  print_ne_injection state "updates field" print_field_path_assign updates


and print_projection state {value; _} =
  let {struct_name; selector; field_path} = value in
  print_var        state struct_name;
  print_token      state selector ".";
  print_field_path state field_path

and print_field_path state sequence =
  print_nsepseq state "." print_selection sequence

and print_selection state = function
  FieldName name -> print_var state name
| Component int  -> print_int state int

and print_record_patch state node =
  let {kwd_patch; path; kwd_with; record_inj} = node in
  print_token        state kwd_patch "patch";
  print_path         state path;
  print_token        state kwd_with "with";
  print_ne_injection state "record" print_field_assign record_inj

and print_set_patch state node =
  let {kwd_patch; path; kwd_with; set_inj} = node in
  print_token        state kwd_patch "patch";
  print_path         state path;
  print_token        state kwd_with "with";
  print_ne_injection state "set" print_expr set_inj

and print_map_patch state node =
  let {kwd_patch; path; kwd_with; map_inj} = node in
  print_token        state kwd_patch "patch";
  print_path         state path;
  print_token        state kwd_with "with";
  print_ne_injection state "map" print_binding map_inj

and print_map_remove state node =
  let {kwd_remove; key; kwd_from; kwd_map; map} = node in
  print_token state kwd_remove "remove";
  print_expr  state key;
  print_token state kwd_from "from";
  print_token state kwd_map "map";
  print_path  state map

and print_set_remove state node =
  let {kwd_remove; element; kwd_from; kwd_set; set} = node in
  print_token state kwd_remove "remove";
  print_expr  state element;
  print_token state kwd_from "from";
  print_token state kwd_set "set";
  print_path  state set

and print_injection :
  'a.state -> string -> (state -> 'a -> unit) ->
  'a injection reg -> unit =
  fun state kwd print {value; _} ->
    let {opening; elements; terminator; closing} = value in
    print_opening    state kwd opening;
    print_sepseq     state ";" print elements;
    print_terminator state terminator;
    print_closing    state closing

and print_ne_injection :
  'a.state -> string -> (state -> 'a -> unit) ->
  'a ne_injection reg -> unit =
  fun state kwd print {value; _} ->
    let {opening; ne_elements; terminator; closing} = value in
    print_opening    state kwd opening;
    print_nsepseq    state ";" print ne_elements;
    print_terminator state terminator;
    print_closing    state closing

and print_opening state lexeme = function
  Kwd kwd ->
    print_token state kwd lexeme
| KwdBracket (kwd, lbracket) ->
    print_token state kwd lexeme;
    print_token state lbracket "["

and print_closing state = function
  RBracket rbracket -> print_token state rbracket "]"
| End kwd_end       -> print_token state kwd_end "end"

and print_binding state {value; _} =
  let {source; arrow; image} = value in
  print_expr  state source;
  print_token state arrow "->";
  print_expr  state image

and print_tuple_expr state {value; _} =
  let {lpar; inside; rpar} = value in
  print_token   state lpar "(";
  print_nsepseq state "," print_expr inside;
  print_token   state rpar ")"

and print_nil state value = print_token state value "nil"

and print_none_expr state value = print_token state value "None"

and print_fun_call state {value; _} =
  let expr, arguments = value in
  print_expr       state expr;
  print_tuple_expr state arguments

and print_constr_app state {value; _} =
  let constr, arguments = value in
  print_constr state constr;
  match arguments with
    None -> ()
  | Some arg -> print_tuple_expr state arg

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

and print_par_expr state {value; _} =
  let {lpar; inside; rpar} = value in
  print_token state lpar "(";
  print_expr  state inside;
  print_token state rpar ")"

and print_pattern state = function
  PVar var         -> print_var state var
| PWild wild       -> print_token state wild "_"
| PInt i           -> print_int state i
| PNat n           -> print_nat state n
| PBytes b         -> print_bytes state b
| PString s        -> print_string state s
| PList pattern    -> print_list_pattern state pattern
| PTuple ptuple    -> print_ptuple state ptuple
| PConstr pattern  -> print_constr_pattern state pattern

and print_constr_pattern state = function
  PUnit region     -> print_token state region "Unit"
| PFalse region    -> print_token state region "False"
| PTrue region     -> print_token state region "True"
| PNone region     -> print_token state region "None"
| PSomeApp psome   -> print_psome state psome
| PConstrApp {value; _} ->
    let constr, arg = value in
    print_constr state constr;
    match arg with
      None -> ()
    | Some tuple -> print_ptuple state tuple

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

and print_patterns state {value; _} =
  let {lpar; inside; rpar} = value in
  print_token   state lpar "(";
  print_pattern state inside;
  print_token   state rpar ")"

and print_list_pattern state = function
  PListComp comp ->
   print_injection state "list" print_pattern comp
| PNil kwd_nil ->
    print_token state kwd_nil "nil"
| PParCons cons ->
    print_par_cons state cons
| PCons {value; _} ->
   print_nsepseq state "#" print_pattern value

and print_par_cons state {value; _} =
  let {lpar; inside; rpar} = value in
  let head, cons, tail = inside in
  print_token   state lpar "(";
  print_pattern state head;
  print_token   state cons "#";
  print_pattern state tail;
  print_token   state rpar ")"

and print_ptuple state {value; _} =
  let {lpar; inside; rpar} = value in
  print_token   state lpar "(";
  print_nsepseq state "," print_pattern inside;
  print_token   state rpar ")"

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

(* Conversion to string *)

let to_string ~offsets ~mode printer node =
  let buffer = Buffer.create 131 in
  let state = mk_state ~offsets ~mode ~buffer in
  let () = printer state node
  in Buffer.contents buffer

let tokens_to_string ~offsets ~mode =
  to_string ~offsets ~mode print_tokens
let path_to_string ~offsets ~mode =
  to_string ~offsets ~mode print_path
let pattern_to_string ~offsets ~mode =
  to_string ~offsets ~mode print_pattern
let instruction_to_string ~offsets ~mode =
  to_string ~offsets ~mode print_instruction

(** {1 Pretty-printing the AST} *)

let pp_ident state {value=name; region} =
  let reg  = compact state region in
  let node = sprintf "%s%s (%s)\n" state#pad_path name reg
  in Buffer.add_string state#buffer node

let pp_node state name =
  let node = sprintf "%s%s\n" state#pad_path name
  in Buffer.add_string state#buffer node

let pp_string state = pp_ident state

let pp_loc_node state name region =
  pp_ident state {value=name; region}

let rec pp_ast state {decl; _} =
  let apply len rank =
    pp_declaration (state#pad len rank) in
  let decls = Utils.nseq_to_list decl in
  pp_node state "<ast>";
  List.iteri (List.length decls |> apply) decls

and pp_declaration state = function
  TypeDecl {value; region} ->
    pp_loc_node state "TypeDecl" region;
    pp_ident (state#pad 2 0) value.name;
    pp_type_expr (state#pad 2 1) value.type_expr
| ConstDecl {value; region} ->
    pp_loc_node state "ConstDecl" region;
    pp_const_decl state value
| FunDecl {value; region} ->
    pp_loc_node state "FunDecl" region;
    pp_fun_decl state value
| AttrDecl {value; region} ->
    pp_loc_node state "AttrDecl" region;
    pp_attr_decl state value

and pp_attr_decl state = pp_ne_injection pp_string state

and pp_fun_decl state decl =
  let arity, start =
    match decl.kwd_recursive with
      None -> 5,0
    | Some _ ->
       let state = state#pad 6 0 in
       let () = pp_node state "recursive"
       in 6,1 in
  let () =
    let state = state#pad arity start in
    pp_ident state decl.fun_name in
  let () =
    let state = state#pad arity (start + 1) in
    pp_node state "<parameters>";
    pp_parameters state decl.param in
  let () =
    let state = state#pad arity (start + 2) in
    pp_node state "<return type>";
    pp_type_expr (state#pad 1 0) decl.ret_type in
  let () =
    let state = state#pad arity (start + 3) in
    pp_node state "<body>";
    let statements =
      match decl.block_with with
        Some (block,_) -> block.value.statements
      | None -> Instr (Skip Region.ghost), [] in
    pp_statements state statements in
  let () =
    let state = state#pad arity (start + 4) in
    pp_node state "<return>";
    pp_expr (state#pad 1 0) decl.return
  in ()

and pp_const_decl state decl =
  let arity = 3 in
  pp_ident (state#pad arity 0) decl.name;
  pp_type_expr (state#pad arity 1) decl.const_type;
  pp_expr (state#pad arity 2) decl.init

and pp_type_expr state = function
  TProd cartesian ->
    pp_loc_node state "TProd" cartesian.region;
    pp_cartesian state cartesian
| TVar v ->
    pp_node state "TVar";
    pp_ident (state#pad 1 0) v
| TPar {value; region} ->
    pp_loc_node state "TPar" region;
    pp_type_expr (state#pad 1 0) value.inside
| TApp {value=name,tuple; region} ->
    pp_loc_node state "TApp" region;
    pp_ident (state#pad 1 0) name;
    pp_type_tuple (state#pad 2 1) tuple
| TFun {value; region} ->
    pp_loc_node state "TFun" region;
    let apply len rank =
      pp_type_expr (state#pad len rank) in
    let domain, _, range = value in
    List.iteri (apply 2) [domain; range]
| TSum {value; region} ->
    pp_loc_node state "TSum" region;
    let apply len rank variant =
      pp_variant (state#pad len rank) variant.value in
    let variants = Utils.nsepseq_to_list value in
    List.iteri (List.length variants |> apply) variants
| TRecord {value; region} ->
    pp_loc_node state "TRecord" region;
    let apply len rank field_decl =
      pp_field_decl (state#pad len rank)
                    field_decl.value in
    let fields = Utils.nsepseq_to_list value.ne_elements in
    List.iteri (List.length fields |> apply) fields
| TStringLiteral s ->
  pp_node   state "String";
  pp_string (state#pad 1 0) s

and pp_cartesian state {value; _} =
  let apply len rank =
    pp_type_expr (state#pad len rank) in
  let components = Utils.nsepseq_to_list value
  in List.iteri (List.length components |> apply) components

and pp_variant state {constr; arg} =
  pp_ident state constr;
  match arg with
          None -> ()
  | Some (_,c) -> pp_type_expr (state#pad 1 0) c

and pp_field_decl state decl =
  pp_ident state decl.field_name;
  pp_type_expr (state#pad 1 0) decl.field_type

and pp_type_tuple state {value; _} =
  let components = Utils.nsepseq_to_list value.inside in
  let apply len rank = pp_type_expr (state#pad len rank)
  in List.iteri (List.length components |> apply) components

and pp_fun_expr state (expr: fun_expr) =
  let () =
    let state = state#pad 3 0 in
    pp_node state "<parameters>";
    pp_parameters state expr.param in
  let () =
    let state = state#pad 3 1 in
    pp_node state "<return type>";
    pp_type_expr (state#pad 1 0) expr.ret_type in
  let () =
    let state = state#pad 3 2 in
    pp_node state "<return>";
    pp_expr (state#pad 1 0) expr.return
  in ()

and pp_parameters state {value; _} =
  let params = Utils.nsepseq_to_list value.inside in
  let arity  = List.length params in
  let apply len rank = pp_param_decl (state#pad len rank)
  in List.iteri (apply arity) params

and pp_param_decl state = function
  ParamConst {value; region} ->
    pp_loc_node state "ParamConst" region;
    pp_ident (state#pad 2 0) value.var;
    pp_type_expr (state#pad 2 1) value.param_type
| ParamVar {value; region} ->
    pp_loc_node state "ParamVar" region;
    pp_ident (state#pad 2 0) value.var;
    pp_type_expr (state#pad 2 1) value.param_type

and pp_statements state statements =
  let statements = Utils.nsepseq_to_list statements in
  let length     = List.length statements in
  let apply len rank = pp_statement (state#pad len rank)
  in List.iteri (apply length) statements

and pp_statement state = function
  Instr instr ->
    pp_node state "Instr";
    pp_instruction (state#pad 1 0) instr
| Data data_decl ->
    pp_node state "Data";
    pp_data_decl (state#pad 1 0) data_decl
| Attr attr_decl ->
    pp_node state "Attr";
    pp_attr_decl state attr_decl.value

and pp_instruction state = function
  Cond {value; region} ->
    pp_loc_node state "Cond" region;
    pp_conditional state value
| CaseInstr {value; region} ->
    pp_loc_node state "CaseInstr" region;
    pp_case pp_if_clause state value
| Assign {value; region} ->
    pp_loc_node state "Assign" region;
    pp_assignment state value
| Loop loop ->
    pp_node state "Loop";
    pp_loop (state#pad 1 0) loop
| ProcCall {value; region} ->
    pp_loc_node state "ProcCall" region;
    pp_fun_call state value
| Skip region ->
    pp_loc_node state "Skip" region
| RecordPatch {value; region} ->
    pp_loc_node state "RecordPatch" region;
    pp_record_patch state value
| MapPatch {value; region} ->
    pp_loc_node state "MapPatch" region;
    pp_map_patch state value
| SetPatch {value; region} ->
    pp_loc_node state "SetPatch" region;
    pp_set_patch state value
| MapRemove {value; region} ->
    pp_loc_node state "MapRemove" region;
    pp_map_remove state value
| SetRemove {value; region} ->
    pp_loc_node state "SetRemove" region;
    pp_set_remove state value

and pp_cond_expr state (cond: cond_expr) =
  let () =
    let state = state#pad 3 0 in
    pp_node state "<condition>";
    pp_expr (state#pad 1 0) cond.test in
  let () =
    let state = state#pad 3 1 in
    pp_node state "<true>";
    pp_expr (state#pad 1 0) cond.ifso in
  let () =
    let state = state#pad 3 2 in
    pp_node state "<false>";
    pp_expr (state#pad 1 0) cond.ifnot
  in ()

and pp_conditional state (cond: conditional) =
  let () =
    let state = state#pad 3 0 in
    pp_node state "<condition>";
    pp_expr (state#pad 1 0) cond.test in
  let () =
    let state = state#pad 3 1 in
    pp_node state "<true>";
    pp_if_clause (state#pad 1 0) cond.ifso in
  let () =
    let state = state#pad 3 2 in
    pp_node state "<false>";
    pp_if_clause (state#pad 1 0) cond.ifnot
  in ()

and pp_if_clause state = function
  ClauseInstr instr ->
    pp_node state "ClauseInstr";
    pp_instruction (state#pad 1 0) instr
| ClauseBlock block ->
    pp_node state "ClauseBlock";
    pp_clause_block (state#pad 1 0) block

and pp_clause_block state = function
  LongBlock {value; region} ->
    pp_loc_node state "LongBlock" region;
    pp_statements state value.statements
| ShortBlock {value; region} ->
    pp_loc_node state "ShortBlock" region;
    pp_statements state (fst value.inside)

and pp_case :
  'a.(state -> 'a -> unit) -> state -> 'a case -> unit =
  fun printer state case ->
    let clauses = Utils.nsepseq_to_list case.cases.value in
    let clauses = List.map (fun {value; _} -> value) clauses in
    let length  = List.length clauses + 1 in
    let apply len rank =
      let state = state#pad len (rank+1)
      in pp_case_clause printer state
    in pp_expr (state#pad length 0) case.expr;
    List.iteri (apply length) clauses

and pp_case_clause :
  'a.(state -> 'a -> unit) -> state -> 'a case_clause -> unit =
  fun printer state clause ->
    pp_node state "<clause>";
    pp_pattern (state#pad 2 0) clause.pattern;
    printer (state#pad 2 1) clause.rhs

and pp_pattern state = function
  PWild region ->
    pp_loc_node state "PWild" region
| PConstr pattern ->
    pp_node state "PConstr";
    pp_constr_pattern (state#pad 1 0) pattern
| PVar v ->
    pp_node state "PVar";
    pp_ident (state#pad 1 0) v
| PInt n ->
    pp_node state "PInt";
    pp_int state n
| PNat n ->
    pp_node state "PNat";
    pp_int state n
| PBytes b ->
    pp_node state "PBytes";
    pp_bytes state b
| PString s ->
    pp_node state "PString";
    pp_ident (state#pad 1 0) s
| PList plist ->
    pp_node state "PList";
    pp_list_pattern (state#pad 1 0) plist
| PTuple {value; region} ->
    pp_loc_node state "PTuple" region;
    pp_tuple_pattern (state#pad 1 0) value

and pp_bytes state {value=lexeme,hex; region} =
  pp_loc_node (state#pad 2 0) lexeme region;
  pp_node     (state#pad 2 1) (Hex.show hex)

and pp_int state {value=lexeme,z; region} =
  pp_loc_node (state#pad 2 0) lexeme region;
  pp_node     (state#pad 2 1) (Z.to_string z)

and pp_constr_pattern state = function
  PNone region ->
    pp_loc_node state "PNone" region
| PSomeApp {value=_,{value=par; _}; region} ->
    pp_loc_node state "PSomeApp" region;
    pp_pattern (state#pad 1 0) par.inside
| PUnit region ->
    pp_loc_node state "PUnit" region
| PFalse region ->
    pp_loc_node state "PFalse" region
| PTrue region ->
    pp_loc_node state "PTrue" region
| PConstrApp {value; region} ->
    pp_loc_node state "PConstrApp" region;
    pp_constr_app_pattern (state#pad 1 0) value

and pp_constr_app_pattern state (constr, pat_opt) =
  pp_ident state constr;
  match pat_opt with
               None -> ()
  | Some {value; _} -> pp_tuple_pattern state value

and pp_list_pattern state = function
  PListComp {value; region} ->
    pp_loc_node state "PListComp" region;
    pp_injection pp_pattern (state#pad 1 0) value
| PNil region ->
    pp_loc_node state "PNil" region
| PParCons {value; region} ->
    pp_loc_node state "PParCons" region;
    pp_bin_cons (state#pad 1 0) value.inside
| PCons {value; region} ->
    let patterns = Utils.nsepseq_to_list value in
    let length   = List.length patterns in
    let apply len rank =
      pp_pattern (state#pad len rank) in
    pp_loc_node state "PCons" region;
    List.iteri (apply length) patterns

and pp_bin_cons state (head, _, tail) =
  pp_pattern (state#pad 2 0) head;
  pp_pattern (state#pad 2 1) tail

and pp_injection :
  'a.(state -> 'a -> unit) -> state -> 'a injection -> unit =
  fun printer state inj ->
    let elements       = Utils.sepseq_to_list inj.elements in
    let length         = List.length elements in
    let apply len rank = printer (state#pad len rank)
    in List.iteri (apply length) elements

and pp_ne_injection :
  'a.(state -> 'a -> unit) -> state -> 'a ne_injection -> unit =
  fun printer state inj ->
    let ne_elements    = Utils.nsepseq_to_list inj.ne_elements in
    let length         = List.length ne_elements in
    let apply len rank = printer (state#pad len rank)
    in List.iteri (apply length) ne_elements

and pp_tuple_pattern state tuple =
  let patterns       = Utils.nsepseq_to_list tuple.inside in
  let length         = List.length patterns in
  let apply len rank = pp_pattern (state#pad len rank)
  in List.iteri (apply length) patterns

and pp_assignment state asgn =
  pp_lhs  (state#pad 2 0) asgn.lhs;
  pp_expr (state#pad 2 1) asgn.rhs

and pp_lhs state = function
  Path path ->
    pp_node state "Path";
    pp_path (state#pad 1 0) path
| MapPath {value; region} ->
    pp_loc_node state "MapPath" region;
    pp_map_lookup state value

and pp_path state = function
  Name name ->
    pp_node state "Name";
    pp_ident (state#pad 1 0) name
| Path {value; region} ->
    pp_loc_node state "Path" region;
    pp_projection state value

and pp_projection state proj =
  let selections     = Utils.nsepseq_to_list proj.field_path in
  let len            = List.length selections in
  let apply len rank = pp_selection (state#pad len rank) in
  pp_ident (state#pad (1+len) 0) proj.struct_name;
  List.iteri (apply len) selections

and pp_update state update =
  pp_path state update.record;
  pp_ne_injection pp_field_path_assign state update.updates.value

and pp_selection state = function
  FieldName name ->
    pp_node state "FieldName";
    pp_ident (state#pad 1 0) name
| Component comp ->
    pp_node state "Component";
    pp_int state comp

and pp_map_lookup state lookup =
  pp_path (state#pad 2 0) lookup.path;
  pp_expr (state#pad 2 1) lookup.index.value.inside

and pp_loop state = function
  While {value; _} ->
    pp_node state "<while>";
    let () =
      let state = state#pad 2 0 in
      pp_node state "<condition>";
      pp_expr (state#pad 1 0) value.cond in
    let () =
      let state = state#pad 2 1 in
      let statements = value.block.value.statements in
      pp_node state "<statements>";
      pp_statements state statements
    in ()
| For for_loop ->
    pp_node state "<for>";
    pp_for_loop (state#pad 1 0) for_loop

and pp_for_loop state = function
  ForInt {value; region} ->
    pp_loc_node state "ForInt" region;
    pp_for_int state value
| ForCollect {value; region} ->
    pp_loc_node state "ForCollect" region;
    pp_for_collect state value

and pp_for_int state for_int =
  let () =
    let state = state#pad 3 0 in
    pp_node state "<init>";
    pp_var_assign state for_int.assign.value in
  let () =
    let state = state#pad 3 1 in
    pp_node state "<bound>";
    pp_expr (state#pad 1 0) for_int.bound in
  let () =
    let state = state#pad 3 2 in
    let statements = for_int.block.value.statements in
    pp_node state "<statements>";
    pp_statements state statements
  in ()

and pp_var_assign state asgn =
  pp_ident (state#pad 2 0) asgn.name;
  pp_expr  (state#pad 2 1) asgn.expr

and pp_for_collect state collect =
  let () =
    let state = state#pad 3 0 in
    match collect.bind_to with
      None ->
        pp_ident state collect.var
    | Some (_, var) ->
        pp_var_binding state (collect.var, var) in
  let () =
    let state = state#pad 3 1 in
    pp_node state "<collection>";
    pp_collection (state#pad 2 0) collect.collection;
    pp_expr (state#pad 1 0) collect.expr in
  let () =
      let state = state#pad 3 2 in
      let statements = collect.block.value.statements in
      pp_node state "<statements>";
      pp_statements state statements
  in ()

and pp_collection state = function
  Map  region -> pp_loc_node state "map"  region
| Set  region -> pp_loc_node state "set"  region
| List region -> pp_loc_node state "list" region

and pp_var_binding state (source, image) =
  pp_node  state "<binding>";
  pp_ident (state#pad 2 0) source;
  pp_ident (state#pad 2 1) image

and pp_fun_call state (expr, args) =
  let args           = Utils.nsepseq_to_list args.value.inside in
  let arity          = List.length args in
  let apply len rank = pp_expr (state#pad len rank)
  in pp_expr (state#pad (1+arity) 0) expr;
     List.iteri (apply arity) args

and pp_record_patch state patch =
  pp_path (state#pad 2 0) patch.path;
  pp_ne_injection pp_field_assign state patch.record_inj.value

and pp_field_assign state {value; _} =
  pp_node  state "<field assignment>";
  pp_ident (state#pad 2 0) value.field_name;
  pp_expr  (state#pad 2 1) value.field_expr

and pp_field_path_assign state {value; _} =
  pp_node  state "<field path for update>";
  let path = Utils.nsepseq_to_list value.field_path in
  List.iter (pp_ident (state#pad 2 0)) path;
  pp_expr  (state#pad 2 1) value.field_expr

and pp_map_patch state patch =
  pp_path (state#pad 2 0) patch.path;
  pp_ne_injection pp_binding state patch.map_inj.value

and pp_binding state {value; _} =
  let source, image = value.source, value.image in
  pp_node state "<binding>";
  pp_expr (state#pad 2 0) source;
  pp_expr (state#pad 2 1) image

and pp_set_patch state patch =
  pp_path (state#pad 2 0) patch.path;
  pp_ne_injection pp_expr state patch.set_inj.value

and pp_map_remove state rem =
  pp_expr (state#pad 2 0) rem.key;
  pp_path (state#pad 2 1) rem.map

and pp_set_remove state rem =
  pp_expr (state#pad 2 0) rem.element;
  pp_path (state#pad 2 1) rem.set

and pp_data_decl state = function
  LocalConst {value; region} ->
    pp_loc_node state "LocalConst" region;
    pp_const_decl state value
| LocalVar {value; region} ->
    pp_loc_node state "LocalVar" region;
    pp_var_decl state value
| LocalFun {value; region} ->
    pp_loc_node state "LocalFun" region;
    pp_fun_decl state value

and pp_var_decl state decl =
  pp_ident     (state#pad 3 0) decl.name;
  pp_type_expr (state#pad 3 1) decl.var_type;
  pp_expr      (state#pad 3 2) decl.init

and pp_expr state = function
  ECase {value; region} ->
    pp_loc_node state "ECase" region;
    pp_case pp_expr state value
| ECond {value; region} ->
    pp_loc_node state "ECond" region;
    pp_cond_expr state value
| EAnnot {value; region} ->
    pp_loc_node state "EAnnot" region;
    pp_annotated state value
| ELogic e_logic ->
    pp_node state "ELogic";
    pp_e_logic (state#pad 1 0) e_logic
| EArith e_arith ->
    pp_node state "EArith";
    pp_arith_expr (state#pad 1 0) e_arith
| EString e_string ->
    pp_node state "EString";
    pp_string_expr (state#pad 1 0) e_string
| EList e_list ->
    pp_node state "EList";
    pp_list_expr (state#pad 1 0) e_list
| ESet e_set ->
    pp_node state "ESet";
    pp_set_expr (state#pad 1 0) e_set
| EConstr e_constr ->
    pp_node state "EConstr";
    pp_constr_expr (state#pad 1 0) e_constr
| ERecord {value; region} ->
    pp_loc_node state "ERecord" region;
    pp_ne_injection pp_field_assign state value
| EProj {value; region} ->
    pp_loc_node state "EProj" region;
    pp_projection state value
| EUpdate {value; region} ->
    pp_loc_node state "EUpdate" region;
    pp_update state value
| EMap e_map ->
    pp_node state "EMap";
    pp_map_expr (state#pad 1 0) e_map
| EVar v ->
    pp_node state "EVar";
    pp_ident (state#pad 1 0) v
| ECall {value; region} ->
    pp_loc_node state "ECall" region;
    pp_fun_call state value
| EBytes b ->
    pp_node state "EBytes";
    pp_bytes state b
| EUnit region ->
    pp_loc_node state "EUnit" region
| ETuple e_tuple ->
    pp_node state "ETuple";
    pp_tuple_expr state e_tuple
| EPar {value; region} ->
    pp_loc_node state "EPar" region;
    pp_expr (state#pad 1 0) value.inside
| EFun {value; region} ->
    pp_loc_node state "EFun" region;
    pp_fun_expr state value;

and pp_list_expr state = function
  ECons {value; region} ->
    pp_loc_node state "ECons" region;
    pp_expr (state#pad 2 0) value.arg1;
    pp_expr (state#pad 2 1) value.arg2
| ENil region ->
    pp_loc_node state "ENil" region
| EListComp {value; region} ->
    pp_loc_node state "EListComp" region;
    if value.elements = None then
      pp_node (state#pad 1 0) "[]"
    else pp_injection pp_expr state value

and pp_arith_expr state = function
  Add {value; region} ->
    pp_bin_op "Add" region state value
| Sub {value; region} ->
    pp_bin_op "Sub" region state value
| Mult {value; region} ->
    pp_bin_op "Mult" region state value
| Div {value; region} ->
    pp_bin_op "Div" region state value
| Mod {value; region} ->
    pp_bin_op "Mod" region state value
| Neg {value; region} ->
    pp_loc_node state "Neg" region;
    pp_expr (state#pad 1 0) value.arg;
| Int i ->
    pp_node state "Int";
    pp_int  state i
| Nat n ->
    pp_node state "Nat";
    pp_int  state n
| Mutez m ->
    pp_node state "Mutez";
    pp_int  state m

and pp_set_expr state = function
  SetInj {value; region} ->
    pp_loc_node  state "SetInj" region;
    pp_injection pp_expr state value
| SetMem {value; region} ->
    pp_loc_node state "SetMem" region;
    pp_expr     (state#pad 2 0) value.set;
    pp_expr     (state#pad 2 1) value.element

and pp_e_logic state = function
  BoolExpr e ->
    pp_node state "BoolExpr";
    pp_bool_expr (state#pad 1 0) e
| CompExpr e ->
    pp_node state "CompExpr";
    pp_comp_expr (state#pad 1 0) e

and pp_bool_expr state = function
  Or {value; region} ->
    pp_bin_op "Or" region state value
| And {value; region} ->
    pp_bin_op "And" region state value
| Not {value; region} ->
    pp_loc_node state "Not" region;
    pp_expr     (state#pad 1 0) value.arg
| False region ->
    pp_loc_node state "False" region
| True region ->
    pp_loc_node state "True" region

and pp_comp_expr state = function
  Lt {value; region} ->
    pp_bin_op "Lt" region state value
| Leq {value; region} ->
    pp_bin_op "Leq" region state value
| Gt {value; region} ->
    pp_bin_op "Gt" region state value
| Geq {value; region} ->
    pp_bin_op "Geq" region state value
| Equal {value; region} ->
    pp_bin_op "Equal" region state  value
| Neq {value; region} ->
    pp_bin_op "Neq" region state value

and pp_constr_expr state = function
  NoneExpr region ->
    pp_loc_node state "NoneExpr" region
| SomeApp {value=_,args; region} ->
    pp_loc_node state "SomeApp" region;
    pp_tuple_expr state args
| ConstrApp {value; region} ->
    pp_loc_node state "ConstrApp" region;
    pp_constr_app (state#pad 1 0) value

and pp_constr_app state (constr, args_opt) =
  pp_ident state constr;
  match args_opt with
         None -> ()
  | Some args -> pp_tuple_expr state args

and pp_map_expr state = function
  MapLookUp {value; region} ->
    pp_loc_node   state "MapLookUp" region;
    pp_map_lookup state value
| MapInj {value; region} | BigMapInj {value; region} ->
    pp_loc_node  state "MapInj" region;
    pp_injection pp_binding state value

and pp_tuple_expr state {value; _} =
  let exprs          = Utils.nsepseq_to_list value.inside in
  let length         = List.length exprs in
  let apply len rank = pp_expr (state#pad len rank)
  in List.iteri (apply length) exprs

and pp_string_expr state = function
  Cat {value; region} ->
    pp_loc_node state "Cat" region;
    pp_expr     (state#pad 2 0) value.arg1;
    pp_expr     (state#pad 2 1) value.arg2;
| String s ->
    pp_node   state "String";
    pp_string (state#pad 1 0) s

and pp_annotated state (expr, t_expr) =
  pp_expr      (state#pad 2 0) expr;
  pp_type_expr (state#pad 2 1) t_expr

and pp_bin_op node region state op =
  pp_loc_node state node region;
  pp_expr     (state#pad 2 0) op.arg1;
  pp_expr     (state#pad 2 1) op.arg2