diff --git a/src/proto_alpha/lib_benchmark/michelson_samplers.ml b/src/proto_alpha/lib_benchmark/michelson_samplers.ml
index 9c2157543f2c7753a44b37548d7f4cdc01b6cd53..5c3d0eedc457b5dfdffe8911cd1996bc3c4d6a72 100644
--- a/src/proto_alpha/lib_benchmark/michelson_samplers.ml
+++ b/src/proto_alpha/lib_benchmark/michelson_samplers.ml
@@ -685,7 +685,7 @@ end)
      fun arg_ty ->
       let open M in
       let* address = value address_t in
-      return {arg_ty; address}
+      return (Typed_contract {arg_ty; address})
 
     and generate_operation : Script_typed_ir.operation sampler =
      fun rng_state ->
diff --git a/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml b/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml
index 2b27e85910548113045f66234e87148cd7c71f21..56b3575b85e2673bed99d3326c76d3c52a28ad2e 100644
--- a/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml
+++ b/src/proto_alpha/lib_benchmarks_proto/interpreter_workload.ml
@@ -1203,17 +1203,18 @@ let extract_ir_sized_step :
       Instructions.map_get_and_update key_size (Size.map map)
   | (IMap_size (_, _), (map, _)) -> Instructions.map_size (Size.map map)
   | (IEmpty_big_map (_, _, _, _), _) -> Instructions.empty_big_map
-  | (IBig_map_mem (_, _), (v, ({diff = {size; _}; key_type; _}, _))) ->
+  | (IBig_map_mem (_, _), (v, (Big_map {diff = {size; _}; key_type; _}, _))) ->
       let key_size = Size.size_of_comparable_value key_type v in
       Instructions.big_map_mem key_size (Size.of_int size)
-  | (IBig_map_get (_, _), (v, ({diff = {size; _}; key_type; _}, _))) ->
+  | (IBig_map_get (_, _), (v, (Big_map {diff = {size; _}; key_type; _}, _))) ->
       let key_size = Size.size_of_comparable_value key_type v in
       Instructions.big_map_get key_size (Size.of_int size)
-  | (IBig_map_update (_, _), (v, (_, ({diff = {size; _}; key_type; _}, _)))) ->
+  | ( IBig_map_update (_, _),
+      (v, (_, (Big_map {diff = {size; _}; key_type; _}, _))) ) ->
       let key_size = Size.size_of_comparable_value key_type v in
       Instructions.big_map_update key_size (Size.of_int size)
   | ( IBig_map_get_and_update (_, _),
-      (v, (_, ({diff = {size; _}; key_type; _}, _))) ) ->
+      (v, (_, (Big_map {diff = {size; _}; key_type; _}, _))) ) ->
       let key_size = Size.size_of_comparable_value key_type v in
       Instructions.big_map_get_and_update key_size (Size.of_int size)
   | (IConcat_string (_, _), (ss, _)) ->
diff --git a/src/proto_alpha/lib_plugin/plugin.ml b/src/proto_alpha/lib_plugin/plugin.ml
index 6153e80bfa93e22aa7991ea81c8d6bb86e8e6fe5..84af0e355618bfc6fa0ab555beb8671fb0f3451c 100644
--- a/src/proto_alpha/lib_plugin/plugin.ml
+++ b/src/proto_alpha/lib_plugin/plugin.ml
@@ -2437,14 +2437,15 @@ module RPC = struct
           let code = Script.lazy_expr expr in
           Script_ir_translator.parse_code ~legacy ctxt ~code
           >>=? fun ( Ex_code
-                       {
-                         code;
-                         arg_type;
-                         storage_type;
-                         views;
-                         entrypoints;
-                         code_size;
-                       },
+                       (Code
+                         {
+                           code;
+                           arg_type;
+                           storage_type;
+                           views;
+                           entrypoints;
+                           code_size;
+                         }),
                      ctxt ) ->
           Script_ir_translator.parse_data
             ~legacy
@@ -2739,8 +2740,8 @@ module RPC = struct
                 ~legacy:true
                 ~allow_forged_in_storage:true
                 script
-              >>=? fun (Ex_script script, ctxt) ->
-              unparse_script ctxt unparsing_mode script
+              >>=? fun (ex_script, ctxt) ->
+              unparse_script ctxt unparsing_mode ex_script
               >>=? fun (script, ctxt) ->
               Script.force_decode_in_context
                 ~consume_deserialization_gas:When_needed
@@ -2763,8 +2764,8 @@ module RPC = struct
                 ~legacy:true
                 ~allow_forged_in_storage:true
                 script
-              >>=? fun (Ex_script script, ctxt) ->
-              unparse_script ctxt unparsing_mode script
+              >>=? fun (ex_script, ctxt) ->
+              unparse_script ctxt unparsing_mode ex_script
               >>=? fun (script, _ctxt) -> return_some script)
 
     let get_storage_normalized ctxt block ~contract ~unparsing_mode =
diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml
index 2cb975ed4e87f6418ff06397fdbf258bfb3a18ae..5d1420e5cab1ecb2412056c14751e7aa49dc3a62 100644
--- a/src/proto_alpha/lib_protocol/contract_services.ml
+++ b/src/proto_alpha/lib_protocol/contract_services.ml
@@ -344,8 +344,8 @@ let[@coq_axiom_with_reason "gadt"] register () =
           let ctxt = Gas.set_unlimited ctxt in
           let open Script_ir_translator in
           parse_script ctxt ~legacy:true ~allow_forged_in_storage:true script
-          >>=? fun (Ex_script script, ctxt) ->
-          unparse_script ctxt Readable script >>=? fun (script, ctxt) ->
+          >>=? fun (ex_script, ctxt) ->
+          unparse_script ctxt Readable ex_script >>=? fun (script, ctxt) ->
           Script.force_decode_in_context
             ~consume_deserialization_gas:When_needed
             ctxt
