Alpha, Gas: gas accounting for serialization of data and types

Also gas accounting in errors, failures and trace

src/proto_alpha/lib_client/michelson_v1_error_reporter.ml

@@ -10,39 +10,32 @@
 open Proto_alpha
 open Alpha_context
 open Tezos_micheline
-open Script_typed_ir
 open Script_tc_errors
-open Script_ir_annot
-open Script_ir_translator
 open Script_interpreter
 open Michelson_v1_printer
 
-let print_ty (type t) ppf (ty : t ty) =
+let print_ty ppf ty =
-  unparse_ty ty
+  Michelson_v1_printer.print_expr_unwrapped ppf ty
-  |> Micheline.strip_locations
-  |> Michelson_v1_printer.print_expr_unwrapped ppf
 
 let print_var_annot ppf annot =
-  List.iter (Format.fprintf ppf "@ %s") (unparse_var_annot annot)
+  List.iter (Format.fprintf ppf "@ %s") annot
 
-let print_stack_ty (type t) ?(depth = max_int) ppf (s : t stack_ty) =
+let print_stack_ty ?(depth = max_int) ppf s =
-  let rec loop
+  let rec loop depth ppf = function
-    : type t. int -> Format.formatter -> t stack_ty -> unit
+    | [] -> ()
-    = fun depth ppf -> function
-      | Empty_t -> ()
     | _ when depth <= 0 ->
         Format.fprintf ppf "..."
-      | Item_t (last, Empty_t, annot) ->
+    | [last, annot] ->
         Format.fprintf ppf "%a%a"
           print_ty last
           print_var_annot annot
-      | Item_t (last, rest, annot) ->
+    | (last, annot) :: rest ->
         Format.fprintf ppf "%a%a@ :@ %a"
           print_ty last
           print_var_annot annot
           (loop (depth - 1)) rest in
   match s with
-  | Empty_t ->
+  | [] ->
       Format.fprintf ppf "[]"
   | sty ->
       Format.fprintf ppf "@[<hov 2>[ %a ]@]" (loop depth) sty
@@ -338,7 +331,7 @@ let report_errors ~details ~show_source ?parsed ppf errs =
                  - @[<v 0>expected return stack type:@ %a,@]@,\
                  - @[<v 0>actual stack type:@ %a.@]@]"
                 print_loc loc
-                (fun ppf -> print_stack_ty ppf) (Item_t (exp, Empty_t, None))
+                (fun ppf -> print_stack_ty ppf) [exp, []]
                 (fun ppf -> print_stack_ty ppf) got
           | Bad_stack (loc, name, depth, sty) ->
               Format.fprintf ppf

src/proto_alpha/lib_protocol/src/helpers_services.ml

@@ -200,7 +200,7 @@ module Scripts = struct
       let ctxt = match maybe_gas with
         | None -> Gas.set_unlimited ctxt
         | Some gas -> Gas.set_limit ctxt gas in
-      Lwt.return (parse_ty ~allow_big_map:false ~allow_operation:false (Micheline.root typ)) >>=? fun (Ex_ty typ) ->
+      Lwt.return (parse_ty ctxt ~allow_big_map:false ~allow_operation:false (Micheline.root typ)) >>=? fun (Ex_ty typ) ->
       parse_data ctxt typ (Micheline.root expr) >>=? fun (data, ctxt) ->
       Script_ir_translator.pack_data ctxt typ data >>=? fun (bytes, ctxt) ->
       return (bytes, Gas.level ctxt)

src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml

@@ -236,21 +236,27 @@ module Cost_of = struct
   end
 
   module Unparse = struct
-    let prim_cost = alloc_cost 4 (* location, primitive name, list, annotation *)
+    let prim_cost nb_args =
+      alloc_cost 4 (* location, primitive name, list, annotation *) +@
+      (nb_args *@ alloc_cost 2)
+    let seq_cost nb_args =
+      alloc_cost 2 (* location, list *) +@
+      (nb_args *@ alloc_cost 2)
     let string_cost length =
       alloc_cost 3 +@ alloc_bytes_cost length
 
     let cycle = step_cost 1
