diff --git a/src/passes/8-typer-new/typer.ml b/src/passes/8-typer-new/typer.ml
index e252d6617..52b8b493c 100644
--- a/src/passes/8-typer-new/typer.ml
+++ b/src/passes/8-typer-new/typer.ml
@@ -461,6 +461,7 @@ and type_expression : environment -> Solver.state -> ?tv_opt:O.type_expression -
    *   ) *)
   | E_record_accessor {record;path} -> (
       let%bind (base' , state') = type_expression e state record in
+      let path = convert_label path in
       let wrapped = Wrap.access_label ~base:base'.type_expression ~label:path in
       return_wrapped (E_record_accessor {record=base';path}) state' wrapped
     )
diff --git a/src/stages/4-ast_typed/PP.ml b/src/stages/4-ast_typed/PP.ml
index 0f1722641..c1857a003 100644
--- a/src/stages/4-ast_typed/PP.ml
+++ b/src/stages/4-ast_typed/PP.ml
@@ -3,7 +3,280 @@ open Types
 open Format
 open PP_helpers
 
-include Stage_common.PP
+(* include Stage_common.PP *)
+open Types
+open Format
+open PP_helpers
+
+let constructor ppf (c:constructor') : unit =
+  let Constructor c = c in fprintf ppf "%s" c
+
+let label ppf (l:label) : unit =
+  let Label l = l in fprintf ppf "%s" l
+
+let cmap_sep value sep ppf m =
+  let lst = CMap.to_kv_list m in
+  let lst = List.sort (fun (Constructor a,_) (Constructor b,_) -> String.compare a b) lst in
+  let new_pp ppf (k, v) = fprintf ppf "%a -> %a" constructor k value v in
+  fprintf ppf "%a" (list_sep new_pp sep) lst
+
+let record_sep value sep ppf (m : 'a label_map) =
+  let lst = LMap.to_kv_list m in
+  let lst = List.sort (fun (Label a,_) (Label b,_) -> String.compare a b) lst in
+  let new_pp ppf (k, v) = fprintf ppf "%a -> %a" label k value v in
+  fprintf ppf "%a" (list_sep new_pp sep) lst
+
+let tuple_sep value sep ppf m =
+  assert (Helpers.is_tuple_lmap m);
+  let lst = LMap.to_kv_list m in
+  let lst = List.sort (fun (Label a,_) (Label b,_) -> String.compare a b) lst in
+  let new_pp ppf (_k, v) = fprintf ppf "%a" value v in
+  fprintf ppf "%a" (list_sep new_pp sep) lst
+
+(* Prints records which only contain the consecutive fields
+   0..(cardinal-1) as tuples *)
+let tuple_or_record_sep value format_record sep_record format_tuple sep_tuple ppf m =
+  if Helpers.is_tuple_lmap m then
+    fprintf ppf format_tuple (tuple_sep value (const sep_tuple)) m
+  else
+    fprintf ppf format_record (record_sep value (const sep_record)) m
+
+let list_sep_d x = list_sep x (const " , ")
+let cmap_sep_d x = cmap_sep x (const " , ")
+let tuple_or_record_sep_expr value = tuple_or_record_sep value "record[%a]" " , " "( %a )" " , "
+let tuple_or_record_sep_type value = tuple_or_record_sep value "record[%a]" " , " "( %a )" " * "
+
+let constant ppf : constant' -> unit = function
+  | C_INT                   -> fprintf ppf "INT"
+  | C_UNIT                  -> fprintf ppf "UNIT"
+  | C_NIL                   -> fprintf ppf "NIL"
+  | C_NOW                   -> fprintf ppf "NOW"
+  | C_IS_NAT                -> fprintf ppf "IS_NAT"
+  | C_SOME                  -> fprintf ppf "SOME"
+  | C_NONE                  -> fprintf ppf "NONE"
+  | C_ASSERTION             -> fprintf ppf "ASSERTION"
+  | C_ASSERT_INFERRED       -> fprintf ppf "ASSERT_INFERRED"
+  | C_FAILWITH              -> fprintf ppf "FAILWITH"
+  | C_UPDATE                -> fprintf ppf "UPDATE"
+  (* Loops *)
+  | C_ITER                  -> fprintf ppf "ITER"
+  | C_FOLD                  -> fprintf ppf "FOLD"
+  | C_FOLD_WHILE            -> fprintf ppf "FOLD_WHILE"
+  | C_FOLD_CONTINUE         -> fprintf ppf "CONTINUE"
+  | C_FOLD_STOP             -> fprintf ppf "STOP"
+  | C_LOOP_LEFT             -> fprintf ppf "LOOP_LEFT"
+  | C_LOOP_CONTINUE         -> fprintf ppf "LOOP_CONTINUE"
+  | C_LOOP_STOP             -> fprintf ppf "LOOP_STOP"
+  (* MATH *)
+  | C_NEG                   -> fprintf ppf "NEG"
+  | C_ABS                   -> fprintf ppf "ABS"
+  | C_ADD                   -> fprintf ppf "ADD"
+  | C_SUB                   -> fprintf ppf "SUB"
+  | C_MUL                   -> fprintf ppf "MUL"
+  | C_EDIV                  -> fprintf ppf "EDIV"
+  | C_DIV                   -> fprintf ppf "DIV"
+  | C_MOD                   -> fprintf ppf "MOD"
+  (* LOGIC *)
+  | C_NOT                   -> fprintf ppf "NOT"
+  | C_AND                   -> fprintf ppf "AND"
+  | C_OR                    -> fprintf ppf "OR"
+  | C_XOR                   -> fprintf ppf "XOR"
+  | C_LSL                   -> fprintf ppf "LSL"
+  | C_LSR                   -> fprintf ppf "LSR"
+  (* COMPARATOR *)
+  | C_EQ                    -> fprintf ppf "EQ"
+  | C_NEQ                   -> fprintf ppf "NEQ"
+  | C_LT                    -> fprintf ppf "LT"
+  | C_GT                    -> fprintf ppf "GT"
+  | C_LE                    -> fprintf ppf "LE"
+  | C_GE                    -> fprintf ppf "GE"
+  (* Bytes/ String *)
+  | C_SIZE                  -> fprintf ppf "SIZE"
+  | C_CONCAT                -> fprintf ppf "CONCAT"
+  | C_SLICE                 -> fprintf ppf "SLICE"
+  | C_BYTES_PACK            -> fprintf ppf "BYTES_PACK"
+  | C_BYTES_UNPACK          -> fprintf ppf "BYTES_UNPACK"
+  | C_CONS                  -> fprintf ppf "CONS"
+  (* Pair *)
+  | C_PAIR                  -> fprintf ppf "PAIR"
+  | C_CAR                   -> fprintf ppf "CAR"
+  | C_CDR                   -> fprintf ppf "CDR"
+  | C_LEFT                  -> fprintf ppf "LEFT"
+  | C_RIGHT                 -> fprintf ppf "RIGHT"
+  (* Set *)
+  | C_SET_EMPTY             -> fprintf ppf "SET_EMPTY"
+  | C_SET_LITERAL           -> fprintf ppf "SET_LITERAL"
+  | C_SET_ADD               -> fprintf ppf "SET_ADD"
+  | C_SET_REMOVE            -> fprintf ppf "SET_REMOVE"
+  | C_SET_ITER              -> fprintf ppf "SET_ITER"
+  | C_SET_FOLD              -> fprintf ppf "SET_FOLD"
+  | C_SET_MEM               -> fprintf ppf "SET_MEM"
+  (* List *)
+  | C_LIST_ITER             -> fprintf ppf "LIST_ITER"
+  | C_LIST_MAP              -> fprintf ppf "LIST_MAP"
+  | C_LIST_FOLD             -> fprintf ppf "LIST_FOLD"
+  (* Maps *)
+  | C_MAP                   -> fprintf ppf "MAP"
+  | C_MAP_EMPTY             -> fprintf ppf "MAP_EMPTY"
+  | C_MAP_LITERAL           -> fprintf ppf "MAP_LITERAL"
+  | C_MAP_GET               -> fprintf ppf "MAP_GET"
+  | C_MAP_GET_FORCE         -> fprintf ppf "MAP_GET_FORCE"
+  | C_MAP_ADD               -> fprintf ppf "MAP_ADD"
+  | C_MAP_REMOVE            -> fprintf ppf "MAP_REMOVE"
+  | C_MAP_UPDATE            -> fprintf ppf "MAP_UPDATE"
+  | C_MAP_ITER              -> fprintf ppf "MAP_ITER"
+  | C_MAP_MAP               -> fprintf ppf "MAP_MAP"
+  | C_MAP_FOLD              -> fprintf ppf "MAP_FOLD"
+  | C_MAP_MEM               -> fprintf ppf "MAP_MEM"
+  | C_MAP_FIND              -> fprintf ppf "MAP_FIND"
+  | C_MAP_FIND_OPT          -> fprintf ppf "MAP_FIND_OP"
+  (* Big Maps *)
+  | C_BIG_MAP               -> fprintf ppf "BIG_MAP"
+  | C_BIG_MAP_EMPTY         -> fprintf ppf "BIG_MAP_EMPTY"
+  | C_BIG_MAP_LITERAL       -> fprintf ppf "BIG_MAP_LITERAL"
+  (* Crypto *)
+  | C_SHA256                -> fprintf ppf "SHA256"
+  | C_SHA512                -> fprintf ppf "SHA512"
+  | C_BLAKE2b               -> fprintf ppf "BLAKE2b"
+  | C_HASH                  -> fprintf ppf "HASH"
+  | C_HASH_KEY              -> fprintf ppf "HASH_KEY"
+  | C_CHECK_SIGNATURE       -> fprintf ppf "CHECK_SIGNATURE"
+  | C_CHAIN_ID              -> fprintf ppf "CHAIN_ID"
+  (* Blockchain *)
+  | C_CALL                  -> fprintf ppf "CALL"
+  | C_CONTRACT              -> fprintf ppf "CONTRACT"
+  | C_CONTRACT_OPT          -> fprintf ppf "CONTRACT_OPT"
+  | C_CONTRACT_ENTRYPOINT   -> fprintf ppf "CONTRACT_ENTRYPOINT"
+  | C_CONTRACT_ENTRYPOINT_OPT -> fprintf ppf "CONTRACT_ENTRYPOINT_OPT"
+  | C_AMOUNT                -> fprintf ppf "AMOUNT"
+  | C_BALANCE               -> fprintf ppf "BALANCE"
+  | C_SOURCE                -> fprintf ppf "SOURCE"
+  | C_SENDER                -> fprintf ppf "SENDER"
+  | C_ADDRESS               -> fprintf ppf "ADDRESS"
+  | C_SELF                  -> fprintf ppf "SELF"
+  | C_SELF_ADDRESS          -> fprintf ppf "SELF_ADDRESS"
+  | C_IMPLICIT_ACCOUNT      -> fprintf ppf "IMPLICIT_ACCOUNT"
+  | C_SET_DELEGATE          -> fprintf ppf "SET_DELEGATE"
+  | C_CREATE_CONTRACT       -> fprintf ppf "CREATE_CONTRACT"
+
+let literal ppf (l : literal) =
+  match l with
+  | Literal_unit ->
+      fprintf ppf "unit"
+  | Literal_void ->
+      fprintf ppf "void"
+  | Literal_bool b ->
+      fprintf ppf "%b" b
+  | Literal_int n ->
+      fprintf ppf "%d" n
+  | Literal_nat n ->
+      fprintf ppf "+%d" n
+  | Literal_timestamp n ->
+      fprintf ppf "+%d" n
+  | Literal_mutez n ->
+      fprintf ppf "%dmutez" n
+  | Literal_string s ->
+      fprintf ppf "%S" s
+  | Literal_bytes b ->
+      fprintf ppf "0x%a" Hex.pp (Hex.of_bytes b)
+  | Literal_address s ->
+      fprintf ppf "@%S" s
+  | Literal_operation _ ->
+      fprintf ppf "Operation(...bytes)"
+  | Literal_key s ->
+      fprintf ppf "key %s" s
+  | Literal_key_hash s ->
+      fprintf ppf "key_hash %s" s
+  | Literal_signature s ->
+      fprintf ppf "Signature %s" s
+  | Literal_chain_id s ->
+      fprintf ppf "Chain_id %s" s
+module Ast_PP_type (PARAMETER : AST_PARAMETER_TYPE) = struct
+  module Agt=Ast_generic_type(PARAMETER)
+  open Agt
+  open Format
+
+  let type_variable ppf (t : type_variable) : unit = fprintf ppf "%a" Var.pp t
+
+  let rec type_expression' :
+         (formatter -> type_expression -> unit)
+      -> formatter
+      -> type_expression
+      -> unit =
+   fun f ppf te ->
+    match te.type_content with
+    | T_sum m ->
+        fprintf ppf "sum[%a]" (cmap_sep_d f) m
+    | T_record m ->
+        fprintf ppf "%a" (tuple_or_record_sep_type f) m
+    | T_arrow a ->
+        fprintf ppf "%a -> %a" f a.type1 f a.type2
+    | T_variable tv ->
+        type_variable ppf tv
+    | T_constant tc ->
+        type_constant ppf tc
+    | T_operator to_ ->
+        type_operator f ppf to_
+
+  and type_expression ppf (te : type_expression) : unit =
+    type_expression' type_expression ppf te
+
+  and type_constant ppf (tc : type_constant) : unit =
+    let s =
+      match tc with
+      | TC_unit ->
+          "unit"
+      | TC_string ->
+          "string"
+      | TC_bytes ->
+          "bytes"
+      | TC_nat ->
+          "nat"
+      | TC_int ->
+          "int"
+      | TC_mutez ->
+          "mutez"
+      | TC_bool ->
+          "bool"
+      | TC_operation ->
+          "operation"
+      | TC_address ->
+          "address"
+      | TC_key ->
+          "key"
+      | TC_key_hash ->
+          "key_hash"
+      | TC_signature ->
+          "signature"
+      | TC_timestamp ->
+          "timestamp"
+      | TC_chain_id ->
+          "chain_id"
+      | TC_void ->
+          "void"
+    in
+    fprintf ppf "%s" s
+
+  and type_operator :
+         (formatter -> type_expression -> unit)
+      -> formatter
+      -> type_operator
+      -> unit =
+   fun f ppf to_ ->
+    let s =
+      match to_ with
+      | TC_option te -> Format.asprintf "option(%a)" f te
+      | TC_list te -> Format.asprintf "list(%a)" f te
+      | TC_set te -> Format.asprintf "set(%a)" f te
+      | TC_map (k, v) -> Format.asprintf "Map (%a,%a)" f k f v
+      | TC_big_map (k, v) -> Format.asprintf "Big Map (%a,%a)" f k f v
+      | TC_michelson_or (l, r) -> Format.asprintf "michelson_or (%a,%a)" f l f r
+      | TC_arrow (k, v) -> Format.asprintf "arrow (%a,%a)" f k f v
+      | TC_contract te  -> Format.asprintf "Contract (%a)" f te
+    in
+    fprintf ppf "(TO_%s)" s
+end
+(* end include Stage_common.PP *)
 include Ast_PP_type(Ast_typed_type_parameter)
 
 let expression_variable ppf (ev : expression_variable) : unit =
diff --git a/src/stages/4-ast_typed/helpers.ml b/src/stages/4-ast_typed/helpers.ml
new file mode 100644
index 000000000..006cae6cb
--- /dev/null
+++ b/src/stages/4-ast_typed/helpers.ml
@@ -0,0 +1,165 @@
+open Types
+open Trace
+
+let map_type_operator f = function
+    TC_contract x -> TC_contract (f x)
+  | TC_option x -> TC_option (f x)
+  | TC_list x -> TC_list (f x)
+  | TC_set x -> TC_set (f x)
+  | TC_map (x , y) -> TC_map (f x , f y)
+  | TC_big_map (x , y)-> TC_big_map (f x , f y)
+  | TC_map_or_big_map (x , y)-> TC_map_or_big_map (f x , f y)
+  | TC_michelson_or (x, y) -> TC_michelson_or (f x, f y)
+  | TC_arrow (x, y) -> TC_arrow (f x, f y)
+
+let bind_map_type_operator f = function
+    TC_contract x -> let%bind x = f x in ok @@ TC_contract x
+  | TC_option x -> let%bind x = f x in ok @@ TC_option x
+  | TC_list x -> let%bind x = f x in ok @@ TC_list x
+  | TC_set x -> let%bind x = f x in ok @@ TC_set x
+  | TC_map (x , y) -> let%bind x = f x in let%bind y = f y in ok @@ TC_map (x , y)
+  | TC_big_map (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_big_map (x , y)
+  | TC_map_or_big_map (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_map_or_big_map (x , y)
+  | TC_michelson_or (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_michelson_or (x , y)
+  | TC_arrow (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_arrow (x , y)
+
+let type_operator_name = function
+    TC_contract _ -> "TC_contract"
+  | TC_option   _ -> "TC_option"
+  | TC_list     _ -> "TC_list"
+  | TC_set      _ -> "TC_set"
+  | TC_map      _ -> "TC_map"
+  | TC_big_map  _ -> "TC_big_map"
+  | TC_map_or_big_map _ -> "TC_map_or_big_map"
+  | TC_michelson_or   _ -> "TC_michelson_or"
+  | TC_arrow    _ -> "TC_arrow"
+
+let type_expression'_of_string = function
+  | "TC_contract" , [x]     -> ok @@ T_operator(TC_contract x)
+  | "TC_option"   , [x]     -> ok @@ T_operator(TC_option x)
+  | "TC_list"     , [x]     -> ok @@ T_operator(TC_list x)
+  | "TC_set"      , [x]     -> ok @@ T_operator(TC_set x)
+  | "TC_map"      , [x ; y] -> ok @@ T_operator(TC_map (x , y))
+  | "TC_big_map"  , [x ; y] -> ok @@ T_operator(TC_big_map (x, y))
+  | ("TC_contract" | "TC_option" | "TC_list" | "TC_set" | "TC_map" | "TC_big_map"), _ ->
+     failwith "internal error: wrong number of arguments for type operator"
+
+  | "TC_unit"      , [] -> ok @@ T_constant(TC_unit)
+  | "TC_string"    , [] -> ok @@ T_constant(TC_string)
+  | "TC_bytes"     , [] -> ok @@ T_constant(TC_bytes)
+  | "TC_nat"       , [] -> ok @@ T_constant(TC_nat)
+  | "TC_int"       , [] -> ok @@ T_constant(TC_int)
+  | "TC_mutez"     , [] -> ok @@ T_constant(TC_mutez)
+  | "TC_bool"      , [] -> ok @@ T_constant(TC_bool)
+  | "TC_operation" , [] -> ok @@ T_constant(TC_operation)
+  | "TC_address"   , [] -> ok @@ T_constant(TC_address)
+  | "TC_key"       , [] -> ok @@ T_constant(TC_key)
+  | "TC_key_hash"  , [] -> ok @@ T_constant(TC_key_hash)
+  | "TC_chain_id"  , [] -> ok @@ T_constant(TC_chain_id)
+  | "TC_signature" , [] -> ok @@ T_constant(TC_signature)
+  | "TC_timestamp" , [] -> ok @@ T_constant(TC_timestamp)
+  | _,               [] ->
+     failwith "internal error: wrong number of arguments for type constant"
+  | _                       ->
+     failwith "internal error: unknown type operator"
+
+let string_of_type_operator = function
+  | TC_contract  x       -> "TC_contract" , [x]
+  | TC_option    x       -> "TC_option"   , [x]
+  | TC_list      x       -> "TC_list"     , [x]
+  | TC_set       x       -> "TC_set"      , [x]
+  | TC_map       (x , y) -> "TC_map"      , [x ; y]
+  | TC_big_map   (x , y) -> "TC_big_map"  , [x ; y]
+  | TC_map_or_big_map   (x , y) -> "TC_map_or_big_map"  , [x ; y]
+  | TC_michelson_or     (x , y) -> "TC_michelson_or"    , [x ; y]
+  | TC_arrow     (x , y) -> "TC_arrow"    , [x ; y]
+
+let string_of_type_constant = function
+  | TC_unit      -> "TC_unit", []
+  | TC_string    -> "TC_string", []
+  | TC_bytes     -> "TC_bytes", []
+  | TC_nat       -> "TC_nat", []
+  | TC_int       -> "TC_int", []
+  | TC_mutez     -> "TC_mutez", []
+  | TC_bool      -> "TC_bool", []
+  | TC_operation -> "TC_operation", []
+  | TC_address   -> "TC_address", []
+  | TC_key       -> "TC_key", []
+  | TC_key_hash  -> "TC_key_hash", []
+  | TC_chain_id  -> "TC_chain_id", []
+  | TC_signature -> "TC_signature", []
+  | TC_timestamp -> "TC_timestamp", []
+  | TC_void      -> "TC_void", []
+
+let string_of_type_expression' = function
+  | T_operator o -> string_of_type_operator o
+  | T_constant c -> string_of_type_constant c
+  | T_sum _ | T_record _ | T_arrow _ | T_variable _ ->
+     failwith "not a type operator or constant"
+
+let bind_lmap (l:_ label_map) =
+  let open Trace in
+  let open LMap in
+  let aux k v prev =
+    prev >>? fun prev' ->
+    v >>? fun v' ->
+    ok @@ add k v' prev' in
+  fold aux l (ok empty)
+
+let bind_cmap (c:_ constructor_map) =
+  let open Trace in
+  let open CMap in
+  let aux k v prev =
+    prev >>? fun prev' ->
+    v >>? fun v' ->
+    ok @@ add k v' prev' in
+  fold aux c (ok empty)
+
+let bind_fold_lmap f init (lmap:_ LMap.t) =
+  let open Trace in
+  let aux k v prev =
+    prev >>? fun prev' ->
+    f prev' k v
+  in
+  LMap.fold aux lmap init
+
+let bind_map_lmap f map = bind_lmap (LMap.map f map)
+let bind_map_cmap f map = bind_cmap (CMap.map f map)
+let bind_map_lmapi f map = bind_lmap (LMap.mapi f map)
+let bind_map_cmapi f map = bind_cmap (CMap.mapi f map)
+
+let range i j =
+  let rec aux i j acc = if i >= j then acc else aux i (j-1) (j-1 :: acc) in
+  aux i j []
+
+let label_range i j =
+  List.map (fun i -> Label (string_of_int i)) @@ range i j
+
+let is_tuple_lmap m =
+  List.for_all (fun i -> LMap.mem i m) @@ (label_range 0 (LMap.cardinal m))
+
+let get_pair m =
+  let open Trace in
+  match (LMap.find_opt (Label "0") m , LMap.find_opt (Label "1") m) with
+  | Some e1, Some e2 -> ok (e1,e2)
+  | _ -> simple_fail "not a pair"
+
+let tuple_of_record (m: _ LMap.t) =
+  let aux i = 
+    let label = Label (string_of_int i) in
+    let opt = LMap.find_opt (label) m in
+    Option.bind (fun opt -> Some ((label,opt),i+1)) opt
+  in
+  Base.Sequence.to_list @@ Base.Sequence.unfold ~init:0 ~f:aux
+
+let list_of_record_or_tuple (m: _ LMap.t) =
+  if (is_tuple_lmap m) then
+    List.map snd @@ tuple_of_record m
+  else
+    List.rev @@ LMap.to_list m
+
+let kv_list_of_record_or_tuple (m: _ LMap.t) =
+  if (is_tuple_lmap m) then
+    tuple_of_record m
+  else
+    List.rev @@ LMap.to_kv_list m
diff --git a/src/stages/4-ast_typed/misc_smart.ml b/src/stages/4-ast_typed/misc_smart.ml
index b4a0b5095..06357e07f 100644
--- a/src/stages/4-ast_typed/misc_smart.ml
+++ b/src/stages/4-ast_typed/misc_smart.ml
@@ -2,7 +2,7 @@ open Trace
 open Types
 open Combinators
 open Misc
-open Stage_common.Types
+(* open Stage_common.Types *)
 
 let program_to_main : program -> string -> lambda result = fun p s ->
   let%bind (main , input_type , _) =
diff --git a/src/stages/4-ast_typed/types.ml b/src/stages/4-ast_typed/types.ml
index e267ff03c..be093157a 100644
--- a/src/stages/4-ast_typed/types.ml
+++ b/src/stages/4-ast_typed/types.ml
@@ -1,7 +1,307 @@
 [@@@warning "-30"]
 
 module S = Ast_core
-include Stage_common.Types
+
+(* include Stage_common.Types *)
+type expression_
+and expression_variable = expression_ Var.t
+type type_
+and type_variable = type_ Var.t
+
+
+type constructor' = Constructor of string
+type label = Label of string
+
+module CMap = Map.Make( struct type t = constructor' let compare (Constructor a) (Constructor b) = compare a b end)
+module LMap = Map.Make( struct type t = label let compare (Label a) (Label b) = String.compare a b end)
+
+type 'a label_map = 'a LMap.t
+type 'a constructor_map = 'a CMap.t
+
+  and type_constant =
+    | TC_unit
+    | TC_string
+    | TC_bytes
+    | TC_nat
+    | TC_int
+    | TC_mutez
+    | TC_bool
+    | TC_operation
+    | TC_address
+    | TC_key
+    | TC_key_hash
+    | TC_chain_id
+    | TC_signature
+    | TC_timestamp
+    | TC_void
+module type AST_PARAMETER_TYPE = sig
+  type type_meta
+end
+
+module Ast_generic_type (PARAMETER : AST_PARAMETER_TYPE) = struct
+  open PARAMETER
+
+  type type_content =
+    | T_sum of type_expression constructor_map
+    | T_record of type_expression label_map
+    | T_arrow of arrow
+    | T_variable of type_variable
+    | T_constant of type_constant
+    | T_operator of type_operator
+
+  and arrow = {type1: type_expression; type2: type_expression}
+
+  and type_operator =
+    | TC_contract of type_expression
+    | TC_option of type_expression
+    | TC_list of type_expression
+    | TC_set of type_expression
+    | TC_map of type_expression * type_expression
+    | TC_big_map of type_expression * type_expression
+    | TC_michelson_or of type_expression * type_expression
+    | TC_arrow of type_expression * type_expression
+
+
+  and type_expression = {type_content: type_content; type_meta: type_meta}
+
+  open Trace
+  let map_type_operator f = function
+      TC_contract x -> TC_contract (f x)
+    | TC_option x -> TC_option (f x)
+    | TC_list x -> TC_list (f x)
+    | TC_set x -> TC_set (f x)
+    | TC_map (x , y) -> TC_map (f x , f y)
+    | TC_big_map (x , y)-> TC_big_map (f x , f y)
+    | TC_arrow (x, y) -> TC_arrow (f x, f y)
+
+  let bind_map_type_operator f = function
+      TC_contract x -> let%bind x = f x in ok @@ TC_contract x
+    | TC_option x -> let%bind x = f x in ok @@ TC_option x
+    | TC_list x -> let%bind x = f x in ok @@ TC_list x
+    | TC_set x -> let%bind x = f x in ok @@ TC_set x
+    | TC_map (x , y) -> let%bind x = f x in let%bind y = f y in ok @@ TC_map (x , y)
+    | TC_big_map (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_big_map (x , y)
+    | TC_arrow (x , y)-> let%bind x = f x in let%bind y = f y in ok @@ TC_arrow (x , y)
+
+  let type_operator_name = function
+        TC_contract _ -> "TC_contract"
+      | TC_option   _ -> "TC_option"
+      | TC_list     _ -> "TC_list"
+      | TC_set      _ -> "TC_set"
+      | TC_map      _ -> "TC_map"
+      | TC_big_map  _ -> "TC_big_map"
+      | TC_arrow    _ -> "TC_arrow"
+
+  let type_expression'_of_string = function
+    | "TC_contract" , [x]     -> ok @@ T_operator(TC_contract x)
+    | "TC_option"   , [x]     -> ok @@ T_operator(TC_option x)
+    | "TC_list"     , [x]     -> ok @@ T_operator(TC_list x)
+    | "TC_set"      , [x]     -> ok @@ T_operator(TC_set x)
+    | "TC_map"      , [x ; y] -> ok @@ T_operator(TC_map (x , y))
+    | "TC_big_map"  , [x ; y] -> ok @@ T_operator(TC_big_map (x, y))
+    | ("TC_contract" | "TC_option" | "TC_list" | "TC_set" | "TC_map" | "TC_big_map"), _ ->
+      failwith "internal error: wrong number of arguments for type operator"
+
+    | "TC_unit"      , [] -> ok @@ T_constant(TC_unit)
+    | "TC_string"    , [] -> ok @@ T_constant(TC_string)
+    | "TC_bytes"     , [] -> ok @@ T_constant(TC_bytes)
+    | "TC_nat"       , [] -> ok @@ T_constant(TC_nat)
+    | "TC_int"       , [] -> ok @@ T_constant(TC_int)
+    | "TC_mutez"     , [] -> ok @@ T_constant(TC_mutez)
+    | "TC_bool"      , [] -> ok @@ T_constant(TC_bool)
+    | "TC_operation" , [] -> ok @@ T_constant(TC_operation)
+    | "TC_address"   , [] -> ok @@ T_constant(TC_address)
+    | "TC_key"       , [] -> ok @@ T_constant(TC_key)
+    | "TC_key_hash"  , [] -> ok @@ T_constant(TC_key_hash)
+    | "TC_chain_id"  , [] -> ok @@ T_constant(TC_chain_id)
+    | "TC_signature" , [] -> ok @@ T_constant(TC_signature)
+    | "TC_timestamp" , [] -> ok @@ T_constant(TC_timestamp)
+    | _,               [] ->
+      failwith "internal error: wrong number of arguments for type constant"
+    | _                       ->
+      failwith "internal error: unknown type operator"
+
+  let string_of_type_operator = function
+    | TC_contract  x       -> "TC_contract" , [x]
+    | TC_option    x       -> "TC_option"   , [x]
+    | TC_list      x       -> "TC_list"     , [x]
+    | TC_set       x       -> "TC_set"      , [x]
+    | TC_map       (x , y) -> "TC_map"      , [x ; y]
+    | TC_big_map   (x , y) -> "TC_big_map"  , [x ; y]
+    | TC_arrow     (x , y) -> "TC_arrow"    , [x ; y]
+
+  let string_of_type_constant = function
+    | TC_unit      -> "TC_unit", []
+    | TC_string    -> "TC_string", []
+    | TC_bytes     -> "TC_bytes", []
+    | TC_nat       -> "TC_nat", []
+    | TC_int       -> "TC_int", []
+    | TC_mutez     -> "TC_mutez", []
+    | TC_bool      -> "TC_bool", []
+    | TC_operation -> "TC_operation", []
+    | TC_address   -> "TC_address", []
+    | TC_key       -> "TC_key", []
+    | TC_key_hash  -> "TC_key_hash", []
+    | TC_chain_id  -> "TC_chain_id", []
+    | TC_signature -> "TC_signature", []
+    | TC_timestamp -> "TC_timestamp", []
+    | TC_void      -> "TC_void", []
+
+  let string_of_type_expression' = function
+    | T_operator o -> string_of_type_operator o
+    | T_constant c -> string_of_type_constant c
+    | T_sum _ | T_record _ | T_arrow _ | T_variable _ ->
+      failwith "not a type operator or constant"
+
+end
+
+type literal =
+  | Literal_unit
+  | Literal_bool of bool
+  | Literal_int of int
+  | Literal_nat of int
+  | Literal_timestamp of int
+  | Literal_mutez of int
+  | Literal_string of string
+  | Literal_bytes of bytes
+  | Literal_address of string
+  | Literal_signature of string
+  | Literal_key of string
+  | Literal_key_hash of string
+  | Literal_chain_id of string
+  | Literal_void
+  | Literal_operation of
+      Memory_proto_alpha.Protocol.Alpha_context.packed_internal_operation
+and ('a,'tv) matching_content =
+  | Match_bool of {
+      match_true : 'a ;
+      match_false : 'a ;
+    }
+  | Match_list of {
+      match_nil : 'a ;
+      match_cons : expression_variable * expression_variable * 'a * 'tv;
+    }
+  | Match_option of {
+      match_none : 'a ;
+      match_some : expression_variable * 'a * 'tv;
+    }
+  | Match_tuple of (expression_variable list * 'a) * 'tv list
+  | Match_variant of ((constructor' * expression_variable) * 'a) list * 'tv
+
+and constant' =
+  | C_INT
+  | C_UNIT
+  | C_NIL
+  | C_NOW
+  | C_IS_NAT
+  | C_SOME
+  | C_NONE
+  | C_ASSERTION
+  | C_ASSERT_INFERRED
+  | C_FAILWITH
+  | C_UPDATE
+  (* Loops *)
+  | C_ITER
+  | C_FOLD_WHILE
+  | C_FOLD_CONTINUE
+  | C_FOLD_STOP
+  | C_LOOP_LEFT
+  | C_LOOP_CONTINUE
+  | C_LOOP_STOP
+  | C_FOLD
+  (* MATH *)
+  | C_NEG
+  | C_ABS
+  | C_ADD
+  | C_SUB
+  | C_MUL
+  | C_EDIV
+  | C_DIV
+  | C_MOD
+  (* LOGIC *)
+  | C_NOT
+  | C_AND
+  | C_OR
+  | C_XOR
+  | C_LSL
+  | C_LSR
+  (* COMPARATOR *)
+  | C_EQ
+  | C_NEQ
+  | C_LT
+  | C_GT
+  | C_LE
+  | C_GE
+  (* Bytes/ String *)
+  | C_SIZE
+  | C_CONCAT
+  | C_SLICE
+  | C_BYTES_PACK
+  | C_BYTES_UNPACK
+  | C_CONS
+  (* Pair *)
+  | C_PAIR
+  | C_CAR
+  | C_CDR
+  | C_LEFT
+  | C_RIGHT
+  (* Set *)
+  | C_SET_EMPTY
+  | C_SET_LITERAL
+  | C_SET_ADD
+  | C_SET_REMOVE
+  | C_SET_ITER
+  | C_SET_FOLD
+  | C_SET_MEM
+  (* List *)
+  | C_LIST_ITER
+  | C_LIST_MAP
+  | C_LIST_FOLD
+  (* Maps *)
+  | C_MAP
+  | C_MAP_EMPTY
+  | C_MAP_LITERAL
+  | C_MAP_GET
+  | C_MAP_GET_FORCE
+  | C_MAP_ADD
+  | C_MAP_REMOVE
+  | C_MAP_UPDATE
+  | C_MAP_ITER
+  | C_MAP_MAP
+  | C_MAP_FOLD
+  | C_MAP_MEM
+  | C_MAP_FIND
+  | C_MAP_FIND_OPT
+  (* Big Maps *)
+  | C_BIG_MAP
+  | C_BIG_MAP_EMPTY
+  | C_BIG_MAP_LITERAL
+  (* Crypto *)
+  | C_SHA256
+  | C_SHA512
+  | C_BLAKE2b
+  | C_HASH
+  | C_HASH_KEY
+  | C_CHECK_SIGNATURE
+  | C_CHAIN_ID
+  (* Blockchain *)
+  | C_CALL
+  | C_CONTRACT
+  | C_CONTRACT_OPT
+  | C_CONTRACT_ENTRYPOINT
+  | C_CONTRACT_ENTRYPOINT_OPT
+  | C_AMOUNT
+  | C_BALANCE
+  | C_SOURCE
+  | C_SENDER
+  | C_ADDRESS
+  | C_SELF
+  | C_SELF_ADDRESS
+  | C_IMPLICIT_ACCOUNT
+  | C_SET_DELEGATE
+  | C_CREATE_CONTRACT
+
+(* end include Stage_common.Types *)
 
 module Ast_typed_type_parameter = struct
   type type_meta = S.type_expression option