@@ -460,8 +460,8 @@ let[@coq_axiom_with_reason "gadt"] register () =
           let ctxt = Gas.set_unlimited ctxt in
           let open Script_ir_translator in
           parse_script ctxt ~legacy:true ~allow_forged_in_storage:true script
-          >>=? fun (Ex_script script, ctxt) ->
-          unparse_script ctxt Readable script >|=? fun (script, ctxt) ->
+          >>=? fun (ex_script, ctxt) ->
+          unparse_script ctxt Readable ex_script >|=? fun (script, ctxt) ->
           (Some script, ctxt))
       >|=? fun (script, _ctxt) -> {balance; delegate; script; counter}) ;
   S.Sapling.register ()
diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 83670f16d3be5f9607f633e18d4d3fe1c04c1d52..9eeb7dbce671453bba86ed9bd0a4a1c50b2c97d3 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -447,14 +447,17 @@ and ilsr_nat : type a b c d e f. (a, b, c, d, e, f) ilsr_nat_type =
   | None -> get_log logger >>=? fun log -> fail (Overflow (kinfo.iloc, log))
   | Some r -> (step [@ocaml.tailcall]) g gas k ks r stack
 
-and ifailwith : type a b. (a, b) ifailwith_type =
- fun logger (ctxt, _) gas kloc tv accu ->
-  let v = accu in
-  let ctxt = update_context gas ctxt in
-  trace Cannot_serialize_failure (unparse_data ctxt Optimized tv v)
-  >>=? fun (v, _ctxt) ->
-  let v = Micheline.strip_locations v in
-  get_log logger >>=? fun log -> fail (Reject (kloc, v, log))
+and ifailwith : ifailwith_type =
+  {
+    ifailwith =
+      (fun logger (ctxt, _) gas kloc tv accu ->
+        let v = accu in
+        let ctxt = update_context gas ctxt in
+        trace Cannot_serialize_failure (unparse_data ctxt Optimized tv v)
+        >>=? fun (v, _ctxt) ->
+        let v = Micheline.strip_locations v in
+        get_log logger >>=? fun log -> fail (Reject (kloc, v, log)));
+  }
 
 and iexec : type a b c d e f g. (a, b, c, d, e, f, g) iexec_type =
  fun logger g gas k ks accu stack ->
@@ -927,7 +930,9 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
           (step [@ocaml.tailcall]) (ctxt, sc) gas k ks lam' stack
       | ILambda (_, lam, k) ->
           (step [@ocaml.tailcall]) g gas k ks lam (accu, stack)
-      | IFailwith (_, kloc, tv) -> ifailwith None g gas kloc tv accu
+      | IFailwith (_, kloc, tv) ->
+          let {ifailwith} = ifailwith in
+          ifailwith None g gas kloc tv accu
       (* comparison *)
       | ICompare (_, ty, k) ->
           let a = accu in
@@ -981,7 +986,8 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
           >>=? fun (opt, ctxt, gas) ->
           (step [@ocaml.tailcall]) (ctxt, sc) gas k ks opt stack
       | IAddress (_, k) ->
-          (step [@ocaml.tailcall]) g gas k ks accu.address stack
+          let (Typed_contract {address; _}) = accu in
+          (step [@ocaml.tailcall]) g gas k ks address stack
       | IContract (kinfo, t, entrypoint, k) -> (
           let addr = accu in
           let entrypoint_opt =
@@ -1005,11 +1011,9 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
           | None -> (step [@ocaml.tailcall]) (ctxt, sc) gas k ks None stack)
       | ITransfer_tokens (_, k) ->
           let p = accu in
-          let (amount, (tcontract, stack)) = stack in
-          let tp = tcontract.arg_ty in
-          let destination = tcontract.address.destination in
-          let entrypoint = tcontract.address.entrypoint in
-          transfer (ctxt, sc) gas amount tp p destination entrypoint
+          let (amount, (Typed_contract {arg_ty; address}, stack)) = stack in
+          let {destination; entrypoint} = address in
+          transfer (ctxt, sc) gas amount arg_ty p destination entrypoint
           >>=? fun (accu, ctxt, gas) ->
           (step [@ocaml.tailcall]) (ctxt, sc) gas k ks accu stack
       | IImplicit_account (_, k) ->
@@ -1021,7 +1025,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
               entrypoint = Entrypoint.default;
             }
           in