-    let bool = prim_cost
+    let bool = prim_cost 0
-    let unit = prim_cost
+    let unit = prim_cost 0
     (* FIXME: not sure we should count the length of strings and bytes
        as they are shared *)
     let string s = string_cost (String.length s)
     let bytes s = alloc_bytes_cost (MBytes.length s)
     (* Approximates log10(x) *)
-    let int i =
+    let z i =
-      let decimal_digits = (Z.numbits (Z.abs (Script_int.to_zint i))) / 4 in
+      let decimal_digits = (Z.numbits (Z.abs i)) / 4 in
-      prim_cost +@ (alloc_bytes_cost decimal_digits)
+      prim_cost 0 +@ (alloc_bytes_cost decimal_digits)
+    let int i = z (Script_int.to_zint i)
     let tez = string_cost 19 (* max length of 64 bit int *)
     let timestamp x = Script_timestamp.to_zint x |> Script_int.of_zint |> int
     let operation bytes = string_cost (MBytes.length bytes * 2)
@@ -258,17 +264,15 @@ module Cost_of = struct
     let key_hash = string_cost 36
     let signature = string_cost 128
     let contract = string_cost 36
-    let pair = prim_cost +@ alloc_cost 4
+    let pair = prim_cost 2
-    let union = prim_cost +@ alloc_cost 2
+    let union = prim_cost 1
-    let lambda = prim_cost +@ alloc_cost 3
+    let some = prim_cost 1
-    let some = prim_cost +@ alloc_cost 2
+    let none = prim_cost 0
-    let none = prim_cost
+    let list_element = prim_cost 1
-    let list_element = prim_cost +@ alloc_cost 2
     let set_element = alloc_cost 2
     let map_element = alloc_cost 2
-    let primitive_type = prim_cost
+    let one_arg_type = prim_cost 1
-    let one_arg_type = prim_cost +@ alloc_cost 2
+    let two_arg_type = prim_cost 2
-    let two_arg_type = prim_cost +@ alloc_cost 4
 
     let set_to_list = set_to_list
     let map_to_list = map_to_list

src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli

@@ -135,9 +135,12 @@ module Cost_of : sig
   end
 
   module Unparse : sig
+    val prim_cost : int -> Gas.cost
+    val seq_cost : int -> Gas.cost
     val cycle : Gas.cost
     val unit : Gas.cost
     val bool : Gas.cost
+    val z : Z.t -> Gas.cost
     val int : 'a Script_int.num -> Gas.cost
     val tez : Gas.cost
     val string : string -> Gas.cost
@@ -155,8 +158,6 @@ module Cost_of : sig
 
     val union : Gas.cost
 
-    val lambda : Gas.cost
-
     val some : Gas.cost
     val none : Gas.cost
 
@@ -164,7 +165,6 @@ module Cost_of : sig
     val set_element : Gas.cost
     val map_element : Gas.cost
 
-    val primitive_type : Gas.cost
     val one_arg_type : Gas.cost
     val two_arg_type : Gas.cost
     val set_to_list : 'a Script_typed_ir.set -> Gas.cost

src/proto_alpha/lib_protocol/src/script_interpreter.ml