-          let res = {arg_ty; address} in
+          let res = Typed_contract {arg_ty; address} in
           (step [@ocaml.tailcall]) g gas k ks res stack
       | IView (_, View_signature {name; input_ty; output_ty}, k) -> (
           let input = accu in
@@ -1211,7 +1215,8 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
           (step [@ocaml.tailcall]) g gas k ks res (accu, stack)
       | ISelf (_, ty, entrypoint, k) ->
           let destination : Destination.t = Contract sc.self in
-          let res = {arg_ty = ty; address = {destination; entrypoint}} in
+          let address = {destination; entrypoint} in
+          let res = Typed_contract {arg_ty = ty; address} in
           (step [@ocaml.tailcall]) g gas k ks res (accu, stack)
       | ISelf_address (_, k) ->
           let destination : Destination.t = Contract sc.self in
@@ -1560,6 +1565,7 @@ and log :
       let extra = (kinfo, k) in
       (ilsr_nat [@ocaml.tailcall]) (Some logger) g gas extra ks accu stack
   | IFailwith (_, kloc, tv) ->
+      let {ifailwith} = ifailwith in
       (ifailwith [@ocaml.tailcall]) (Some logger) g gas kloc tv accu
   | IExec (_, k) ->
       (iexec [@ocaml.tailcall]) (Some logger) g gas k ks accu stack
diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index bf71131c4f7cc431cae7d45cdd8ccb349ebf4d75..0525756fc9821ed3b3dc0c9ee373d313d9485735 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -89,16 +89,16 @@ let cost_of_instr : type a s r f. (a, s, r, f) kinstr -> a -> s -> Gas.cost =
       let k = accu and (_, (map, _)) = stack in
       Interp_costs.map_get_and_update k map
   | IBig_map_mem _ ->
-      let (map, _) = stack in
+      let (Big_map map, _) = stack in
       Interp_costs.big_map_mem map.diff
   | IBig_map_get _ ->
-      let (map, _) = stack in
+      let (Big_map map, _) = stack in
       Interp_costs.big_map_get map.diff
   | IBig_map_update _ ->
-      let (_, (map, _)) = stack in
+      let (_, (Big_map map, _)) = stack in
       Interp_costs.big_map_update map.diff
   | IBig_map_get_and_update _ ->
-      let (_, (map, _)) = stack in
+      let (_, (Big_map map, _)) = stack in
       Interp_costs.big_map_get_and_update map.diff
   | IAdd_seconds_to_timestamp _ ->
       let n = accu and (t, _) = stack in
@@ -873,14 +873,18 @@ type ('a, 'b, 'c, 'd, 'e, 'f) ilsr_nat_type =
   Script_int.n Script_int.num * 'b ->
   ('e * 'f * outdated_context * local_gas_counter, error trace) result Lwt.t
 
-type ('a, 'b) ifailwith_type =
-  logger option ->
-  outdated_context * step_constants ->
-  local_gas_counter ->
-  Script.location ->
-  'a ty ->
-  'a ->
-  ('b, error trace) result Lwt.t
+type ifailwith_type = {
+  ifailwith :
+    'a 'b.
+    logger option ->
+    outdated_context * step_constants ->
+    local_gas_counter ->
+    Script.location ->
+    'a ty ->
+    'a ->
+    ('b, error trace) result Lwt.t;
+}
+[@@unboxed]
 
 type ('a, 'b, 'c, 'd, 'e, 'f, 'g) iexec_type =
   logger option ->
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index adeb659f5467e42e3fbab1f0e58c6c300c0ba663..1ce2ac73e2435beaaf6f2b4ca784585bdeb7721a 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -438,7 +438,7 @@ let unparse_tx_rollup_l2_address ~loc ctxt mode
       let b58check = Tx_rollup_l2_address.to_b58check tx_address in
       (String (loc, b58check), ctxt)
 
-let unparse_contract ~loc ctxt mode {arg_ty = _; address} =
+let unparse_contract ~loc ctxt mode (Typed_contract {arg_ty = _; address}) =
   unparse_address ~loc ctxt mode address
 
 let unparse_signature ~loc ctxt mode s =
@@ -1754,16 +1754,35 @@ type toplevel = {
   views : view_map;
 }
 
-type ('arg, 'storage) code = {
-  code : (('arg, 'storage) pair, (operation boxed_list, 'storage) pair) lambda;
-  arg_type : 'arg ty;
-  storage_type : 'storage ty;
-  views : view_map;
-  entrypoints : 'arg entrypoints;
-  code_size : Cache_memory_helpers.sint;
-}
-
-type ex_script = Ex_script : ('a, 'c) script -> ex_script
+type ('arg, 'storage) code =
+  | Code : {
+      code :
+        (('arg, 'storage) pair, (operation boxed_list, 'storage) pair) lambda;
+      arg_type : 'arg ty;
+      storage_type : 'storage ty;
+      views : view_map;
+      entrypoints : 'arg entrypoints;
+      code_size : Cache_memory_helpers.sint;
+    }
+      -> ('arg, 'storage) code
+
+type ex_script =
+  | Ex_script : {
+      code :
+        (('arg, 'storage) pair, (operation boxed_list, 'storage) pair) lambda;
+      arg_type : 'arg ty;
+      storage : 'storage;
+      storage_type : 'storage ty;
+      views : view_map;
+      entrypoints : 'arg entrypoints;
+      code_size : Cache_memory_helpers.sint;
+          (* This is an over-approximation of the value size in memory, in
+             bytes, of the contract's static part, that is its source
+             code. This includes the code of the contract as well as the code
+             of the views. The storage size is not taken into account by this
+             field as it has a dynamic size. *)
+    }
+      -> ex_script
 
 type ex_code = Ex_code : ('a, 'c) code -> ex_code
 
@@ -2638,7 +2657,7 @@ let[@coq_axiom_with_reason "gadt"] rec parse_data :
             arg_ty
             address.destination
             ~entrypoint:address.entrypoint
-          >|=? fun (ctxt, _) -> ({arg_ty; address}, ctxt) )
+          >|=? fun (ctxt, _) -> (Typed_contract {arg_ty; address}, ctxt) )
   (* Pairs *)
   | (Pair_t (tl, tr, _), expr) ->
       let r_witness = comb_witness1 tr in
@@ -2789,7 +2808,8 @@ let[@coq_axiom_with_reason "gadt"] rec parse_data :
                     >>? fun (eq, ctxt) ->
                     eq >|? fun Eq -> (Some id, ctxt) )
           else traced_fail (Unexpected_forged_value loc))
-      >|=? fun (id, ctxt) -> ({id; diff; key_type = tk; value_type = tv}, ctxt)
+      >|=? fun (id, ctxt) ->
+      (Big_map {id; diff; key_type = tk; value_type = tv}, ctxt)
   | (Never_t, expr) -> Lwt.return @@ traced_no_lwt @@ parse_never expr
   (* Bls12_381 types *)
   | (Bls12_381_g1_t, Bytes (_, bs)) -> (
@@ -5031,7 +5051,8 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contra
               >>? fun (eq, ctxt) ->
                 eq >|? fun Eq ->
                 let destination : Destination.t = Contract contract in
-                (ctxt, {arg_ty = arg; address = {destination; entrypoint}}) )
+                let address = {destination; entrypoint} in
+                (ctxt, Typed_contract {arg_ty = arg; address}) )
           else fail (No_such_entrypoint entrypoint)
       | None -> (
           (* Originated account *)
@@ -5069,7 +5090,8 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contra
                        loc
                   >>? fun (entrypoint_arg, ctxt) ->
                   entrypoint_arg >|? fun (entrypoint, arg_ty) ->
-                  (ctxt, {arg_ty; address = {destination; entrypoint}}) )))
+                  let address = {destination; entrypoint} in
+                  (ctxt, Typed_contract {arg_ty; address}) )))
   | Tx_rollup tx_rollup ->
       Tx_rollup_state.assert_exist ctxt tx_rollup >>=? fun ctxt ->
       if Entrypoint.(entrypoint = Tx_rollup.deposit_entrypoint) then