@@ -21,6 +21,9 @@ type error += Reject of Script.location * Script.expr * execution_trace option
 type error += Overflow of Script.location * execution_trace option
 type error += Runtime_contract_error : Contract.t * Script.expr -> error
 type error += Bad_contract_parameter of Contract.t (* `Permanent *)
+type error += Cannot_serialize_log
+type error += Cannot_serialize_failure
+type error += Cannot_serialize_storage
 
 let () =
   let open Data_encoding in
@@ -82,7 +85,37 @@ let () =
                   the wrong type"
     Data_encoding.(obj1 (req "contract" Contract.encoding))
     (function Bad_contract_parameter c -> Some c | _ -> None)
-    (fun c -> Bad_contract_parameter c)
+    (fun c -> Bad_contract_parameter c) ;
+  (* Cannot serialize log *)
+  register_error_kind
+    `Temporary
+    ~id:"cannotSerializeLog"
+    ~title:"Not enough gas to serialize execution trace"
+    ~description:"Execution trace with stacks was to big to be serialized with \
+                  the provided gas"
+    Data_encoding.empty
+    (function Cannot_serialize_log -> Some () | _ -> None)
+    (fun () -> Cannot_serialize_log) ;
+  (* Cannot serialize failure *)
+  register_error_kind
+    `Temporary
+    ~id:"cannotSerializeFailure"
+    ~title:"Not enough gas to serialize argument of FAILWITH"
+    ~description:"Argument of FAILWITH was too big to be serialized with \
+                  the provided gas"
+    Data_encoding.empty
+    (function Cannot_serialize_failure -> Some () | _ -> None)
+    (fun () -> Cannot_serialize_failure) ;
+  (* Cannot serialize storage *)
+  register_error_kind
+    `Temporary
+    ~id:"cannotSerializeStorage"
+    ~title:"Not enough gas to serialize execution storage"
+    ~description:"The returned storage was too big to be serialized with \
+                  the provided gas"
+    Data_encoding.empty
+    (function Cannot_serialize_storage -> Some () | _ -> None)
+    (fun () -> Cannot_serialize_storage)
 
 (* ---- interpreter ---------------------------------------------------------*)
 
@@ -132,7 +165,9 @@ let rec interp
             match log with
             | None -> return (ret, ctxt)
             | Some log ->
-                unparse_stack ctxt (ret, descr.aft) >>=? fun stack ->
+                trace
+                  Cannot_serialize_log
+                  (unparse_stack ctxt (ret, descr.aft)) >>=? fun stack ->
                 log := (descr.loc, Gas.level ctxt, stack) :: !log ;
                 return (ret, ctxt) in
         let get_log (log : execution_trace ref option) =
@@ -544,7 +579,8 @@ let rec interp
             Lwt.return (Gas.consume ctxt Interp_costs.push) >>=? fun ctxt ->
             logged_return (Item (lam, rest), ctxt)
         | Failwith tv, Item (v, _) ->
-            unparse_data ctxt Optimized tv v >>=? fun (v, _ctxt) ->
+            trace Cannot_serialize_failure
+              (unparse_data ctxt Optimized tv v) >>=? fun (v, _ctxt) ->
             let v = Micheline.strip_locations v in
             fail (Reject (loc, v, get_log log))
         | Nop, stack ->
@@ -658,10 +694,12 @@ let rec interp
                            (credit, Item
                               (init, rest)))))) ->
             Lwt.return (Gas.consume ctxt Interp_costs.create_contract) >>=? fun ctxt ->
+            unparse_ty ctxt param_type >>=? fun (u_param_type, ctxt) ->
+            unparse_ty ctxt storage_type >>=? fun (u_storage_type, ctxt) ->
             let code =
               Micheline.strip_locations