@@ -5077,7 +5099,8 @@ and[@coq_axiom_with_reason "complex mutually recursive definition"] parse_contra
            [parse_contract] and [parse_tx_rollup_deposit_parameters]. *)
         match arg with
         | Pair_t (Ticket_t (_, _), Tx_rollup_l2_address_t, _) ->
-            return (ctxt, {arg_ty = arg; address = {destination; entrypoint}})
+            let address = {destination; entrypoint} in
+            return (ctxt, Typed_contract {arg_ty = arg; address})
         | _ ->
             fail
             @@ Tx_rollup_bad_deposit_parameter (loc, serialize_ty_for_error arg)
@@ -5222,9 +5245,8 @@ let parse_contract_for_script :
                 match eq with
                 | Ok Eq ->
                     let destination : Destination.t = Contract contract in
-                    let contract =
-                      {arg_ty = arg; address = {destination; entrypoint}}
-                    in
+                    let address = {destination; entrypoint} in
+                    let contract = Typed_contract {arg_ty = arg; address} in
                     (ctxt, Some contract)
                 | Error Inconsistent_types_fast -> (ctxt, None) )
           else
@@ -5276,9 +5298,8 @@ let parse_contract_for_script :
                           match entrypoint_arg with
                           | Ok (entrypoint, arg_ty) ->
                               let destination = Destination.Contract contract in
-                              let contract =
-                                {arg_ty; address = {destination; entrypoint}}
-                              in
+                              let address = {destination; entrypoint} in
+                              let contract = Typed_contract {arg_ty; address} in
                               (ctxt, Some contract)
                           | Error Inconsistent_types_fast -> (ctxt, None))) )))
   | Tx_rollup tx_rollup -> (
@@ -5291,10 +5312,8 @@ let parse_contract_for_script :
                entrypoint = Alpha_context.Tx_rollup.deposit_entrypoint) -> (
           Tx_rollup_state.find ctxt tx_rollup >|=? function
           | (ctxt, Some _) ->
-              ( ctxt,
-                Some
-                  {arg_ty = arg; address = {destination = contract; entrypoint}}
-              )
+              let address = {destination = contract; entrypoint} in
+              (ctxt, Some (Typed_contract {arg_ty = arg; address}))
           | (ctxt, None) -> (ctxt, None))
       | _ -> return (ctxt, None))
 
@@ -5358,7 +5377,8 @@ let parse_code :
     Gas.consume ctxt (Script_typed_ir_size_costs.nodes_cost ~nodes)
     >>? fun ctxt ->
     ok
-      ( Ex_code {code; arg_type; storage_type; views; entrypoints; code_size},
+      ( Ex_code
+          (Code {code; arg_type; storage_type; views; entrypoints; code_size}),
         ctxt ))
 
 let parse_storage :
@@ -5398,7 +5418,8 @@ let[@coq_axiom_with_reason "gadt"] parse_script :
  fun ?type_logger ctxt ~legacy ~allow_forged_in_storage {code; storage} ->
   parse_code ~legacy ctxt ?type_logger ~code
   >>=? fun ( Ex_code
-               {code; arg_type; storage_type; views; entrypoints; code_size},
+               (Code
+                 {code; arg_type; storage_type; views; entrypoints; code_size}),
              ctxt ) ->
   parse_storage
     ?type_logger
@@ -5612,10 +5633,10 @@ let[@coq_axiom_with_reason "gadt"] rec unparse_data :
       let items = Script_map.fold (fun k v acc -> (k, v) :: acc) map [] in
       unparse_items ctxt ~stack_depth:(stack_depth + 1) mode kt vt items
       >|=? fun (items, ctxt) -> (Micheline.Seq (loc, items), ctxt)
-  | (Big_map_t (_kt, _vt, _), {id = Some id; diff = {size; _}; _})
+  | (Big_map_t (_kt, _vt, _), Big_map {id = Some id; diff = {size; _}; _})
     when Compare.Int.( = ) size 0 ->
       return (Micheline.Int (loc, Big_map.Id.unparse_to_z id), ctxt)
-  | (Big_map_t (kt, vt, _), {id = Some id; diff = {map; _}; _}) ->
+  | (Big_map_t (kt, vt, _), Big_map {id = Some id; diff = {map; _}; _}) ->
       let items =
         Big_map_overlay.fold (fun _ (k, v) acc -> (k, v) :: acc) map []
       in
@@ -5640,7 +5661,7 @@ let[@coq_axiom_with_reason "gadt"] rec unparse_data :
             [Int (loc, Big_map.Id.unparse_to_z id); Seq (loc, items)],
             [] ),
         ctxt )
-  | (Big_map_t (kt, vt, _), {id = None; diff = {map; _}; _}) ->
+  | (Big_map_t (kt, vt, _), Big_map {id = None; diff = {map; _}; _}) ->
       let items =
         Big_map_overlay.fold
           (fun _ (k, v) acc ->
@@ -5776,7 +5797,7 @@ and[@coq_axiom_with_reason "gadt"] unparse_code ctxt ~stack_depth mode code =
 (* TODO: https://gitlab.com/tezos/tezos/-/issues/1688
    Refactor the sharing part of unparse_script and create_contract *)
 let unparse_script ctxt mode
-    {code; arg_type; storage; storage_type; entrypoints; views; _} =
+    (Ex_script {code; arg_type; storage; storage_type; entrypoints; views; _}) =
   let (Lam (_, original_code)) = code in
   Gas.consume ctxt Unparse_costs.unparse_script >>?= fun ctxt ->
   unparse_code ctxt ~stack_depth:0 mode original_code >>=? fun (code, ctxt) ->
@@ -5841,14 +5862,15 @@ let pack_data ctxt ty data =
 (* ---------------- Big map -------------------------------------------------*)
 
 let empty_big_map key_type value_type =
-  {
-    id = None;
-    diff = {map = Big_map_overlay.empty; size = 0};
-    key_type;
-    value_type;
-  }
+  Big_map
+    {
+      id = None;
+      diff = {map = Big_map_overlay.empty; size = 0};
+      key_type;
+      value_type;
+    }
 
-let big_map_mem ctxt key {id; diff; key_type; _} =
+let big_map_mem ctxt key (Big_map {id; diff; key_type; _}) =
   hash_comparable_data ctxt key_type key >>=? fun (key, ctxt) ->
   match (Big_map_overlay.find key diff.map, id) with
   | (None, None) -> return (false, ctxt)
@@ -5857,7 +5879,7 @@ let big_map_mem ctxt key {id; diff; key_type; _} =
   | (Some (_, None), _) -> return (false, ctxt)
   | (Some (_, Some _), _) -> return (true, ctxt)
 
-let big_map_get_by_hash ctxt key {id; diff; value_type; _} =
+let big_map_get_by_hash ctxt key (Big_map {id; diff; value_type; _}) =
   match (Big_map_overlay.find key diff.map, id) with
   | (Some (_, x), _) -> return (x, ctxt)
   | (None, None) -> return (None, ctxt)
@@ -5874,29 +5896,30 @@ let big_map_get_by_hash ctxt key {id; diff; value_type; _} =
             (Micheline.root value)
           >|=? fun (x, ctxt) -> (Some x, ctxt))
 
-let big_map_get ctxt key map =
-  hash_comparable_data ctxt map.key_type key >>=? fun (key_hash, ctxt) ->
+let big_map_get ctxt key (Big_map {key_type; _} as map) =
+  hash_comparable_data ctxt key_type key >>=? fun (key_hash, ctxt) ->
   big_map_get_by_hash ctxt key_hash map
 
-let big_map_update_by_hash ctxt key_hash key value map =
+let big_map_update_by_hash ctxt key_hash key value (Big_map map) =
   let contains = Big_map_overlay.mem key_hash map.diff.map in
   return