-                (Seq (0, [ Prim (0, K_parameter, [ unparse_ty param_type ], []) ;
+                (Seq (0, [ Prim (0, K_parameter, [ u_param_type ], []) ;
-                           Prim (0, K_storage, [ unparse_ty storage_type ], []) ;
+                           Prim (0, K_storage, [ u_storage_type ], []) ;
                            Prim (0, K_code, [ Micheline.root code ], []) ])) in
             unparse_data ctxt Optimized storage_type init >>=? fun (storage, ctxt) ->
             let storage = Micheline.strip_locations storage in
@@ -732,7 +770,8 @@ let rec interp
     begin match log with
       | None -> return_unit
       | Some log ->
-          unparse_stack ctxt (stack, code.bef) >>=? fun stack ->
+          trace Cannot_serialize_log
+            (unparse_stack ctxt (stack, code.bef)) >>=? fun stack ->
           log := (code.loc, Gas.level ctxt, stack) :: !log ;
           return_unit
     end >>=? fun () ->
@@ -755,7 +794,8 @@ and execute ?log ctxt mode ~source ~payer ~self script amount arg :
     (Runtime_contract_error (self, script_code))
     (interp ?log ctxt ~source ~payer ~self amount code (arg, storage))
   >>=? fun ((ops, sto), ctxt) ->
-  unparse_data ctxt mode storage_type sto >>=? fun (storage, ctxt) ->
+  trace Cannot_serialize_storage
+    (unparse_data ctxt mode storage_type sto) >>=? fun (storage, ctxt) ->
   return (Micheline.strip_locations storage, ops, ctxt,
           Script_ir_translator.extract_big_map storage_type sto)
 

src/proto_alpha/lib_protocol/src/script_interpreter.mli

@@ -16,6 +16,9 @@ type error += Reject of Script.location * Script.expr * execution_trace option
 type error += Overflow of Script.location * execution_trace option
 type error += Runtime_contract_error : Contract.t * Script.expr -> error
 type error += Bad_contract_parameter of Contract.t (* `Permanent *)
+type error += Cannot_serialize_log
+type error += Cannot_serialize_failure
+type error += Cannot_serialize_storage
 
 type execution_result =
   { ctxt : context ;

src/proto_alpha/lib_protocol/src/script_ir_translator.mli

@@ -57,6 +57,7 @@ val big_map_update :
   ('key, 'value) Script_typed_ir.big_map
 
 val ty_eq :
+  context ->
   'ta Script_typed_ir.ty -> 'tb Script_typed_ir.ty ->
   ('ta Script_typed_ir.ty, 'tb Script_typed_ir.ty) eq tzresult
 
@@ -69,13 +70,16 @@ val unparse_data :
   (Script.node * context) tzresult Lwt.t
 
 val parse_ty :
+  context ->
   allow_big_map: bool ->
   allow_operation: bool ->
   Script.node -> ex_ty tzresult
-val unparse_ty : 'a Script_typed_ir.ty -> Script.node
 
-val parse_toplevel
+val unparse_ty :
-  : Script.expr -> (Script.node * Script.node * Script.node) tzresult
+  context -> 'a Script_typed_ir.ty -> (Script.node * context) tzresult Lwt.t
+
+val parse_toplevel :
+  Script.expr -> (Script.node * Script.node * Script.node) tzresult
 
 val typecheck_code :
   context -> Script.expr -> (type_map * context) tzresult Lwt.t

src/proto_alpha/lib_protocol/src/script_tc_errors.ml

@@ -9,7 +9,6 @@
 
 open Alpha_context
 open Script
-open Script_typed_ir
 
 
 (* ---- Error definitions ---------------------------------------------------*)
@@ -17,7 +16,8 @@ open Script_typed_ir
 (* Auxiliary types for error documentation *)
 type namespace = Type_namespace | Constant_namespace | Instr_namespace | Keyword_namespace
 type kind = Int_kind | String_kind | Bytes_kind | Prim_kind | Seq_kind
-type type_map = (int * ((Script.expr * Script.annot) list * (Script.expr * Script.annot) list)) list
+type unparsed_stack_ty = (Script.expr * Script.annot) list
+type type_map = (int * (unparsed_stack_ty * unparsed_stack_ty)) list
 
 (* Structure errors *)
 type error += Invalid_arity of Script.location * prim * int * int
@@ -31,35 +31,38 @@ type error += Unexpected_operation of Script.location
 
 (* Instruction typing errors *)
 type error += Fail_not_in_tail_position of Script.location
-type error += Undefined_binop : Script.location * prim * _ ty * _ ty -> error
+type error += Undefined_binop : Script.location * prim * Script.expr * Script.expr -> error
-type error += Undefined_unop : Script.location * prim * _ ty -> error
+type error += Undefined_unop : Script.location * prim * Script.expr -> error
-type error += Bad_return : Script.location * _ stack_ty * _ ty -> error
+type error += Bad_return : Script.location * unparsed_stack_ty * Script.expr -> error
-type error += Bad_stack : Script.location * prim * int * _ stack_ty -> error
+type error += Bad_stack : Script.location * prim * int * unparsed_stack_ty -> error
-type error += Unmatched_branches : Script.location * _ stack_ty * _ stack_ty -> error
+type error += Unmatched_branches : Script.location * unparsed_stack_ty * unparsed_stack_ty -> error
 type error += Self_in_lambda of Script.location
 type error += Bad_stack_length
 type error += Bad_stack_item of int
 type error += Inconsistent_annotations of string * string
-type error += Inconsistent_type_annotations : Script.location * _ ty * _ ty -> error
+type error += Inconsistent_type_annotations : Script.location * Script.expr * Script.expr -> error
 type error += Inconsistent_field_annotations of string * string
 type error += Unexpected_annotation of Script.location
 type error += Ungrouped_annotations of Script.location
-type error += Invalid_map_body : Script.location * _ stack_ty -> error
+type error += Invalid_map_body : Script.location * unparsed_stack_ty -> error
 type error += Invalid_map_block_fail of Script.location
-type error += Invalid_iter_body : Script.location * _ stack_ty * _ stack_ty -> error
+type error += Invalid_iter_body : Script.location * unparsed_stack_ty * unparsed_stack_ty -> error
 type error += Type_too_large : Script.location * int * int -> error
 
 (* Value typing errors *)
-type error += Invalid_constant : Script.location * Script.expr * _ ty -> error
+type error += Invalid_constant : Script.location * Script.expr * Script.expr -> error
 type error += Invalid_contract of Script.location * Contract.t
-type error += Comparable_type_expected : Script.location * _ ty -> error
+type error += Comparable_type_expected : Script.location * Script.expr -> error
-type error += Inconsistent_types : _ ty * _ ty -> error
+type error += Inconsistent_types : Script.expr * Script.expr -> error
 type error += Unordered_map_keys of Script.location * Script.expr
 type error += Unordered_set_values of Script.location * Script.expr
 type error += Duplicate_map_keys of Script.location * Script.expr
 type error += Duplicate_set_values of Script.location * Script.expr
 
 (* Toplevel errors *)
-type error += Ill_typed_data : string option * Script.expr * _ ty -> error
+type error += Ill_typed_data : string option * Script.expr * Script.expr -> error
 type error += Ill_formed_type of string option * Script.expr * Script.location
 type error += Ill_typed_contract : Script.expr * type_map -> error
+
+(* Gas related errors *)
+type error += Cannot_serialize_error

src/proto_alpha/lib_protocol/src/script_tc_errors_registration.ml

@@ -8,11 +8,8 @@
 (**************************************************************************)
 
 open Alpha_context
-open Micheline
 open Script
-open Script_typed_ir
 open Script_tc_errors
-open Script_ir_translator
 
 (* Helpers for encoding *)
 let type_map_enc =
@@ -27,49 +24,12 @@ let type_map_enc =
           (req "stackBefore" stack_enc)
           (req "stackAfter" stack_enc)))
 
-let rec strip_var_annots = function
+let stack_ty_enc =
-  | Int _ | String _ | Bytes _ as atom -> atom
-  | Seq (loc, args) -> Seq (loc, List.map strip_var_annots args)
-  | Prim (loc, name, args, annots) ->
-      let not_var_annot s = Compare.Char.(String.get s 0 <> '@') in
-      let annots = List.filter not_var_annot annots in
-      Prim (loc, name, List.map strip_var_annots args, annots)
-
-let ex_ty_enc =
-  Data_encoding.conv
-    (fun (Ex_ty ty) ->
-       strip_locations (strip_var_annots (unparse_ty ty)))
-    (fun expr ->
-       match parse_ty ~allow_big_map:true ~allow_operation:true (root expr) with
-       | Ok ty -> ty
-       | _ -> assert false)
-    Script.expr_encoding
-
-let var_annot_enc =
   let open Data_encoding in
-  conv
-    (function `Var_annot x -> "@" ^ x)
-    (function x ->
-       assert (Compare.Int.(String.length x > 0) && Compare.Char.(String.get x 0 = '@')) ;
-       `Var_annot (String.sub x 1 (String.length x - 1)))
-    string
-
-let ex_stack_ty_enc =
-  let open Data_encoding in
-  let rec unfold = function
-    | Ex_stack_ty (Item_t (ty, rest, annot)) ->
-        (Ex_ty ty, annot) :: unfold (Ex_stack_ty rest)
-    | Ex_stack_ty Empty_t -> [] in
-  let rec fold = function
-    | (Ex_ty ty, annot) :: rest ->
-        let Ex_stack_ty rest = fold rest in
-        Ex_stack_ty (Item_t (ty, rest, annot))
-    | [] -> Ex_stack_ty Empty_t in
-  conv unfold fold
   (list
      (obj2
-          (req "type" ex_ty_enc)
+        (req "type" Script.expr_encoding)
-          (opt "annot" var_annot_enc)))
+        (dft "annots" (list string) [])))
 
 (* main registration *)
 let () =
@@ -290,13 +250,13 @@ let () =
        over which it is not defined."
     (located (obj3
                 (req "operatorName" prim_encoding)
-                (req "wrongLeftOperandType" ex_ty_enc)
+                (req "wrongLeftOperandType" Script.expr_encoding)
-                (req "wrongRightOperandType" ex_ty_enc)))
+                (req "wrongRightOperandType" Script.expr_encoding)))
     (function
       | Undefined_binop (loc, n, tyl, tyr) ->
-          Some (loc, (n, Ex_ty tyl, Ex_ty tyr))
+          Some (loc, (n, tyl, tyr))
       | _ -> None)
-    (fun (loc, (n, Ex_ty tyl, Ex_ty tyr)) ->
+    (fun (loc, (n, tyl, tyr)) ->
        Undefined_binop (loc, n, tyl, tyr)) ;
   (* Undefined unary operation *)
   register_error_kind
@@ -308,12 +268,12 @@ let () =
        over which it is not defined."
     (located (obj2
                 (req "operatorName" prim_encoding)
-                (req "wrongOperandType" ex_ty_enc)))
+                (req "wrongOperandType" Script.expr_encoding)))
     (function
       | Undefined_unop (loc, n, ty) ->
-          Some (loc, (n, Ex_ty ty))
+          Some (loc, (n, ty))
       | _ -> None)
-    (fun (loc, (n, Ex_ty ty)) ->
+    (fun (loc, (n, ty)) ->
        Undefined_unop (loc, n, ty)) ;
   (* Bad return *)
   register_error_kind
@@ -323,12 +283,12 @@ let () =
     ~description:
       "Unexpected stack at the end of a lambda or script."
     (located (obj2
-                (req "expectedReturnType" ex_ty_enc)
+                (req "expectedReturnType" Script.expr_encoding)
-                (req "wrongStackType" ex_stack_ty_enc)))
+                (req "wrongStackType" stack_ty_enc)))
     (function
-      | Bad_return (loc, sty, ty) -> Some (loc, (Ex_ty ty, Ex_stack_ty sty))
+      | Bad_return (loc, sty, ty) -> Some (loc, (ty, sty))
       | _ -> None)
-    (fun (loc, (Ex_ty ty, Ex_stack_ty sty)) ->
+    (fun (loc, (ty, sty)) ->
        Bad_return (loc, sty, ty)) ;
   (* Bad stack *)
   register_error_kind
@@ -340,11 +300,11 @@ let () =
     (located (obj3
                 (req "primitiveName" prim_encoding)
                 (req "relevantStackPortion" int16)
-                (req "wrongStackType" ex_stack_ty_enc)))
+                (req "wrongStackType" stack_ty_enc)))
     (function
-      | Bad_stack (loc, name, s, sty) -> Some (loc, (name, s, Ex_stack_ty sty))
+      | Bad_stack (loc, name, s, sty) -> Some (loc, (name, s, sty))
       | _ -> None)
-    (fun (loc, (name, s, Ex_stack_ty sty)) ->
+    (fun (loc, (name, s, sty)) ->
        Bad_stack (loc, name, s, sty)) ;
   (* Inconsistent annotations *)
   register_error_kind
@@ -377,12 +337,12 @@ let () =
     ~title:"Types contain inconsistent annotations"
     ~description:"The two types contain annotations that do not match"
     (located (obj2
-                (req "type1" ex_ty_enc)
+                (req "type1" Script.expr_encoding)
-                (req "type2" ex_ty_enc)))
+                (req "type2" Script.expr_encoding)))
     (function
-      | Inconsistent_type_annotations (loc, ty1, ty2) -> Some (loc, (Ex_ty ty1, Ex_ty ty2))
+      | Inconsistent_type_annotations (loc, ty1, ty2) -> Some (loc, (ty1, ty2))
       | _ -> None)
-    (fun (loc, (Ex_ty ty1, Ex_ty ty2)) -> Inconsistent_type_annotations (loc, ty1, ty2)) ;
+    (fun (loc, (ty1, ty2)) -> Inconsistent_type_annotations (loc, ty1, ty2)) ;
   (* Unexpected annotation *)
   register_error_kind
     `Permanent
@@ -412,13 +372,13 @@ let () =
       "At the join point at the end of two code branches \
        the stacks have inconsistent lengths or contents."
     (located (obj2
-                (req "firstStackType" ex_stack_ty_enc)
+                (req "firstStackType" stack_ty_enc)
-                (req "otherStackType" ex_stack_ty_enc)))
+                (req "otherStackType" stack_ty_enc)))
     (function
       | Unmatched_branches (loc, stya, styb) ->
-          Some (loc, (Ex_stack_ty stya, Ex_stack_ty styb))
+          Some (loc, (stya, styb))
       | _ -> None)
-    (fun (loc, (Ex_stack_ty stya, Ex_stack_ty styb)) ->
+    (fun (loc, (stya, styb)) ->
        Unmatched_branches (loc, stya, styb)) ;
   (* Bad stack item *)
   register_error_kind
@@ -470,13 +430,13 @@ let () =
     ~description:
       "A data expression was invalid for its expected type."
     (located (obj2
-                (req "expectedType" ex_ty_enc)
+                (req "expectedType" Script.expr_encoding)
                 (req "wrongExpression" Script.expr_encoding)))
     (function
       | Invalid_constant (loc, expr, ty) ->
-          Some (loc, (Ex_ty ty, expr))
+          Some (loc, (ty, expr))
       | _ -> None)
-    (fun (loc, (Ex_ty ty, expr)) ->
+    (fun (loc, (ty, expr)) ->
        Invalid_constant (loc, expr, ty)) ;
   (* Invalid contract *)
   register_error_kind
@@ -501,11 +461,11 @@ let () =
     ~description:
       "A non comparable type was used in a place where \
        only comparable types are accepted."
-    (located (obj1 (req "wrongType" ex_ty_enc)))
+    (located (obj1 (req "wrongType" Script.expr_encoding)))
     (function
-      | Comparable_type_expected (loc, ty) -> Some (loc, Ex_ty ty)
+      | Comparable_type_expected (loc, ty) -> Some (loc, ty)
       | _ -> None)
-    (fun (loc, Ex_ty ty) ->
+    (fun (loc, ty) ->
        Comparable_type_expected (loc, ty)) ;
   (* Inconsistent types *)
   register_error_kind
@@ -518,14 +478,12 @@ let () =
        two types have to be proven, it is always accompanied \
        with another error that provides more context."
     (obj2
-       (req "firstType" ex_ty_enc)
+       (req "firstType" Script.expr_encoding)
-       (req "otherType" ex_ty_enc))
+       (req "otherType" Script.expr_encoding))
     (function
-      | Inconsistent_types (tya, tyb) ->
+      | Inconsistent_types (tya, tyb) -> Some (tya, tyb)
-          Some (Ex_ty tya, Ex_ty tyb)
       | _ -> None)
-    (fun (Ex_ty tya, Ex_ty tyb) ->
+    (fun (tya, tyb) -> Inconsistent_types (tya, tyb)) ;
-       Inconsistent_types (tya, tyb)) ;
   (* -- Instruction typing errors ------------------- *)
   (* Invalid map body *)
   register_error_kind
@@ -536,13 +494,11 @@ let () =
       "The body of a map block did not match the expected type"
     (obj2
        (req "loc" Script.location_encoding)
-       (req "bodyType" ex_stack_ty_enc))
+       (req "bodyType" stack_ty_enc))
     (function
-      | Invalid_map_body (loc, stack) ->
+      | Invalid_map_body (loc, stack) -> Some (loc, stack)
-          Some (loc, Ex_stack_ty stack)
       | _ -> None)
-    (fun (loc, Ex_stack_ty stack) ->
+    (fun (loc, stack) -> Invalid_map_body (loc, stack)) ;
-       Invalid_map_body (loc, stack)) ;
   (* Invalid map block FAIL *)
   register_error_kind
     `Permanent
@@ -565,12 +521,12 @@ let () =
                   the ITER."
     (obj3
        (req "loc" Script.location_encoding)
-       (req "befStack" ex_stack_ty_enc)
+       (req "befStack" stack_ty_enc)
-       (req "aftStack" ex_stack_ty_enc))
+       (req "aftStack" stack_ty_enc))
     (function
-      | Invalid_iter_body (loc, bef, aft) -> Some (loc, Ex_stack_ty bef, Ex_stack_ty aft)
+      | Invalid_iter_body (loc, bef, aft) -> Some (loc, bef, aft)
       | _ -> None)
-    (fun (loc, Ex_stack_ty bef, Ex_stack_ty aft) -> Invalid_iter_body (loc, bef, aft)) ;
+    (fun (loc, bef, aft) -> Invalid_iter_body (loc, bef, aft)) ;
   (* Type too large *)
   register_error_kind
     `Permanent
@@ -597,13 +553,12 @@ let () =
        (always followed by more precise errors)."
     (obj3
        (opt "identifier" string)
-       (req "expectedType" ex_ty_enc)
+       (req "expectedType" Script.expr_encoding)
        (req "illTypedExpression" Script.expr_encoding))
     (function
-      | Ill_typed_data (name, expr, ty) -> Some (name, Ex_ty ty,  expr)
+      | Ill_typed_data (name, expr, ty) -> Some (name, ty,  expr)
       | _ -> None)
-    (fun (name, Ex_ty ty,  expr) ->
+    (fun (name, ty,  expr) -> Ill_typed_data (name, expr, ty)) ;
-       Ill_typed_data (name, expr, ty)) ;
   (* Ill formed type *)
   register_error_kind
     `Permanent
@@ -638,4 +593,14 @@ let () =
           Some (expr, type_map)
       | _ -> None)
     (fun (expr, type_map) ->
-       Ill_typed_contract (expr, type_map))
+       Ill_typed_contract (expr, type_map)) ;
+  (* Cannot serialize error *)
+  register_error_kind
+    `Temporary
+    ~id:"cannotSerializeError"
+    ~title:"Not enough gas to serialize error"
+    ~description:"The error was too big to be serialized with \
+                  the provided gas"
+    Data_encoding.empty
+    (function Cannot_serialize_error -> Some () | _ -> None)
+    (fun () -> Cannot_serialize_error)