-    ( {
-        map with
-        diff =
-          {
-            map = Big_map_overlay.add key_hash (key, value) map.diff.map;
-            size = (if contains then map.diff.size else map.diff.size + 1);
-          };
-      },
+    ( Big_map
+        {
+          map with
+          diff =
+            {
+              map = Big_map_overlay.add key_hash (key, value) map.diff.map;
+              size = (if contains then map.diff.size else map.diff.size + 1);
+            };
+        },
       ctxt )
 
-let big_map_update ctxt key value map =
-  hash_comparable_data ctxt map.key_type key >>=? fun (key_hash, ctxt) ->
+let big_map_update ctxt key value (Big_map {key_type; _} as map) =
+  hash_comparable_data ctxt key_type key >>=? fun (key_hash, ctxt) ->
   big_map_update_by_hash ctxt key_hash key value map
 
-let big_map_get_and_update ctxt key value map =
-  hash_comparable_data ctxt map.key_type key >>=? fun (key_hash, ctxt) ->
+let big_map_get_and_update ctxt key value (Big_map {key_type; _} as map) =
+  hash_comparable_data ctxt key_type key >>=? fun (key_hash, ctxt) ->
   big_map_update_by_hash ctxt key_hash key value map >>=? fun (map', ctxt) ->
   big_map_get_by_hash ctxt key_hash map >>=? fun (old_value, ctxt) ->
   return ((old_value, map'), ctxt)
@@ -5908,7 +5931,7 @@ type lazy_storage_ids = Lazy_storage.IdSet.t
 let no_lazy_storage_id = Lazy_storage.IdSet.empty
 
 let diff_of_big_map ctxt mode ~temporary ~ids_to_copy
-    {id; key_type; value_type; diff} =
+    (Big_map {id; key_type; value_type; diff}) =
   (match id with
   | Some id ->
       if Lazy_storage.IdSet.mem Big_map id ids_to_copy then
@@ -6088,11 +6111,13 @@ let[@coq_axiom_with_reason "gadt"] extract_lazy_storage_updates ctxt mode
         diff_of_big_map ctxt mode ~temporary ~ids_to_copy map
         >|=? fun (diff, id, ctxt) ->
         let map =
-          {
-            map with
-            diff = {map = Big_map_overlay.empty; size = 0};
-            id = Some id;
-          }
+          let (Big_map map) = map in
+          Big_map
+            {
+              map with
+              diff = {map = Big_map_overlay.empty; size = 0};
+              id = Some id;
+            }
         in
         let diff = Lazy_storage.make Big_map id diff in
         let ids_to_copy = Lazy_storage.IdSet.add Big_map id ids_to_copy in
@@ -6189,14 +6214,14 @@ let[@coq_axiom_with_reason "gadt"] rec fold_lazy_storage :
  fun ~f ~init ctxt ty x ~has_lazy_storage ->
   Gas.consume ctxt Typecheck_costs.parse_instr_cycle >>? fun ctxt ->
   match (has_lazy_storage, ty, x) with
-  | (Big_map_f, Big_map_t (_, _, _), {id = Some id; _}) ->
+  | (Big_map_f, Big_map_t (_, _, _), Big_map {id = Some id; _}) ->
       Gas.consume ctxt Typecheck_costs.parse_instr_cycle >>? fun ctxt ->
       ok (f.f Big_map id (Fold_lazy_storage.Ok init), ctxt)
   | (Sapling_state_f, Sapling_state_t _, {id = Some id; _}) ->
       Gas.consume ctxt Typecheck_costs.parse_instr_cycle >>? fun ctxt ->
       ok (f.f Sapling_state id (Fold_lazy_storage.Ok init), ctxt)
   | (False_f, _, _) -> ok (Fold_lazy_storage.Ok init, ctxt)
-  | (Big_map_f, Big_map_t (_, _, _), {id = None; _}) ->
+  | (Big_map_f, Big_map_t (_, _, _), Big_map {id = None; _}) ->
       ok (Fold_lazy_storage.Ok init, ctxt)
   | (Sapling_state_f, Sapling_state_t _, {id = None; _}) ->
       ok (Fold_lazy_storage.Ok init, ctxt)
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index 76afa476ea055953cde743b91af50f01bbe5af47..cfeea77563982f6c9d8dfa8425fe3a0b63265414 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -82,7 +82,22 @@ type ex_parameter_ty_and_entrypoints =
 type ex_stack_ty =
   | Ex_stack_ty : ('a, 's) Script_typed_ir.stack_ty -> ex_stack_ty
 
-type ex_script = Ex_script : ('a, 'b) Script_typed_ir.script -> ex_script
+type ex_script =
+  | Ex_script : {
+      code :
+        ( ('arg, 'storage) Script_typed_ir.pair,
+          ( Script_typed_ir.operation Script_typed_ir.boxed_list,
+            'storage )
+          Script_typed_ir.pair )
+        Script_typed_ir.lambda;
+      arg_type : 'arg Script_typed_ir.ty;
+      storage : 'storage;
+      storage_type : 'storage Script_typed_ir.ty;
+      views : Script_typed_ir.view_map;
+      entrypoints : 'arg Script_typed_ir.entrypoints;
+      code_size : Cache_memory_helpers.sint;
+    }
+      -> ex_script
 
 type toplevel = {
   code_field : Script.node;
@@ -91,24 +106,26 @@ type toplevel = {
   views : Script_typed_ir.view_map;
 }
 
-type ('arg, 'storage) code = {
-  code :
-    ( ('arg, 'storage) Script_typed_ir.pair,
-      ( Script_typed_ir.operation Script_typed_ir.boxed_list,
-        'storage )
-      Script_typed_ir.pair )
-    Script_typed_ir.lambda;
-  arg_type : 'arg Script_typed_ir.ty;
-  storage_type : 'storage Script_typed_ir.ty;
-  views : Script_typed_ir.view_map;
-  entrypoints : 'arg Script_typed_ir.entrypoints;
-  code_size : Cache_memory_helpers.sint;
-      (** This is an over-approximation of the value size in memory, in
+type ('arg, 'storage) code =
+  | Code : {
+      code :
+        ( ('arg, 'storage) Script_typed_ir.pair,
+          ( Script_typed_ir.operation Script_typed_ir.boxed_list,
+            'storage )
+          Script_typed_ir.pair )
+        Script_typed_ir.lambda;
+      arg_type : 'arg Script_typed_ir.ty;
+      storage_type : 'storage Script_typed_ir.ty;
+      views : Script_typed_ir.view_map;
+      entrypoints : 'arg Script_typed_ir.entrypoints;
+      code_size : Cache_memory_helpers.sint;
+          (** This is an over-approximation of the value size in memory, in
          bytes, of the contract's static part, that is its source
          code. This includes the code of the contract as well as the code
          of the views. The storage size is not taken into account by this
          field as it has a dynamic size. *)
-}
+    }
+      -> ('arg, 'storage) code
 
 type ex_code = Ex_code : ('a, 'c) code -> ex_code
 
@@ -390,10 +407,7 @@ val parse_script :
 
 (* Gas accounting may not be perfect in this function, as it is only called by RPCs. *)
 val unparse_script :
-  context ->
-  unparsing_mode ->
-  ('a, 'b) Script_typed_ir.script ->
-  (Script.t * context) tzresult Lwt.t
+  context -> unparsing_mode -> ex_script -> (Script.t * context) tzresult Lwt.t
 
 val parse_contract :
   context ->
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml
index 381135a95b444a7f2ab9f0789b76a87443d64178..712e01b2bcca62d7cca48586b8fdf7aae0aa9b02 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -523,23 +523,8 @@ and 'arg nested_entrypoints =
 
 let no_entrypoints = {name = None; nested = Entrypoints_None}
 
-type ('arg, 'storage) script = {
-  code : (('arg, 'storage) pair, (operation boxed_list, 'storage) pair) lambda;
-  arg_type : 'arg ty;
-  storage : 'storage;
-  storage_type : 'storage ty;
-  views : view_map;
-  entrypoints : 'arg entrypoints;
-  code_size : Cache_memory_helpers.sint;
-      (* This is an over-approximation of the value size in memory, in
-         bytes, of the contract's static part, that is its source
-         code. This includes the code of the contract as well as the code
-         of the views. The storage size is not taken into account by this
-         field as it has a dynamic size. *)
-}
-
 (* ---- Instructions --------------------------------------------------------*)
-and ('before_top, 'before, 'result_top, 'result) kinstr =
+type ('before_top, 'before, 'result_top, 'result) kinstr =
   (*
      Stack
      -----
@@ -1214,7 +1199,12 @@ and ('arg, 'ret) lambda =
       -> ('arg, 'ret) lambda
 [@@coq_force_gadt]
 
-and 'arg typed_contract = {arg_ty : 'arg ty; address : address}
+and 'arg typed_contract =
+  | Typed_contract : {
+      arg_ty : 'arg ty;
+      address : address;
+    }
+      -> 'arg typed_contract
 
 and (_, _, _, _) continuation =
   | KNil : ('r, 'f, 'r, 'f) continuation
@@ -1339,12 +1329,14 @@ and ('top_ty, 'resty) stack_ty =
   | Item_t : 'ty ty * ('ty2, 'rest) stack_ty -> ('ty, 'ty2 * 'rest) stack_ty
   | Bot_t : (empty_cell, empty_cell) stack_ty
 
-and ('key, 'value) big_map = {
-  id : Big_map.Id.t option;
-  diff : ('key, 'value) big_map_overlay;
-  key_type : 'key comparable_ty;
-  value_type : 'value ty;
-}
+and ('key, 'value) big_map =
+  | Big_map : {
+      id : Big_map.Id.t option;
+      diff : ('key, 'value) big_map_overlay;
+      key_type : 'key comparable_ty;
+      value_type : 'value ty;
+    }
+      -> ('key, 'value) big_map
 
 and ('a, 's, 'r, 'f) kdescr = {
   kloc : Script.location;
@@ -1403,12 +1395,13 @@ and (_, _) dup_n_gadt_witness =
       ('stack, 'b) dup_n_gadt_witness
       -> ('a * 'stack, 'b) dup_n_gadt_witness
 
-and ('a, 'b) view_signature =
-  | View_signature of {
+and ('input, 'output) view_signature =
+  | View_signature : {
       name : Script_string.t;
-      input_ty : 'a ty;
-      output_ty : 'b ty;
+      input_ty : 'input ty;
+      output_ty : 'output ty;
     }
+      -> ('input, 'output) view_signature
 
 let kinfo_of_kinstr : type a s b f. (a, s, b, f) kinstr -> (a, s) kinfo =
  fun i ->
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli
index 5b16b3d06329cce7b2ca3efed49e49995e4b002a..e21826294f59c00de06749064aaff5ed9d38906f 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.mli
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli
@@ -385,16 +385,6 @@ and 'arg nested_entrypoints =
 (** [no_entrypoints] is [{name = None; nested = Entrypoints_None}] *)
 val no_entrypoints : _ entrypoints
 
-type ('arg, 'storage) script = {
-  code : (('arg, 'storage) pair, (operation boxed_list, 'storage) pair) lambda;
-  arg_type : 'arg ty;
-  storage : 'storage;
-  storage_type : 'storage ty;
-  views : view_map;
-  entrypoints : 'arg entrypoints;
-  code_size : Cache_memory_helpers.sint;
-}
-
 (* ---- Instructions --------------------------------------------------------*)
 
 (*
@@ -496,7 +486,7 @@ type ('arg, 'storage) script = {
    [1]: http://www.complang.tuwien.ac.at/projects/interpreters.html
 
  *)
-and ('before_top, 'before, 'result_top, 'result) kinstr =
+type ('before_top, 'before, 'result_top, 'result) kinstr =
   (*
      Stack
      -----
@@ -1211,7 +1201,12 @@ and ('arg, 'ret) lambda =
       -> ('arg, 'ret) lambda
 [@@coq_force_gadt]
 
-and 'arg typed_contract = {arg_ty : 'arg ty; address : address}
+and 'arg typed_contract =
+  | Typed_contract : {
+      arg_ty : 'arg ty;
+      address : address;
+    }
+      -> 'arg typed_contract
 
 (*
 
@@ -1432,12 +1427,14 @@ and ('top_ty, 'resty) stack_ty =
   | Item_t : 'ty ty * ('ty2, 'rest) stack_ty -> ('ty, 'ty2 * 'rest) stack_ty
   | Bot_t : (empty_cell, empty_cell) stack_ty
 
-and ('key, 'value) big_map = {
-  id : Big_map.Id.t option;
-  diff : ('key, 'value) big_map_overlay;
-  key_type : 'key comparable_ty;
-  value_type : 'value ty;
-}
+and ('key, 'value) big_map =
+  | Big_map : {
+      id : Big_map.Id.t option;
+      diff : ('key, 'value) big_map_overlay;
+      key_type : 'key comparable_ty;
+      value_type : 'value ty;
+    }
+      -> ('key, 'value) big_map
 
 and ('a, 's, 'r, 'f) kdescr = {
   kloc : Script.location;
@@ -1530,12 +1527,13 @@ and (_, _) dup_n_gadt_witness =
       ('stack, 'b) dup_n_gadt_witness
       -> ('a * 'stack, 'b) dup_n_gadt_witness
 
-and ('a, 'b) view_signature =
-  | View_signature of {
+and ('input, 'output) view_signature =
+  | View_signature : {
       name : Script_string.t;
-      input_ty : 'a ty;
-      output_ty : 'b ty;
+      input_ty : 'input ty;
+      output_ty : 'output ty;
     }
+      -> ('input, 'output) view_signature
 
 val kinfo_of_kinstr : ('a, 's, 'b, 'f) kinstr -> ('a, 's) kinfo
 
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir_size.ml b/src/proto_alpha/lib_protocol/script_typed_ir_size.ml
index 0d0e243ec276284d311f523f61469457019acf20..303cba4c5527f55a729fdfc5bd02745c7f8b8a0f 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir_size.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir_size.ml
@@ -189,7 +189,7 @@ let comb_set_gadt_witness_size = peano_shape_proof
 
 let dup_n_gadt_witness_size = peano_shape_proof
 
-let contract_size {arg_ty; address} =
+let contract_size (Typed_contract {arg_ty; address}) =
   ret_adding (ty_size arg_ty) (h2w +! address_size address)
 
 let sapling_state_size {Sapling.id; diff; memo_size = _} =
@@ -358,7 +358,7 @@ and big_map_size :
     b ty ->
     (a, b) big_map ->
     nodes_and_size =
- fun ~count_lambda_nodes accu cty ty' {id; diff; key_type; value_type} ->
+ fun ~count_lambda_nodes accu cty ty' (Big_map {id; diff; key_type; value_type}) ->
   (* [Map.bindings] cannot overflow and only consumes a
      logarithmic amount of stack. *)
   let diff_size =
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
index da849f548ff2577e04973712fea737631b6dd151..fc9c6aaa1b21ca2ba6ee2f4ee3a43b56e0a52555 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
@@ -282,12 +282,13 @@ let empty_big_map ctxt ~key_type ~value_type =
   let open Script_typed_ir in
   let* (ctxt, big_map_id) = wrap @@ Big_map.fresh ~temporary:false ctxt in
   return
-    ( {
-        id = Some big_map_id;
-        diff = {map = Big_map_overlay.empty; size = 0};
-        key_type;
-        value_type;
-      },
+    ( Big_map
+        {
+          id = Some big_map_id;
+          diff = {map = Big_map_overlay.empty; size = 0};
+          key_type;
+          value_type;
+        },
       ctxt )
 
 let make_big_map ctxt contract ~key_type ~value_type entries =
@@ -297,12 +298,13 @@ let make_big_map ctxt contract ~key_type ~value_type entries =
     new_big_map ctxt contract ~key_type ~value_type entries
   in
   return
-    ( {
-        id = Some big_map_id;
-        diff = {map = Big_map_overlay.empty; size = 0};
-        key_type;
-        value_type;
-      },
+    ( Big_map
+        {
+          id = Some big_map_id;
+          diff = {map = Big_map_overlay.empty; size = 0};
+          key_type;
+          value_type;
+        },
       ctxt )
 
 let originate_script block ~script ~storage ~src ~baker ~forges_tickets =
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml
index 7bea77de4e6a95bdaf0a35fef22e6208cbfeb63c..c63cd71ce4f11c459c39b7dd3459f3a5cd44cf69 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_typechecking.ml
@@ -58,8 +58,8 @@ let test_unparse_view () =
     ~legacy:true
     ~allow_forged_in_storage:false
     script
-  >>=?? fun (Ex_script script, ctx) ->
-  Script_ir_translator.unparse_script ctx Readable script
+  >>=?? fun (ex_script, ctx) ->
+  Script_ir_translator.unparse_script ctx Readable ex_script
   >>=?? fun (unparse_script, _ctx) ->
   let aft = Data_encoding.force_bytes unparse_script.code in
   Alcotest.(check bytes) "didn't match" bef aft |> return
@@ -449,9 +449,10 @@ let test_parse_comb_data () =
     let open Script_typed_ir in
     let diff = {map = Big_map_overlay.empty; size = 0} in
     let nat_key_ty = nat_key in
-    {id = Some big_map_id; diff; key_type = nat_key_ty; value_type = nat_ty}
+    Big_map
+      {id = Some big_map_id; diff; key_type = nat_key_ty; value_type = nat_ty}
   in
-  let equal (nat1, big_map1) (nat2, big_map2) =
+  let equal (nat1, Big_map big_map1) (nat2, Big_map big_map2) =
     (* Custom equal needed because big maps contain boxed maps containing functional values *)
     nat1 = nat2 && big_map1.id = big_map2.id
     && big_map1.key_type = big_map2.key_type
diff --git a/src/proto_alpha/lib_protocol/ticket_scanner.ml b/src/proto_alpha/lib_protocol/ticket_scanner.ml
index 34efc616787aa51a6471336046e0bbb7921e034b..fa63c380fc10a3cedb6a4fd1d1a718a4741a71ee 100644
--- a/src/proto_alpha/lib_protocol/ticket_scanner.ml
+++ b/src/proto_alpha/lib_protocol/ticket_scanner.ml
@@ -473,7 +473,7 @@ module Ticket_collection = struct
    fun ctxt
        val_hty
        key_ty
-       {Script_typed_ir.id; diff = {map = _; size}; key_type = _; value_type}
+       (Big_map {id; diff = {map = _; size}; key_type = _; value_type})
        acc
        k ->
     consume_gas_steps ctxt ~num_steps:1 >>?= fun ctxt ->
@@ -512,19 +512,23 @@ module Ticket_collection = struct
         return (ex_tickets, ctxt))
 end
 
-type 'a has_tickets = 'a Ticket_inspection.has_tickets * 'a Script_typed_ir.ty
+type 'a has_tickets =
+  | Has_tickets :
+      'a Ticket_inspection.has_tickets * 'a Script_typed_ir.ty
+      -> 'a has_tickets
 
 let type_has_tickets ctxt ty =
   Ticket_inspection.has_tickets_of_ty ctxt ty >|? fun (has_tickets, ctxt) ->
-  ((has_tickets, ty), ctxt)
+  (Has_tickets (has_tickets, ty), ctxt)
 
-let tickets_of_value ctxt ~include_lazy (ht, ty) =
+let tickets_of_value ctxt ~include_lazy (Has_tickets (ht, ty)) =
   Ticket_collection.tickets_of_value ctxt ~include_lazy ht ty
 
-let has_tickets (ht, _) =
+let has_tickets (Has_tickets (ht, _)) =
   match ht with Ticket_inspection.False_ht -> false | _ -> true
 
-let tickets_of_node ctxt ~include_lazy (ht, ty) expr =
+let tickets_of_node ctxt ~include_lazy has_tickets expr =
+  let (Has_tickets (ht, ty)) = has_tickets in
   match ht with
   | Ticket_inspection.False_ht -> return ([], ctxt)
   | _ ->
@@ -535,4 +539,4 @@ let tickets_of_node ctxt ~include_lazy (ht, ty) expr =
         ty
         expr
       >>=? fun (value, ctxt) ->
-      tickets_of_value ctxt ~include_lazy (ht, ty) value
+      tickets_of_value ctxt ~include_lazy has_tickets value