Source file registerer.ml

module Source = struct
  let hash =
    Some (Tezos_crypto.Hashed.Protocol_hash.of_b58check_exn "Psithaca2MLRFYargivpo7YvUr7wUDqyxrdhC5CQq78mRvimz6A")
  let sources = Tezos_base.Protocol.
{ expected_env = V4 ;
  components = [{ name = "Misc" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** {2 Helper functions} *)\n\nmodule Public_key_map : Map.S with type key = Signature.Public_key.t\n\ntype 'a lazyt = unit -> 'a\n\ntype 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt\n\ntype 'a lazy_list = 'a lazy_list_t tzresult Lwt.t\n\n(** Include bounds *)\nval ( --> ) : int -> int -> int list\n\nval ( <-- ) : int -> int -> int list\n\nval ( ---> ) : Int32.t -> Int32.t -> Int32.t list\n\nval pp_print_paragraph : Format.formatter -> string -> unit\n\nval take : int -> 'a list -> ('a list * 'a list) option\n\n(** Some (input with [prefix] removed), if string has [prefix], else [None] *)\nval remove_prefix : prefix:string -> string -> string option\n\n(** [remove nb list] remove the first [nb] elements from the list [list]. *)\nval remove_elem_from_list : int -> 'a list -> 'a list\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nmodule Public_key_map = Map.Make (Signature.Public_key)\n\ntype 'a lazyt = unit -> 'a\n\ntype 'a lazy_list_t = LCons of 'a * 'a lazy_list_t tzresult Lwt.t lazyt\n\ntype 'a lazy_list = 'a lazy_list_t tzresult Lwt.t\n\nlet[@coq_struct \"i\"] rec ( --> ) i j =\n  (* [i; i+1; ...; j] *)\n  if Compare.Int.(i > j) then [] else i :: (succ i --> j)\n\nlet[@coq_struct \"j\"] rec ( <-- ) i j =\n  (* [j; j-1; ...; i] *)\n  if Compare.Int.(i > j) then [] else j :: (i <-- pred j)\n\nlet[@coq_struct \"i\"] rec ( ---> ) i j =\n  (* [i; i+1; ...; j] *)\n  if Compare.Int32.(i > j) then [] else i :: (Int32.succ i ---> j)\n\nlet split delim ?(limit = max_int) path =\n  let l = String.length path in\n  let rec do_slashes acc limit i =\n    if Compare.Int.(i >= l) then List.rev acc\n    else if Compare.Char.(path.[i] = delim) then do_slashes acc limit (i + 1)\n    else do_split acc limit i\n  and do_split acc limit i =\n    if Compare.Int.(limit <= 0) then\n      if Compare.Int.(i = l) then List.rev acc\n      else List.rev (String.sub path i (l - i) :: acc)\n    else do_component acc (pred limit) i i\n  and do_component acc limit i j =\n    if Compare.Int.(j >= l) then\n      if Compare.Int.(i = j) then List.rev acc\n      else List.rev (String.sub path i (j - i) :: acc)\n    else if Compare.Char.(path.[j] = delim) then\n      do_slashes (String.sub path i (j - i) :: acc) limit j\n    else do_component acc limit i (j + 1)\n  in\n  if Compare.Int.(limit > 0) then do_slashes [] limit 0 else [path]\n  [@@coq_axiom_with_reason \"non-top-level mutual recursion\"]\n\nlet pp_print_paragraph ppf description =\n  Format.fprintf\n    ppf\n    \"@[%a@]\"\n    Format.(pp_print_list ~pp_sep:pp_print_space pp_print_string)\n    (split ' ' description)\n\nlet take n l =\n  let rec loop acc n xs =\n    if Compare.Int.(n <= 0) then Some (List.rev acc, xs)\n    else match xs with [] -> None | x :: xs -> loop (x :: acc) (n - 1) xs\n  in\n  loop [] n l\n\nlet remove_prefix ~prefix s =\n  let x = String.length prefix in\n  let n = String.length s in\n  if Compare.Int.(n >= x) && Compare.String.(String.sub s 0 x = prefix) then\n    Some (String.sub s x (n - x))\n  else None\n\nlet rec remove_elem_from_list nb = function\n  | [] -> []\n  | _ :: _ as l when Compare.Int.(nb <= 0) -> l\n  | _ :: tl -> remove_elem_from_list (nb - 1) tl\n" ;
                } ;
                { name = "Non_empty_string" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** A string that is guaranteed to be non-empty *)\ntype t = private string\n\ninclude Compare.S with type t := t\n\n(** Returns [None] if the original string is empty. *)\nval of_string : string -> t option\n\n(** Fails with [Invalid_argument] if the original string is empty. *)\nval of_string_exn : string -> t\n\n(** [cat2 a b] concatenates [a] and [b].\n    [cat2 a ~sep b] concatenates [a], [sep], and [b]. *)\nval cat2 : t -> ?sep:string -> t -> t\n\n(** [split_on_last c s] finds the last occurrence of [c] in [s] and returns\n    the substring before and the substring after.\n    Returns [None] if [c] is not present in [s] or if one or both substrings\n    would end up being empty. *)\nval split_on_last : char -> t -> (t * t) option\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ninclude Compare.String\n\nlet of_string = function \"\" -> None | s -> Some s\n\nlet of_string_exn = function\n  | \"\" -> invalid_arg \"Unexpected empty string\"\n  | s -> s\n\nlet cat2 a ?(sep = \"\") b = String.concat sep [a; b]\n\nlet split_on_last sep s =\n  match String.rindex_opt s sep with\n  | Some i when Compare.Int.(i > 0 && i < String.length s - 1) ->\n      let s1 = String.sub s 0 i in\n      let s2 = String.sub s (i + 1) (String.length s - 1 - i) in\n      Some (s1, s2)\n  | _ -> None\n" ;
                } ;
                { name = "Path_encoding" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2021 DaiLambda, Inc. <contact@dailambda.jp>                 *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nmodule type S = sig\n  type t\n\n  (** [to_path t postfix] returns the context path name for [t]\n      postfixed with [postfix] *)\n  val to_path : t -> string list -> string list\n\n  (** [of_path path] parses [path] as a context path name for [t] *)\n  val of_path : string list -> t option\n\n  (** Directory levels of the path encoding of [t] *)\n  val path_length : int\nend\n\n(** Path encoding in hex: /[0-9a-f]{2}+/ *)\nmodule Make_hex (H : sig\n  type t\n\n  val to_bytes : t -> bytes\n\n  val of_bytes_opt : bytes -> t option\nend) : S with type t := H.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2021 DaiLambda, Inc. <contact@dailambda.jp>                 *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nmodule type S = sig\n  type t\n\n  val to_path : t -> string list -> string list\n\n  val of_path : string list -> t option\n\n  val path_length : int\nend\n\nmodule Make_hex (H : sig\n  type t\n\n  val to_bytes : t -> bytes\n\n  val of_bytes_opt : bytes -> t option\nend) =\nstruct\n  let path_length = 1\n\n  let to_path t l =\n    let (`Hex key) = Hex.of_bytes (H.to_bytes t) in\n    key :: l\n\n  let of_path = function\n    | [path] -> Option.bind (Hex.to_bytes (`Hex path)) H.of_bytes_opt\n    | _ -> None\nend\n" ;
                } ;
                { name = "Storage_description" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** This module is responsible for building the description of the current state\n    of the storage, which is then used to build specification of the RPC\n    endpoints for accessing the storage. It produces [resto] [RPC_directory.t]\n    values, which can be used directly to construct the RPC endpoint tree. *)\n\n(** Typed description of the key-value context. *)\ntype 'key t\n\n(** Trivial display of the key-value context layout. *)\nval pp : Format.formatter -> 'key t -> unit\n\n(** Export an RPC hierarchy for querying the context. There is one service\n    by possible path in the context. Services for \"directory\" are able to\n    aggregate in one JSON object the whole subtree. *)\nval build_directory : 'key t -> 'key RPC_directory.t\n\n(** Create a empty context description,\n    keys will be registered by side effects. *)\nval create : unit -> 'key t\n\n(** Register a single key accessor at a given path. *)\nval register_value :\n  'key t -> get:('key -> 'a option tzresult Lwt.t) -> 'a Data_encoding.t -> unit\n\n(** Return a description for a prefixed fragment of the given context.\n    All keys registered in the subcontext will be shared by the external\n    context *)\nval register_named_subcontext : 'key t -> string list -> 'key t\n\n(** Description of an index as a sequence of `RPC_arg.t`. *)\ntype (_, _, _) args =\n  | One : {\n      rpc_arg : 'a RPC_arg.t;\n      encoding : 'a Data_encoding.t;\n      compare : 'a -> 'a -> int;\n    }\n      -> ('key, 'a, 'key * 'a) args\n  | Pair :\n      ('key, 'a, 'inter_key) args * ('inter_key, 'b, 'sub_key) args\n      -> ('key, 'a * 'b, 'sub_key) args\n\n(** Return a description for a indexed sub-context.\n    All keys registered in the subcontext will be shared by the external\n    context. One should provide a function to list all the registered\n    index in the context. *)\nval register_indexed_subcontext :\n  'key t ->\n  list:('key -> 'arg list tzresult Lwt.t) ->\n  ('key, 'arg, 'sub_key) args ->\n  'sub_key t\n\n(** Helpers for manipulating and defining indexes. *)\n\nval pack : ('key, 'a, 'sub_key) args -> 'key -> 'a -> 'sub_key\n\nval unpack : ('key, 'a, 'sub_key) args -> 'sub_key -> 'key * 'a\n\nmodule type INDEX = sig\n  type t\n\n  include Path_encoding.S with type t := t\n\n  val rpc_arg : t RPC_arg.t\n\n  val encoding : t Data_encoding.t\n\n  val compare : t -> t -> int\nend\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nmodule StringMap = Map.Make (String)\n\ntype 'key t = 'key desc_with_path\n\n(** [desc_with_path] describes a position in the storage. It's composed\n    [rev_path] which is the reverse path up to the position, and [dir] the\n    position's [description]. [rev_path] is only useful in case of an error to\n    print a descriptive message. [List.rev rev_path] is a storage's path that\n    contains no conflict and allows the registration of a [dir]'s storage.\n    NB: [rev_path] indicates the position in the tree, so once the node is\n    added, it won't change; whereas [dir] is mutable because when more subtrees\n    are added this may require updating it. *)\nand 'key desc_with_path = {\n  rev_path : string list;\n  mutable dir : 'key description;\n}\n\nand 'key description =\n  | Empty : 'key description\n  | Value : {\n      get : 'key -> 'a option tzresult Lwt.t;\n      encoding : 'a Data_encoding.t;\n    }\n      -> 'key description\n  | NamedDir : 'key t StringMap.t -> 'key description\n  | IndexedDir : {\n      arg : 'a RPC_arg.t;\n      arg_encoding : 'a Data_encoding.t;\n      list : 'key -> 'a list tzresult Lwt.t;\n      subdir : ('key * 'a) t;\n    }\n      -> 'key description\n\nlet[@coq_struct \"function_parameter\"] rec pp :\n    type a. Format.formatter -> a t -> unit =\n fun ppf {dir; _} ->\n  match dir with\n  | Empty -> Format.fprintf ppf \"Empty\"\n  | Value _e -> Format.fprintf ppf \"Value\"\n  | NamedDir map ->\n      Format.fprintf\n        ppf\n        \"@[<v>%a@]\"\n        (Format.pp_print_list pp_item)\n        (StringMap.bindings map)\n  | IndexedDir {arg; subdir; _} ->\n      let name = Format.asprintf \"<%s>\" (RPC_arg.descr arg).name in\n      pp_item ppf (name, subdir)\n\nand[@coq_mutual_as_notation] pp_item :\n    type a. Format.formatter -> string * a t -> unit =\n fun ppf (name, desc) -> Format.fprintf ppf \"@[<hv 2>%s@ %a@]\" name pp desc\n\nlet pp_rev_path ppf path =\n  Format.fprintf\n    ppf\n    \"[%a]\"\n    Format.(\n      pp_print_list\n        ~pp_sep:(fun ppf () -> pp_print_string ppf \" / \")\n        pp_print_string)\n    (List.rev path)\n\nlet rec register_named_subcontext : type r. r t -> string list -> r t =\n fun desc names ->\n  match (desc.dir, names) with\n  | (_, []) -> desc\n  | (Value _, _) | (IndexedDir _, _) ->\n      Format.kasprintf\n        invalid_arg\n        \"Could not register a named subcontext at %a because of an existing %a.\"\n        pp_rev_path\n        desc.rev_path\n        pp\n        desc\n  | (Empty, name :: names) ->\n      let subdir = {rev_path = name :: desc.rev_path; dir = Empty} in\n      desc.dir <- NamedDir (StringMap.singleton name subdir) ;\n      register_named_subcontext subdir names\n  | (NamedDir map, name :: names) ->\n      let subdir =\n        match StringMap.find name map with\n        | Some subdir -> subdir\n        | None ->\n            let subdir = {rev_path = name :: desc.rev_path; dir = Empty} in\n            desc.dir <- NamedDir (StringMap.add name subdir map) ;\n            subdir\n      in\n      register_named_subcontext subdir names\n\ntype (_, _, _) args =\n  | One : {\n      rpc_arg : 'a RPC_arg.t;\n      encoding : 'a Data_encoding.t;\n      compare : 'a -> 'a -> int;\n    }\n      -> ('key, 'a, 'key * 'a) args\n  | Pair :\n      ('key, 'a, 'inter_key) args * ('inter_key, 'b, 'sub_key) args\n      -> ('key, 'a * 'b, 'sub_key) args\n\nlet rec unpack : type a b c. (a, b, c) args -> c -> a * b = function\n  | One _ -> fun x -> x\n  | Pair (l, r) ->\n      let unpack_l = unpack l in\n      let unpack_r = unpack r in\n      fun x ->\n        let (c, d) = unpack_r x in\n        let (b, a) = unpack_l c in\n        (b, (a, d))\n  [@@coq_axiom_with_reason \"gadt\"]\n\nlet rec pack : type a b c. (a, b, c) args -> a -> b -> c = function\n  | One _ -> fun b a -> (b, a)\n  | Pair (l, r) ->\n      let pack_l = pack l in\n      let pack_r = pack r in\n      fun b (a, d) ->\n        let c = pack_l b a in\n        pack_r c d\n  [@@coq_axiom_with_reason \"gadt\"]\n\nlet rec compare : type a b c. (a, b, c) args -> b -> b -> int = function\n  | One {compare; _} -> compare\n  | Pair (l, r) -> (\n      let compare_l = compare l in\n      let compare_r = compare r in\n      fun (a1, b1) (a2, b2) ->\n        match compare_l a1 a2 with 0 -> compare_r b1 b2 | x -> x)\n  [@@coq_axiom_with_reason \"gadt\"]\n\nlet destutter equal l =\n  match l with\n  | [] -> []\n  | (i, _) :: l ->\n      let rec loop acc i = function\n        | [] -> acc\n        | (j, _) :: l -> if equal i j then loop acc i l else loop (j :: acc) j l\n      in\n      loop [i] i l\n\nlet rec register_indexed_subcontext :\n    type r a b.\n    r t -> list:(r -> a list tzresult Lwt.t) -> (r, a, b) args -> b t =\n fun desc ~list path ->\n  match path with\n  | Pair (left, right) ->\n      let compare_left = compare left in\n      let equal_left x y = Compare.Int.(compare_left x y = 0) in\n      let list_left r = list r >|=? fun l -> destutter equal_left l in\n      let list_right r =\n        let (a, k) = unpack left r in\n        list a >|=? fun l ->\n        List.map snd (List.filter (fun (x, _) -> equal_left x k) l)\n      in\n      register_indexed_subcontext\n        (register_indexed_subcontext desc ~list:list_left left)\n        ~list:list_right\n        right\n  | One {rpc_arg = arg; encoding = arg_encoding; _} -> (\n      match desc.dir with\n      | Value _ | NamedDir _ ->\n          Format.kasprintf\n            invalid_arg\n            \"Could not register an indexed subcontext at %a because of an \\\n             existing %a.\"\n            pp_rev_path\n            desc.rev_path\n            pp\n            desc\n      | Empty ->\n          let subdir =\n            {\n              rev_path =\n                Format.sprintf \"(Maybe of %s)\" RPC_arg.(descr arg).name\n                :: desc.rev_path;\n              dir = Empty;\n            }\n          in\n          desc.dir <- IndexedDir {arg; arg_encoding; list; subdir} ;\n          subdir\n      | IndexedDir {arg = inner_arg; subdir; _} -> (\n          match RPC_arg.eq arg inner_arg with\n          | None ->\n              Format.kasprintf\n                invalid_arg\n                \"An indexed subcontext at %a already exists but has a \\\n                 different argument: `%s` <> `%s`.\"\n                pp_rev_path\n                desc.rev_path\n                (RPC_arg.descr arg).name\n                (RPC_arg.descr inner_arg).name\n          | Some RPC_arg.Eq -> subdir))\n [@@coq_axiom_with_reason \"gadt\"]\n\nlet register_value :\n    type a b.\n    a t -> get:(a -> b option tzresult Lwt.t) -> b Data_encoding.t -> unit =\n fun desc ~get encoding ->\n  match desc.dir with\n  | Empty -> desc.dir <- Value {get; encoding}\n  | _ ->\n      Format.kasprintf\n        invalid_arg\n        \"Could not register a value at %a because of an existing %a.\"\n        pp_rev_path\n        desc.rev_path\n        pp\n        desc\n\nlet create () = {rev_path = []; dir = Empty}\n\nmodule type INDEX = sig\n  type t\n\n  include Path_encoding.S with type t := t\n\n  val rpc_arg : t RPC_arg.t\n\n  val encoding : t Data_encoding.t\n\n  val compare : t -> t -> int\nend\n\ntype _ handler =\n  | Handler : {\n      encoding : 'a Data_encoding.t;\n      get : 'key -> int -> 'a tzresult Lwt.t;\n    }\n      -> 'key handler\n\ntype _ opt_handler =\n  | Opt_handler : {\n      encoding : 'a Data_encoding.t;\n      get : 'key -> int -> 'a option tzresult Lwt.t;\n    }\n      -> 'key opt_handler\n\nlet rec combine_object = function\n  | [] ->\n      Handler {encoding = Data_encoding.unit; get = (fun _ _ -> return_unit)}\n  | (name, Opt_handler handler) :: fields ->\n      let (Handler handlers) = combine_object fields in\n      Handler\n        {\n          encoding =\n            Data_encoding.merge_objs\n              Data_encoding.(obj1 (opt name (dynamic_size handler.encoding)))\n              handlers.encoding;\n          get =\n            (fun k i ->\n              handler.get k i >>=? fun v1 ->\n              handlers.get k i >|=? fun v2 -> (v1, v2));\n        }\n  [@@coq_axiom_with_reason \"gadt\"]\n\ntype query = {depth : int}\n\nlet depth_query =\n  let open RPC_query in\n  query (fun depth -> {depth})\n  |+ field \"depth\" RPC_arg.uint 0 (fun t -> t.depth)\n  |> seal\n\nlet build_directory : type key. key t -> key RPC_directory.t =\n fun dir ->\n  let rpc_dir = ref (RPC_directory.empty : key RPC_directory.t) in\n  let register :\n      type ikey.\n      chunked:bool -> (key, ikey) RPC_path.t -> ikey opt_handler -> unit =\n   fun ~chunked path (Opt_handler {encoding; get}) ->\n    let service =\n      RPC_service.get_service ~query:depth_query ~output:encoding path\n    in\n    rpc_dir :=\n      RPC_directory.opt_register ~chunked !rpc_dir service (fun k q () ->\n          get k (q.depth + 1))\n  in\n  let rec build_handler :\n      type ikey. ikey t -> (key, ikey) RPC_path.t -> ikey opt_handler =\n   fun desc path ->\n    match desc.dir with\n    | Empty ->\n        Opt_handler\n          {encoding = Data_encoding.unit; get = (fun _ _ -> return_none)}\n    | Value {get; encoding} ->\n        let handler =\n          Opt_handler\n            {\n              encoding;\n              get =\n                (fun k i -> if Compare.Int.(i < 0) then return_none else get k);\n            }\n        in\n        register ~chunked:true path handler ;\n        handler\n    | NamedDir map ->\n        let fields = StringMap.bindings map in\n        let fields =\n          List.map\n            (fun (name, dir) ->\n              (name, build_handler dir RPC_path.(path / name)))\n            fields\n        in\n        let (Handler handler) = combine_object fields in\n        let handler =\n          Opt_handler\n            {\n              encoding = handler.encoding;\n              get =\n                (fun k i ->\n                  if Compare.Int.(i < 0) then return_none\n                  else handler.get k (i - 1) >>=? fun v -> return_some v);\n            }\n        in\n        register ~chunked:true path handler ;\n        handler\n    | IndexedDir {arg; arg_encoding; list; subdir} ->\n        let (Opt_handler handler) =\n          build_handler subdir RPC_path.(path /: arg)\n        in\n        let encoding =\n          let open Data_encoding in\n          union\n            [\n              case\n                (Tag 0)\n                ~title:\"Leaf\"\n                (dynamic_size arg_encoding)\n                (function (key, None) -> Some key | _ -> None)\n                (fun key -> (key, None));\n              case\n                (Tag 1)\n                ~title:\"Dir\"\n                (tup2\n                   (dynamic_size arg_encoding)\n                   (dynamic_size handler.encoding))\n                (function (key, Some value) -> Some (key, value) | _ -> None)\n                (fun (key, value) -> (key, Some value));\n            ]\n        in\n        let get k i =\n          if Compare.Int.(i < 0) then return_none\n          else if Compare.Int.(i = 0) then return_some []\n          else\n            list k >>=? fun keys ->\n            List.map_es\n              (fun key ->\n                if Compare.Int.(i = 1) then return (key, None)\n                else handler.get (k, key) (i - 1) >|=? fun value -> (key, value))\n              keys\n            >>=? fun values -> return_some values\n        in\n        let handler =\n          Opt_handler\n            {encoding = Data_encoding.(list (dynamic_size encoding)); get}\n        in\n        register ~chunked:true path handler ;\n        handler\n  in\n  ignore (build_handler dir RPC_path.open_root : key opt_handler) ;\n  !rpc_dir\n [@@coq_axiom_with_reason \"gadt\"]\n" ;
                } ;
                { name = "State_hash" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020-2021 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** A specialized Blake2B implementation for hashing internal states of random\n    number generators. *)\n\ninclude S.HASH\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nlet random_state_hash = \"\\076\\064\\204\" (* rng(53): never used... *)\n\nmodule H =\n  Blake2B.Make\n    (Base58)\n    (struct\n      let name = \"random\"\n\n      let title = \"A random generation state\"\n\n      let b58check_prefix = random_state_hash\n\n      let size = None\n    end)\n\ninclude H\ninclude Path_encoding.Make_hex (H)\n\nlet () = Base58.check_encoded_prefix b58check_encoding \"rng\" 53\n" ;
                } ;
                { name = "Nonce_hash" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020-2021 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** A specialized Blake2B implementation for hashing nonces. *)\n\ninclude S.HASH\n\ninclude Path_encoding.S with type t := t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(* 32 *)\nlet nonce_hash = \"\\069\\220\\169\" (* nce(53) *)\n\nmodule H =\n  Blake2B.Make\n    (Base58)\n    (struct\n      let name = \"cycle_nonce\"\n\n      let title = \"A nonce hash\"\n\n      let b58check_prefix = nonce_hash\n\n      let size = None\n    end)\n\ninclude H\ninclude Path_encoding.Make_hex (H)\n\nlet () = Base58.check_encoded_prefix b58check_encoding \"nce\" 53\n" ;
                } ;
                { name = "Script_expr_hash" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020-2021 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** A specialized Blake2B implementation for hashing Michelson expressions. *)\n\ninclude S.HASH\n\ninclude Path_encoding.S with type t := t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nlet script_expr_hash = \"\\013\\044\\064\\027\" (* expr(54) *)\n\nmodule H =\n  Blake2B.Make\n    (Base58)\n    (struct\n      let name = \"script_expr\"\n\n      let title = \"A script expression ID\"\n\n      let b58check_prefix = script_expr_hash\n\n      let size = None\n    end)\n\ninclude H\ninclude Path_encoding.Make_hex (H)\n\nlet () = Base58.check_encoded_prefix b58check_encoding \"expr\" 54\n" ;
                } ;
                { name = "Contract_hash" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020-2021 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** A specialized Blake2B implementation for hashing contract identifiers. *)\n\ninclude S.HASH\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(* 20 *)\nlet contract_hash = \"\\002\\090\\121\" (* KT1(36) *)\n\nmodule H =\n  Blake2B.Make\n    (Base58)\n    (struct\n      let name = \"Contract_hash\"\n\n      let title = \"A contract ID\"\n\n      let b58check_prefix = contract_hash\n\n      let size = Some 20\n    end)\n\ninclude H\ninclude Path_encoding.Make_hex (H)\n\nlet () = Base58.check_encoded_prefix b58check_encoding \"KT1\" 36\n" ;
                } ;
                { name = "Blinded_public_key_hash" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** This module handles hashes of implicit contract addresses used for\n    commitments in the origin block.\n\n    This module is needed because for legal reasons, when the blockchain is\n    activated, the btz1 addresses of participants to the fundraising are not\n    listed directly but instead their hashes are listed, together with their\n    balances. Thus, the listed accounts can be activated and credited in the\n    activation block. *)\n\ninclude S.HASH\n\ntype activation_code\n\nval activation_code_encoding : activation_code Data_encoding.t\n\nval of_ed25519_pkh : activation_code -> Ed25519.Public_key_hash.t -> t\n\nval activation_code_of_hex : string -> activation_code option\n\nmodule Index : Storage_description.INDEX with type t = t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nmodule H =\n  Blake2B.Make\n    (Base58)\n    (struct\n      let name = \"Blinded public key hash\"\n\n      let title = \"A blinded public key hash\"\n\n      let b58check_prefix = \"\\001\\002\\049\\223\"\n\n      let size = Some Ed25519.Public_key_hash.size\n    end)\n\nmodule Index = struct\n  include H\n  include Path_encoding.Make_hex (H)\nend\n\ninclude H\n\nlet () = Base58.check_encoded_prefix b58check_encoding \"btz1\" 37\n\nlet of_ed25519_pkh activation_code pkh =\n  hash_bytes ~key:activation_code [Ed25519.Public_key_hash.to_bytes pkh]\n\ntype activation_code = bytes\n\nlet activation_code_size = Ed25519.Public_key_hash.size\n\nlet activation_code_encoding = Data_encoding.Fixed.bytes activation_code_size\n\nlet activation_code_of_hex h =\n  if Compare.Int.(String.length h <> activation_code_size * 2) then None\n  else Hex.to_bytes (`Hex h)\n" ;
                } ;
                { name = "Block_payload_hash" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** A specialized Blake2B implementation for hashing block's payloads. *)\n\ninclude S.HASH\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2020 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(* 32 *)\nlet prefix = \"\\001\\106\\242\" (* vh(52) *)\n\ninclude\n  Blake2B.Make\n    (Base58)\n    (struct\n      let name = \"value_hash\"\n\n      let title = \"Hash of a consensus value\"\n\n      let b58check_prefix = prefix\n\n      let size = None\n    end)\n\nlet () = Base58.check_encoded_prefix b58check_encoding \"vh\" 52\n" ;
                } ;
                { name = "Slot_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(* TODO: https://gitlab.com/tezos/tezos/-/issues/2057\n   remake abstract (required index for storage) *)\ntype t = int\n\nval encoding : t Data_encoding.t\n\nval pp : Format.formatter -> t -> unit\n\nval zero : t\n\nval succ : t -> t\n\nval max_value : t\n\nval of_int_do_not_use_except_for_parameters : int -> t\n\n(** [of_int i] creates a slot index from integer [i]\n\n    @raise Invalid_argument if [i < 0 || i > max_value]\n*)\nval of_int_exn : int -> t\n\nval to_int : t -> int\n\nmodule Map : Map.S with type key = t\n\nmodule Set : Set.S with type elt = t\n\ninclude Compare.S with type t := t\n\nmodule List : sig\n  (* Expected invariant: list of increasing values *)\n  type nonrec t = t list\n\n  val encoding : t Data_encoding.t\n\n  val slot_range : min:int -> count:int -> t tzresult\nend\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype error += Invalid_slot of int\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"slot.invalid_slot\"\n    ~title:\"invalid slot\"\n    ~description:\"Invalid slot\"\n    ~pp:(fun ppf x -> Format.fprintf ppf \"invalid slot: %d\" x)\n    Data_encoding.(obj1 (req \"bad_slot\" int31))\n    (function Invalid_slot x -> Some x | _ -> None)\n    (fun x -> Invalid_slot x)\n\ninclude Compare.Int\n\n(* TODO? should there be some assertions to verify that slots are\n   never too big ? Or do that in a storage module that depends on\n   constants ? *)\n\nlet encoding = Data_encoding.uint16\n\nlet pp = Format.pp_print_int\n\nlet zero = 0\n\nlet succ = succ\n\nlet to_int x = x\n\nlet max_value = (1 lsl 16) - 1\n\nlet of_int_do_not_use_except_for_parameters i = i\n\nlet of_int_exn i =\n  if Compare.Int.(i < 0 || i > max_value) then\n    invalid_arg\n      (Format.sprintf\n         \"valid slot values are in the interval [0, %d] (%d given)\"\n         max_value\n         i)\n  else i\n\nmodule Map = Map.Make (Compare.Int)\nmodule Set = Set.Make (Compare.Int)\n\nmodule List = struct\n  (* Expected invariant: list of increasing values *)\n  (* TODO find a way to properly enforce this invariant *)\n  type nonrec t = t list\n\n  module Compressed = struct\n    type elt = {skip : int; take : int}\n\n    type encoded = elt list\n\n    let elt_encoding =\n      Data_encoding.(\n        conv\n          (fun {skip; take} -> (skip, take))\n          (fun (skip, take) -> {skip; take})\n          (obj2 (req \"skip\" uint16) (req \"take\" uint16)))\n\n    let encoding = Data_encoding.list elt_encoding\n\n    let encode l : encoded =\n      let rec loop_taking ~pos ~skipped ~taken l =\n        match l with\n        | [] -> if taken > 0 then [{skip = skipped; take = taken}] else []\n        | h :: t ->\n            if h = pos then\n              loop_taking ~pos:(pos + 1) ~skipped ~taken:(taken + 1) t\n            else\n              let elt = {skip = skipped; take = taken} in\n              let skipped = h - pos in\n              let taken = 1 in\n              let elts = loop_taking ~pos:(h + 1) ~skipped ~taken t in\n              elt :: elts\n      in\n      loop_taking ~pos:0 ~skipped:0 ~taken:0 l\n\n    let decode (elts : encoded) =\n      let rec loop ~pos elts =\n        match elts with\n        | [] -> Ok []\n        | elt :: elts -> (\n            let pos = pos + elt.skip in\n            match\n              List.init ~when_negative_length:() elt.take (fun i -> i + pos)\n            with\n            | Ok l -> (\n                let pos = pos + elt.take in\n                match loop ~pos elts with Ok t -> Ok (l @ t) | e -> e)\n            | Error () ->\n                Error \"A compressed element contains a negative list size\")\n      in\n      loop ~pos:0 elts\n  end\n\n  let encoding =\n    Data_encoding.conv_with_guard\n      Compressed.encode\n      Compressed.decode\n      Compressed.encoding\n\n  let slot_range ~min ~count =\n    error_when (min < 0) (Invalid_slot min) >>? fun () ->\n    error_when (min > max_value) (Invalid_slot min) >>? fun () ->\n    error_when (count < 1) (Invalid_slot count) >>? fun () ->\n    error_when (count > max_value) (Invalid_slot count) >>? fun () ->\n    let max = min + count - 1 in\n    error_when (max > max_value) (Invalid_slot max) >>? fun () ->\n    ok Misc.(min --> max)\nend\n" ;
                } ;
                { name = "Tez_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype t\n\ntype tez = t\n\nval zero : t\n\nval one_mutez : t\n\nval one_cent : t\n\nval fifty_cents : t\n\nval one : t\n\nval ( -? ) : t -> t -> t tzresult\n\n(** Same as ( -? ) but returns None instead of an error. *)\nval sub_opt : t -> t -> t option\n\nval ( +? ) : t -> t -> t tzresult\n\nval ( *? ) : t -> int64 -> t tzresult\n\nval ( /? ) : t -> int64 -> t tzresult\n\nval to_mutez : t -> int64\n\n(** [of_mutez n] (micro tez) is None if n is negative *)\nval of_mutez : int64 -> t option\n\n(** [of_mutez_exn n] fails if n is negative.\n    It should only be used at toplevel for constants. *)\nval of_mutez_exn : int64 -> t\n\n(** It should only be used at toplevel for constants. *)\nval mul_exn : t -> int -> t\n\n(** It should only be used at toplevel for constants. *)\nval div_exn : t -> int -> t\n\nval encoding : t Data_encoding.t\n\ninclude Compare.S with type t := t\n\nval pp : Format.formatter -> t -> unit\n\nval of_string : string -> t option\n\nval to_string : t -> string\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nlet id = \"tez\"\n\nlet name = \"mutez\"\n\ninclude Compare.Int64 (* invariant: positive *)\n\ntype error +=\n  | Addition_overflow of t * t (* `Temporary *)\n  | Subtraction_underflow of t * t (* `Temporary *)\n  | Multiplication_overflow of t * int64 (* `Temporary *)\n  | Negative_multiplicator of t * int64 (* `Temporary *)\n  | Invalid_divisor of t * int64\n\n(* `Temporary *)\n\nlet zero = 0L\n\n(* all other constant are defined from the value of one micro tez *)\nlet one_mutez = 1L\n\nlet one_cent = Int64.mul one_mutez 10_000L\n\nlet fifty_cents = Int64.mul one_cent 50L\n\n(* 1 tez = 100 cents = 1_000_000 mutez *)\nlet one = Int64.mul one_cent 100L\n\nlet of_string s =\n  let triplets = function\n    | hd :: tl ->\n        let len = String.length hd in\n        Compare.Int.(\n          len <= 3 && len > 0 && List.for_all (fun s -> String.length s = 3) tl)\n    | [] -> false\n  in\n  let integers s = triplets (String.split_on_char ',' s) in\n  let decimals s =\n    let l = String.split_on_char ',' s in\n    if Compare.List_length_with.(l > 2) then false else triplets (List.rev l)\n  in\n  let parse left right =\n    let remove_commas s = String.concat \"\" (String.split_on_char ',' s) in\n    let pad_to_six s =\n      let len = String.length s in\n      String.init 6 (fun i -> if Compare.Int.(i < len) then s.[i] else '0')\n    in\n    Int64.of_string_opt (remove_commas left ^ pad_to_six (remove_commas right))\n  in\n  match String.split_on_char '.' s with\n  | [left; right] ->\n      if String.contains s ',' then\n        if integers left && decimals right then parse left right else None\n      else if\n        Compare.Int.(String.length right > 0)\n        && Compare.Int.(String.length right <= 6)\n      then parse left right\n      else None\n  | [left] ->\n      if (not (String.contains s ',')) || integers left then parse left \"\"\n      else None\n  | _ -> None\n\nlet pp ppf amount =\n  let mult_int = 1_000_000L in\n  let[@coq_struct \"amount\"] rec left ppf amount =\n    let (d, r) = (Int64.(div amount 1000L), Int64.(rem amount 1000L)) in\n    if d > 0L then Format.fprintf ppf \"%a%03Ld\" left d r\n    else Format.fprintf ppf \"%Ld\" r\n  in\n  let right ppf amount =\n    let triplet ppf v =\n      if Compare.Int.(v mod 10 > 0) then Format.fprintf ppf \"%03d\" v\n      else if Compare.Int.(v mod 100 > 0) then Format.fprintf ppf \"%02d\" (v / 10)\n      else Format.fprintf ppf \"%d\" (v / 100)\n    in\n    let (hi, lo) = (amount / 1000, amount mod 1000) in\n    if Compare.Int.(lo = 0) then Format.fprintf ppf \"%a\" triplet hi\n    else Format.fprintf ppf \"%03d%a\" hi triplet lo\n  in\n  let (ints, decs) =\n    (Int64.(div amount mult_int), Int64.(to_int (rem amount mult_int)))\n  in\n  left ppf ints ;\n  if Compare.Int.(decs > 0) then Format.fprintf ppf \".%a\" right decs\n\nlet to_string t = Format.asprintf \"%a\" pp t\n\nlet ( -? ) t1 t2 =\n  if t2 <= t1 then ok (Int64.sub t1 t2)\n  else error (Subtraction_underflow (t1, t2))\n\nlet sub_opt t1 t2 = if t2 <= t1 then Some (Int64.sub t1 t2) else None\n\nlet ( +? ) t1 t2 =\n  let t = Int64.add t1 t2 in\n  if t < t1 then error (Addition_overflow (t1, t2)) else ok t\n\nlet ( *? ) t m =\n  if m < 0L then error (Negative_multiplicator (t, m))\n  else if m = 0L then ok 0L\n  else if t > Int64.(div max_int m) then error (Multiplication_overflow (t, m))\n  else ok (Int64.mul t m)\n\nlet ( /? ) t d =\n  if d <= 0L then error (Invalid_divisor (t, d)) else ok (Int64.div t d)\n\nlet mul_exn t m =\n  match t *? Int64.(of_int m) with\n  | Ok v -> v\n  | Error _ -> invalid_arg \"mul_exn\"\n\nlet div_exn t d =\n  match t /? Int64.(of_int d) with\n  | Ok v -> v\n  | Error _ -> invalid_arg \"div_exn\"\n\nlet of_mutez t = if t < 0L then None else Some t\n\nlet of_mutez_exn x =\n  match of_mutez x with None -> invalid_arg \"Tez.of_mutez\" | Some v -> v\n\nlet to_mutez t = t\n\nlet encoding =\n  let open Data_encoding in\n  Data_encoding.def\n    name\n    (check_size 10 (conv Z.of_int64 (Json.wrap_error Z.to_int64) n))\n\nlet () =\n  let open Data_encoding in\n  register_error_kind\n    `Temporary\n    ~id:(id ^ \".addition_overflow\")\n    ~title:(\"Overflowing \" ^ id ^ \" addition\")\n    ~pp:(fun ppf (opa, opb) ->\n      Format.fprintf\n        ppf\n        \"Overflowing addition of %a %s and %a %s\"\n        pp\n        opa\n        id\n        pp\n        opb\n        id)\n    ~description:(\"An addition of two \" ^ id ^ \" amounts overflowed\")\n    (obj1 (req \"amounts\" (tup2 encoding encoding)))\n    (function Addition_overflow (a, b) -> Some (a, b) | _ -> None)\n    (fun (a, b) -> Addition_overflow (a, b)) ;\n  register_error_kind\n    `Temporary\n    ~id:(id ^ \".subtraction_underflow\")\n    ~title:(\"Underflowing \" ^ id ^ \" subtraction\")\n    ~pp:(fun ppf (opa, opb) ->\n      Format.fprintf\n        ppf\n        \"Underflowing subtraction of %a %s and %a %s\"\n        pp\n        opa\n        id\n        pp\n        opb\n        id)\n    ~description:(\"A subtraction of two \" ^ id ^ \" amounts underflowed\")\n    (obj1 (req \"amounts\" (tup2 encoding encoding)))\n    (function Subtraction_underflow (a, b) -> Some (a, b) | _ -> None)\n    (fun (a, b) -> Subtraction_underflow (a, b)) ;\n  register_error_kind\n    `Temporary\n    ~id:(id ^ \".multiplication_overflow\")\n    ~title:(\"Overflowing \" ^ id ^ \" multiplication\")\n    ~pp:(fun ppf (opa, opb) ->\n      Format.fprintf\n        ppf\n        \"Overflowing multiplication of %a %s and %Ld\"\n        pp\n        opa\n        id\n        opb)\n    ~description:\n      (\"A multiplication of a \" ^ id ^ \" amount by an integer overflowed\")\n    (obj2 (req \"amount\" encoding) (req \"multiplicator\" int64))\n    (function Multiplication_overflow (a, b) -> Some (a, b) | _ -> None)\n    (fun (a, b) -> Multiplication_overflow (a, b)) ;\n  register_error_kind\n    `Temporary\n    ~id:(id ^ \".negative_multiplicator\")\n    ~title:(\"Negative \" ^ id ^ \" multiplicator\")\n    ~pp:(fun ppf (opa, opb) ->\n      Format.fprintf\n        ppf\n        \"Multiplication of %a %s by negative integer %Ld\"\n        pp\n        opa\n        id\n        opb)\n    ~description:(\"Multiplication of a \" ^ id ^ \" amount by a negative integer\")\n    (obj2 (req \"amount\" encoding) (req \"multiplicator\" int64))\n    (function Negative_multiplicator (a, b) -> Some (a, b) | _ -> None)\n    (fun (a, b) -> Negative_multiplicator (a, b)) ;\n  register_error_kind\n    `Temporary\n    ~id:(id ^ \".invalid_divisor\")\n    ~title:(\"Invalid \" ^ id ^ \" divisor\")\n    ~pp:(fun ppf (opa, opb) ->\n      Format.fprintf\n        ppf\n        \"Division of %a %s by non positive integer %Ld\"\n        pp\n        opa\n        id\n        opb)\n    ~description:\n      (\"Multiplication of a \" ^ id ^ \" amount by a non positive integer\")\n    (obj2 (req \"amount\" encoding) (req \"divisor\" int64))\n    (function Invalid_divisor (a, b) -> Some (a, b) | _ -> None)\n    (fun (a, b) -> Invalid_divisor (a, b))\n\ntype tez = t\n" ;
                } ;
                { name = "Period_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype t\n\n(** Represents a period of time as a non-negative integer. *)\ntype period = t\n\ninclude Compare.S with type t := t\n\nval encoding : period Data_encoding.t\n\nval rpc_arg : period RPC_arg.t\n\nval pp : Format.formatter -> period -> unit\n\n(** Returns the number of seconds contained in the period. *)\nval to_seconds : period -> int64\n\n(** Converts a number of seconds to a [period].\n\n    [of_second s] fails if [s] is not positive. *)\nval of_seconds : int64 -> period tzresult\n\n(** Converts a number of seconds to [period].\n\n   [of_second s] fails if [s] is not positive.\n    It should only be used at toplevel for constants. *)\nval of_seconds_exn : int64 -> period\n\n(** Safe addition of periods, guarded against overflow. *)\nval add : period -> period -> period tzresult\n\n(** Alias for [add]. *)\nval ( +? ) : period -> period -> period tzresult\n\n(** Safe multiplication by a positive integer. Guarded against overflow. *)\nval mult : int32 -> period -> period tzresult\n\nval zero : period\n\nval one_second : period\n\nval one_minute : period\n\nval one_hour : period\n\n(** [compare x y] returns [0] if [x] is equal to [y], a negative\n    integer if [x] is shorter than [y], and a positive integer if [x]\n    is longer than [y]. *)\nval compare : period -> period -> int\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(* `Permanent *)\ntype error += Malformed_period of int64 | Invalid_arg | Period_overflow\n\nlet () =\n  let open Data_encoding in\n  (* Malformed period *)\n  register_error_kind\n    `Permanent\n    ~id:\"malformed_period\"\n    ~title:\"Malformed period\"\n    ~description:\"Period is negative.\"\n    ~pp:(fun ppf period ->\n      Format.fprintf ppf \"The given period '%Ld' is negative \" period)\n    (obj1 (req \"malformed_period\" int64))\n    (function Malformed_period n -> Some n | _ -> None)\n    (fun n -> Malformed_period n) ;\n  (* Invalid arg *)\n  register_error_kind\n    `Permanent\n    ~id:\"invalid_arg\"\n    ~title:\"Invalid arg\"\n    ~description:\"Negative multiple of periods are not allowed.\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"Invalid arg\")\n    empty\n    (function Invalid_arg -> Some () | _ -> None)\n    (fun () -> Invalid_arg) ;\n  let title = \"Period overflow\" in\n  register_error_kind\n    `Permanent\n    ~id:\"period_overflow\"\n    ~title\n    ~description:\"Last operation generated an integer overflow.\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"%s\" title)\n    empty\n    (function Period_overflow -> Some () | _ -> None)\n    (fun () -> Period_overflow)\n\nmodule type INTERNAL = sig\n  type t = private int64\n\n  val create : int64 -> t option\n\n  val zero : t\n\n  val one : t\n\n  val mult_ : t -> t -> t option\n\n  val add_ : t -> t -> t option\n\n  val encoding : t Data_encoding.t\n\n  val rpc_arg : t RPC_arg.arg\n\n  val pp : Format.formatter -> t -> unit\n\n  include Compare.S with type t := t\nend\n\n(* Internal module implementing natural numbers using int64. These are different\n   from usual (wrapping up) unsigned integers in that if one overflows the\n   representation bounds for int64 through [add] or [mul], a [None] value is\n   returned *)\nmodule Internal : INTERNAL = struct\n  type t = Int64.t\n\n  let encoding =\n    Data_encoding.(\n      with_decoding_guard\n        (fun t ->\n          if Compare.Int64.(t >= 0L) then Ok ()\n          else Error \"Positive int64 required\")\n        int64)\n\n  let rpc_arg = RPC_arg.uint63\n\n  let pp ppf v = Format.fprintf ppf \"%Ld\" v\n\n  include (Compare.Int64 : Compare.S with type t := t)\n\n  let zero = 0L\n\n  let one = 1L\n\n  let create t = if t >= zero then Some t else None\n\n  (* The create function is not used in the [mul_] and [add_] below to not add\n      extra Some | None pattern matching to handle since the overflow checks are\n      generic and apply as well to negative as positive integers .\n\n     To handle overflows, both [add_] and [mult_] return option types. [None] is\n      returned on detected overflow, [Some value] when everything went well. *)\n  let mult_ a b =\n    if a <> zero then\n      let res = Int64.mul a b in\n      if Int64.div res a <> b then None else Some res\n    else Some zero\n\n  let add_ a b =\n    let res = Int64.add a b in\n    if res < a || res < b then None else Some res\nend\n\ninclude Internal\n\ntype period = Internal.t\n\nlet to_seconds (t : Internal.t) = (t :> int64)\n\nlet of_seconds secs =\n  match Internal.create secs with\n  | Some v -> ok v\n  | None -> error (Malformed_period secs)\n\nlet of_seconds_exn t =\n  match Internal.create t with\n  | Some t -> t\n  | None -> invalid_arg \"Period.of_seconds_exn\"\n\nlet mult i p =\n  match Internal.create (Int64.of_int32 i) with\n  | None -> error Invalid_arg\n  | Some iper -> (\n      match Internal.mult_ iper p with\n      | None -> error Period_overflow\n      | Some res -> ok res)\n\nlet add p1 p2 =\n  match Internal.add_ p1 p2 with\n  | None -> error Period_overflow\n  | Some res -> ok res\n\nlet ( +? ) = add\n\nlet one_second = Internal.one\n\nlet one_minute = of_seconds_exn 60L\n\nlet one_hour = of_seconds_exn 3600L\n" ;
                } ;
                { name = "Time_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ninclude module type of struct\n  include Time\nend\n\n(** Internal timestamp representation. *)\ntype time = t\n\n(** Pretty-prints the time stamp using RFC3339 format. *)\nval pp : Format.formatter -> t -> unit\n\n(** Parses RFC3339 representation and returns a timestamp. *)\nval of_seconds_string : string -> time option\n\n(** Returns the timestamp encoded in RFC3339 format. *)\nval to_seconds_string : time -> string\n\n(** Adds a time span to a timestamp.\n    This function fails on integer overflow *)\nval ( +? ) : time -> Period_repr.t -> time tzresult\n\n(** Returns the difference between two timestamps as a time span.\n    This function fails when the difference is negative *)\nval ( -? ) : time -> time -> Period_repr.t tzresult\n\n(** [t - p] Returns a timestamps [p] seconds before [t].\n\n    TODO: https://gitlab.com/tezos/tezos/-/issues/2054\n    This function should be made available in the environment.\n *)\nval ( - ) : time -> Period_repr.t -> time\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\ninclude Time\n\ntype time = Time.t\n\ntype error += Timestamp_add (* `Permanent *)\n\ntype error += Timestamp_sub (* `Permanent *)\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"timestamp_add\"\n    ~title:\"Timestamp add\"\n    ~description:\"Overflow when adding timestamps.\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"Overflow when adding timestamps.\")\n    Data_encoding.empty\n    (function Timestamp_add -> Some () | _ -> None)\n    (fun () -> Timestamp_add) ;\n  register_error_kind\n    `Permanent\n    ~id:\"timestamp_sub\"\n    ~title:\"Timestamp sub\"\n    ~description:\"Subtracting timestamps resulted in negative period.\"\n    ~pp:(fun ppf () ->\n      Format.fprintf ppf \"Subtracting timestamps resulted in negative period.\")\n    Data_encoding.empty\n    (function Timestamp_sub -> Some () | _ -> None)\n    (fun () -> Timestamp_sub)\n\nlet of_seconds_string s = Option.map Time.of_seconds (Int64.of_string_opt s)\n\nlet to_seconds_string s = Int64.to_string (to_seconds s)\n\nlet pp = pp_hum\n\nlet ( +? ) x y =\n  let span = Period_repr.to_seconds y in\n  let t64 = Time.add x span in\n  (* As long as span and time representations are int64, we cannont overflow if\n     x is negative. *)\n  if x < Time.of_seconds 0L then ok t64\n  else if t64 < Time.of_seconds 0L then error Timestamp_add\n  else ok t64\n\nlet ( -? ) x y =\n  record_trace Timestamp_sub (Period_repr.of_seconds (Time.diff x y))\n\nlet ( - ) x y =\n  Time.of_seconds Int64.(sub (Time.to_seconds x) (Period_repr.to_seconds y))\n" ;
                } ;
                { name = "Round_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** A round represents an iteration of the single-shot consensus algorithm.\n\n   Rounds can be seen as an infinite, 0-indexed, list of durations. The\n   durations are generated by an arithmetic progression depending on\n   {!val:Constants_repr.minimal_block_delay} (its initial value, a.k.a the one for\n   round 0) and {!val:Constants_repr.delay_increment_per_round} (its common\n   difference) .\n\n   Round identifiers are non-negative 32 bit integers. This interface ensures\n   that no negative round can be created. *)\n\ntype round\n\ntype t = round\n\n(** Round zero  *)\nval zero : t\n\n(** Successor of the given round.\n\n    @raise [Invalid_arg] if applied to the upper bound of the round integer\n    representation.  *)\nval succ : t -> t\n\n(** Predecessor of the given round.\n    Returns an error if applied to [zero], as negative round are\n    prohibited. *)\nval pred : t -> t tzresult\n\n(** Building a round from an int32.\n    Returns an error if applied to a negative number. *)\nval of_int32 : int32 -> t tzresult\n\nval to_int32 : t -> int32\n\n(** Building a round from an int.\n    Returns an error if applied to a negative number or a number\n    greater than Int32.max_int. *)\nval of_int : int -> t tzresult\n\n(** Building an int from a round.\n    Returns an error if the value does not fit in max_int. (current\n    32bit encodings always fit in int on 64bit architecture though). *)\nval to_int : t -> int tzresult\n\n(** Returns the slot corresponding to the given round [r], that is [r\n   mod committee_size]. *)\nval to_slot : t -> committee_size:int -> Slot_repr.t tzresult\n\n(** Round encoding.\n    Be aware that decoding a negative 32 bit integer would lead to an\n    exception. *)\nval encoding : t Data_encoding.t\n\nval pp : Format.formatter -> t -> unit\n\ninclude Compare.S with type t := t\n\nmodule Map : Map.S with type key = t\n\n(** {2 Round duration representation} *)\n\nmodule Durations : sig\n  (** [round_durations] represents the duration of rounds in seconds *)\n  type t\n\n  val pp : Format.formatter -> t -> unit\n\n  (** {3 Creation functions} *)\n\n  (** [create ~first_round_duration ~delay_increment_per_round] creates a valid\n      duration value\n\n      @param first_round_duration duration of round 0\n      @param delay_increment_per_round amount of time added in from one round\n                                       duration to the duration of its next round\n      @raises Invalid_argument if\n        - first_round_duration <= 1; or\n        - delay_increment_per_round is <= 0\n   *)\n  val create :\n    first_round_duration:Period_repr.t ->\n    delay_increment_per_round:Period_repr.t ->\n    t tzresult\n\n  (** [create_opt ~first_round_duration ~delay_increment_per_round] returns a valid duration value\n      [Some d] when [create ~first_round_duration ~delay_increment_per_round]\n      does not fail. It returns [None] otherwise. *)\n  val create_opt :\n    first_round_duration:Period_repr.t ->\n    delay_increment_per_round:Period_repr.t ->\n    t option\n\n  (** {b Warning} May trigger an exception when the expected invariant\n      does not hold. *)\n  val encoding : t Data_encoding.encoding\n\n  (** {3 Accessors}*)\n\n  (** [round_duration round_durations ~round] returns the duration of round\n      [~round]. This duration follows the arithmetic progression\n\n      duration(round_n) = [first_round_duration] + round_n * [delay_increment_per_round]\n\n   *)\n  val round_duration : t -> round -> Period_repr.t\nend\n\n(** [level_offset_of_round round_durations ~round:r] represents the offset of the\n    starting time of round [r] with respect to the start of the level.\n    round = 0      1     2    3                            r\n\n          |-----|-----|-----|-----|-----|--- ... ... --|------|-------\n                                                       |\n          <------------------------------------------->\n                              level_offset\n*)\nval level_offset_of_round : Durations.t -> round:t -> Period_repr.t tzresult\n\n(** [timestamp_of_round round_durations ~predecessor_timestamp:pred_ts\n     ~predecessor_round:pred_round ~round] returns the\n    starting time of round [round] given that the timestamp and the round of\n    the block at the previous level is [pred_ts] and [pred_round],\n    respectively.\n\n    pred_round = 0            pred_round\n\n              |-----|.. ... --|--------|-- ... --|-------\n                              |        |\n                              |        |\n                           pred_ts     |\n                                       |\n                                start_of_cur_level\n                                       |\n                                       |\n                                       |-----|------|-- ... --|-------|-\n    cur_round =                           0      1            | round\n                                                              |\n                                                            res_ts\n\n    Precisely, the resulting timestamp is:\n      [pred_ts + round_duration(pred_round) + level_offset_of_round(round)].\n*)\nval timestamp_of_round :\n  Durations.t ->\n  predecessor_timestamp:Time_repr.t ->\n  predecessor_round:t ->\n  round:t ->\n  Time_repr.t tzresult\n\n(** [timestamp_of_another_round_same_level\n        round_durations\n        ~current_timestamp\n        ~current_round\n        ~considered_round]\n       returns the starting time of round [considered_round].\n\n       start of current\n            level         current ts      result\n              |               |             |\n              |               |             |\n              |-----|----...--|-- ... ------|-\n              |     |         |             |\n  cur_round = 0     1      current      considered\n                            round         round\n\n    It also works when [considered_round] is lower than [current_round].\n\n  Precisely, the resulting timestamp is:\n    [current_timestamp - level_offset_of_round(current_round)\n                       + level_offset_of_round(considered_round)].\n*)\nval timestamp_of_another_round_same_level :\n  Durations.t ->\n  current_timestamp:Time_repr.t ->\n  current_round:t ->\n  considered_round:t ->\n  Time_repr.t tzresult\n\n(** [round_of_timestamp round_durations ~predecessor_timestamp ~predecessor_round\n     ~timestamp:ts] returns the round to which the timestamp [ts] belongs to,\n    given that the timestamp and the round of the block at the previous level is\n    [pred_ts] and [pred_round], respectively.\n\n    Precisely, the resulting round is:\n      [round_and_offset round_durations ~level_offset:diff] where\n    [diff = ts - (predecessor_timestamp + round_duration(predecessor_round)].\n\n    Returns an error when the timestamp is before the level start.*)\nval round_of_timestamp :\n  Durations.t ->\n  predecessor_timestamp:Time_repr.t ->\n  predecessor_round:t ->\n  timestamp:Time_repr.t ->\n  t tzresult\n\nmodule Internals_for_test : sig\n  type round_and_offset_raw = {round : round; offset : Period_repr.t}\n\n  (** [round_and_offset round_durations ~level_offset], where [level_offset]\n    represents a time offset with respect to the start of the first round,\n    returns a tuple [(r, round_offset)] where the round [r] is such that\n    [level_offset_of_round(r) <= level_offset < level_offset_of_round(r+1)] and\n    [round_offset := level_offset - level_offset_of_round(r)]].\n\n    round = 0      1     2    3                            r\n\n          |-----|-----|-----|-----|-----|--- ... ... --|--------|-- ... --|-------\n                                                       |\n                                                 round_delay(r)\n                                                              |\n                                                              |\n                                                        <----->\n                                                      round_offset\n          <--------------------------------------------------->\n                              level_offset\n*)\n  val round_and_offset :\n    Durations.t -> level_offset:Period_repr.t -> round_and_offset_raw tzresult\nend\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype round = int32\n\ntype t = round\n\nmodule Map = Map.Make (Int32)\n\ninclude (Compare.Int32 : Compare.S with type t := t)\n\nlet zero = 0l\n\nlet succ n =\n  if Compare.Int32.equal n Int32.max_int then\n    invalid_arg \"round_repr.succ: cannot apply succ to maximum round value\"\n  else Int32.succ n\n\nlet pp fmt i = Format.fprintf fmt \"%ld\" i\n\ntype error += Negative_round of int\n\ntype error += Round_overflow of int\n\nlet () =\n  let open Data_encoding in\n  register_error_kind\n    `Permanent\n    ~id:\"negative_round\"\n    ~title:\"Negative round\"\n    ~description:\"Round cannot be built out of negative integers.\"\n    ~pp:(fun ppf i ->\n      Format.fprintf\n        ppf\n        \"Negative round cannot be built out of negative integers (%Ld)\"\n        i)\n    (obj1 (req \"Negative_round\" int64))\n    (function Negative_round i -> Some (Int64.of_int i) | _ -> None)\n    (fun i -> Negative_round (Int64.to_int i)) ;\n  register_error_kind\n    `Permanent\n    ~id:\"round_overflow\"\n    ~title:\"Round overflow\"\n    ~description:\n      \"Round cannot be built out of integer greater than maximum int32 value.\"\n    ~pp:(fun ppf i ->\n      Format.fprintf\n        ppf\n        \"Round cannot be built out of integer greater than maximum int32 value \\\n         (%Ld)\"\n        i)\n    (obj1 (req \"Negative_round\" int64))\n    (function Round_overflow i -> Some (Int64.of_int i) | _ -> None)\n    (fun i -> Round_overflow (Int64.to_int i))\n\nlet of_int32 i =\n  if i >= 0l then Ok i else error (Negative_round (Int32.to_int i))\n  [@@inline]\n\nlet pred r =\n  let p = Int32.pred r in\n  of_int32 p\n\nlet of_int i =\n  if Compare.Int.(i < 0) then error (Negative_round i)\n  else\n    (* i is positive *)\n    let i32 = Int32.of_int i in\n    if Compare.Int.(Int32.to_int i32 = i) then Ok i32\n    else error (Round_overflow i)\n\nlet to_int i32 =\n  let i = Int32.to_int i32 in\n  if Int32.(equal (of_int i) i32) then ok i else error (Round_overflow i)\n\nlet to_int32 t = t [@@inline]\n\nlet to_slot round ~committee_size =\n  to_int round >|? fun r ->\n  let slot = r mod committee_size in\n  Slot_repr.of_int_exn slot\n\nlet encoding =\n  Data_encoding.conv_with_guard\n    (fun i -> i)\n    (fun i ->\n      match of_int32 i with\n      | Ok _ as res -> res\n      | Error _ -> Error \"Round_repr.encoding: negative round\")\n    Data_encoding.int32\n\nmodule Durations = struct\n  type t = {\n    first_round_duration : Period_repr.t;\n    delay_increment_per_round : Period_repr.t;\n  }\n\n  type error +=\n    | Non_increasing_rounds of {increment : Period_repr.t}\n    | Round_durations_must_be_at_least_one_second of {round : Period_repr.t}\n\n  let () =\n    register_error_kind\n      `Permanent\n      ~id:\"durations.non_increasing_rounds\"\n      ~title:\"Non increasing round\"\n      ~description:\"The provided rounds are not increasing.\"\n      ~pp:(fun ppf increment ->\n        Format.fprintf\n          ppf\n          \"The provided rounds are not increasing (increment: %a)\"\n          Period_repr.pp\n          increment)\n      Data_encoding.(obj1 (req \"increment\" Period_repr.encoding))\n      (function\n        | Non_increasing_rounds {increment} -> Some increment | _ -> None)\n      (fun increment -> Non_increasing_rounds {increment})\n\n  let pp fmt t =\n    Format.fprintf\n      fmt\n      \"%a,@ +%a\"\n      Period_repr.pp\n      t.first_round_duration\n      Period_repr.pp\n      t.delay_increment_per_round\n\n  let create ~first_round_duration ~delay_increment_per_round =\n    error_when\n      Compare.Int64.(Period_repr.to_seconds first_round_duration < 1L)\n      (Round_durations_must_be_at_least_one_second\n         {round = first_round_duration})\n    >>? fun () ->\n    error_when\n      Compare.Int64.(Period_repr.to_seconds delay_increment_per_round < 1L)\n      (Non_increasing_rounds {increment = delay_increment_per_round})\n    >>? fun () -> ok {first_round_duration; delay_increment_per_round}\n\n  let create_opt ~first_round_duration ~delay_increment_per_round =\n    match create ~first_round_duration ~delay_increment_per_round with\n    | Ok v -> Some v\n    | Error _ -> None\n\n  let encoding =\n    let open Data_encoding in\n    conv_with_guard\n      (fun {first_round_duration; delay_increment_per_round} ->\n        (first_round_duration, delay_increment_per_round))\n      (fun (first_round_duration, delay_increment_per_round) ->\n        match create_opt ~first_round_duration ~delay_increment_per_round with\n        | None ->\n            Error\n              \"Either round durations are non-increasing or minimal block \\\n               delay < 1\"\n        | Some rounds -> Ok rounds)\n      (obj2\n         (req \"first_round_duration\" Period_repr.encoding)\n         (req \"delay_increment_per_round\" Period_repr.encoding))\n\n  let round_duration {first_round_duration; delay_increment_per_round} round =\n    if Compare.Int32.(round < 0l) then\n      invalid_arg \"round must be a non-negative integer\"\n    else\n      let first_round_duration_s = Period_repr.to_seconds first_round_duration\n      and delay_increment_per_round_s =\n        Period_repr.to_seconds delay_increment_per_round\n      in\n      Period_repr.of_seconds_exn\n        Int64.(\n          add\n            first_round_duration_s\n            (mul (of_int32 round) delay_increment_per_round_s))\nend\n\ntype error += Round_too_high of int32\n\nlet () =\n  let open Data_encoding in\n  register_error_kind\n    `Permanent\n    ~id:\"round_too_high\"\n    ~title:\"round too high\"\n    ~description:\"block round too high.\"\n    ~pp:(fun ppf round ->\n      Format.fprintf ppf \"Block round is too high: %ld\" round)\n    (obj1 (req \"level_offset_too_high\" int32))\n    (function Round_too_high round -> Some round | _ -> None)\n    (fun round -> Round_too_high round)\n\n(* The duration of round n follows the arithmetic sequence:\n\n     round_duration(0)   = first_round_duration\n     round_duration(r+1) = round_duration(r) + delay_increment_per_round\n\n   Hence, this sequence can be explicited into:\n\n     round_duration(r) = first_round_duration + r * delay_increment_per_round\n\n   The level offset of round r is the sum of the durations of the rounds up\n   until round r - 1. In other words, when r > 0\n\n     level_offset_of_round(0)   = 0\n     level_offset_of_round(r+1) = level_offset_of_round(r) + round_duration(r)\n\nHence\n\n     level_offset_of_round(r) = \206\163_{k=0}^{r-1} (round_duration(k))\n\n   After unfolding the series, the same function can be finally explicited into\n\n     level_offset_of_round(0) = 0\n     level_offset_of_round(r) = r * first_round_duration\n                                + 1/2 * r * (r - 1) * delay_increment_per_round\n*)\nlet level_offset_of_round round_durations ~round =\n  if Compare.Int32.(round = zero) then ok Int64.zero\n  else\n    let sum_durations =\n      let Durations.{first_round_duration; delay_increment_per_round} =\n        round_durations\n      in\n      let roundz = Int64.of_int32 round in\n      let m = Z.of_int64 Int64.(div (mul roundz (pred roundz)) (of_int 2)) in\n      Z.(\n        add\n          (mul\n             m\n             (Z.of_int64 @@ Period_repr.to_seconds delay_increment_per_round))\n          (mul\n             (Z.of_int32 round)\n             (Z.of_int64 @@ Period_repr.to_seconds first_round_duration)))\n    in\n    if Compare.Z.(sum_durations > Z.of_int64 Int64.max_int) then\n      error (Round_too_high round)\n    else ok (Z.to_int64 sum_durations)\n\ntype error += Level_offset_too_high of Period_repr.t\n\nlet () =\n  let open Data_encoding in\n  register_error_kind\n    `Permanent\n    ~id:\"level_offset_too_high\"\n    ~title:\"level offset too high\"\n    ~description:\"The block's level offset is too high.\"\n    ~pp:(fun ppf offset ->\n      Format.fprintf\n        ppf\n        \"The block's level offset is too high: %a\"\n        Period_repr.pp\n        offset)\n    (obj1 (req \"level_offset_too_high\" Period_repr.encoding))\n    (function Level_offset_too_high offset -> Some offset | _ -> None)\n    (fun offset -> Level_offset_too_high offset)\n\ntype round_and_offset = {round : int32; offset : Period_repr.t}\n\n(** Complexity: O(log max_int). *)\nlet round_and_offset round_durations ~level_offset =\n  let level_offset_in_seconds = Period_repr.to_seconds level_offset in\n  (* We have the invariant [round <= level_offset] so there is no need to search\n     beyond [level_offset]. We set [right_bound] to [level_offset + 1] to avoid\n     triggering the error level_offset too high when the round equals\n     [level_offset]. *)\n  let right_bound =\n    if Compare.Int64.(level_offset_in_seconds < Int64.of_int32 Int32.max_int)\n    then Int32.of_int (Int64.to_int level_offset_in_seconds + 1)\n    else Int32.max_int\n  in\n  let rec bin_search min_r max_r =\n    if Compare.Int32.(min_r >= right_bound) then\n      error (Level_offset_too_high level_offset)\n    else\n      let round = Int32.(add min_r (div (sub max_r min_r) 2l)) in\n      level_offset_of_round round_durations ~round:(Int32.succ round)\n      >>? fun next_level_offset ->\n      if\n        Compare.Int64.(Period_repr.to_seconds level_offset >= next_level_offset)\n      then bin_search (Int32.succ round) max_r\n      else\n        level_offset_of_round round_durations ~round\n        >>? fun current_level_offset ->\n        if\n          Compare.Int64.(\n            Period_repr.to_seconds level_offset < current_level_offset)\n        then bin_search min_r round\n        else\n          ok\n            {\n              round;\n              offset =\n                Period_repr.of_seconds_exn\n                  (Int64.sub\n                     (Period_repr.to_seconds level_offset)\n                     current_level_offset);\n            }\n  in\n  bin_search 0l right_bound\n\n(** Complexity: O(|round_durations|). *)\nlet timestamp_of_round round_durations ~predecessor_timestamp ~predecessor_round\n    ~round =\n  let pred_round_duration =\n    Durations.round_duration round_durations predecessor_round\n  in\n  (* First, the function computes when the current level l is supposed\n     to start. This is given by adding to the timestamp of the round\n     of predecessor level l-1 [predecessor_timestamp], the duration of\n     its last round [predecessor_round]. *)\n  Time_repr.(predecessor_timestamp +? pred_round_duration)\n  >>? fun start_of_current_level ->\n  (* Finally, we sum the durations of the rounds at the current level l until\n     reaching current [round]. *)\n  level_offset_of_round round_durations ~round >>? fun level_offset ->\n  let level_offset = Period_repr.of_seconds_exn level_offset in\n  Time_repr.(start_of_current_level +? level_offset)\n\n(** Unlike [timestamp_of_round], this function gets the starting time\n    of a given round, given the timestamp and the round of a proposal\n    at the same level.\n\n    We compute the starting time of [considered_round] from a given\n    [round_durations] description, some [current_round], and its\n    starting time [current_timestamp].\n\n    Complexity: O(|round_durations|). *)\nlet timestamp_of_another_round_same_level round_durations ~current_timestamp\n    ~current_round ~considered_round =\n  level_offset_of_round round_durations ~round:considered_round\n  >>? fun target_offset ->\n  level_offset_of_round round_durations ~round:current_round\n  >>? fun current_offset ->\n  ok\n  @@ Time_repr.of_seconds\n       Int64.(\n         add\n           (sub (Time_repr.to_seconds current_timestamp) current_offset)\n           target_offset)\n\ntype error +=\n  | Round_of_past_timestamp of {\n      provided_timestamp : Time.t;\n      predecessor_timestamp : Time.t;\n      predecessor_round : t;\n    }\n\nlet () =\n  let open Data_encoding in\n  register_error_kind\n    `Permanent\n    ~id:\"round_of_past_timestamp\"\n    ~title:\"Round_of_timestamp for past timestamp\"\n    ~description:\"Provided timestamp is before the expected level start.\"\n    ~pp:(fun ppf (provided_ts, predecessor_ts, round) ->\n      Format.fprintf\n        ppf\n        \"Provided timestamp (%a) is before the expected level start (computed \\\n         based on predecessor_ts %a at round %a).\"\n        Time.pp_hum\n        provided_ts\n        Time.pp_hum\n        predecessor_ts\n        pp\n        round)\n    (obj3\n       (req \"provided_timestamp\" Time.encoding)\n       (req \"predecessor_timestamp\" Time.encoding)\n       (req \"predecessor_round\" encoding))\n    (function\n      | Round_of_past_timestamp\n          {provided_timestamp; predecessor_timestamp; predecessor_round} ->\n          Some (provided_timestamp, predecessor_timestamp, predecessor_round)\n      | _ -> None)\n    (fun (provided_timestamp, predecessor_timestamp, predecessor_round) ->\n      Round_of_past_timestamp\n        {provided_timestamp; predecessor_timestamp; predecessor_round})\n\nlet round_of_timestamp round_durations ~predecessor_timestamp ~predecessor_round\n    ~timestamp =\n  let round_duration =\n    Durations.round_duration round_durations predecessor_round\n  in\n  Time_repr.(predecessor_timestamp +? round_duration)\n  >>? fun start_of_current_level ->\n  Period_repr.of_seconds (Time_repr.diff timestamp start_of_current_level)\n  |> Error_monad.record_trace\n       (Round_of_past_timestamp\n          {\n            predecessor_timestamp;\n            provided_timestamp = timestamp;\n            predecessor_round;\n          })\n  >>? fun diff ->\n  round_and_offset round_durations ~level_offset:diff\n  >>? fun round_and_offset -> ok round_and_offset.round\n\nlet level_offset_of_round round_durations ~round =\n  level_offset_of_round round_durations ~round >>? fun offset ->\n  ok (Period_repr.of_seconds_exn offset)\n\nmodule Internals_for_test = struct\n  type round_and_offset_raw = {round : round; offset : Period_repr.t}\n\n  let round_and_offset round_durations ~level_offset =\n    round_and_offset round_durations ~level_offset >|? fun v ->\n    {round = v.round; offset = v.offset}\nend\n" ;
                } ;
                { name = "Block_payload_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Value on which validators try to reach a consensus.\n\n    Consensus at a given level is reached on a sequence of operations.  However,\n   to differentiate between two blocks having the same sequence of operations,\n   assuming that could ever happen (for instance, two empty blocks), we also\n   include the hash of the block that precedes the block where these operations\n   should be included. *)\n\n(** [hash ~predecessor:block_hash round oplh] creates a payload hash given a\n    [block_hash], the first [round] at which the payload was proposed\n    and the hash [oplh] of the non-consensus operations. *)\nval hash :\n  predecessor:Block_hash.t ->\n  Round_repr.t ->\n  Operation_list_hash.t ->\n  Block_payload_hash.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Value on which validators try to reach a consensus.\n\n    Consensus at a given level is reached on a sequence of operations.  However,\n    to differentiate between two blocks having the same sequence of operations,\n    assuming that could ever happen (for instance, two empty blocks), we also\n    include the hash of the block that precedes the block where these operations\n    should be included. *)\n\nlet hash ~predecessor round operations_hash =\n  let open Data_encoding in\n  let predecessor = Binary.to_bytes_exn Block_hash.encoding predecessor in\n  let round = Binary.to_bytes_exn Round_repr.encoding round in\n  let operations_hash =\n    Binary.to_bytes_exn Operation_list_hash.encoding operations_hash\n  in\n  Block_payload_hash.hash_bytes [predecessor; round; operations_hash]\n" ;
                } ;
                { name = "Fixed_point_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2020 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** This module defines a standard signature for modules providing fixed-point\n    arithmetic. *)\n\ntype fp_tag (* Tag for fixed point computations *)\n\ntype integral_tag (* Tag for integral computations *)\n\n(** A signature for modules implementing a fixed-point arithmetic.\n\n    Fixed-point types come in two flavours:\n    - integral (marked with [integral_tag]), behaving like integers;\n    - fp (marked with [fp_tag]), allowing for fractions.\n\n    Such numbers represent standard arithmetic, rounding (converting fp\n    flavour to integral one) and comparisons (which can work across flavours). *)\nmodule type Safe = sig\n  type 'a t [@@coq_phantom]\n\n  type fp = fp_tag t\n\n  type integral = integral_tag t\n\n  val integral_exn : Z.t -> integral\n\n  val integral_of_int_exn : int -> integral\n\n  val integral_to_z : integral -> Z.t\n\n  val zero : 'a t\n\n  val add : 'a t -> 'a t -> 'a t\n\n  val sub : 'a t -> 'a t -> 'a t\n\n  val ceil : fp -> integral\n\n  val floor : fp -> integral\n\n  val fp : 'a t -> fp\n\n  val ( = ) : 'a t -> 'b t -> bool\n\n  val ( <> ) : 'a t -> 'b t -> bool\n\n  val ( < ) : 'a t -> 'b t -> bool\n\n  val ( <= ) : 'a t -> 'b t -> bool\n\n  val ( >= ) : 'a t -> 'b t -> bool\n\n  val ( > ) : 'a t -> 'b t -> bool\n\n  val compare : 'a t -> 'b t -> int\n\n  val equal : 'a t -> 'b t -> bool\n\n  val max : 'a t -> 'a t -> 'a t\n\n  val min : 'a t -> 'a t -> 'a t\n\n  val pp : Format.formatter -> 'a t -> unit\n\n  val pp_integral : Format.formatter -> integral -> unit\n\n  val n_fp_encoding : fp Data_encoding.t\n\n  val n_integral_encoding : integral Data_encoding.t\n\n  val z_fp_encoding : fp Data_encoding.t\n\n  val z_integral_encoding : integral Data_encoding.t\nend\n\nmodule type Full = sig\n  type 'a t [@@coq_phantom]\n\n  include Safe with type 'a t := 'a t\n\n  val unsafe_fp : Z.t -> fp\nend\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2020 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype fp_tag (* Tag for fixed point computations *)\n\ntype integral_tag (* Tag for integral computations *)\n\nmodule type Safe = sig\n  type 'a t [@@coq_phantom]\n\n  type fp = fp_tag t\n\n  type integral = integral_tag t\n\n  val integral_exn : Z.t -> integral\n\n  val integral_of_int_exn : int -> integral\n\n  val integral_to_z : integral -> Z.t\n\n  val zero : 'a t\n\n  val add : 'a t -> 'a t -> 'a t\n\n  val sub : 'a t -> 'a t -> 'a t\n\n  val ceil : fp -> integral\n\n  val floor : fp -> integral\n\n  val fp : 'a t -> fp\n\n  val ( = ) : 'a t -> 'b t -> bool\n\n  val ( <> ) : 'a t -> 'b t -> bool\n\n  val ( < ) : 'a t -> 'b t -> bool\n\n  val ( <= ) : 'a t -> 'b t -> bool\n\n  val ( >= ) : 'a t -> 'b t -> bool\n\n  val ( > ) : 'a t -> 'b t -> bool\n\n  val compare : 'a t -> 'b t -> int\n\n  val equal : 'a t -> 'b t -> bool\n\n  val max : 'a t -> 'a t -> 'a t\n\n  val min : 'a t -> 'a t -> 'a t\n\n  val pp : Format.formatter -> 'a t -> unit\n\n  val pp_integral : Format.formatter -> integral -> unit\n\n  val n_fp_encoding : fp Data_encoding.t\n\n  val n_integral_encoding : integral Data_encoding.t\n\n  val z_fp_encoding : fp Data_encoding.t\n\n  val z_integral_encoding : integral Data_encoding.t\nend\n\nmodule type Full = sig\n  type 'a t [@@coq_phantom]\n\n  include Safe with type 'a t := 'a t\n\n  val unsafe_fp : Z.t -> fp\nend\n" ;
                } ;
                { name = "Saturation_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2020 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** This module provides saturated arithmetic between 0 and 2^62 - 1.\n\n   This means that the arithmetic operations provided by this module\n   do not overflow. If an operation would produce an integer [x]\n   greater than [2 ^ 62 - 1], it is [saturated] to this\n   value. Similarly, if an operation would produce a negative integer,\n   it outputs [zero] instead.\n\n   This saturation arithmetic is used to monitor gas levels. While the\n   gas model can produce values beyond 2^62 - 1, there is no point in\n   distinguishing these values from 2^62 - 1 because the amount of gas\n   available is significantly lower than this limit.\n\n   Notice that most saturation arithmetic operations do not behave\n   as their standard counterparts when one of their operands is\n   saturated. For instance,\n\n              (saturated + saturated) - saturated = 0\n\n   For more information about saturation arithmetic, take a look at:\n\n        https://en.wikipedia.org/wiki/Saturation_arithmetic\n\n*)\n\n(** An integer of type ['a t] is between [0] and [saturated].\n\n    The type parameter ['a] is [mul_safe] if the integer is known\n    not to overflow when multiplied with another [mul_safe t].\n\n    The type parameter ['a] is [may_saturate] if the integer is\n    not known to be sufficiently small to prevent overflow during\n    multiplication.\n\n*)\ntype 'a t = private int\n\ntype mul_safe\n\ntype may_saturate\n\nval may_saturate : _ t -> may_saturate t\n\n(** [to_int x] returns the underlying integer representing [x]. *)\nval to_int : 'a t -> int\n\n(** 0 *)\nval zero : _ t\n\n(** 1 *)\nval one : _ t\n\n(** 2^62 - 1 *)\nval saturated : may_saturate t\n\n(** We inherit the order over native integers. *)\nval ( >= ) : _ t -> _ t -> bool\n\nval ( > ) : _ t -> _ t -> bool\n\nval ( <= ) : _ t -> _ t -> bool\n\nval ( < ) : _ t -> _ t -> bool\n\nval ( = ) : _ t -> _ t -> bool\n\nval ( <> ) : _ t -> _ t -> bool\n\nval equal : _ t -> _ t -> bool\n\nval min : 'a t -> 'a t -> 'a t\n\nval max : 'a t -> 'a t -> 'a t\n\nval compare : 'a t -> 'b t -> int\n\n(** [numbits x] returns the number of bits used in the binary representation\n    of [x]. *)\nval numbits : 'a t -> int\n\n(** [shift_right x y] behaves like a logical shift of [x] by [y] bits\n   to the right. [y] must be between 0 and 63. *)\nval shift_right : 'a t -> int -> 'a t\n\n(** [shift_left x y] behaves like a logical shift of [x] by [y] bits\n    to the left. [y] must be between 0 and 63. In cases where [x lsl y]\n    is overflowing, [shift_left x y] is [saturated]. *)\nval shift_left : 'a t -> int -> 'a t\n\n(** [mul x y] behaves like multiplication between native integers as\n   long as its result stay below [saturated]. Otherwise, [mul] returns\n   [saturated]. *)\nval mul : _ t -> _ t -> may_saturate t\n\n(** [mul_safe x] returns a [mul_safe t] only if [x] does not trigger\n    overflows when multiplied with another [mul_safe t]. More precisely,\n    [x] is safe for fast multiplications if [x < 2147483648]. *)\nval mul_safe : _ t -> mul_safe t option\n\n(** [mul_fast x y] exploits the fact that [x] and [y] are known not to\n   provoke overflows during multiplication to perform a mere\n   multiplication. *)\nval mul_fast : mul_safe t -> mul_safe t -> may_saturate t\n\n(** [scale_fast x y] exploits the fact that [x] is known not to\n   provoke overflows during multiplication to perform a\n   multiplication faster than [mul]. *)\nval scale_fast : mul_safe t -> _ t -> may_saturate t\n\n(** [add x y] behaves like addition between native integers as long as\n   its result stay below [saturated]. Otherwise, [add] returns\n   [saturated]. *)\nval add : _ t -> _ t -> may_saturate t\n\n(** [succ x] is like [add one x] *)\nval succ : _ t -> may_saturate t\n\n(** [sub x y] behaves like subtraction between native integers as long\n   as its result stay positive. Otherwise, [sub] returns [zero].\n   This function assumes that [x] is not saturated.\n*)\nval sub : 'a t -> _ t -> 'a t\n\n(** [sub_opt x y] behaves like subtraction between native integers as\n   long as its result stay positive. Otherwise, [sub] returns\n   [None]. *)\nval sub_opt : 'a t -> _ t -> 'a t option\n\n(** [ediv x y] returns [x / y]. This operation never saturates, hence\n   it is exactly the same as its native counterpart. [y] is supposed\n   to be strictly greater than 0, otherwise this function raises\n   [Division_by_zero]. *)\nval ediv : 'a t -> _ t -> 'a t\n\n(** [erem x y] returns [x mod y]. [y] is supposed to be strictly\n   greater than 0, otherwise this function raises\n   [Division_by_zero]. *)\nval erem : _ t -> 'b t -> 'b t\n\n(** [of_int_opt x] returns [Some x] if [x >= 0] and [x < saturated],\n    and [None] otherwise. *)\nval of_int_opt : int -> may_saturate t option\n\n(** [of_z_opt x] returns [Some x] if [x >= 0] and [x < saturated],\n    and [None] otherwise. *)\nval of_z_opt : Z.t -> may_saturate t option\n\n(** When a saturated integer is sufficiently small (i.e. strictly less\n   than 2147483648), we can assign it the type [mul_safe S.t] to use\n   it within fast multiplications, named [S.scale_fast] and\n   [S.mul_fast].\n\n   The following function allows such type assignment but may raise an\n   exception if the assumption is wrong.  Therefore, [mul_safe_exn]\n   should only be used to define toplevel values, so that these\n   exceptions can only occur during startup.\n *)\nval mul_safe_exn : may_saturate t -> mul_safe t\n\n(** [mul_safe_of_int_exn x] is the composition of [of_int_opt] and\n   [mul_safe] in the option monad. This function raises [Invalid_argument]\n   if [x] is not safe. This function should be used on integer literals\n   that are obviously [mul_safe]. *)\nval mul_safe_of_int_exn : int -> mul_safe t\n\n(** [safe_int x] is [of_int_opt x |> saturate_if_undef]. *)\nval safe_int : int -> may_saturate t\n\n(** [to_z z] is [Z.of_int]. *)\nval to_z : _ t -> Z.t\n\n(** Encoding for [t] through the encoding for [z] integers. *)\nval z_encoding : _ t Data_encoding.t\n\n(** Encoding for [t] through the encoding for non-negative integers. *)\nval n_encoding : _ t Data_encoding.t\n\n(** A pretty-printer for native integers. *)\nval pp : Format.formatter -> _ t -> unit\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2020 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(* let () = assert (Sys.int_size = 63) *)\n\ntype _ t = int\n\ntype mul_safe\n\ntype may_saturate\n\nlet may_saturate : _ t -> may_saturate t = fun x -> x\n\nlet to_int x = x\n\nlet ( < ) : _ t -> _ t -> bool = Compare.Int.( < )\n\nlet ( <= ) : _ t -> _ t -> bool = Compare.Int.( <= )\n\nlet ( > ) : _ t -> _ t -> bool = Compare.Int.( > )\n\nlet ( >= ) : _ t -> _ t -> bool = Compare.Int.( >= )\n\nlet ( = ) : _ t -> _ t -> bool = Compare.Int.( = )\n\nlet equal = ( = )\n\nlet ( <> ) : _ t -> _ t -> bool = Compare.Int.( <> )\n\nlet max : _ t -> _ t -> _ t = fun x y -> if x >= y then x else y\n\nlet min : _ t -> _ t -> _ t = fun x y -> if x >= y then y else x\n\nlet compare : _ t -> _ t -> _ t = Compare.Int.compare\n\nlet saturated = max_int\n\nlet of_int_opt t = if t >= 0 && t < saturated then Some t else None\n\nlet of_z_opt z =\n  match Z.to_int z with int -> of_int_opt int | exception Z.Overflow -> None\n\nlet to_z x = Z.of_int x\n\nlet saturate_if_undef = function None -> saturated | Some x -> x\n\nlet safe_int x = of_int_opt x |> saturate_if_undef\n\nlet numbits x =\n  let x = ref x and n = ref 0 in\n  (let y = !x lsr 32 in\n   if y <> 0 then (\n     n := !n + 32 ;\n     x := y)) ;\n  (let y = !x lsr 16 in\n   if y <> 0 then (\n     n := !n + 16 ;\n     x := y)) ;\n  (let y = !x lsr 8 in\n   if y <> 0 then (\n     n := !n + 8 ;\n     x := y)) ;\n  (let y = !x lsr 4 in\n   if y <> 0 then (\n     n := !n + 4 ;\n     x := y)) ;\n  (let y = !x lsr 2 in\n   if y <> 0 then (\n     n := !n + 2 ;\n     x := y)) ;\n  if !x lsr 1 <> 0 then !n + 2 else !n + !x\n\nlet zero = 0\n\nlet one = 1\n\nlet small_enough z =\n  (* The following literal triggers an error if compiled under 32-bit\n     architectures, please do not modify it. This is a static way to\n     ensure that this file is compiled under a 64-bit architecture. *)\n  z land 0x7fffffff80000000 = 0\n\nlet mul_safe x = if small_enough x then Some x else None\n\nlet mul_safe_exn x =\n  if small_enough x then x\n  else failwith (Format.sprintf \"mul_safe_exn: %d must be below 2147483648\" x)\n\nlet mul_safe_of_int_exn x =\n  Option.bind (of_int_opt x) mul_safe |> function\n  | None ->\n      failwith\n        (Format.sprintf \"mul_safe_of_int_exn: %d must be below 2147483648\" x)\n  | Some x -> x\n\n(* If [x] is positive, shifting to the right will produce a number\n   which is positive and is less than [x]. *)\nlet shift_right x y = (x :> int) lsr y\n\nlet shift_left x y =\n  if shift_right saturated y < x then saturated else (x :> int) lsl y\n\nlet mul x y =\n  (* assert (x >= 0 && y >= 0); *)\n  match x with\n  | 0 -> 0\n  | x ->\n      if small_enough x && small_enough y then x * y\n      else if Compare.Int.(y > saturated / x) then saturated\n      else x * y\n\nlet mul_fast x y = x * y\n\nlet scale_fast x y =\n  if x = 0 then 0\n  else if small_enough y then x * y\n  else if Compare.Int.(y > saturated / x) then saturated\n  else x * y\n\nlet add x y =\n  let z = x + y in\n  if Compare.Int.(z >= 0) then z else saturated\n\nlet succ x = add one x\n\nlet sub x y = Compare.Int.max (x - y) 0\n\nlet sub_opt x y =\n  let s = x - y in\n  if Compare.Int.(s >= 0) then Some s else None\n\n(* Notice that Z.erem does not behave as mod on negative numbers.\n   Fortunately, the inhabitant of [t] are non-negative. *)\nlet erem x y = x mod y\n\nlet ediv x y = x / y\n\nlet t_to_z_exn z =\n  match of_z_opt z with\n  | None ->\n      (* since the encoding is applied to values of type [t]. *) assert false\n  | Some x -> x\n\nlet z_encoding = Data_encoding.(check_size 9 (conv to_z t_to_z_exn z))\n\nlet n_encoding = Data_encoding.(check_size 9 (conv to_z t_to_z_exn n))\n\nlet pp fmt x = Format.pp_print_int fmt x\n" ;
                } ;
                { name = "Gas_limit_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Internal representation of the gas limit available to the node baking a new\n    block. It should be proportional to the time and energy required to perform a\n    computation.\n\n    This protects the bakers from performing exceedingly costly computations\n    while baking and also allows them to select cheaper-to-compute operations to\n    include in their blocks, as their reward for baking a block is not directly\n    related to the resources consumed by the machine performing the operation.\n\n    It can be [Unaccounted] (unlimited) or [Limited] to some fixed-point value\n    (see [Fixed_point_repr] for the details). The value is represented with 3\n    decimal places of precision.\n\n    All computations on gas are performed in saturation arithmetic (see\n    [Saturation_repr]) bounded between [0] and [2 ^ 62 - 1]*)\n\nmodule Arith :\n  Fixed_point_repr.Full\n    with type 'a t = Saturation_repr.may_saturate Saturation_repr.t\n[@@coq_plain_module]\n\ntype t = Unaccounted | Limited of {remaining : Arith.fp}\n\nval encoding : t Data_encoding.encoding\n\nval pp : Format.formatter -> t -> unit\n\n(** Represents a gas cost of an operation. The gas model is constructed such\n    that the cost of each operation is roughly proportional to the time required\n    to perform the operation. If the gas cost of an operation exceeds the\n    available limit, such an operation is rejected. This is especially meant to\n    protect bakers against DoS attacks. *)\ntype cost = Saturation_repr.may_saturate Saturation_repr.t\n\nval cost_encoding : cost Data_encoding.encoding\n\nval pp_cost : Format.formatter -> cost -> unit\n\n(** Subtracts the cost from the current limit. Returns [None] if the limit\n    would fall below [0]. *)\nval raw_consume : Arith.fp -> cost -> Arith.fp option\n\n(** The cost of free operation is [0]. *)\nval free : cost\n\n(** [atomic_step_cost x] corresponds to [x] milliunit of gas. *)\nval atomic_step_cost : _ Saturation_repr.t -> cost\n\n(** [step_cost x] corresponds to [x] units of gas. *)\nval step_cost : _ Saturation_repr.t -> cost\n\n(** Cost of allocating qwords of storage.\n\n    [alloc_cost n] estimates the cost of allocating [n] qwords of storage. *)\nval alloc_cost : _ Saturation_repr.t -> cost\n\n(** Cost of allocating bytes in the storage.\n\n    [alloc_bytes_cost b] estimates the cost of allocating [b] bytes of\n    storage. *)\nval alloc_bytes_cost : int -> cost\n\n(** Cost of allocating bytes in the storage.\n\n    [alloc_mbytes_cost b] estimates the cost of allocating [b] bytes of\n    storage and the cost of a header to describe these bytes. *)\nval alloc_mbytes_cost : int -> cost\n\n(** Cost of reading the storage.\n\n    [read_bytes_const n] estimates the cost of reading [n] bytes of storage. *)\nval read_bytes_cost : int -> cost\n\n(** Cost of writing to storage.\n\n    [write_bytes_const n] estimates the cost of writing [n] bytes to the\n    storage. *)\nval write_bytes_cost : int -> cost\n\n(** Multiply a cost by a factor. Both arguments are saturated arithmetic values,\n    so no negative numbers are involved. *)\nval ( *@ ) : _ Saturation_repr.t -> cost -> cost\n\n(** Add two costs together. *)\nval ( +@ ) : cost -> cost -> cost\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nlet decimals = 3\n\ntype fp_tag\n\ntype integral_tag\n\nmodule S = Saturation_repr\n\n(* 1 gas unit *)\nlet scaling_factor = S.mul_safe_of_int_exn 1000\n\nmodule Arith = struct\n  type 'a t = S.may_saturate S.t\n\n  type fp = fp_tag t\n\n  type integral = integral_tag t\n\n  let scaling_factor = scaling_factor\n\n  let sub = S.sub\n\n  let add = S.add\n\n  let zero = S.zero\n\n  let min = S.min\n\n  let max = S.max\n\n  let compare = S.compare\n\n  let ( < ) = S.( < )\n\n  let ( <> ) = S.( <> )\n\n  let ( > ) = S.( > )\n\n  let ( <= ) = S.( <= )\n\n  let ( >= ) = S.( >= )\n\n  let ( = ) = S.( = )\n\n  let equal = S.equal\n\n  let of_int_opt = S.of_int_opt\n\n  let fatally_saturated_int i =\n    failwith (string_of_int i ^ \" should not be saturated.\")\n\n  let fatally_saturated_z z =\n    failwith (Z.to_string z ^ \" should not be saturated.\")\n\n  let integral_of_int_exn i =\n    S.(\n      match of_int_opt i with\n      | None -> fatally_saturated_int i\n      | Some i' ->\n          let r = scale_fast scaling_factor i' in\n          if r = saturated then fatally_saturated_int i else r)\n\n  let integral_exn z =\n    match Z.to_int z with\n    | i -> integral_of_int_exn i\n    | exception Z.Overflow -> fatally_saturated_z z\n\n  let integral_to_z (i : integral) : Z.t = S.(to_z (ediv i scaling_factor))\n\n  let ceil x =\n    let r = S.erem x scaling_factor in\n    if r = zero then x else add x (sub scaling_factor r)\n\n  let floor x = sub x (S.erem x scaling_factor)\n\n  let fp x = x\n\n  let pp fmtr fp =\n    let q = S.(ediv fp scaling_factor |> to_int) in\n    let r = S.(erem fp scaling_factor |> to_int) in\n    if Compare.Int.(r = 0) then Format.fprintf fmtr \"%d\" q\n    else Format.fprintf fmtr \"%d.%0*d\" q decimals r\n\n  let pp_integral = pp\n\n  let n_fp_encoding : fp Data_encoding.t = S.n_encoding\n\n  let z_fp_encoding : fp Data_encoding.t = S.z_encoding\n\n  let n_integral_encoding : integral Data_encoding.t =\n    Data_encoding.conv integral_to_z integral_exn Data_encoding.n\n\n  let z_integral_encoding : integral Data_encoding.t =\n    Data_encoding.conv integral_to_z integral_exn Data_encoding.z\n\n  let unsafe_fp x =\n    match of_int_opt (Z.to_int x) with\n    | Some int -> int\n    | None -> fatally_saturated_z x\n\n  let sub_opt = S.sub_opt\nend\n\ntype t = Unaccounted | Limited of {remaining : Arith.fp}\n\ntype cost = S.may_saturate S.t\n\nlet encoding =\n  let open Data_encoding in\n  union\n    [\n      case\n        (Tag 0)\n        ~title:\"Limited\"\n        Arith.z_fp_encoding\n        (function Limited {remaining} -> Some remaining | _ -> None)\n        (fun remaining -> Limited {remaining});\n      case\n        (Tag 1)\n        ~title:\"Unaccounted\"\n        (constant \"unaccounted\")\n        (function Unaccounted -> Some () | _ -> None)\n        (fun () -> Unaccounted);\n    ]\n\nlet pp ppf = function\n  | Unaccounted -> Format.fprintf ppf \"unaccounted\"\n  | Limited {remaining} ->\n      Format.fprintf ppf \"%a units remaining\" Arith.pp remaining\n\nlet cost_encoding = S.z_encoding\n\nlet pp_cost fmt z = S.pp fmt z\n\n(* 2 units of gas *)\nlet allocation_weight =\n  S.(mul_fast scaling_factor (S.mul_safe_of_int_exn 2)) |> S.mul_safe_exn\n\nlet step_weight = scaling_factor\n\n(* 100 units of gas *)\nlet read_base_weight =\n  S.(mul_fast scaling_factor (S.mul_safe_of_int_exn 100)) |> S.mul_safe_exn\n\n(* 160 units of gas *)\nlet write_base_weight =\n  S.(mul_fast scaling_factor (S.mul_safe_of_int_exn 160)) |> S.mul_safe_exn\n\n(* 10 units of gas *)\nlet byte_read_weight =\n  S.(mul_fast scaling_factor (S.mul_safe_of_int_exn 10)) |> S.mul_safe_exn\n\n(* 15 units of gas *)\nlet byte_written_weight =\n  S.(mul_fast scaling_factor (S.mul_safe_of_int_exn 15)) |> S.mul_safe_exn\n\nlet cost_to_milligas (cost : cost) : Arith.fp = cost\n\nlet raw_consume gas_counter cost =\n  let gas = cost_to_milligas cost in\n  Arith.sub_opt gas_counter gas\n\nlet alloc_cost n =\n  S.scale_fast allocation_weight S.(add n (S.mul_safe_of_int_exn 1))\n\nlet alloc_bytes_cost n = alloc_cost (S.safe_int ((n + 7) / 8))\n\nlet atomic_step_cost : 'a S.t -> cost = S.may_saturate\n\nlet step_cost n = S.scale_fast step_weight n\n\nlet free = S.zero\n\nlet read_bytes_cost n =\n  S.add read_base_weight (S.scale_fast byte_read_weight (S.safe_int n))\n\nlet write_bytes_cost n =\n  S.add write_base_weight (S.scale_fast byte_written_weight (S.safe_int n))\n\nlet ( +@ ) x y = S.add x y\n\nlet ( *@ ) x y = S.mul x y\n\nlet alloc_mbytes_cost n =\n  alloc_cost (S.mul_safe_of_int_exn 12) +@ alloc_bytes_cost n\n" ;
                } ;
                { name = "Constants_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020-2021 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nval fitness_version_number : string\n\nval proof_of_work_nonce_size : int\n\nval nonce_length : int\n\nval max_anon_ops_per_block : int\n\nval max_proposals_per_delegate : int\n\nval max_operation_data_length : int\n\n(** A global size limit on the size of Micheline expressions\n    after expansion.\n\n    We want to prevent constants from being\n    used to create huge values that could potentially do damage\n    if ever printed or sent over the network. We arrived at this\n    number by finding the largest possible contract in terms of\n    number of nodes. The number of nodes is constrained by the\n    current \"max_operation_data_length\" (32768) to be ~10,000 (\n    see \"largest_flat_contract.tz\" in the tezt suite for the largest\n    contract with constants that can be originated). As a first\n    approximation, we set the node size limit to 5 times this amount. *)\nval max_micheline_node_count : int\n\n(** Same as [max_micheline_node_count] but for limiting the combined\n    bytes of the strings, ints and bytes in a expanded Micheline\n    expression.  *)\nval max_micheline_bytes_limit : int\n\n(** Represents the maximum depth of an expression stored\n    in the table after all references to other constants have\n    (recursively) been expanded, where depth refers to the\n    nesting of [Prim] and/or [Seq] nodes.\n\n    The size was chosen arbitrarily to match the typechecker\n    in [Script_ir_translator]. *)\nval max_allowed_global_constant_depth : int\n\n(* an over-approximation of the size (in bytes) of an entry in the cache\n   storing the stake distribution for a given cycle *)\nval stake_distribution_size : int\n\n(* an over-approximation of the size (in bytes) of an entry in the\n   cache storing the sampler state for a given cycle *)\nval sampler_state_size : int\n\n(** Each protocol defines the number of subcaches and their respective\n    limit size using [cache_layout]. *)\nval cache_layout : int list\n\nval michelson_maximum_type_size : int\n\ntype fixed\n\nval fixed_encoding : fixed Data_encoding.encoding\n\ntype ratio = {numerator : int; denominator : int}\n\nval ratio_encoding : ratio Data_encoding.t\n\nval pp_ratio : Format.formatter -> ratio -> unit\n\ntype delegate_selection =\n  | Random\n  | Round_robin_over of Signature.Public_key.t list list\n\nval delegate_selection_encoding : delegate_selection Data_encoding.encoding\n\ntype parametric = {\n  preserved_cycles : int;\n  blocks_per_cycle : int32;\n  blocks_per_commitment : int32;\n  blocks_per_stake_snapshot : int32;\n  blocks_per_voting_period : int32;\n  hard_gas_limit_per_operation : Gas_limit_repr.Arith.integral;\n  hard_gas_limit_per_block : Gas_limit_repr.Arith.integral;\n  proof_of_work_threshold : int64;\n  tokens_per_roll : Tez_repr.t;\n  seed_nonce_revelation_tip : Tez_repr.t;\n  origination_size : int;\n  baking_reward_fixed_portion : Tez_repr.t;\n  baking_reward_bonus_per_slot : Tez_repr.t;\n  endorsing_reward_per_slot : Tez_repr.t;\n  cost_per_byte : Tez_repr.t;\n  hard_storage_limit_per_operation : Z.t;\n  quorum_min : int32;\n  (* in centile of a percentage *)\n  quorum_max : int32;\n  min_proposal_quorum : int32;\n  liquidity_baking_subsidy : Tez_repr.t;\n  liquidity_baking_sunset_level : int32;\n  liquidity_baking_escape_ema_threshold : int32;\n  max_operations_time_to_live : int;\n  minimal_block_delay : Period_repr.t;\n  delay_increment_per_round : Period_repr.t;\n  minimal_participation_ratio : ratio;\n  consensus_committee_size : int;\n  (* in slots *)\n  consensus_threshold : int;\n  (* in slots *)\n  max_slashing_period : int;\n  (* in cycles *)\n  frozen_deposits_percentage : int;\n  (* that is, (100 * delegated tz / own tz) *)\n  double_baking_punishment : Tez_repr.t;\n  ratio_of_frozen_deposits_slashed_per_double_endorsement : ratio;\n  delegate_selection : delegate_selection;\n}\n\nval parametric_encoding : parametric Data_encoding.encoding\n\ntype t = private {fixed : fixed; parametric : parametric}\n\nval all : parametric -> t\n\nval encoding : t Data_encoding.encoding\n\ntype error += (* `Permanent *) Invalid_protocol_constants of string\n\n(** performs some consistency checks on the protocol parameters *)\nval check_constants : parametric -> unit tzresult\n\nmodule Generated : sig\n  type t = {\n    consensus_threshold : int;\n    baking_reward_fixed_portion : Tez_repr.t;\n    baking_reward_bonus_per_slot : Tez_repr.t;\n    endorsing_reward_per_slot : Tez_repr.t;\n  }\n\n  (* This function is meant to be used just in lib_parameters and in the\n     migration code to be sure that the parameters are consistent. *)\n  val generate : consensus_committee_size:int -> blocks_per_minute:ratio -> t\nend\n\nmodule Proto_previous : sig\n  type parametric = {\n    preserved_cycles : int;\n    blocks_per_cycle : int32;\n    blocks_per_commitment : int32;\n    blocks_per_roll_snapshot : int32;\n    blocks_per_voting_period : int32;\n    time_between_blocks : Period_repr.t list;\n    minimal_block_delay : Period_repr.t;\n    endorsers_per_block : int;\n    hard_gas_limit_per_operation : Gas_limit_repr.Arith.integral;\n    hard_gas_limit_per_block : Gas_limit_repr.Arith.integral;\n    proof_of_work_threshold : int64;\n    tokens_per_roll : Tez_repr.t;\n    seed_nonce_revelation_tip : Tez_repr.t;\n    origination_size : int;\n    block_security_deposit : Tez_repr.t;\n    endorsement_security_deposit : Tez_repr.t;\n    baking_reward_per_endorsement : Tez_repr.t list;\n    endorsement_reward : Tez_repr.t list;\n    cost_per_byte : Tez_repr.t;\n    hard_storage_limit_per_operation : Z.t;\n    quorum_min : int32;\n    quorum_max : int32;\n    min_proposal_quorum : int32;\n    initial_endorsers : int;\n    delay_per_missing_endorsement : Period_repr.t;\n    liquidity_baking_subsidy : Tez_repr.t;\n    liquidity_baking_sunset_level : int32;\n    liquidity_baking_escape_ema_threshold : int32;\n  }\n\n  val parametric_encoding : parametric Data_encoding.encoding\nend\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020-2021 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(* The fitness version number was:\n   - \"\\000\" until and including proto 004\n   - \"\\001\" until and including proto 010\n*)\nlet fitness_version_number = \"\\002\"\n\nlet proof_of_work_nonce_size = 8\n\nlet nonce_length = 32\n\nlet max_anon_ops_per_block = 132\n\nlet max_proposals_per_delegate = 20\n\nlet max_operation_data_length = 32 * 1024 (* 32kB *)\n\nlet max_micheline_node_count = 50_000\n\nlet max_micheline_bytes_limit = 50_000\n\nlet max_allowed_global_constant_depth = 10_000\n\n(* In this version of the protocol, there are the following subcaches:\n\n   * One for contract source code and storage. Its size has been\n   chosen not too exceed 100 000 000 bytes.\n\n   * One for the stake distribution for all cycles stored at any\n   moment (* preserved_cycles + max_slashing_period + 1 *)\n\n   * One for the sampler state for all cycles stored at any moment.  *)\n\nlet stake_distribution_size = 500 (* delegates*) * 15 (* words *) * 4\n(* bytes *)\n\nlet sampler_state_size = 80 (* words *) * 4 (* bytes *)\n\nlet cache_layout =\n  [\n    100_000_000;\n    8 (* cycles *) * stake_distribution_size;\n    8 (* cycles *) * sampler_state_size;\n  ]\n\n(* In previous versions of the protocol, this\n   [michelson_maximum_type_size] limit was set to 1000 but\n   the contract input types (pair <parameter_type> <storage_type>)\n   were not checked. Both components, <parameter_type> and\n   <storage_type> where however checked hence it was possible to build\n   types as big as 2001. *)\nlet michelson_maximum_type_size = 2001\n\ntype fixed = unit\n\ntype ratio = {numerator : int; denominator : int}\n\nlet ratio_encoding =\n  let open Data_encoding in\n  conv_with_guard\n    (fun r -> (r.numerator, r.denominator))\n    (fun (numerator, denominator) ->\n      if Compare.Int.(denominator > 0) then ok {numerator; denominator}\n      else Error \"The denominator must be greater than 0.\")\n    (obj2 (req \"numerator\" uint16) (req \"denominator\" uint16))\n\nlet pp_ratio fmt {numerator; denominator} =\n  Format.fprintf fmt \"%d/%d\" numerator denominator\n\nlet fixed_encoding =\n  let open Data_encoding in\n  let uint62 =\n    let max_int_int64 = Int64.of_int max_int in\n    conv_with_guard\n      (fun int -> Int64.of_int int)\n      (fun int64 ->\n        if Compare.Int64.(int64 < 0L) then Error \"Negative integer\"\n        else if Compare.Int64.(int64 > max_int_int64) then\n          Error \"Integer does not fit in 62 bits\"\n        else ok @@ Int64.to_int int64)\n      int64\n  in\n  conv\n    (fun () ->\n      ( proof_of_work_nonce_size,\n        nonce_length,\n        max_anon_ops_per_block,\n        max_operation_data_length,\n        max_proposals_per_delegate,\n        max_micheline_node_count,\n        max_micheline_bytes_limit,\n        max_allowed_global_constant_depth,\n        cache_layout,\n        michelson_maximum_type_size ))\n    (fun ( _proof_of_work_nonce_size,\n           _nonce_length,\n           _max_anon_ops_per_block,\n           _max_operation_data_length,\n           _max_proposals_per_delegate,\n           _max_micheline_node_count,\n           _max_micheline_bytes_limit,\n           _max_allowed_global_constant_depth,\n           _cache_layout,\n           _michelson_maximum_type_size ) -> ())\n    (obj10\n       (req \"proof_of_work_nonce_size\" uint8)\n       (req \"nonce_length\" uint8)\n       (req \"max_anon_ops_per_block\" uint8)\n       (req \"max_operation_data_length\" int31)\n       (req \"max_proposals_per_delegate\" uint8)\n       (req \"max_micheline_node_count\" int31)\n       (req \"max_micheline_bytes_limit\" int31)\n       (req \"max_allowed_global_constants_depth\" int31)\n       (req \"cache_layout\" (list uint62))\n       (req \"michelson_maximum_type_size\" uint16))\n\nlet fixed = ()\n\ntype delegate_selection =\n  | Random\n  | Round_robin_over of Signature.Public_key.t list list\n\nlet delegate_selection_encoding =\n  let open Data_encoding in\n  union\n    [\n      case\n        (Tag 0)\n        ~title:\"Random_delegate_selection\"\n        (constant \"random\")\n        (function Random -> Some () | _ -> None)\n        (fun () -> Random);\n      case\n        (Tag 1)\n        ~title:\"Round_robin_over_delegates\"\n        (list (list Signature.Public_key.encoding))\n        (function Round_robin_over l -> Some l | _ -> None)\n        (fun l -> Round_robin_over l);\n    ]\n\n(* The encoded representation of this type is stored in the context as\n   bytes. Changing the encoding, or the value of these constants from\n   the previous protocol may break the context migration, or (even\n   worse) yield an incorrect context after migration.\n\n   If you change this encoding, you should ensure that there is a\n   proper migration of the constants during context migration.  *)\ntype parametric = {\n  preserved_cycles : int;\n  blocks_per_cycle : int32;\n  blocks_per_commitment : int32;\n  blocks_per_stake_snapshot : int32;\n  blocks_per_voting_period : int32;\n  hard_gas_limit_per_operation : Gas_limit_repr.Arith.integral;\n  hard_gas_limit_per_block : Gas_limit_repr.Arith.integral;\n  proof_of_work_threshold : int64;\n  tokens_per_roll : Tez_repr.t;\n  seed_nonce_revelation_tip : Tez_repr.t;\n  origination_size : int;\n  baking_reward_fixed_portion : Tez_repr.t;\n  baking_reward_bonus_per_slot : Tez_repr.t;\n  endorsing_reward_per_slot : Tez_repr.t;\n  cost_per_byte : Tez_repr.t;\n  hard_storage_limit_per_operation : Z.t;\n  quorum_min : int32;\n  quorum_max : int32;\n  min_proposal_quorum : int32;\n  liquidity_baking_subsidy : Tez_repr.t;\n  liquidity_baking_sunset_level : int32;\n  liquidity_baking_escape_ema_threshold : int32;\n  max_operations_time_to_live : int;\n  minimal_block_delay : Period_repr.t;\n  delay_increment_per_round : Period_repr.t;\n  minimal_participation_ratio : ratio;\n  consensus_committee_size : int;\n  consensus_threshold : int;\n  max_slashing_period : int;\n  frozen_deposits_percentage : int;\n  double_baking_punishment : Tez_repr.t;\n  ratio_of_frozen_deposits_slashed_per_double_endorsement : ratio;\n  delegate_selection : delegate_selection;\n}\n\nlet parametric_encoding =\n  let open Data_encoding in\n  conv\n    (fun c ->\n      ( ( c.preserved_cycles,\n          c.blocks_per_cycle,\n          c.blocks_per_commitment,\n          c.blocks_per_stake_snapshot,\n          c.blocks_per_voting_period,\n          c.hard_gas_limit_per_operation,\n          c.hard_gas_limit_per_block,\n          c.proof_of_work_threshold,\n          c.tokens_per_roll ),\n        ( ( c.seed_nonce_revelation_tip,\n            c.origination_size,\n            c.baking_reward_fixed_portion,\n            c.baking_reward_bonus_per_slot,\n            c.endorsing_reward_per_slot,\n            c.cost_per_byte,\n            c.hard_storage_limit_per_operation,\n            c.quorum_min ),\n          ( ( c.quorum_max,\n              c.min_proposal_quorum,\n              c.liquidity_baking_subsidy,\n              c.liquidity_baking_sunset_level,\n              c.liquidity_baking_escape_ema_threshold,\n              c.max_operations_time_to_live,\n              c.minimal_block_delay,\n              c.delay_increment_per_round,\n              c.consensus_committee_size,\n              c.consensus_threshold ),\n            ( c.minimal_participation_ratio,\n              c.max_slashing_period,\n              c.frozen_deposits_percentage,\n              c.double_baking_punishment,\n              c.ratio_of_frozen_deposits_slashed_per_double_endorsement,\n              c.delegate_selection ) ) ) ))\n    (fun ( ( preserved_cycles,\n             blocks_per_cycle,\n             blocks_per_commitment,\n             blocks_per_stake_snapshot,\n             blocks_per_voting_period,\n             hard_gas_limit_per_operation,\n             hard_gas_limit_per_block,\n             proof_of_work_threshold,\n             tokens_per_roll ),\n           ( ( seed_nonce_revelation_tip,\n               origination_size,\n               baking_reward_fixed_portion,\n               baking_reward_bonus_per_slot,\n               endorsing_reward_per_slot,\n               cost_per_byte,\n               hard_storage_limit_per_operation,\n               quorum_min ),\n             ( ( quorum_max,\n                 min_proposal_quorum,\n                 liquidity_baking_subsidy,\n                 liquidity_baking_sunset_level,\n                 liquidity_baking_escape_ema_threshold,\n                 max_operations_time_to_live,\n                 minimal_block_delay,\n                 delay_increment_per_round,\n                 consensus_committee_size,\n                 consensus_threshold ),\n               ( minimal_participation_ratio,\n                 max_slashing_period,\n                 frozen_deposits_percentage,\n                 double_baking_punishment,\n                 ratio_of_frozen_deposits_slashed_per_double_endorsement,\n                 delegate_selection ) ) ) ) ->\n      {\n        preserved_cycles;\n        blocks_per_cycle;\n        blocks_per_commitment;\n        blocks_per_stake_snapshot;\n        blocks_per_voting_period;\n        hard_gas_limit_per_operation;\n        hard_gas_limit_per_block;\n        proof_of_work_threshold;\n        tokens_per_roll;\n        seed_nonce_revelation_tip;\n        origination_size;\n        baking_reward_fixed_portion;\n        baking_reward_bonus_per_slot;\n        endorsing_reward_per_slot;\n        cost_per_byte;\n        hard_storage_limit_per_operation;\n        quorum_min;\n        quorum_max;\n        min_proposal_quorum;\n        liquidity_baking_subsidy;\n        liquidity_baking_sunset_level;\n        liquidity_baking_escape_ema_threshold;\n        max_operations_time_to_live;\n        minimal_block_delay;\n        delay_increment_per_round;\n        minimal_participation_ratio;\n        max_slashing_period;\n        consensus_committee_size;\n        consensus_threshold;\n        frozen_deposits_percentage;\n        double_baking_punishment;\n        ratio_of_frozen_deposits_slashed_per_double_endorsement;\n        delegate_selection;\n      })\n    (merge_objs\n       (obj9\n          (req \"preserved_cycles\" uint8)\n          (req \"blocks_per_cycle\" int32)\n          (req \"blocks_per_commitment\" int32)\n          (req \"blocks_per_stake_snapshot\" int32)\n          (req \"blocks_per_voting_period\" int32)\n          (req\n             \"hard_gas_limit_per_operation\"\n             Gas_limit_repr.Arith.z_integral_encoding)\n          (req\n             \"hard_gas_limit_per_block\"\n             Gas_limit_repr.Arith.z_integral_encoding)\n          (req \"proof_of_work_threshold\" int64)\n          (req \"tokens_per_roll\" Tez_repr.encoding))\n       (merge_objs\n          (obj8\n             (req \"seed_nonce_revelation_tip\" Tez_repr.encoding)\n             (req \"origination_size\" int31)\n             (req \"baking_reward_fixed_portion\" Tez_repr.encoding)\n             (req \"baking_reward_bonus_per_slot\" Tez_repr.encoding)\n             (req \"endorsing_reward_per_slot\" Tez_repr.encoding)\n             (req \"cost_per_byte\" Tez_repr.encoding)\n             (req \"hard_storage_limit_per_operation\" z)\n             (req \"quorum_min\" int32))\n          (merge_objs\n             (obj10\n                (req \"quorum_max\" int32)\n                (req \"min_proposal_quorum\" int32)\n                (req \"liquidity_baking_subsidy\" Tez_repr.encoding)\n                (req \"liquidity_baking_sunset_level\" int32)\n                (req \"liquidity_baking_escape_ema_threshold\" int32)\n                (req \"max_operations_time_to_live\" int16)\n                (req \"minimal_block_delay\" Period_repr.encoding)\n                (req \"delay_increment_per_round\" Period_repr.encoding)\n                (req \"consensus_committee_size\" int31)\n                (req \"consensus_threshold\" int31))\n             (obj6\n                (req \"minimal_participation_ratio\" ratio_encoding)\n                (req \"max_slashing_period\" int31)\n                (req \"frozen_deposits_percentage\" int31)\n                (req \"double_baking_punishment\" Tez_repr.encoding)\n                (req\n                   \"ratio_of_frozen_deposits_slashed_per_double_endorsement\"\n                   ratio_encoding)\n                (dft \"delegate_selection\" delegate_selection_encoding Random)))))\n\ntype t = {fixed : fixed; parametric : parametric}\n\nlet all parametric = {fixed; parametric}\n\nlet encoding =\n  let open Data_encoding in\n  conv\n    (fun {fixed; parametric} -> (fixed, parametric))\n    (fun (fixed, parametric) -> {fixed; parametric})\n    (merge_objs fixed_encoding parametric_encoding)\n\ntype error += Invalid_protocol_constants of string (* `Permanent *)\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"constants.invalid_protocol_constants\"\n    ~title:\"Invalid protocol constants\"\n    ~description:\"The provided protocol constants are not coherent.\"\n    ~pp:(fun ppf reason ->\n      Format.fprintf ppf \"Invalid protocol constants: %s\" reason)\n    Data_encoding.(obj1 (req \"reason\" string))\n    (function Invalid_protocol_constants reason -> Some reason | _ -> None)\n    (fun reason -> Invalid_protocol_constants reason)\n\nlet check_constants constants =\n  error_unless\n    Period_repr.(constants.minimal_block_delay > zero)\n    (Invalid_protocol_constants\n       \"The minimal block delay must be greater than zero\")\n  >>? fun () ->\n  error_unless\n    Period_repr.(constants.delay_increment_per_round > zero)\n    (Invalid_protocol_constants\n       \"The delay increment per round must be greater than zero\")\n  >>? fun () ->\n  error_unless\n    Compare.Int.(constants.consensus_committee_size > 3)\n    (Invalid_protocol_constants\n       \"The consensus committee size must be strictly greater than 3.\")\n  >>? fun () ->\n  error_unless\n    Compare.Int.(\n      constants.consensus_threshold >= 0\n      && constants.consensus_threshold <= constants.consensus_committee_size)\n    (Invalid_protocol_constants\n       \"The consensus threshold must be greater than or equal to 0 and less \\\n        than or equal to the consensus commitee size.\")\n  >>? fun () ->\n  error_unless\n    (let {numerator; denominator} = constants.minimal_participation_ratio in\n     Compare.Int.(numerator >= 0 && denominator > 0))\n    (Invalid_protocol_constants\n       \"The minimal participation ratio must be a non-negative valid ratio.\")\n  >>? fun () ->\n  error_unless\n    Compare.Int.(\n      constants.minimal_participation_ratio.numerator\n      <= constants.minimal_participation_ratio.denominator)\n    (Invalid_protocol_constants\n       \"The minimal participation ratio must be less than or equal to 100%.\")\n  >>? fun () ->\n  error_unless\n    Compare.Int.(constants.max_slashing_period > 0)\n    (Invalid_protocol_constants\n       \"The unfreeze delay must be strictly greater than 0.\")\n  >>? fun () ->\n  (* The [frozen_deposits_percentage] should be a percentage *)\n  error_unless\n    Compare.Int.(\n      constants.frozen_deposits_percentage > 0\n      && constants.frozen_deposits_percentage <= 100)\n    (Invalid_protocol_constants\n       \"The frozen percentage ratio must be strictly greater than 0 and less \\\n        or equal than 100.\")\n  >>? fun () ->\n  error_unless\n    Tez_repr.(constants.double_baking_punishment >= zero)\n    (Invalid_protocol_constants\n       \"The double baking punishment must be non-negative.\")\n  >>? fun () ->\n  error_unless\n    (let {numerator; denominator} =\n       constants.ratio_of_frozen_deposits_slashed_per_double_endorsement\n     in\n     Compare.Int.(numerator >= 0 && denominator > 0))\n    (Invalid_protocol_constants\n       \"The ratio of frozen deposits ratio slashed per double endorsement must \\\n        be a non-negative valid ratio.\")\n  >>? fun () -> Result.return_unit\n\nmodule Generated = struct\n  type t = {\n    consensus_threshold : int;\n    baking_reward_fixed_portion : Tez_repr.t;\n    baking_reward_bonus_per_slot : Tez_repr.t;\n    endorsing_reward_per_slot : Tez_repr.t;\n  }\n\n  let generate ~consensus_committee_size ~blocks_per_minute =\n    let consensus_threshold = (consensus_committee_size * 2 / 3) + 1 in\n    (* As in previous protocols, we set the maximum total rewards per minute to\n       be 80 tez. *)\n    let rewards_per_minute = Tez_repr.(mul_exn one 80) in\n    let rewards_per_block =\n      Tez_repr.(\n        div_exn\n          (mul_exn rewards_per_minute blocks_per_minute.denominator)\n          blocks_per_minute.numerator)\n    in\n    let rewards_half = Tez_repr.(div_exn rewards_per_block 2) in\n    let rewards_quarter = Tez_repr.(div_exn rewards_per_block 4) in\n    {\n      consensus_threshold;\n      baking_reward_fixed_portion = rewards_quarter;\n      baking_reward_bonus_per_slot =\n        Tez_repr.div_exn\n          rewards_quarter\n          (consensus_committee_size - consensus_threshold);\n      endorsing_reward_per_slot =\n        Tez_repr.div_exn rewards_half consensus_committee_size;\n    }\nend\n\nmodule Proto_previous = struct\n  type parametric = {\n    preserved_cycles : int;\n    blocks_per_cycle : int32;\n    blocks_per_commitment : int32;\n    blocks_per_roll_snapshot : int32;\n    blocks_per_voting_period : int32;\n    time_between_blocks : Period_repr.t list;\n    minimal_block_delay : Period_repr.t;\n    endorsers_per_block : int;\n    hard_gas_limit_per_operation : Gas_limit_repr.Arith.integral;\n    hard_gas_limit_per_block : Gas_limit_repr.Arith.integral;\n    proof_of_work_threshold : int64;\n    tokens_per_roll : Tez_repr.t;\n    seed_nonce_revelation_tip : Tez_repr.t;\n    origination_size : int;\n    block_security_deposit : Tez_repr.t;\n    endorsement_security_deposit : Tez_repr.t;\n    baking_reward_per_endorsement : Tez_repr.t list;\n    endorsement_reward : Tez_repr.t list;\n    cost_per_byte : Tez_repr.t;\n    hard_storage_limit_per_operation : Z.t;\n    quorum_min : int32;\n    quorum_max : int32;\n    min_proposal_quorum : int32;\n    initial_endorsers : int;\n    delay_per_missing_endorsement : Period_repr.t;\n    liquidity_baking_subsidy : Tez_repr.t;\n    liquidity_baking_sunset_level : int32;\n    liquidity_baking_escape_ema_threshold : int32;\n  }\n\n  let parametric_encoding =\n    let open Data_encoding in\n    conv\n      (fun c ->\n        ( ( c.preserved_cycles,\n            c.blocks_per_cycle,\n            c.blocks_per_commitment,\n            c.blocks_per_roll_snapshot,\n            c.blocks_per_voting_period,\n            c.time_between_blocks,\n            c.endorsers_per_block,\n            c.hard_gas_limit_per_operation,\n            c.hard_gas_limit_per_block,\n            c.proof_of_work_threshold ),\n          ( ( c.tokens_per_roll,\n              c.seed_nonce_revelation_tip,\n              c.origination_size,\n              c.block_security_deposit,\n              c.endorsement_security_deposit,\n              c.baking_reward_per_endorsement,\n              c.endorsement_reward,\n              c.cost_per_byte,\n              c.hard_storage_limit_per_operation ),\n            ( c.quorum_min,\n              c.quorum_max,\n              c.min_proposal_quorum,\n              c.initial_endorsers,\n              c.delay_per_missing_endorsement,\n              c.minimal_block_delay,\n              c.liquidity_baking_subsidy,\n              c.liquidity_baking_sunset_level,\n              c.liquidity_baking_escape_ema_threshold ) ) ))\n      (fun ( ( preserved_cycles,\n               blocks_per_cycle,\n               blocks_per_commitment,\n               blocks_per_roll_snapshot,\n               blocks_per_voting_period,\n               time_between_blocks,\n               endorsers_per_block,\n               hard_gas_limit_per_operation,\n               hard_gas_limit_per_block,\n               proof_of_work_threshold ),\n             ( ( tokens_per_roll,\n                 seed_nonce_revelation_tip,\n                 origination_size,\n                 block_security_deposit,\n                 endorsement_security_deposit,\n                 baking_reward_per_endorsement,\n                 endorsement_reward,\n                 cost_per_byte,\n                 hard_storage_limit_per_operation ),\n               ( quorum_min,\n                 quorum_max,\n                 min_proposal_quorum,\n                 initial_endorsers,\n                 delay_per_missing_endorsement,\n                 minimal_block_delay,\n                 liquidity_baking_subsidy,\n                 liquidity_baking_sunset_level,\n                 liquidity_baking_escape_ema_threshold ) ) ) ->\n        {\n          preserved_cycles;\n          blocks_per_cycle;\n          blocks_per_commitment;\n          blocks_per_roll_snapshot;\n          blocks_per_voting_period;\n          time_between_blocks;\n          endorsers_per_block;\n          hard_gas_limit_per_operation;\n          hard_gas_limit_per_block;\n          proof_of_work_threshold;\n          tokens_per_roll;\n          seed_nonce_revelation_tip;\n          origination_size;\n          block_security_deposit;\n          endorsement_security_deposit;\n          baking_reward_per_endorsement;\n          endorsement_reward;\n          cost_per_byte;\n          hard_storage_limit_per_operation;\n          quorum_min;\n          quorum_max;\n          min_proposal_quorum;\n          initial_endorsers;\n          delay_per_missing_endorsement;\n          minimal_block_delay;\n          liquidity_baking_subsidy;\n          liquidity_baking_sunset_level;\n          liquidity_baking_escape_ema_threshold;\n        })\n      (merge_objs\n         (obj10\n            (req \"preserved_cycles\" uint8)\n            (req \"blocks_per_cycle\" int32)\n            (req \"blocks_per_commitment\" int32)\n            (req \"blocks_per_roll_snapshot\" int32)\n            (req \"blocks_per_voting_period\" int32)\n            (req \"time_between_blocks\" (list Period_repr.encoding))\n            (req \"endorsers_per_block\" uint16)\n            (req\n               \"hard_gas_limit_per_operation\"\n               Gas_limit_repr.Arith.z_integral_encoding)\n            (req\n               \"hard_gas_limit_per_block\"\n               Gas_limit_repr.Arith.z_integral_encoding)\n            (req \"proof_of_work_threshold\" int64))\n         (merge_objs\n            (obj9\n               (req \"tokens_per_roll\" Tez_repr.encoding)\n               (req \"seed_nonce_revelation_tip\" Tez_repr.encoding)\n               (req \"origination_size\" int31)\n               (req \"block_security_deposit\" Tez_repr.encoding)\n               (req \"endorsement_security_deposit\" Tez_repr.encoding)\n               (req \"baking_reward_per_endorsement\" (list Tez_repr.encoding))\n               (req \"endorsement_reward\" (list Tez_repr.encoding))\n               (req \"cost_per_byte\" Tez_repr.encoding)\n               (req \"hard_storage_limit_per_operation\" z))\n            (obj9\n               (req \"quorum_min\" int32)\n               (req \"quorum_max\" int32)\n               (req \"min_proposal_quorum\" int32)\n               (req \"initial_endorsers\" uint16)\n               (req \"delay_per_missing_endorsement\" Period_repr.encoding)\n               (req \"minimal_block_delay\" Period_repr.encoding)\n               (req \"liquidity_baking_subsidy\" Tez_repr.encoding)\n               (req \"liquidity_baking_sunset_level\" int32)\n               (req \"liquidity_baking_escape_ema_threshold\" int32))))\nend\n" ;
                } ;
                { name = "Raw_level_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** The shell's notion of a level: an integer indicating the number of blocks\n    since genesis: genesis is 0, all other blocks have increasing levels from\n    there. *)\ntype t\n\ntype raw_level = t\n\n(** @raise Invalid_argument when the level to encode is not positive *)\nval encoding : raw_level Data_encoding.t\n\nval rpc_arg : raw_level RPC_arg.arg\n\nval pp : Format.formatter -> raw_level -> unit\n\ninclude Compare.S with type t := raw_level\n\nval to_int32 : raw_level -> int32\n\n(** @raise Invalid_argument when the level to encode is negative *)\nval of_int32_exn : int32 -> raw_level\n\n(** Can trigger Unexpected_level error when the level to encode is negative *)\nval of_int32 : int32 -> raw_level tzresult\n\nval diff : raw_level -> raw_level -> int32\n\nval root : raw_level\n\nval succ : raw_level -> raw_level\n\nval pred : raw_level -> raw_level option\n\n(** [add l i] i must be positive *)\nval add : raw_level -> int -> raw_level\n\n(** [sub l i] i must be positive *)\nval sub : raw_level -> int -> raw_level option\n\nmodule Index : Storage_description.INDEX with type t = raw_level\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype t = int32\n\ntype raw_level = t\n\ninclude (Compare.Int32 : Compare.S with type t := t)\n\nlet pp ppf level = Format.fprintf ppf \"%ld\" level\n\nlet rpc_arg =\n  let construct raw_level = Int32.to_string raw_level in\n  let destruct str =\n    Int32.of_string_opt str |> Option.to_result ~none:\"Cannot parse level\"\n  in\n  RPC_arg.make\n    ~descr:\"A level integer\"\n    ~name:\"block_level\"\n    ~construct\n    ~destruct\n    ()\n\nlet root = 0l\n\nlet succ = Int32.succ\n\nlet add l i =\n  assert (Compare.Int.(i >= 0)) ;\n  Int32.add l (Int32.of_int i)\n\nlet sub l i =\n  assert (Compare.Int.(i >= 0)) ;\n  let res = Int32.sub l (Int32.of_int i) in\n  if Compare.Int32.(res >= 0l) then Some res else None\n\nlet pred l = if l = 0l then None else Some (Int32.pred l)\n\nlet diff = Int32.sub\n\nlet to_int32 l = l\n\nlet of_int32_exn l =\n  if Compare.Int32.(l >= 0l) then l else invalid_arg \"Level_repr.of_int32\"\n\nlet encoding =\n  Data_encoding.conv_with_guard\n    (fun i -> i)\n    (fun i -> try ok (of_int32_exn i) with Invalid_argument s -> Error s)\n    Data_encoding.int32\n\ntype error += Unexpected_level of Int32.t (* `Permanent *)\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"unexpected_level\"\n    ~title:\"Unexpected level\"\n    ~description:\"Level must be non-negative.\"\n    ~pp:(fun ppf l ->\n      Format.fprintf\n        ppf\n        \"The level is %s but should be non-negative.\"\n        (Int32.to_string l))\n    Data_encoding.(obj1 (req \"level\" int32))\n    (function Unexpected_level l -> Some l | _ -> None)\n    (fun l -> Unexpected_level l)\n\nlet of_int32 l =\n  Error_monad.catch_f (fun () -> of_int32_exn l) (fun _ -> Unexpected_level l)\n\nmodule Index = struct\n  type t = raw_level\n\n  let path_length = 1\n\n  let to_path level l = Int32.to_string level :: l\n\n  let of_path = function [s] -> Int32.of_string_opt s | _ -> None\n\n  let rpc_arg = rpc_arg\n\n  let encoding = encoding\n\n  let compare = compare\nend\n" ;
                } ;
                { name = "Fitness_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2020 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype error +=\n  | (* `Permanent *) Invalid_fitness\n  | (* `Permanent *) Wrong_fitness\n  | (* `Permanent *) Outdated_fitness\n  | (* `Permanent *)\n      Locked_round_not_less_than_round of {\n      round : Round_repr.t;\n      locked_round : Round_repr.t;\n    }\n\ntype t\n\nval encoding : t Data_encoding.t\n\nval pp : Format.formatter -> t -> unit\n\nval create :\n  level:Raw_level_repr.t ->\n  locked_round:Round_repr.t option ->\n  predecessor_round:Round_repr.t ->\n  round:Round_repr.t ->\n  t tzresult\n\nval create_without_locked_round :\n  level:Raw_level_repr.t ->\n  predecessor_round:Round_repr.t ->\n  round:Round_repr.t ->\n  t\n\nval to_raw : t -> Fitness.t\n\n(** Returns the corresponding protocol fitness if the shell fitness has\n    the expected version, given by\n    Constants_repr.fitness_version_number. If the fitness' version is\n    from a previous protocol version, then it raises an \"outdated\n    fitness\" error. If the fitness version is higher then\n    it raises an \"invalid fitness\" error. *)\nval from_raw : Fitness.t -> t tzresult\n\n(** Returns the round from a raw fitness. If the fitness is from a\n    previous protocol, the returned value will be Round.zero. *)\nval round_from_raw : Fitness.t -> Round_repr.t tzresult\n\n(** Returns the predecessor round from a raw fitness. If the fitness\n   is from a previous protocol, the returned value will be Round.zero. *)\nval predecessor_round_from_raw : Fitness.t -> Round_repr.t tzresult\n\n(** Validate only the part of the fitness for which information are\n    available during begin_application *)\nval check_except_locked_round :\n  t -> level:Raw_level_repr.t -> predecessor_round:Round_repr.t -> unit tzresult\n\n(** Validate the locked_round component of the fitness, which could\n    not be validated during begin_application. *)\nval check_locked_round : t -> locked_round:Round_repr.t option -> unit tzresult\n\nval level : t -> Raw_level_repr.t\n\nval round : t -> Round_repr.t\n\nval locked_round : t -> Round_repr.t option\n\nval predecessor_round : t -> Round_repr.t\n\n(**/**)\n\nmodule Internal_for_tests : sig\n  (** uses a lexicographic order relation for [level, locked_round,\n     -predecessor_round, round] *)\n  val compare : t -> t -> int\nend\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype t = {\n  level : Raw_level_repr.t;\n  locked_round : Round_repr.t option;\n  predecessor_round : Round_repr.t;\n  (* by convention, predecessor_round is 0 in case of protocol migration *)\n  round : Round_repr.t;\n}\n\nlet encoding =\n  let open Data_encoding in\n  def\n    \"fitness\"\n    (conv_with_guard\n       (fun {level; locked_round; predecessor_round; round} ->\n         (level, locked_round, predecessor_round, round))\n       (fun (level, locked_round, predecessor_round, round) ->\n         match locked_round with\n         | None -> ok {level; locked_round; predecessor_round; round}\n         | Some locked_round_val ->\n             if Round_repr.(round <= locked_round_val) then\n               Error \"Locked round must be smaller than round.\"\n             else ok {level; locked_round; predecessor_round; round})\n       (obj4\n          (req \"level\" Raw_level_repr.encoding)\n          (req \"locked_round\" (option Round_repr.encoding))\n          (req \"predecessor_round\" Round_repr.encoding)\n          (req \"round\" Round_repr.encoding)))\n\nlet pp ppf f =\n  let minus_sign =\n    if Round_repr.(f.predecessor_round = Round_repr.zero) then \"\" else \"-\"\n  in\n  let locked_round ppf locked_round =\n    match locked_round with\n    | None -> Format.pp_print_string ppf \"unlocked\"\n    | Some round -> Format.fprintf ppf \"locked: %a\" Round_repr.pp round\n  in\n  Format.fprintf\n    ppf\n    \"(%a, %a, %s%a, %a)\"\n    Raw_level_repr.pp\n    f.level\n    locked_round\n    f.locked_round\n    minus_sign\n    Round_repr.pp\n    f.predecessor_round\n    Round_repr.pp\n    f.round\n\ntype error +=\n  | (* `Permanent *) Invalid_fitness\n  | (* `Permanent *) Wrong_fitness\n  | (* `Permanent *) Outdated_fitness\n  | (* `Permanent *)\n      Locked_round_not_less_than_round of {\n      round : Round_repr.t;\n      locked_round : Round_repr.t;\n    }\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"invalid_fitness\"\n    ~title:\"Invalid fitness\"\n    ~description:\n      \"Fitness representation should be exactly 4 times 4 bytes long.\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"Invalid fitness\")\n    Data_encoding.empty\n    (function Invalid_fitness -> Some () | _ -> None)\n    (fun () -> Invalid_fitness) ;\n  register_error_kind\n    `Permanent\n    ~id:\"wrong_fitness\"\n    ~title:\"Wrong fitness\"\n    ~description:\"Wrong fitness.\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"Wrong fitness.\")\n    Data_encoding.empty\n    (function Wrong_fitness -> Some () | _ -> None)\n    (fun () -> Wrong_fitness) ;\n  register_error_kind\n    `Permanent\n    ~id:\"outdated_fitness\"\n    ~title:\"Outdated fitness\"\n    ~description:\"Outdated fitness: referring to a previous version\"\n    ~pp:(fun ppf () ->\n      Format.fprintf ppf \"Outdated fitness: referring to a previous version.\")\n    Data_encoding.empty\n    (function Outdated_fitness -> Some () | _ -> None)\n    (fun () -> Outdated_fitness) ;\n  register_error_kind\n    `Permanent\n    ~id:\"locked_round_not_less_than_round\"\n    ~title:\"Locked round not smaller than round\"\n    ~description:\"The round is smaller than or equal to the locked round.\"\n    ~pp:(fun ppf (round, locked_round) ->\n      Format.fprintf\n        ppf\n        \"Incorrect fitness: round %a is less than or equal to locked round %a.\"\n        Round_repr.pp\n        round\n        Round_repr.pp\n        locked_round)\n    Data_encoding.(\n      obj2\n        (req \"round\" Round_repr.encoding)\n        (req \"locked_round\" Round_repr.encoding))\n    (function\n      | Locked_round_not_less_than_round {round; locked_round} ->\n          Some (round, locked_round)\n      | _ -> None)\n    (fun (round, locked_round) ->\n      Locked_round_not_less_than_round {round; locked_round})\n\nlet create_without_locked_round ~level ~predecessor_round ~round =\n  {level; locked_round = None; predecessor_round; round}\n\nlet create ~level ~locked_round ~predecessor_round ~round =\n  match locked_round with\n  | None -> ok {level; locked_round; predecessor_round; round}\n  | Some locked_round_val ->\n      error_when\n        Round_repr.(round <= locked_round_val)\n        (Locked_round_not_less_than_round\n           {round; locked_round = locked_round_val})\n      >>? fun () -> ok {level; locked_round; predecessor_round; round}\n\nlet int32_to_bytes i =\n  let b = Bytes.make 4 '\\000' in\n  TzEndian.set_int32 b 0 i ;\n  b\n\nlet int32_of_bytes b =\n  if Compare.Int.(Bytes.length b <> 4) then error Invalid_fitness\n  else ok (TzEndian.get_int32 b 0)\n\n(* Locked round is an option. And we want None to be smaller than any other\n   value. The way the shell handles the order makes the empty Bytes smaller\n   than any other *)\nlet locked_round_to_bytes = function\n  | None -> Bytes.empty\n  | Some locked_round -> int32_to_bytes (Round_repr.to_int32 locked_round)\n\nlet locked_round_of_bytes b =\n  match Bytes.length b with\n  | 0 -> ok None\n  | 4 -> Round_repr.of_int32 (TzEndian.get_int32 b 0) >>? fun r -> ok (Some r)\n  | _ -> error Invalid_fitness\n\nlet predecessor_round_of_bytes neg_predecessor_round =\n  int32_of_bytes neg_predecessor_round >>? fun neg_predecessor_round ->\n  Round_repr.of_int32 @@ Int32.pred (Int32.neg neg_predecessor_round)\n\nlet round_of_bytes round = int32_of_bytes round >>? Round_repr.of_int32\n\nlet to_raw {level; locked_round; predecessor_round; round} =\n  [\n    Bytes.of_string Constants_repr.fitness_version_number;\n    int32_to_bytes (Raw_level_repr.to_int32 level);\n    locked_round_to_bytes locked_round;\n    int32_to_bytes\n      (Int32.pred (Int32.neg (Round_repr.to_int32 predecessor_round)));\n    int32_to_bytes (Round_repr.to_int32 round);\n  ]\n\nlet from_raw = function\n  | [version; level; locked_round; neg_predecessor_round; round]\n    when Compare.String.(\n           Bytes.to_string version = Constants_repr.fitness_version_number) ->\n      int32_of_bytes level >>? Raw_level_repr.of_int32 >>? fun level ->\n      locked_round_of_bytes locked_round >>? fun locked_round ->\n      predecessor_round_of_bytes neg_predecessor_round\n      >>? fun predecessor_round ->\n      round_of_bytes round >>? fun round ->\n      create ~level ~locked_round ~predecessor_round ~round\n  | [version; _]\n    when Compare.String.(\n           Bytes.to_string version < Constants_repr.fitness_version_number) ->\n      error Outdated_fitness\n  | [] (* genesis fitness *) -> error Outdated_fitness\n  | _ -> error Invalid_fitness\n\nlet round_from_raw = function\n  | [version; _level; _locked_round; _neg_predecessor_round; round]\n    when Compare.String.(\n           Bytes.to_string version = Constants_repr.fitness_version_number) ->\n      round_of_bytes round\n  | [version; _]\n    when Compare.String.(\n           Bytes.to_string version < Constants_repr.fitness_version_number) ->\n      ok Round_repr.zero\n  | [] (* genesis fitness *) -> ok Round_repr.zero\n  | _ -> error Invalid_fitness\n\nlet predecessor_round_from_raw = function\n  | [version; _level; _locked_round; neg_predecessor_round; _round]\n    when Compare.String.(\n           Bytes.to_string version = Constants_repr.fitness_version_number) ->\n      predecessor_round_of_bytes neg_predecessor_round\n  | [version; _]\n    when Compare.String.(\n           Bytes.to_string version < Constants_repr.fitness_version_number) ->\n      ok Round_repr.zero\n  | [] (* genesis fitness *) -> ok Round_repr.zero\n  | _ -> error Invalid_fitness\n\nlet check_except_locked_round fitness ~level ~predecessor_round =\n  let {\n    level = expected_level;\n    locked_round = _;\n    predecessor_round = expected_predecessor_round;\n    round = _;\n  } =\n    fitness\n  in\n  let correct =\n    Raw_level_repr.(level = expected_level)\n    && Round_repr.(predecessor_round = expected_predecessor_round)\n  in\n  error_unless correct Wrong_fitness\n\nlet check_locked_round fitness ~locked_round =\n  let {\n    level = _;\n    locked_round = expected_locked_round;\n    predecessor_round = _;\n    round = _;\n  } =\n    fitness\n  in\n  let correct =\n    match (locked_round, expected_locked_round) with\n    | (None, None) -> true\n    | (Some _, None) | (None, Some _) -> false\n    | (Some v, Some v') -> Round_repr.(v = v')\n  in\n  error_unless correct Wrong_fitness\n\nlet level fitness = fitness.level\n\nlet round fitness = fitness.round\n\nlet locked_round fitness = fitness.locked_round\n\nlet predecessor_round fitness = fitness.predecessor_round\n\nmodule Internal_for_tests = struct\n  module ListInt32Compare = Compare.List (Compare.Int32)\n\n  let compare f ff =\n    let unopt l =\n      match l with Some l -> Round_repr.to_int32 l | None -> -1l\n    in\n    let to_list {level; locked_round; predecessor_round; round} =\n      Int32.\n        [\n          Raw_level_repr.to_int32 level;\n          unopt locked_round;\n          neg (Round_repr.to_int32 predecessor_round);\n          Round_repr.to_int32 round;\n        ]\n    in\n    ListInt32Compare.compare (to_list f) (to_list ff)\nend\n" ;
                } ;
                { name = "Cycle_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype t\n\ntype cycle = t\n\ninclude Compare.S with type t := t\n\nval encoding : cycle Data_encoding.t\n\nval rpc_arg : cycle RPC_arg.arg\n\nval pp : Format.formatter -> cycle -> unit\n\nval root : cycle\n\nval pred : cycle -> cycle option\n\nval add : cycle -> int -> cycle\n\nval sub : cycle -> int -> cycle option\n\nval succ : cycle -> cycle\n\nval diff : cycle -> cycle -> int32\n\n(** a ---> b = [a; ...; b] *)\nval ( ---> ) : cycle -> cycle -> cycle list\n\nval to_int32 : cycle -> int32\n\nval of_int32_exn : int32 -> cycle\n\nval of_string_exn : string -> cycle\n\nmodule Map : Map.S with type key = cycle\n\nmodule Index : Storage_description.INDEX with type t = cycle\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype t = int32\n\ntype cycle = t\n\nlet encoding = Data_encoding.int32\n\nlet rpc_arg = RPC_arg.like RPC_arg.uint31 ~descr:\"A cycle integer\" \"block_cycle\"\n\nlet pp ppf cycle = Format.fprintf ppf \"%ld\" cycle\n\ninclude (Compare.Int32 : Compare.S with type t := t)\n\nmodule Map = Map.Make (Compare.Int32)\n\nlet root = 0l\n\nlet succ = Int32.succ\n\nlet pred = function 0l -> None | i -> Some (Int32.pred i)\n\nlet add c i =\n  assert (Compare.Int.(i >= 0)) ;\n  Int32.add c (Int32.of_int i)\n\nlet sub c i =\n  assert (Compare.Int.(i >= 0)) ;\n  let r = Int32.sub c (Int32.of_int i) in\n  if Compare.Int32.(r < 0l) then None else Some r\n\nlet diff = Int32.sub\n\nlet to_int32 i = i\n\nlet of_int32_exn l =\n  if Compare.Int32.(l >= 0l) then l else invalid_arg \"Cycle_repr.of_int32_exn\"\n\nlet of_string_exn s =\n  let int32_opt = Int32.of_string_opt s in\n  match int32_opt with\n  | None -> invalid_arg \"Cycle_repr.of_string_exn\"\n  | Some int32 -> of_int32_exn int32\n\nlet ( ---> ) = Misc.( ---> )\n\nmodule Index = struct\n  type t = cycle\n\n  let path_length = 1\n\n  let to_path c l = Int32.to_string (to_int32 c) :: l\n\n  let of_path = function [s] -> Int32.of_string_opt s | _ -> None\n\n  let rpc_arg = rpc_arg\n\n  let encoding = encoding\n\n  let compare = compare\nend\n" ;
                } ;
                { name = "Level_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** This module defines the protocol representation of a level. Besides the \"raw\n    level\", which is the shell's notion of the level, this representation also\n    contains additional information, like the cycle the level belongs to. *)\n\ntype t = private {\n  level : Raw_level_repr.t;\n      (** The level of the block relative to genesis. This\n                              is also the Shell's notion of level. *)\n  level_position : int32;\n      (** The level of the block relative to the block that starts the\n     alpha family of protocols.  *)\n  cycle : Cycle_repr.t;\n      (** The current cycle's number. Note that cycles are a protocol-specific\n     notion. As a result, the cycle number starts at 0 with the first block of\n     the first version of protocol alpha. *)\n  cycle_position : int32;\n      (** The current level of the block relative to the first block of the current\n     cycle. *)\n  expected_commitment : bool;\n}\n\ntype level = t\n\ninclude Compare.S with type t := level\n\nval encoding : level Data_encoding.t\n\nval pp : Format.formatter -> level -> unit\n\nval pp_full : Format.formatter -> level -> unit\n\nval diff : level -> level -> int32\n\n(** A cycle era is a chunk of cycles having the same number of levels\n   per cycle and the same number of blocks per commitment. *)\ntype cycle_era = {\n  first_level : Raw_level_repr.t;  (** The first level of a cycle era. *)\n  first_cycle : Cycle_repr.t;  (** The first cycle of a cycle era. *)\n  blocks_per_cycle : int32;\n      (** The value of the blocks_per_cycle constant used during the cycle\n       era starting with first_level. *)\n  blocks_per_commitment : int32;\n      (** The value of the blocks_per_commitment constant used during the\n       cycle era starting with first_level. *)\n}\n\n(** Stores the cycles eras of the Alpha family of protocols *)\ntype cycle_eras\n\nval cycle_eras_encoding : cycle_eras Data_encoding.t\n\n(** Preconditions on the input list of cycle eras:\n   - the list is not empty\n   - the first levels and the first cycles are decreasing, meaning that the\n     first era in the list is the current era, and the last era in the list\n     is the oldest era\n   Invariants:\n   - the first era therefore contains the same constants as in Constants\n   - the first level of an era is the first level of a cycle\n*)\nval create_cycle_eras : cycle_era list -> cycle_eras tzresult\n\n(** Returns the current era *)\nval current_era : cycle_eras -> cycle_era\n\n(** Returns the first level of the oldest era *)\nval root_level : cycle_eras -> level\n\n(** Returns the annotated level corresponding to a raw level *)\nval from_raw : cycle_eras:cycle_eras -> Raw_level_repr.t -> level\n\n(** Returns the annotated level corresponding to a raw level and an\n   offset. A positive offset corresponds to a higher level.\n   Fails with [Negative_level_and_offset_sum] if the sum of the raw_level and the offset is negative.\n   Fails with [Level_not_in_alpha] if the sum of the raw_level and the offset \n   is a level before the first level in the Alpha family of protocols. *)\nval from_raw_with_offset :\n  cycle_eras:cycle_eras -> offset:int32 -> Raw_level_repr.t -> level tzresult\n\n(** Returns the first level of the given cycle. *)\nval first_level_in_cycle_from_eras :\n  cycle_eras:cycle_eras -> Cycle_repr.t -> level\n\n(** Returns true if the given level is the last of a cycle. *)\nval last_of_cycle : cycle_eras:cycle_eras -> level -> bool\n\n(**/**)\n\n(* exported for unit testing only *)\ntype error += Invalid_cycle_eras\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype t = {\n  level : Raw_level_repr.t;\n  level_position : int32;\n  cycle : Cycle_repr.t;\n  cycle_position : int32;\n  expected_commitment : bool;\n}\n\ninclude Compare.Make (struct\n  type nonrec t = t\n\n  let compare {level = l1; _} {level = l2; _} = Raw_level_repr.compare l1 l2\nend)\n\ntype level = t\n\nlet pp ppf {level; _} = Raw_level_repr.pp ppf level\n\nlet pp_full ppf l =\n  Format.fprintf\n    ppf\n    \"%a.%ld (cycle %a.%ld)\"\n    Raw_level_repr.pp\n    l.level\n    l.level_position\n    Cycle_repr.pp\n    l.cycle\n    l.cycle_position\n\nlet encoding =\n  let open Data_encoding in\n  conv\n    (fun {level; level_position; cycle; cycle_position; expected_commitment} ->\n      (level, level_position, cycle, cycle_position, expected_commitment))\n    (fun (level, level_position, cycle, cycle_position, expected_commitment) ->\n      {level; level_position; cycle; cycle_position; expected_commitment})\n    (obj5\n       (req\n          \"level\"\n          ~description:\n            \"The level of the block relative to genesis. This is also the \\\n             Shell's notion of level.\"\n          Raw_level_repr.encoding)\n       (req\n          \"level_position\"\n          ~description:\n            \"The level of the block relative to the successor of the genesis \\\n             block. More precisely, it is the position of the block relative \\\n             to the block that starts the \\\"Alpha family\\\" of protocols, which \\\n             includes all protocols except Genesis (that is, from 001 \\\n             onwards).\"\n          int32)\n       (req\n          \"cycle\"\n          ~description:\n            \"The current cycle's number. Note that cycles are a \\\n             protocol-specific notion. As a result, the cycle number starts at \\\n             0 with the first block of the Alpha family of protocols.\"\n          Cycle_repr.encoding)\n       (req\n          \"cycle_position\"\n          ~description:\n            \"The current level of the block relative to the first block of the \\\n             current cycle.\"\n          int32)\n       (req\n          \"expected_commitment\"\n          ~description:\n            \"Tells whether the baker of this block has to commit a seed nonce \\\n             hash.\"\n          bool))\n\nlet diff {level = l1; _} {level = l2; _} =\n  Int32.sub (Raw_level_repr.to_int32 l1) (Raw_level_repr.to_int32 l2)\n\ntype cycle_era = {\n  first_level : Raw_level_repr.t;\n  first_cycle : Cycle_repr.t;\n  blocks_per_cycle : int32;\n  blocks_per_commitment : int32;\n}\n\ntype cycle_eras = cycle_era list\n\ntype error += Invalid_cycle_eras\n\nlet () =\n  register_error_kind\n    `Temporary\n    ~id:\"level_repr.invalid_cycle_eras\"\n    ~title:\"Invalid cycle eras\"\n    ~description:\n      \"The cycles eras are not valid: empty list or non-decreasing first \\\n       levels or first cycles.\"\n    ~pp:(fun ppf () ->\n      Format.fprintf\n        ppf\n        \"The cycles eras are not valid: empty list or non-decreasing first \\\n         levels or first cycles.\")\n    Data_encoding.empty\n    (function Invalid_cycle_eras -> Some () | _ -> None)\n    (fun () -> Invalid_cycle_eras)\n\nlet create_cycle_eras cycle_eras =\n  match cycle_eras with\n  | [] -> error Invalid_cycle_eras\n  | newest_era :: older_eras ->\n      let rec aux {first_level; first_cycle; _} older_eras =\n        match older_eras with\n        | ({\n             first_level = first_level_of_previous_era;\n             first_cycle = first_cycle_of_previous_era;\n             _;\n           } as previous_era)\n          :: even_older_eras ->\n            if\n              Raw_level_repr.(first_level > first_level_of_previous_era)\n              && Cycle_repr.(first_cycle > first_cycle_of_previous_era)\n            then aux previous_era even_older_eras\n            else error Invalid_cycle_eras\n        | [] -> ok ()\n      in\n      aux newest_era older_eras >>? fun () -> ok cycle_eras\n\nlet cycle_era_encoding =\n  let open Data_encoding in\n  conv\n    (fun {first_level; first_cycle; blocks_per_cycle; blocks_per_commitment} ->\n      (first_level, first_cycle, blocks_per_cycle, blocks_per_commitment))\n    (fun (first_level, first_cycle, blocks_per_cycle, blocks_per_commitment) ->\n      {first_level; first_cycle; blocks_per_cycle; blocks_per_commitment})\n    (obj4\n       (req\n          \"first_level\"\n          ~description:\"The first level of a new cycle era.\"\n          Raw_level_repr.encoding)\n       (req\n          \"first_cycle\"\n          ~description:\"The first cycle of a new cycle era.\"\n          Cycle_repr.encoding)\n       (req\n          \"blocks_per_cycle\"\n          ~description:\n            \"The value of the blocks_per_cycle constant used during the cycle \\\n             era starting with first_level.\"\n          int32)\n       (req\n          \"blocks_per_commitment\"\n          ~description:\n            \"The value of the blocks_per_commitment constant used during the \\\n             cycle era starting with first_level.\"\n          int32))\n\nlet cycle_eras_encoding =\n  Data_encoding.conv_with_guard\n    (fun eras -> eras)\n    (fun eras ->\n      match create_cycle_eras eras with\n      | Ok eras -> Ok eras\n      | Error _ -> Error \"Invalid cycle eras\")\n    (Data_encoding.list cycle_era_encoding)\n\nlet current_era = function [] -> assert false | cycle_era :: _ -> cycle_era\n\nlet root_level cycle_eras =\n  let first_era = List.last_opt cycle_eras in\n  let first_era =\n    match first_era with\n    | Some first_era -> first_era\n    | None ->\n        (* {!create_cycle_eras} fails if the list is empty.\n           {!cycle_eras_encoding} uses {!create_cycle_eras} and so fails on empty\n           lists too. *)\n        assert false\n  in\n  {\n    level = first_era.first_level;\n    level_position = 0l;\n    cycle = Cycle_repr.root;\n    cycle_position = 0l;\n    expected_commitment = false;\n  }\n\n(* This function returns the cycle era to which [level] belongs. *)\nlet era_of_level ~cycle_eras level =\n  let rec aux = function\n    | ({first_level; _} as era) :: previous_eras ->\n        if Raw_level_repr.(level >= first_level) then era else aux previous_eras\n    | [] -> assert false\n  in\n  aux cycle_eras\n\n(* This function returns the cycle era to which [cycle] belongs. *)\nlet era_of_cycle ~cycle_eras cycle =\n  let rec aux = function\n    | ({first_cycle; _} as era) :: previous_eras ->\n        if Cycle_repr.(cycle >= first_cycle) then era else aux previous_eras\n    | [] -> assert false\n  in\n  aux cycle_eras\n\n(* precondition: [level] belongs to [era] *)\nlet level_from_raw_with_era era ~first_level_in_alpha_family level =\n  let {first_level; first_cycle; blocks_per_cycle; blocks_per_commitment} =\n    era\n  in\n  let level_position_in_era = Raw_level_repr.diff level first_level in\n  assert (Compare.Int32.(level_position_in_era >= 0l)) ;\n  let cycles_since_era_start =\n    Int32.div level_position_in_era blocks_per_cycle\n  in\n  let cycle =\n    Cycle_repr.add first_cycle (Int32.to_int cycles_since_era_start)\n  in\n  let cycle_position = Int32.rem level_position_in_era blocks_per_cycle in\n  let level_position = Raw_level_repr.diff level first_level_in_alpha_family in\n  let expected_commitment =\n    Compare.Int32.(\n      Int32.rem cycle_position blocks_per_commitment\n      = Int32.pred blocks_per_commitment)\n  in\n  {level; level_position; cycle; cycle_position; expected_commitment}\n\nlet level_from_raw_aux_exn ~cycle_eras level =\n  let first_level_in_alpha_family =\n    match List.rev cycle_eras with\n    | [] -> assert false\n    | {first_level; _} :: _ -> first_level\n  in\n  let era = era_of_level ~cycle_eras level in\n  level_from_raw_with_era era ~first_level_in_alpha_family level\n\nlet from_raw ~cycle_eras l = level_from_raw_aux_exn ~cycle_eras l\n\ntype error += Level_not_in_alpha of Raw_level_repr.t\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"level_not_in_alpha\"\n    ~title:\"Level not in Alpha family\"\n    ~description:\"Level not in Alpha family\"\n    ~pp:(fun ppf level ->\n      Format.fprintf\n        ppf\n        \"Level %a is not in the Alpha family of protocols.\"\n        Raw_level_repr.pp\n        level)\n    Data_encoding.(obj1 (req \"level\" Raw_level_repr.encoding))\n    (function Level_not_in_alpha level -> Some level | _ -> None)\n    (fun level -> Level_not_in_alpha level)\n\nlet level_from_raw_aux ~cycle_eras level =\n  let first_level_in_alpha_family =\n    match List.rev cycle_eras with\n    | [] -> assert false\n    | {first_level; _} :: _ -> first_level\n  in\n  error_when\n    Raw_level_repr.(level < first_level_in_alpha_family)\n    (Level_not_in_alpha level)\n  >|? fun () ->\n  let era = era_of_level ~cycle_eras level in\n  level_from_raw_with_era era ~first_level_in_alpha_family level\n\ntype error += Negative_level_and_offset_sum of int32 * int32\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"negative_level_and_offset_sum\"\n    ~title:\"Negative sum of level and offset\"\n    ~description:\"Negative sum of level and offset\"\n    ~pp:(fun ppf (level, offset) ->\n      Format.fprintf\n        ppf\n        \"Sum of level (%ld) and offset (%ld) is negative.\"\n        level\n        offset)\n    Data_encoding.(obj2 (req \"level\" int32) (req \"offset\" int32))\n    (function\n      | Negative_level_and_offset_sum (level, offset) -> Some (level, offset)\n      | _ -> None)\n    (fun (level, offset) -> Negative_level_and_offset_sum (level, offset))\n\nlet from_raw_with_offset ~cycle_eras ~offset raw_level =\n  let res = Raw_level_repr.(of_int32 (Int32.add (to_int32 raw_level) offset)) in\n  match res with\n  | Ok level -> level_from_raw_aux ~cycle_eras level\n  | Error _ ->\n      error\n        (Negative_level_and_offset_sum\n           (Raw_level_repr.to_int32 raw_level, offset))\n\nlet first_level_in_cycle_from_eras ~cycle_eras cycle =\n  let first_level_in_alpha_family =\n    match List.rev cycle_eras with\n    | [] -> assert false\n    | {first_level; _} :: _ -> first_level\n  in\n  let era = era_of_cycle ~cycle_eras cycle in\n  let cycle_position = Cycle_repr.diff cycle era.first_cycle in\n  let offset = Int32.mul era.blocks_per_cycle cycle_position in\n  let first_level_in_cycle =\n    Raw_level_repr.(of_int32_exn (Int32.add (to_int32 era.first_level) offset))\n  in\n  level_from_raw_with_era era ~first_level_in_alpha_family first_level_in_cycle\n\nlet last_of_cycle ~cycle_eras level =\n  let era = era_of_level ~cycle_eras level.level in\n  Compare.Int32.(Int32.succ level.cycle_position = era.blocks_per_cycle)\n" ;
                } ;
                { name = "Seed_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Tezos Protocol Implementation - Random number generation\n\n    This is not expected to be a good cryptographic random number\n    generator. In particular this is supposed to be used in situations\n    where the seed is a globally known information.\n\n    The only expected property is: It should be difficult to find a\n    seed such that the generated sequence is a given one. *)\n\n(** {2 Random Generation} *)\n\n(** The state of the random number generator *)\ntype t\n\n(** A random seed, to derive random sequences from *)\ntype seed\n\n(** A random sequence, to derive random values from *)\ntype sequence\n\n(** [initialize_new state ident] returns a new generator *)\nval initialize_new : seed -> bytes list -> t\n\n(** [sequence state n] prepares the n-th sequence of a state  *)\nval sequence : t -> int32 -> sequence\n\n(** Generates the next random value in the sequence *)\nval take : sequence -> bytes * sequence\n\n(** [take_int32 s bound] generates the next random value as a bounded [int32]\n\n    @param bound must be a positive integer\n    @raise Invalid_argument \"Seed_repr.take_int32\" if [bound] <= 0\n *)\nval take_int32 : sequence -> int32 -> int32 * sequence\n\n(** [take_int64 s bound] generates the next random value as a bounded [int64]\n\n    @param bound must be a positive integer\n    @raise Invalid_argument \"Seed_repr.take_int64\" if [bound] <= 0\n *)\nval take_int64 : sequence -> int64 -> int64 * sequence\n\n(** {2 Predefined seeds} *)\n\nval empty : seed\n\n(** Returns a new seed by hashing the one passed with a constant. *)\nval deterministic_seed : seed -> seed\n\n(** [initial_seeds n] generates the first [n] seeds for which there are no nonces.\n    The first seed is a constant value. The kth seed is the hash of seed (k-1)\n    concatenated with a constant. *)\nval initial_seeds : int -> seed list\n\n(** {2 Entropy} *)\n\n(** A nonce for adding entropy to the generator *)\ntype nonce\n\n(** Add entropy to the seed generator *)\nval nonce : seed -> nonce -> seed\n\n(** Use a byte sequence as a nonce *)\nval make_nonce : bytes -> nonce tzresult\n\n(** Compute the has of a nonce *)\nval hash : nonce -> Nonce_hash.t\n\n(** [check_hash nonce hash] is true if the nonce correspond to the hash *)\nval check_hash : nonce -> Nonce_hash.t -> bool\n\n(** For using nonce hashes as keys in the hierarchical database *)\nval nonce_hash_key_part : Nonce_hash.t -> string list -> string list\n\n(** {2 Predefined nonce} *)\n\nval initial_nonce_0 : nonce\n\nval initial_nonce_hash_0 : Nonce_hash.t\n\n(** {2 Serializers} *)\n\nval nonce_encoding : nonce Data_encoding.t\n\nval seed_encoding : seed Data_encoding.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(* Tezos Protocol Implementation - Random number generation *)\n\ntype seed = B of State_hash.t\n\ntype t = T of State_hash.t\n\ntype sequence = S of State_hash.t\n\ntype nonce = bytes\n\nlet nonce_encoding = Data_encoding.Fixed.bytes Constants_repr.nonce_length\n\nlet initial_seed = \"Laissez-faire les proprietaires.\"\n\nlet zero_bytes = Bytes.make Nonce_hash.size '\\000'\n\nlet state_hash_encoding =\n  let open Data_encoding in\n  conv State_hash.to_bytes State_hash.of_bytes_exn (Fixed.bytes Nonce_hash.size)\n\nlet seed_encoding =\n  let open Data_encoding in\n  conv (fun (B b) -> b) (fun b -> B b) state_hash_encoding\n\nlet empty = B (State_hash.hash_string [initial_seed])\n\nlet nonce (B state) nonce =\n  B (State_hash.hash_bytes [State_hash.to_bytes state; nonce])\n\nlet initialize_new (B state) append =\n  T (State_hash.hash_bytes (State_hash.to_bytes state :: zero_bytes :: append))\n\nlet xor_higher_bits i b =\n  let higher = TzEndian.get_int32 b 0 in\n  let r = Int32.logxor higher i in\n  let res = Bytes.copy b in\n  TzEndian.set_int32 res 0 r ;\n  res\n\nlet sequence (T state) n =\n  State_hash.to_bytes state |> xor_higher_bits n |> fun b ->\n  S (State_hash.hash_bytes [b])\n\nlet take (S state) =\n  let b = State_hash.to_bytes state in\n  let h = State_hash.hash_bytes [b] in\n  (State_hash.to_bytes h, S h)\n\nlet take_int32 s bound =\n  if Compare.Int32.(bound <= 0l) then invalid_arg \"Seed_repr.take_int32\"\n    (* FIXME *)\n  else\n    let drop_if_over =\n      Int32.sub Int32.max_int (Int32.rem Int32.max_int bound)\n    in\n    let rec loop s =\n      let (bytes, s) = take s in\n      let r = Int32.abs (TzEndian.get_int32 bytes 0) in\n      if Compare.Int32.(r >= drop_if_over) then loop s\n      else\n        let v = Int32.rem r bound in\n        (v, s)\n    in\n    loop s\n\nlet take_int64 s bound =\n  if Compare.Int64.(bound <= 0L) then invalid_arg \"Seed_repr.take_int64\"\n    (* FIXME *)\n  else\n    let drop_if_over =\n      Int64.sub Int64.max_int (Int64.rem Int64.max_int bound)\n    in\n\n    let rec loop s =\n      let (bytes, s) = take s in\n      let r = Int64.abs (TzEndian.get_int64 bytes 0) in\n      if Compare.Int64.(r >= drop_if_over) then loop s\n      else\n        let v = Int64.rem r bound in\n        (v, s)\n    in\n    loop s\n\ntype error += Unexpected_nonce_length (* `Permanent *)\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"unexpected_nonce_length\"\n    ~title:\"Unexpected nonce length\"\n    ~description:\"Nonce length is incorrect.\"\n    ~pp:(fun ppf () ->\n      Format.fprintf\n        ppf\n        \"Nonce length is not %i bytes long as it should.\"\n        Constants_repr.nonce_length)\n    Data_encoding.empty\n    (function Unexpected_nonce_length -> Some () | _ -> None)\n    (fun () -> Unexpected_nonce_length)\n\nlet make_nonce nonce =\n  if Compare.Int.(Bytes.length nonce <> Constants_repr.nonce_length) then\n    error Unexpected_nonce_length\n  else ok nonce\n\nlet hash nonce = Nonce_hash.hash_bytes [nonce]\n\nlet check_hash nonce hash =\n  Compare.Int.(Bytes.length nonce = Constants_repr.nonce_length)\n  && Nonce_hash.equal (Nonce_hash.hash_bytes [nonce]) hash\n\nlet nonce_hash_key_part = Nonce_hash.to_path\n\nlet initial_nonce_0 = zero_bytes\n\nlet initial_nonce_hash_0 = hash initial_nonce_0\n\nlet deterministic_seed seed = nonce seed zero_bytes\n\nlet initial_seeds n =\n  let[@coq_struct \"i\"] rec loop acc elt i =\n    if Compare.Int.(i = 1) then List.rev (elt :: acc)\n    else loop (elt :: acc) (deterministic_seed elt) (i - 1)\n  in\n  loop [] (B (State_hash.hash_bytes [])) n\n" ;
                } ;
                { name = "Sampler" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n(** Efficient sampling from given finitely supported (nonzero, positive)\n      measures using the alias method. Measures need not be normalized on input,\n      but sampling proceeds from the normalized probability measure associated\n      to the given measure.\n  *)\n\n(** [Mass] is the module type describing the measure associated to points. *)\nmodule type Mass = sig\n  (** [t] is the type describing the measure associated to points. *)\n  type t\n\n  val encoding : t Data_encoding.t\n\n  val zero : t\n\n  val of_int : int -> t\n\n  val mul : t -> t -> t\n\n  val add : t -> t -> t\n\n  val sub : t -> t -> t\n\n  val ( = ) : t -> t -> bool\n\n  val ( <= ) : t -> t -> bool\n\n  val ( < ) : t -> t -> bool\nend\n\n(** [S] is the module type of a module allowing to construct samplers based\n    on the alias method. *)\nmodule type S = sig\n  (** [mass] is the type in which finite measures take their values\n        (see [Mass] module type). *)\n  type mass\n\n  (** ['a t] is the type of auxilliary data for sampling from\n          a given distribution. *)\n  type 'a t\n\n  (** [create measure] constructs auxilliary data to sample from\n          [measure] after normalization. Complexity: O(n).\n\n          It is assumed that the measure is positive. [measure] can contain\n          zero mass elements: those are removed in a pre-processing step.\n          The total mass of the measure should be strictly positive.\n\n          @raise Invalid_argument if [measure] contains negative mass elements\n          or if it contains only zero mass elements. *)\n  val create : ('a * mass) list -> 'a t\n\n  (** [sample auxdata rand] creates a sampler from [auxdata] that follows\n          the distribution associated to the measure specified when\n          creating the [auxdata]. The parameter [rand] is a random sampler\n          for the two random values used by the sampling method. The first\n          bound is at most the length of the list passed to [create] when\n          creating [auxdata]. The second bound is at most the sum of all\n          items in the list passed to [create]. *)\n  val sample : 'a t -> (int_bound:int -> mass_bound:mass -> int * mass) -> 'a\n\n  (** [encoding e] constructs an encoding for ['a t] given an encoding for ['a]. *)\n  val encoding : 'a Data_encoding.t -> 'a t Data_encoding.t\nend\n\n(**/**)\n\nmodule Internal_for_tests : sig\n  (** [Make(Mass)] instantiates a module allowing to creates\n      samplers for [Mass]-valued finite measures. *)\n  module Make : functor (Mass : Mass) -> S with type mass = Mass.t\nend\n\ninclude S with type mass = Int64.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(*\n\n   This module implements the alias method for sampling from a given\n   distribution. The distribution need not be normalized.\n\n*)\n\nmodule type Mass = sig\n  type t\n\n  val encoding : t Data_encoding.t\n\n  val zero : t\n\n  val of_int : int -> t\n\n  val mul : t -> t -> t\n\n  val add : t -> t -> t\n\n  val sub : t -> t -> t\n\n  val ( = ) : t -> t -> bool\n\n  val ( <= ) : t -> t -> bool\n\n  val ( < ) : t -> t -> bool\nend\n\nmodule type S = sig\n  type mass\n\n  type 'a t\n\n  val create : ('a * mass) list -> 'a t\n\n  val sample : 'a t -> (int_bound:int -> mass_bound:mass -> int * mass) -> 'a\n\n  val encoding : 'a Data_encoding.t -> 'a t Data_encoding.t\nend\n\nmodule Make (Mass : Mass) : S with type mass = Mass.t = struct\n  type mass = Mass.t\n\n  type 'a t = {\n    total : Mass.t;\n    support : 'a FallbackArray.t;\n    p : Mass.t FallbackArray.t;\n    alias : int FallbackArray.t;\n  }\n\n  let rec init_loop total p alias small large =\n    match (small, large) with\n    | ([], _) -> List.iter (fun (_, i) -> FallbackArray.set p i total) large\n    | (_, []) ->\n        (* This can only happen because of numerical inaccuracies when using\n           eg [Mass.t = float] *)\n        List.iter (fun (_, i) -> FallbackArray.set p i total) small\n    | ((qi, i) :: small', (qj, j) :: large') ->\n        FallbackArray.set p i qi ;\n        FallbackArray.set alias i j ;\n        let qj' = Mass.sub (Mass.add qi qj) total in\n        if Mass.(qj' < total) then\n          init_loop total p alias ((qj', j) :: small') large'\n        else init_loop total p alias small' ((qj', j) :: large')\n\n  let support :\n      fallback:'a -> length:int -> ('a * Mass.t) list -> 'a FallbackArray.t =\n   fun ~fallback ~length measure ->\n    let a = FallbackArray.make length fallback in\n    List.iteri (fun i (elt, _) -> FallbackArray.set a i elt) measure ;\n    a\n\n  let check_and_cleanup measure =\n    let (total, measure) =\n      List.fold_left\n        (fun ((total, m) as acc) ((_, p) as point) ->\n          if Mass.(zero < p) then (Mass.add total p, point :: m)\n          else if Mass.(p < zero) then invalid_arg \"create\"\n          else (* p = zero: drop point *)\n            acc)\n        (Mass.zero, [])\n        measure\n    in\n    match measure with\n    | [] -> invalid_arg \"create\"\n    | (fallback, _) :: _ -> (fallback, total, measure)\n\n  (* NB: duplicate elements in the support are not merged;\n     the algorithm should still function correctly. *)\n  let create (measure : ('a * Mass.t) list) =\n    let (fallback, total, measure) = check_and_cleanup measure in\n    let length = List.length measure in\n    let n = Mass.of_int length in\n    let (_, small, large) =\n      List.fold_left\n        (fun (i, small, large) (_, p) ->\n          let q = Mass.mul p n in\n          if Mass.(q < total) then (i + 1, (q, i) :: small, large)\n          else (i + 1, small, (q, i) :: large))\n        (0, [], [])\n        measure\n    in\n    let support = support ~fallback ~length measure in\n    let p = FallbackArray.make length total in\n    let alias = FallbackArray.make length (-1) in\n    init_loop total p alias small large ;\n    {total; support; p; alias}\n\n  let sample {total; support; p; alias} draw_i_elt =\n    let n = FallbackArray.length support in\n    let (i, elt) = draw_i_elt ~int_bound:n ~mass_bound:total in\n    let p = FallbackArray.get p i in\n    if Mass.(elt < p) then FallbackArray.get support i\n    else\n      let j = FallbackArray.get alias i in\n      assert (Compare.Int.(j >= 0)) ;\n      FallbackArray.get support j\n\n  (* Note: this could go in the environment maybe? *)\n  let array_encoding : 'a Data_encoding.t -> 'a FallbackArray.t Data_encoding.t\n      =\n   fun venc ->\n    let open Data_encoding in\n    conv\n      (fun array ->\n        let length = FallbackArray.length array in\n        let fallback = FallbackArray.fallback array in\n        let elements =\n          List.rev (FallbackArray.fold (fun acc elt -> elt :: acc) array [])\n        in\n        (length, fallback, elements))\n      (fun (length, fallback, elements) ->\n        let array = FallbackArray.make length fallback in\n        List.iteri (fun i elt -> FallbackArray.set array i elt) elements ;\n        array)\n      (obj3\n         (req \"length\" int31)\n         (req \"fallback\" venc)\n         (req \"elements\" (list venc)))\n\n  let mass_array_encoding = array_encoding Mass.encoding\n\n  let int_array_encoding = array_encoding Data_encoding.int31\n\n  let encoding enc =\n    let open Data_encoding in\n    conv\n      (fun {total; support; p; alias} -> (total, support, p, alias))\n      (fun (total, support, p, alias) -> {total; support; p; alias})\n      (obj4\n         (req \"total\" Mass.encoding)\n         (req \"support\" (array_encoding enc))\n         (req \"p\" mass_array_encoding)\n         (req \"alias\" int_array_encoding))\nend\n\nmodule Internal_for_tests = struct\n  module Make = Make\nend\n\nmodule Mass : Mass with type t = int64 = struct\n  type t = int64\n\n  let encoding = Data_encoding.int64\n\n  let zero = 0L\n\n  let of_int = Int64.of_int\n\n  let mul = Int64.mul\n\n  let add = Int64.add\n\n  let sub = Int64.sub\n\n  let ( = ) = Compare.Int64.( = )\n\n  let ( <= ) = Compare.Int64.( <= )\n\n  let ( < ) = Compare.Int64.( < )\nend\n\ninclude Make (Mass)\n" ;
                } ;
                { name = "Voting_period_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** The voting period kinds are ordered as follows:\n    Proposal -> Testing_vote -> Testing -> Promotion -> Adoption.\n    This order is the one used be the function [succ] below.\n *)\ntype kind =\n  | Proposal  (** protocols can be proposed *)\n  | Exploration  (** a proposal can be voted *)\n  | Cooldown  (** a delay before the second vote of the Promotion period. *)\n  | Promotion  (** activation can be voted *)\n  | Adoption  (** a delay before activation *)\n\nval kind_encoding : kind Data_encoding.t\n\n(** A voting period can be of several kinds and is uniquely identified by\n   the counter 'index'. The 'start_position' represents the relative\n   position of the first level of the period with respect to the\n   first level of the Alpha family of protocols. *)\ntype voting_period = {index : Int32.t; kind : kind; start_position : Int32.t}\n\ntype t = voting_period\n\n(** Information about a block with respect to the voting period it\n   belongs to: the voting period, the position within the voting\n   period and the number of remaining blocks till the end of the\n   period. The following invariant is satisfied:\n     `position + remaining + 1 = blocks_per_voting_period` *)\ntype info = {voting_period : t; position : Int32.t; remaining : Int32.t}\n\nval root : start_position:Int32.t -> t\n\ninclude Compare.S with type t := voting_period\n\nval encoding : t Data_encoding.t\n\nval info_encoding : info Data_encoding.t\n\nval pp : Format.formatter -> t -> unit\n\nval pp_info : Format.formatter -> info -> unit\n\nval pp_kind : Format.formatter -> kind -> unit\n\n(** [raw_reset period ~start_position] increment the index by one and set the\n    kind to Proposal which is the period kind that start the voting\n    process. [start_position] is the level at wich this voting_period started.\n*)\nval raw_reset : t -> start_position:Int32.t -> t\n\n(** [raw_succ period ~start_position] increment the index by one and set the\n    kind to its successor. [start_position] is the level at which this\n    voting_period started. *)\nval raw_succ : t -> start_position:Int32.t -> t\n\nval position_since : Level_repr.t -> t -> Int32.t\n\nval remaining_blocks :\n  Level_repr.t -> t -> blocks_per_voting_period:Int32.t -> Int32.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype kind = Proposal | Exploration | Cooldown | Promotion | Adoption\n\nlet string_of_kind = function\n  | Proposal -> \"proposal\"\n  | Exploration -> \"exploration\"\n  | Cooldown -> \"cooldown\"\n  | Promotion -> \"promotion\"\n  | Adoption -> \"adoption\"\n\nlet pp_kind ppf kind = Format.fprintf ppf \"%s\" @@ string_of_kind kind\n\nlet kind_encoding =\n  let open Data_encoding in\n  union\n    ~tag_size:`Uint8\n    [\n      case\n        (Tag 0)\n        ~title:\"Proposal\"\n        (constant \"proposal\")\n        (function Proposal -> Some () | _ -> None)\n        (fun () -> Proposal);\n      case\n        (Tag 1)\n        ~title:\"exploration\"\n        (constant \"exploration\")\n        (function Exploration -> Some () | _ -> None)\n        (fun () -> Exploration);\n      case\n        (Tag 2)\n        ~title:\"Cooldown\"\n        (constant \"cooldown\")\n        (function Cooldown -> Some () | _ -> None)\n        (fun () -> Cooldown);\n      case\n        (Tag 3)\n        ~title:\"Promotion\"\n        (constant \"promotion\")\n        (function Promotion -> Some () | _ -> None)\n        (fun () -> Promotion);\n      case\n        (Tag 4)\n        ~title:\"Adoption\"\n        (constant \"adoption\")\n        (function Adoption -> Some () | _ -> None)\n        (fun () -> Adoption);\n    ]\n\nlet succ_kind = function\n  | Proposal -> Exploration\n  | Exploration -> Cooldown\n  | Cooldown -> Promotion\n  | Promotion -> Adoption\n  | Adoption -> Proposal\n\ntype voting_period = {index : int32; kind : kind; start_position : int32}\n\ntype t = voting_period\n\ntype info = {voting_period : t; position : int32; remaining : int32}\n\nlet root ~start_position = {index = 0l; kind = Proposal; start_position}\n\nlet pp ppf {index; kind; start_position} =\n  Format.fprintf\n    ppf\n    \"@[<hv 2>index: %ld,@ kind:%a,@ start_position: %ld@]\"\n    index\n    pp_kind\n    kind\n    start_position\n\nlet pp_info ppf {voting_period; position; remaining} =\n  Format.fprintf\n    ppf\n    \"@[<hv 2>voting_period: %a,@ position:%ld,@ remaining: %ld@]\"\n    pp\n    voting_period\n    position\n    remaining\n\nlet encoding =\n  let open Data_encoding in\n  conv\n    (fun {index; kind; start_position} -> (index, kind, start_position))\n    (fun (index, kind, start_position) -> {index; kind; start_position})\n    (obj3\n       (req\n          \"index\"\n          ~description:\n            \"The voting period's index. Starts at 0 with the first block of \\\n             the Alpha family of protocols.\"\n          int32)\n       (req\n          ~description:\n            \"One of the several kinds of periods in the voting procedure.\"\n          \"kind\"\n          kind_encoding)\n       (req\n          ~description:\n            \"The relative position of the first level of the period with \\\n             respect to the first level of the Alpha family of protocols.\"\n          \"start_position\"\n          int32))\n\nlet info_encoding =\n  let open Data_encoding in\n  conv\n    (fun {voting_period; position; remaining} ->\n      (voting_period, position, remaining))\n    (fun (voting_period, position, remaining) ->\n      {voting_period; position; remaining})\n    (obj3\n       (req\n          ~description:\"The voting period to which the block belongs.\"\n          \"voting_period\"\n          encoding)\n       (req\n          ~description:\"The position of the block within the voting period.\"\n          \"position\"\n          int32)\n       (req\n          ~description:\n            \"The number of blocks remaining till the end of the voting period.\"\n          \"remaining\"\n          int32))\n\ninclude Compare.Make (struct\n  type nonrec t = t\n\n  let compare p p' = Compare.Int32.compare p.index p'.index\nend)\n\nlet raw_reset period ~start_position =\n  let index = Int32.succ period.index in\n  let kind = Proposal in\n  {index; kind; start_position}\n\nlet raw_succ period ~start_position =\n  let index = Int32.succ period.index in\n  let kind = succ_kind period.kind in\n  {index; kind; start_position}\n\nlet position_since (level : Level_repr.t) (voting_period : t) =\n  Int32.(sub level.level_position voting_period.start_position)\n\nlet remaining_blocks (level : Level_repr.t) (voting_period : t)\n    ~blocks_per_voting_period =\n  let position = position_since level voting_period in\n  Int32.(sub blocks_per_voting_period (succ position))\n" ;
                } ;
                { name = "Script_string_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Strings of printable characters *)\n\ntype t\n\ntype error += Non_printable_character of (int * string)\n\nval empty : t\n\nval of_string : string -> t tzresult\n\nval to_string : t -> string\n\nval compare : t -> t -> int\n\nval length : t -> int\n\nval concat_pair : t -> t -> t\n\nval concat : t list -> t\n\nval sub : t -> int -> int -> t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Strings of printable characters *)\n\ntype t = string (* Invariant: contains only printable characters *)\n\ntype error += Non_printable_character of (int * string)\n\nlet () =\n  let open Data_encoding in\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.non_printable_character\"\n    ~title:\"Non printable character in a Michelson string\"\n    ~description:\n      \"Michelson strings are only allowed to contain printable characters \\\n       (either the newline character or characters in the [32, 126] ASCII \\\n       range).\"\n    ~pp:(fun ppf (pos, s) ->\n      Format.fprintf\n        ppf\n        \"In Michelson string \\\"%s\\\", character at position %d has ASCII code \\\n         %d. Expected: either a newline character (ASCII code 10) or a \\\n         printable character (ASCII code between 32 and 126).\"\n        s\n        pos\n        (Char.code s.[pos]))\n    (obj2 (req \"position\" int31) (req \"string\" string))\n    (function Non_printable_character (pos, s) -> Some (pos, s) | _ -> None)\n    (fun (pos, s) -> Non_printable_character (pos, s))\n\nlet empty = \"\"\n\nlet of_string v =\n  let rec check_printable_ascii i =\n    if Compare.Int.(i < 0) then ok v\n    else\n      match v.[i] with\n      | '\\n' | '\\x20' .. '\\x7E' -> check_printable_ascii (i - 1)\n      | _ -> error @@ Non_printable_character (i, v)\n  in\n  check_printable_ascii (String.length v - 1)\n\nlet to_string s = s\n\nlet compare = Compare.String.compare\n\nlet length = String.length\n\nlet concat_pair x y = x ^ y\n\nlet concat l = String.concat \"\" l\n\nlet sub s offset length = String.sub s offset length\n" ;
                } ;
                { name = "Script_int_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** The types for arbitrary precision integers in Michelson.\n    The type variable ['t] is always [n] or [z],\n    [n num] and [z num] are incompatible.\n\n    This is internally a [Z.t].\n    This module mostly adds signedness preservation guarantees. *)\ntype 't num [@@coq_phantom]\n\n(** Flag for natural numbers. *)\ntype n = Natural_tag\n\n(** Flag for relative numbers. *)\ntype z = Integer_tag\n\n(** Natural zero. *)\nval zero_n : n num\n\n(** Natural one. *)\nval one_n : n num\n\n(** Natural successor.\n\n    [succ_n x] is the same as [add_n one_n].\n *)\nval succ_n : n num -> n num\n\n(** Relative zero. *)\nval zero : z num\n\n(** Compare two numbers as if they were *)\nval compare : 'a num -> 'a num -> int\n\n(** Conversion to an OCaml [string] in decimal notation. *)\nval to_string : _ num -> string\n\n(** Conversion from an OCaml [string].\n    Returns [None] in case of an invalid notation.\n    Supports [+] and [-] sign modifiers, and [0x], [0o] and [0b] base modifiers. *)\nval of_string : string -> z num option\n\n(** Conversion from an OCaml [int32]. *)\nval of_int32 : int32 -> z num\n\n(** Conversion to an OCaml [int64], returns [None] on overflow. *)\nval to_int64 : _ num -> int64 option\n\n(** Conversion from an OCaml [int64]. *)\nval of_int64 : int64 -> z num\n\n(** Conversion to an OCaml [int], returns [None] on overflow. *)\nval to_int : _ num -> int option\n\n(** Conversion from an OCaml [int]. *)\nval of_int : int -> z num\n\n(** Conversion from a Zarith integer ([Z.t]). *)\nval of_zint : Z.t -> z num\n\n(** Conversion to a Zarith integer ([Z.t]). *)\nval to_zint : 'a num -> Z.t\n\n(** Addition between naturals. *)\nval add_n : n num -> n num -> n num\n\n(** Multiplication with a natural. *)\nval mul_n : n num -> 'a num -> 'a num\n\n(** Euclidean division of a natural.\n    [ediv_n n d] returns [None] if divisor is zero,\n    or [Some (q, r)] where [n = d * q + r] and [[0 <= r < d]] otherwise. *)\nval ediv_n : n num -> 'a num -> ('a num * n num) option\n\n(** Sign agnostic addition.\n    Use {!add_n} when working with naturals to preserve the sign. *)\nval add : _ num -> _ num -> z num\n\n(** Sign agnostic subtraction.\n    Use {!sub_n} when working with naturals to preserve the sign. *)\nval sub : _ num -> _ num -> z num\n\n(** Sign agnostic multiplication.\n    Use {!mul_n} when working with a natural to preserve the sign. *)\nval mul : _ num -> _ num -> z num\n\n(** Sign agnostic euclidean division.\n    [ediv n d] returns [None] if divisor is zero,\n    or [Some (q, r)] where [n = d * q + r] and [[0 <= r < |d|]] otherwise.\n    Use {!ediv_n} when working with a natural to preserve the sign. *)\nval ediv : _ num -> _ num -> (z num * n num) option\n\n(** Compute the absolute value of a relative, turning it into a natural. *)\nval abs : z num -> n num\n\n(** Partial identity over [N]. *)\nval is_nat : z num -> n num option\n\n(** Negates a number. *)\nval neg : _ num -> z num\n\n(** Turns a natural into a relative, not changing its value. *)\nval int : n num -> z num\n\n(** Reverses each bit in the representation of the number.\n    Also applies to the sign. *)\nval lognot : _ num -> z num\n\n(** Shifts the natural to the left of a number of bits between 0 and 256.\n    Returns [None] if the amount is too high. *)\nval shift_left_n : n num -> n num -> n num option\n\n(** Shifts the natural to the right of a number of bits between 0 and 256.\n    Returns [None] if the amount is too high. *)\nval shift_right_n : n num -> n num -> n num option\n\n(** Shifts the number to the left of a number of bits between 0 and 256.\n    Returns [None] if the amount is too high. *)\nval shift_left : 'a num -> n num -> 'a num option\n\n(** Shifts the number to the right of a number of bits between 0 and 256.\n    Returns [None] if the amount is too high. *)\nval shift_right : 'a num -> n num -> 'a num option\n\n(** Applies a boolean or operation to each bit. *)\nval logor : 'a num -> 'a num -> 'a num\n\n(** Applies a boolean and operation to each bit. *)\nval logand : _ num -> n num -> n num\n\n(** Applies a boolean xor operation to each bit. *)\nval logxor : n num -> n num -> n num\n\n(** Naturals are encoded using Data_encoding.n *)\nval n_encoding : n num Data_encoding.encoding\n\n(** Integers are encoded using Data_encoding.z *)\nval z_encoding : z num Data_encoding.encoding\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype n = Natural_tag\n\ntype z = Integer_tag\n\n(* We could define `num` as a GADT with constructors for `n` and `z`.\n  This would enable factorizing the code a bit in the Michelson interpreter and\n  also make formal the claim that `num` is only instantiated with `n` and `z`,\n  but it would result in space and time overheads when manipulating `num`s, by\n  having to deconstruct to and reconstruct from `Z.t`. *)\ntype 't num = Z.t\n\nlet compare x y = Z.compare x y\n\nlet zero = Z.zero\n\nlet zero_n = Z.zero\n\nlet one_n = Z.one\n\nlet to_string x = Z.to_string x\n\nlet of_string s = Option.catch (fun () -> Z.of_string s)\n\nlet of_int32 n = Z.of_int64 @@ Int64.of_int32 n\n\nlet to_int64 x = Option.catch (fun () -> Z.to_int64 x)\n\nlet of_int64 n = Z.of_int64 n\n\nlet to_int x = Option.catch (fun () -> Z.to_int x)\n\nlet of_int n = Z.of_int n\n\nlet of_zint x = x\n\nlet to_zint x = x\n\nlet add x y = Z.add x y\n\nlet sub x y = Z.sub x y\n\nlet mul x y = Z.mul x y\n\nlet ediv x y = Option.catch (fun () -> Z.ediv_rem x y)\n\nlet add_n = add\n\nlet succ_n = Z.succ\n\nlet mul_n = mul\n\nlet ediv_n = ediv\n\nlet abs x = Z.abs x\n\nlet is_nat x = if Compare.Z.(x < Z.zero) then None else Some x\n\nlet neg x = Z.neg x\n\nlet int x = x\n\nlet shift_left x y =\n  if Compare.Int.(Z.compare y (Z.of_int 256) > 0) then None\n  else\n    let y = Z.to_int y in\n    Some (Z.shift_left x y)\n\nlet shift_right x y =\n  if Compare.Int.(Z.compare y (Z.of_int 256) > 0) then None\n  else\n    let y = Z.to_int y in\n    Some (Z.shift_right x y)\n\nlet shift_left_n = shift_left\n\nlet shift_right_n = shift_right\n\nlet logor x y = Z.logor x y\n\nlet logxor x y = Z.logxor x y\n\nlet logand x y = Z.logand x y\n\nlet lognot x = Z.lognot x\n\nlet z_encoding : z num Data_encoding.encoding = Data_encoding.z\n\nlet n_encoding : n num Data_encoding.encoding = Data_encoding.n\n" ;
                } ;
                { name = "Script_timestamp_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Defines the internal Michelson representation for timestamps and basic\n    operations that can be performed on it. *)\n\nopen Script_int_repr\n\n(** Representation of timestamps specific to the Michelson interpreter.\n    A number of seconds since the epoch. *)\ntype t\n\n(** Convert a number of seconds since the epoch to a timestamp.*)\nval of_int64 : int64 -> t\n\n(** Compare timestamps. Returns [1] if the first timestamp is later than the\n    second one; [0] if they're equal and [-1] othwerwise. *)\nval compare : t -> t -> int\n\n(** Convert a timestamp to RFC3339 notation if possible **)\nval to_notation : t -> string option\n\n(** Convert a timestamp to a string representation of the seconds *)\nval to_num_str : t -> string\n\n(** Convert to RFC3339 notation if possible, or num if not *)\nval to_string : t -> string\n\nval of_string : string -> t option\n\n(** Returns difference between timestamps as integral number of seconds\n    in Michelson representation of numbers. *)\nval diff : t -> t -> z num\n\n(** Add a number of seconds to the timestamp. *)\nval add_delta : t -> z num -> t\n\n(** Subtract a number of seconds from the timestamp. *)\nval sub_delta : t -> z num -> t\n\nval to_zint : t -> Z.t\n\nval of_zint : Z.t -> t\n\n(* Timestamps are encoded exactly as Z. *)\nval encoding : t Data_encoding.encoding\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype t = Z.t\n\nlet compare = Z.compare\n\nlet of_int64 = Z.of_int64\n\nlet of_string x =\n  match Time_repr.of_notation x with\n  | None -> Option.catch (fun () -> Z.of_string x)\n  | Some time -> Some (of_int64 (Time_repr.to_seconds time))\n\nlet to_notation x =\n  Option.catch (fun () ->\n      Time_repr.to_notation (Time.of_seconds (Z.to_int64 x)))\n\nlet to_num_str = Z.to_string\n\nlet to_string x = match to_notation x with None -> to_num_str x | Some s -> s\n\nlet diff x y = Script_int_repr.of_zint @@ Z.sub x y\n\nlet sub_delta t delta = Z.sub t (Script_int_repr.to_zint delta)\n\nlet add_delta t delta = Z.add t (Script_int_repr.to_zint delta)\n\nlet to_zint x = x\n\nlet of_zint x = x\n\nlet encoding : t Data_encoding.encoding = Data_encoding.z\n" ;
                } ;
                { name = "Michelson_v1_primitives" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype error += (* `Permanent *) Unknown_primitive_name of string\n\ntype error += (* `Permanent *) Invalid_case of string\n\ntype error +=\n  | (* `Permanent *)\n      Invalid_primitive_name of\n      string Micheline.canonical * Micheline.canonical_location\n\n(** Types of nodes in Michelson's AST. They fall into 4 categories:\n    - types (prefixed with [T_]);\n    - constants (prefixed with [D_]);\n    - instructions (prefixed with [I_]);\n    - keywords (prefixed with [K_]).\n\n    Recall that Micheline is essentially just S-expressions with\n    a few extra atom types for strings and numbers. This variant\n    represents the values the [Prim] atoms in the Michelson subset\n    of Micheline. Other types (such as ['a Micheline.canonical]) are\n    frequently parameterized by this type. This gives us a strongly-typed \n    subset of Micheline while keeping the set of primitives independent\n    from the definition of Micheline for easier changes.\n*)\ntype prim =\n  | K_parameter\n  | K_storage\n  | K_code\n  | K_view\n  | D_False\n  | D_Elt\n  | D_Left\n  | D_None\n  | D_Pair\n  | D_Right\n  | D_Some\n  | D_True\n  | D_Unit\n  | I_PACK\n  | I_UNPACK\n  | I_BLAKE2B\n  | I_SHA256\n  | I_SHA512\n  | I_ABS\n  | I_ADD\n  | I_AMOUNT\n  | I_AND\n  | I_BALANCE\n  | I_CAR\n  | I_CDR\n  | I_CHAIN_ID\n  | I_CHECK_SIGNATURE\n  | I_COMPARE\n  | I_CONCAT\n  | I_CONS\n  | I_CREATE_ACCOUNT\n  | I_CREATE_CONTRACT\n  | I_IMPLICIT_ACCOUNT\n  | I_DIP\n  | I_DROP\n  | I_DUP\n  | I_VIEW\n  | I_EDIV\n  | I_EMPTY_BIG_MAP\n  | I_EMPTY_MAP\n  | I_EMPTY_SET\n  | I_EQ\n  | I_EXEC\n  | I_APPLY\n  | I_FAILWITH\n  | I_GE\n  | I_GET\n  | I_GET_AND_UPDATE\n  | I_GT\n  | I_HASH_KEY\n  | I_IF\n  | I_IF_CONS\n  | I_IF_LEFT\n  | I_IF_NONE\n  | I_INT\n  | I_LAMBDA\n  | I_LE\n  | I_LEFT\n  | I_LEVEL\n  | I_LOOP\n  | I_LSL\n  | I_LSR\n  | I_LT\n  | I_MAP\n  | I_MEM\n  | I_MUL\n  | I_NEG\n  | I_NEQ\n  | I_NIL\n  | I_NONE\n  | I_NOT\n  | I_NOW\n  | I_OR\n  | I_PAIR\n  | I_UNPAIR\n  | I_PUSH\n  | I_RIGHT\n  | I_SIZE\n  | I_SOME\n  | I_SOURCE\n  | I_SENDER\n  | I_SELF\n  | I_SELF_ADDRESS\n  | I_SLICE\n  | I_STEPS_TO_QUOTA\n  | I_SUB\n  | I_SUB_MUTEZ\n  | I_SWAP\n  | I_TRANSFER_TOKENS\n  | I_SET_DELEGATE\n  | I_UNIT\n  | I_UPDATE\n  | I_XOR\n  | I_ITER\n  | I_LOOP_LEFT\n  | I_ADDRESS\n  | I_CONTRACT\n  | I_ISNAT\n  | I_CAST\n  | I_RENAME\n  | I_SAPLING_EMPTY_STATE\n  | I_SAPLING_VERIFY_UPDATE\n  | I_DIG\n  | I_DUG\n  | I_NEVER\n  | I_VOTING_POWER\n  | I_TOTAL_VOTING_POWER\n  | I_KECCAK\n  | I_SHA3\n  | I_PAIRING_CHECK\n  | I_TICKET\n  | I_READ_TICKET\n  | I_SPLIT_TICKET\n  | I_JOIN_TICKETS\n  | I_OPEN_CHEST\n  | T_bool\n  | T_contract\n  | T_int\n  | T_key\n  | T_key_hash\n  | T_lambda\n  | T_list\n  | T_map\n  | T_big_map\n  | T_nat\n  | T_option\n  | T_or\n  | T_pair\n  | T_set\n  | T_signature\n  | T_string\n  | T_bytes\n  | T_mutez\n  | T_timestamp\n  | T_unit\n  | T_operation\n  | T_address\n  | T_sapling_transaction\n  | T_sapling_state\n  | T_chain_id\n  | T_never\n  | T_bls12_381_g1\n  | T_bls12_381_g2\n  | T_bls12_381_fr\n  | T_ticket\n  | T_chest_key\n  | T_chest\n  (* See the interface of [Global_constants_storage]. *)\n  | H_constant\n\n(** Auxiliary types for error documentation.\n    All the prim constructor prefixes must match their namespace. *)\n\ntype namespace =\n  | (* prefix \"T\" *) Type_namespace\n  | (* prefix \"D\" *) Constant_namespace\n  | (* prefix \"I\" *) Instr_namespace\n  | (* prefix \"K\" *) Keyword_namespace\n  (* The Constant Hash namespace is a singleton reserved\n     for the constant keyword. Unlike other primitives,\n     constants have no representation in the typed IR,\n     being fully expanded away before typechecking. *)\n  | (* prefix \"H\" *) Constant_hash_namespace\n\nval namespace : prim -> namespace\n\nval prim_encoding : prim Data_encoding.encoding\n\nval string_of_prim : prim -> string\n\nval prim_of_string : string -> prim tzresult\n\nval prims_of_strings :\n  string Micheline.canonical -> prim Micheline.canonical tzresult\n\nval strings_of_prims : prim Micheline.canonical -> string Micheline.canonical\n\n(** The string corresponds to the constructor prefix from the given namespace\n    (i.e. \"T\", \"D\", \"I\" or \"K\") *)\nval string_of_namespace : namespace -> string\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Micheline\n\ntype error += Unknown_primitive_name of string\n\ntype error += Invalid_case of string\n\ntype error +=\n  | Invalid_primitive_name of\n      string Micheline.canonical * Micheline.canonical_location\n\ntype prim =\n  | K_parameter\n  | K_storage\n  | K_code\n  | K_view\n  | D_False\n  | D_Elt\n  | D_Left\n  | D_None\n  | D_Pair\n  | D_Right\n  | D_Some\n  | D_True\n  | D_Unit\n  | I_PACK\n  | I_UNPACK\n  | I_BLAKE2B\n  | I_SHA256\n  | I_SHA512\n  | I_ABS\n  | I_ADD\n  | I_AMOUNT\n  | I_AND\n  | I_BALANCE\n  | I_CAR\n  | I_CDR\n  | I_CHAIN_ID\n  | I_CHECK_SIGNATURE\n  | I_COMPARE\n  | I_CONCAT\n  | I_CONS\n  | I_CREATE_ACCOUNT\n  | I_CREATE_CONTRACT\n  | I_IMPLICIT_ACCOUNT\n  | I_DIP\n  | I_DROP\n  | I_DUP\n  | I_VIEW\n  | I_EDIV\n  | I_EMPTY_BIG_MAP\n  | I_EMPTY_MAP\n  | I_EMPTY_SET\n  | I_EQ\n  | I_EXEC\n  | I_APPLY\n  | I_FAILWITH\n  | I_GE\n  | I_GET\n  | I_GET_AND_UPDATE\n  | I_GT\n  | I_HASH_KEY\n  | I_IF\n  | I_IF_CONS\n  | I_IF_LEFT\n  | I_IF_NONE\n  | I_INT\n  | I_LAMBDA\n  | I_LE\n  | I_LEFT\n  | I_LEVEL\n  | I_LOOP\n  | I_LSL\n  | I_LSR\n  | I_LT\n  | I_MAP\n  | I_MEM\n  | I_MUL\n  | I_NEG\n  | I_NEQ\n  | I_NIL\n  | I_NONE\n  | I_NOT\n  | I_NOW\n  | I_OR\n  | I_PAIR\n  | I_UNPAIR\n  | I_PUSH\n  | I_RIGHT\n  | I_SIZE\n  | I_SOME\n  | I_SOURCE\n  | I_SENDER\n  | I_SELF\n  | I_SELF_ADDRESS\n  | I_SLICE\n  | I_STEPS_TO_QUOTA\n  | I_SUB\n  | I_SUB_MUTEZ\n  | I_SWAP\n  | I_TRANSFER_TOKENS\n  | I_SET_DELEGATE\n  | I_UNIT\n  | I_UPDATE\n  | I_XOR\n  | I_ITER\n  | I_LOOP_LEFT\n  | I_ADDRESS\n  | I_CONTRACT\n  | I_ISNAT\n  | I_CAST\n  | I_RENAME\n  | I_SAPLING_EMPTY_STATE\n  | I_SAPLING_VERIFY_UPDATE\n  | I_DIG\n  | I_DUG\n  | I_NEVER\n  | I_VOTING_POWER\n  | I_TOTAL_VOTING_POWER\n  | I_KECCAK\n  | I_SHA3\n  | I_PAIRING_CHECK\n  | I_TICKET\n  | I_READ_TICKET\n  | I_SPLIT_TICKET\n  | I_JOIN_TICKETS\n  | I_OPEN_CHEST\n  | T_bool\n  | T_contract\n  | T_int\n  | T_key\n  | T_key_hash\n  | T_lambda\n  | T_list\n  | T_map\n  | T_big_map\n  | T_nat\n  | T_option\n  | T_or\n  | T_pair\n  | T_set\n  | T_signature\n  | T_string\n  | T_bytes\n  | T_mutez\n  | T_timestamp\n  | T_unit\n  | T_operation\n  | T_address\n  | T_sapling_transaction\n  | T_sapling_state\n  | T_chain_id\n  | T_never\n  | T_bls12_381_g1\n  | T_bls12_381_g2\n  | T_bls12_381_fr\n  | T_ticket\n  | T_chest_key\n  | T_chest\n  | H_constant\n\n(* Auxiliary types for error documentation.\n   All the prim constructor prefixes must match their namespace. *)\ntype namespace =\n  | (* prefix \"T\" *) Type_namespace\n  | (* prefix \"D\" *) Constant_namespace\n  | (* prefix \"I\" *) Instr_namespace\n  | (* prefix \"K\" *) Keyword_namespace\n  | (* prefix \"H\" *) Constant_hash_namespace\n\nlet namespace = function\n  | K_code | K_view | K_parameter | K_storage -> Keyword_namespace\n  | D_Elt | D_False | D_Left | D_None | D_Pair | D_Right | D_Some | D_True\n  | D_Unit ->\n      Constant_namespace\n  | I_ABS | I_ADD | I_ADDRESS | I_AMOUNT | I_AND | I_APPLY | I_BALANCE\n  | I_BLAKE2B | I_CAR | I_CAST | I_CDR | I_CHAIN_ID | I_CHECK_SIGNATURE\n  | I_COMPARE | I_CONCAT | I_CONS | I_CONTRACT | I_CREATE_ACCOUNT\n  | I_CREATE_CONTRACT | I_DIG | I_DIP | I_DROP | I_DUG | I_DUP | I_VIEW | I_EDIV\n  | I_EMPTY_BIG_MAP | I_EMPTY_MAP | I_EMPTY_SET | I_EQ | I_EXEC | I_FAILWITH\n  | I_GE | I_GET | I_GET_AND_UPDATE | I_GT | I_HASH_KEY | I_IF | I_IF_CONS\n  | I_IF_LEFT | I_IF_NONE | I_IMPLICIT_ACCOUNT | I_INT | I_ISNAT | I_ITER\n  | I_JOIN_TICKETS | I_KECCAK | I_LAMBDA | I_LE | I_LEFT | I_LEVEL | I_LOOP\n  | I_LOOP_LEFT | I_LSL | I_LSR | I_LT | I_MAP | I_MEM | I_MUL | I_NEG | I_NEQ\n  | I_NEVER | I_NIL | I_NONE | I_NOT | I_NOW | I_OR | I_PACK | I_PAIR\n  | I_PAIRING_CHECK | I_PUSH | I_READ_TICKET | I_RENAME | I_RIGHT\n  | I_SAPLING_EMPTY_STATE | I_SAPLING_VERIFY_UPDATE | I_SELF | I_SELF_ADDRESS\n  | I_SENDER | I_SET_DELEGATE | I_SHA256 | I_SHA512 | I_SHA3 | I_SIZE | I_SLICE\n  | I_SOME | I_SOURCE | I_SPLIT_TICKET | I_STEPS_TO_QUOTA | I_SUB | I_SUB_MUTEZ\n  | I_SWAP | I_TICKET | I_TOTAL_VOTING_POWER | I_TRANSFER_TOKENS | I_UNIT\n  | I_UNPACK | I_UNPAIR | I_UPDATE | I_VOTING_POWER | I_XOR | I_OPEN_CHEST ->\n      Instr_namespace\n  | T_address | T_big_map | T_bool | T_bytes | T_chain_id | T_contract | T_int\n  | T_key | T_key_hash | T_lambda | T_list | T_map | T_mutez | T_nat | T_never\n  | T_operation | T_option | T_or | T_pair | T_sapling_state\n  | T_sapling_transaction | T_set | T_signature | T_string | T_timestamp\n  | T_unit | T_bls12_381_fr | T_bls12_381_g1 | T_bls12_381_g2 | T_ticket\n  | T_chest_key | T_chest ->\n      Type_namespace\n  | H_constant -> Constant_hash_namespace\n\nlet valid_case name =\n  let is_lower = function '_' | 'a' .. 'z' -> true | _ -> false in\n  let is_upper = function '_' | 'A' .. 'Z' -> true | _ -> false in\n  let[@coq_struct \"a_value\"] rec for_all a b f =\n    Compare.Int.(a > b) || (f a && for_all (a + 1) b f)\n  in\n  let len = String.length name in\n  Compare.Int.(len <> 0)\n  && Compare.Char.(name.[0] <> '_')\n  && ((is_upper name.[0] && for_all 1 (len - 1) (fun i -> is_upper name.[i]))\n     || (is_upper name.[0] && for_all 1 (len - 1) (fun i -> is_lower name.[i]))\n     || (is_lower name.[0] && for_all 1 (len - 1) (fun i -> is_lower name.[i]))\n     )\n\nlet string_of_prim = function\n  | K_parameter -> \"parameter\"\n  | K_storage -> \"storage\"\n  | K_code -> \"code\"\n  | K_view -> \"view\"\n  | D_False -> \"False\"\n  | D_Elt -> \"Elt\"\n  | D_Left -> \"Left\"\n  | D_None -> \"None\"\n  | D_Pair -> \"Pair\"\n  | D_Right -> \"Right\"\n  | D_Some -> \"Some\"\n  | D_True -> \"True\"\n  | D_Unit -> \"Unit\"\n  | I_PACK -> \"PACK\"\n  | I_UNPACK -> \"UNPACK\"\n  | I_BLAKE2B -> \"BLAKE2B\"\n  | I_SHA256 -> \"SHA256\"\n  | I_SHA512 -> \"SHA512\"\n  | I_ABS -> \"ABS\"\n  | I_ADD -> \"ADD\"\n  | I_AMOUNT -> \"AMOUNT\"\n  | I_AND -> \"AND\"\n  | I_BALANCE -> \"BALANCE\"\n  | I_CAR -> \"CAR\"\n  | I_CDR -> \"CDR\"\n  | I_CHAIN_ID -> \"CHAIN_ID\"\n  | I_CHECK_SIGNATURE -> \"CHECK_SIGNATURE\"\n  | I_COMPARE -> \"COMPARE\"\n  | I_CONCAT -> \"CONCAT\"\n  | I_CONS -> \"CONS\"\n  | I_CREATE_ACCOUNT -> \"CREATE_ACCOUNT\"\n  | I_CREATE_CONTRACT -> \"CREATE_CONTRACT\"\n  | I_IMPLICIT_ACCOUNT -> \"IMPLICIT_ACCOUNT\"\n  | I_DIP -> \"DIP\"\n  | I_DROP -> \"DROP\"\n  | I_DUP -> \"DUP\"\n  | I_EDIV -> \"EDIV\"\n  | I_EMPTY_BIG_MAP -> \"EMPTY_BIG_MAP\"\n  | I_EMPTY_MAP -> \"EMPTY_MAP\"\n  | I_EMPTY_SET -> \"EMPTY_SET\"\n  | I_EQ -> \"EQ\"\n  | I_EXEC -> \"EXEC\"\n  | I_APPLY -> \"APPLY\"\n  | I_FAILWITH -> \"FAILWITH\"\n  | I_GE -> \"GE\"\n  | I_GET -> \"GET\"\n  | I_GET_AND_UPDATE -> \"GET_AND_UPDATE\"\n  | I_GT -> \"GT\"\n  | I_HASH_KEY -> \"HASH_KEY\"\n  | I_IF -> \"IF\"\n  | I_IF_CONS -> \"IF_CONS\"\n  | I_IF_LEFT -> \"IF_LEFT\"\n  | I_IF_NONE -> \"IF_NONE\"\n  | I_INT -> \"INT\"\n  | I_LAMBDA -> \"LAMBDA\"\n  | I_LE -> \"LE\"\n  | I_LEFT -> \"LEFT\"\n  | I_LEVEL -> \"LEVEL\"\n  | I_LOOP -> \"LOOP\"\n  | I_LSL -> \"LSL\"\n  | I_LSR -> \"LSR\"\n  | I_LT -> \"LT\"\n  | I_MAP -> \"MAP\"\n  | I_MEM -> \"MEM\"\n  | I_MUL -> \"MUL\"\n  | I_NEG -> \"NEG\"\n  | I_NEQ -> \"NEQ\"\n  | I_NIL -> \"NIL\"\n  | I_NONE -> \"NONE\"\n  | I_NOT -> \"NOT\"\n  | I_NOW -> \"NOW\"\n  | I_OR -> \"OR\"\n  | I_PAIR -> \"PAIR\"\n  | I_PUSH -> \"PUSH\"\n  | I_RIGHT -> \"RIGHT\"\n  | I_SIZE -> \"SIZE\"\n  | I_SOME -> \"SOME\"\n  | I_SOURCE -> \"SOURCE\"\n  | I_SENDER -> \"SENDER\"\n  | I_SELF -> \"SELF\"\n  | I_SELF_ADDRESS -> \"SELF_ADDRESS\"\n  | I_SLICE -> \"SLICE\"\n  | I_STEPS_TO_QUOTA -> \"STEPS_TO_QUOTA\"\n  | I_SUB -> \"SUB\"\n  | I_SUB_MUTEZ -> \"SUB_MUTEZ\"\n  | I_SWAP -> \"SWAP\"\n  | I_TRANSFER_TOKENS -> \"TRANSFER_TOKENS\"\n  | I_SET_DELEGATE -> \"SET_DELEGATE\"\n  | I_UNIT -> \"UNIT\"\n  | I_UNPAIR -> \"UNPAIR\"\n  | I_UPDATE -> \"UPDATE\"\n  | I_XOR -> \"XOR\"\n  | I_ITER -> \"ITER\"\n  | I_LOOP_LEFT -> \"LOOP_LEFT\"\n  | I_ADDRESS -> \"ADDRESS\"\n  | I_CONTRACT -> \"CONTRACT\"\n  | I_ISNAT -> \"ISNAT\"\n  | I_CAST -> \"CAST\"\n  | I_RENAME -> \"RENAME\"\n  | I_SAPLING_EMPTY_STATE -> \"SAPLING_EMPTY_STATE\"\n  | I_SAPLING_VERIFY_UPDATE -> \"SAPLING_VERIFY_UPDATE\"\n  | I_DIG -> \"DIG\"\n  | I_DUG -> \"DUG\"\n  | I_NEVER -> \"NEVER\"\n  | I_VOTING_POWER -> \"VOTING_POWER\"\n  | I_TOTAL_VOTING_POWER -> \"TOTAL_VOTING_POWER\"\n  | I_KECCAK -> \"KECCAK\"\n  | I_SHA3 -> \"SHA3\"\n  | I_PAIRING_CHECK -> \"PAIRING_CHECK\"\n  | I_TICKET -> \"TICKET\"\n  | I_READ_TICKET -> \"READ_TICKET\"\n  | I_SPLIT_TICKET -> \"SPLIT_TICKET\"\n  | I_JOIN_TICKETS -> \"JOIN_TICKETS\"\n  | I_OPEN_CHEST -> \"OPEN_CHEST\"\n  | I_VIEW -> \"VIEW\"\n  | T_bool -> \"bool\"\n  | T_contract -> \"contract\"\n  | T_int -> \"int\"\n  | T_key -> \"key\"\n  | T_key_hash -> \"key_hash\"\n  | T_lambda -> \"lambda\"\n  | T_list -> \"list\"\n  | T_map -> \"map\"\n  | T_big_map -> \"big_map\"\n  | T_nat -> \"nat\"\n  | T_option -> \"option\"\n  | T_or -> \"or\"\n  | T_pair -> \"pair\"\n  | T_set -> \"set\"\n  | T_signature -> \"signature\"\n  | T_string -> \"string\"\n  | T_bytes -> \"bytes\"\n  | T_mutez -> \"mutez\"\n  | T_timestamp -> \"timestamp\"\n  | T_unit -> \"unit\"\n  | T_operation -> \"operation\"\n  | T_address -> \"address\"\n  | T_sapling_state -> \"sapling_state\"\n  | T_sapling_transaction -> \"sapling_transaction\"\n  | T_chain_id -> \"chain_id\"\n  | T_never -> \"never\"\n  | T_bls12_381_g1 -> \"bls12_381_g1\"\n  | T_bls12_381_g2 -> \"bls12_381_g2\"\n  | T_bls12_381_fr -> \"bls12_381_fr\"\n  | T_ticket -> \"ticket\"\n  | T_chest_key -> \"chest_key\"\n  | T_chest -> \"chest\"\n  | H_constant -> \"constant\"\n\nlet prim_of_string = function\n  | \"parameter\" -> ok K_parameter\n  | \"storage\" -> ok K_storage\n  | \"code\" -> ok K_code\n  | \"view\" -> ok K_view\n  | \"False\" -> ok D_False\n  | \"Elt\" -> ok D_Elt\n  | \"Left\" -> ok D_Left\n  | \"None\" -> ok D_None\n  | \"Pair\" -> ok D_Pair\n  | \"Right\" -> ok D_Right\n  | \"Some\" -> ok D_Some\n  | \"True\" -> ok D_True\n  | \"Unit\" -> ok D_Unit\n  | \"PACK\" -> ok I_PACK\n  | \"UNPACK\" -> ok I_UNPACK\n  | \"BLAKE2B\" -> ok I_BLAKE2B\n  | \"SHA256\" -> ok I_SHA256\n  | \"SHA512\" -> ok I_SHA512\n  | \"ABS\" -> ok I_ABS\n  | \"ADD\" -> ok I_ADD\n  | \"AMOUNT\" -> ok I_AMOUNT\n  | \"AND\" -> ok I_AND\n  | \"BALANCE\" -> ok I_BALANCE\n  | \"CAR\" -> ok I_CAR\n  | \"CDR\" -> ok I_CDR\n  | \"CHAIN_ID\" -> ok I_CHAIN_ID\n  | \"CHECK_SIGNATURE\" -> ok I_CHECK_SIGNATURE\n  | \"COMPARE\" -> ok I_COMPARE\n  | \"CONCAT\" -> ok I_CONCAT\n  | \"CONS\" -> ok I_CONS\n  | \"CREATE_ACCOUNT\" -> ok I_CREATE_ACCOUNT\n  | \"CREATE_CONTRACT\" -> ok I_CREATE_CONTRACT\n  | \"IMPLICIT_ACCOUNT\" -> ok I_IMPLICIT_ACCOUNT\n  | \"DIP\" -> ok I_DIP\n  | \"DROP\" -> ok I_DROP\n  | \"DUP\" -> ok I_DUP\n  | \"VIEW\" -> ok I_VIEW\n  | \"EDIV\" -> ok I_EDIV\n  | \"EMPTY_BIG_MAP\" -> ok I_EMPTY_BIG_MAP\n  | \"EMPTY_MAP\" -> ok I_EMPTY_MAP\n  | \"EMPTY_SET\" -> ok I_EMPTY_SET\n  | \"EQ\" -> ok I_EQ\n  | \"EXEC\" -> ok I_EXEC\n  | \"APPLY\" -> ok I_APPLY\n  | \"FAILWITH\" -> ok I_FAILWITH\n  | \"GE\" -> ok I_GE\n  | \"GET\" -> ok I_GET\n  | \"GET_AND_UPDATE\" -> ok I_GET_AND_UPDATE\n  | \"GT\" -> ok I_GT\n  | \"HASH_KEY\" -> ok I_HASH_KEY\n  | \"IF\" -> ok I_IF\n  | \"IF_CONS\" -> ok I_IF_CONS\n  | \"IF_LEFT\" -> ok I_IF_LEFT\n  | \"IF_NONE\" -> ok I_IF_NONE\n  | \"INT\" -> ok I_INT\n  | \"KECCAK\" -> ok I_KECCAK\n  | \"LAMBDA\" -> ok I_LAMBDA\n  | \"LE\" -> ok I_LE\n  | \"LEFT\" -> ok I_LEFT\n  | \"LEVEL\" -> ok I_LEVEL\n  | \"LOOP\" -> ok I_LOOP\n  | \"LSL\" -> ok I_LSL\n  | \"LSR\" -> ok I_LSR\n  | \"LT\" -> ok I_LT\n  | \"MAP\" -> ok I_MAP\n  | \"MEM\" -> ok I_MEM\n  | \"MUL\" -> ok I_MUL\n  | \"NEG\" -> ok I_NEG\n  | \"NEQ\" -> ok I_NEQ\n  | \"NIL\" -> ok I_NIL\n  | \"NONE\" -> ok I_NONE\n  | \"NOT\" -> ok I_NOT\n  | \"NOW\" -> ok I_NOW\n  | \"OR\" -> ok I_OR\n  | \"PAIR\" -> ok I_PAIR\n  | \"UNPAIR\" -> ok I_UNPAIR\n  | \"PAIRING_CHECK\" -> ok I_PAIRING_CHECK\n  | \"PUSH\" -> ok I_PUSH\n  | \"RIGHT\" -> ok I_RIGHT\n  | \"SHA3\" -> ok I_SHA3\n  | \"SIZE\" -> ok I_SIZE\n  | \"SOME\" -> ok I_SOME\n  | \"SOURCE\" -> ok I_SOURCE\n  | \"SENDER\" -> ok I_SENDER\n  | \"SELF\" -> ok I_SELF\n  | \"SELF_ADDRESS\" -> ok I_SELF_ADDRESS\n  | \"SLICE\" -> ok I_SLICE\n  | \"STEPS_TO_QUOTA\" -> ok I_STEPS_TO_QUOTA\n  | \"SUB\" -> ok I_SUB\n  | \"SUB_MUTEZ\" -> ok I_SUB_MUTEZ\n  | \"SWAP\" -> ok I_SWAP\n  | \"TRANSFER_TOKENS\" -> ok I_TRANSFER_TOKENS\n  | \"SET_DELEGATE\" -> ok I_SET_DELEGATE\n  | \"UNIT\" -> ok I_UNIT\n  | \"UPDATE\" -> ok I_UPDATE\n  | \"XOR\" -> ok I_XOR\n  | \"ITER\" -> ok I_ITER\n  | \"LOOP_LEFT\" -> ok I_LOOP_LEFT\n  | \"ADDRESS\" -> ok I_ADDRESS\n  | \"CONTRACT\" -> ok I_CONTRACT\n  | \"ISNAT\" -> ok I_ISNAT\n  | \"CAST\" -> ok I_CAST\n  | \"RENAME\" -> ok I_RENAME\n  | \"SAPLING_EMPTY_STATE\" -> ok I_SAPLING_EMPTY_STATE\n  | \"SAPLING_VERIFY_UPDATE\" -> ok I_SAPLING_VERIFY_UPDATE\n  | \"DIG\" -> ok I_DIG\n  | \"DUG\" -> ok I_DUG\n  | \"NEVER\" -> ok I_NEVER\n  | \"VOTING_POWER\" -> ok I_VOTING_POWER\n  | \"TOTAL_VOTING_POWER\" -> ok I_TOTAL_VOTING_POWER\n  | \"TICKET\" -> ok I_TICKET\n  | \"READ_TICKET\" -> ok I_READ_TICKET\n  | \"SPLIT_TICKET\" -> ok I_SPLIT_TICKET\n  | \"JOIN_TICKETS\" -> ok I_JOIN_TICKETS\n  | \"OPEN_CHEST\" -> ok I_OPEN_CHEST\n  | \"bool\" -> ok T_bool\n  | \"contract\" -> ok T_contract\n  | \"int\" -> ok T_int\n  | \"key\" -> ok T_key\n  | \"key_hash\" -> ok T_key_hash\n  | \"lambda\" -> ok T_lambda\n  | \"list\" -> ok T_list\n  | \"map\" -> ok T_map\n  | \"big_map\" -> ok T_big_map\n  | \"nat\" -> ok T_nat\n  | \"option\" -> ok T_option\n  | \"or\" -> ok T_or\n  | \"pair\" -> ok T_pair\n  | \"set\" -> ok T_set\n  | \"signature\" -> ok T_signature\n  | \"string\" -> ok T_string\n  | \"bytes\" -> ok T_bytes\n  | \"mutez\" -> ok T_mutez\n  | \"timestamp\" -> ok T_timestamp\n  | \"unit\" -> ok T_unit\n  | \"operation\" -> ok T_operation\n  | \"address\" -> ok T_address\n  | \"sapling_state\" -> ok T_sapling_state\n  | \"sapling_transaction\" -> ok T_sapling_transaction\n  | \"chain_id\" -> ok T_chain_id\n  | \"never\" -> ok T_never\n  | \"bls12_381_g1\" -> ok T_bls12_381_g1\n  | \"bls12_381_g2\" -> ok T_bls12_381_g2\n  | \"bls12_381_fr\" -> ok T_bls12_381_fr\n  | \"ticket\" -> ok T_ticket\n  | \"chest_key\" -> ok T_chest_key\n  | \"chest\" -> ok T_chest\n  | \"constant\" -> ok H_constant\n  | n ->\n      if valid_case n then error (Unknown_primitive_name n)\n      else error (Invalid_case n)\n\nlet prims_of_strings expr =\n  let rec convert = function\n    | (Int _ | String _ | Bytes _) as expr -> ok expr\n    | Prim (loc, prim, args, annot) ->\n        Error_monad.record_trace\n          (Invalid_primitive_name (expr, loc))\n          (prim_of_string prim)\n        >>? fun prim ->\n        List.map_e convert args >|? fun args -> Prim (loc, prim, args, annot)\n    | Seq (loc, args) -> List.map_e convert args >|? fun args -> Seq (loc, args)\n  in\n  convert (root expr) >|? fun expr -> strip_locations expr\n  [@@coq_axiom_with_reason\n    \"implicit type conversion for expr in the constant cases\"]\n\nlet strings_of_prims expr =\n  let rec convert = function\n    | (Int _ | String _ | Bytes _) as expr -> expr\n    | Prim (loc, prim, args, annot) ->\n        let prim = string_of_prim prim in\n        let args = List.map convert args in\n        Prim (loc, prim, args, annot)\n    | Seq (loc, args) ->\n        let args = List.map convert args in\n        Seq (loc, args)\n  in\n  strip_locations (convert (root expr))\n  [@@coq_axiom_with_reason\n    \"implicit type conversion for expr in the constant cases\"]\n\nlet prim_encoding =\n  let open Data_encoding in\n  def \"michelson.v1.primitives\"\n  @@ string_enum\n       (* Add the comment below every 10 lines *)\n       [\n         (* /!\\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)\n         (\"parameter\", K_parameter);\n         (\"storage\", K_storage);\n         (\"code\", K_code);\n         (\"False\", D_False);\n         (\"Elt\", D_Elt);\n         (\"Left\", D_Left);\n         (\"None\", D_None);\n         (\"Pair\", D_Pair);\n         (\"Right\", D_Right);\n         (\"Some\", D_Some);\n         (* /!\\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)\n         (\"True\", D_True);\n         (\"Unit\", D_Unit);\n         (\"PACK\", I_PACK);\n         (\"UNPACK\", I_UNPACK);\n         (\"BLAKE2B\", I_BLAKE2B);\n         (\"SHA256\", I_SHA256);\n         (\"SHA512\", I_SHA512);\n         (\"ABS\", I_ABS);\n         (\"ADD\", I_ADD);\n         (\"AMOUNT\", I_AMOUNT);\n         (* /!\\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)\n         (\"AND\", I_AND);\n         (\"BALANCE\", I_BALANCE);\n         (\"CAR\", I_CAR);\n         (\"CDR\", I_CDR);\n         (\"CHECK_SIGNATURE\", I_CHECK_SIGNATURE);\n         (\"COMPARE\", I_COMPARE);\n         (\"CONCAT\", I_CONCAT);\n         (\"CONS\", I_CONS);\n         (\"CREATE_ACCOUNT\", I_CREATE_ACCOUNT);\n         (\"CREATE_CONTRACT\", I_CREATE_CONTRACT);\n         (* /!\\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)\n         (\"IMPLICIT_ACCOUNT\", I_IMPLICIT_ACCOUNT);\n         (\"DIP\", I_DIP);\n         (\"DROP\", I_DROP);\n         (\"DUP\", I_DUP);\n         (\"EDIV\", I_EDIV);\n         (\"EMPTY_MAP\", I_EMPTY_MAP);\n         (\"EMPTY_SET\", I_EMPTY_SET);\n         (\"EQ\", I_EQ);\n         (\"EXEC\", I_EXEC);\n         (\"FAILWITH\", I_FAILWITH);\n         (* /!\\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)\n         (\"GE\", I_GE);\n         (\"GET\", I_GET);\n         (\"GT\", I_GT);\n         (\"HASH_KEY\", I_HASH_KEY);\n         (\"IF\", I_IF);\n         (\"IF_CONS\", I_IF_CONS);\n         (\"IF_LEFT\", I_IF_LEFT);\n         (\"IF_NONE\", I_IF_NONE);\n         (\"INT\", I_INT);\n         (\"LAMBDA\", I_LAMBDA);\n         (* /!\\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)\n         (\"LE\", I_LE);\n         (\"LEFT\", I_LEFT);\n         (\"LOOP\", I_LOOP);\n         (\"LSL\", I_LSL);\n         (\"LSR\", I_LSR);\n         (\"LT\", I_LT);\n         (\"MAP\", I_MAP);\n         (\"MEM\", I_MEM);\n         (\"MUL\", I_MUL);\n         (\"NEG\", I_NEG);\n         (* /!\\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)\n         (\"NEQ\", I_NEQ);\n         (\"NIL\", I_NIL);\n         (\"NONE\", I_NONE);\n         (\"NOT\", I_NOT);\n         (\"NOW\", I_NOW);\n         (\"OR\", I_OR);\n         (\"PAIR\", I_PAIR);\n         (\"PUSH\", I_PUSH);\n         (\"RIGHT\", I_RIGHT);\n         (\"SIZE\", I_SIZE);\n         (* /!\\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)\n         (\"SOME\", I_SOME);\n         (\"SOURCE\", I_SOURCE);\n         (\"SENDER\", I_SENDER);\n         (\"SELF\", I_SELF);\n         (\"STEPS_TO_QUOTA\", I_STEPS_TO_QUOTA);\n         (\"SUB\", I_SUB);\n         (\"SWAP\", I_SWAP);\n         (\"TRANSFER_TOKENS\", I_TRANSFER_TOKENS);\n         (\"SET_DELEGATE\", I_SET_DELEGATE);\n         (\"UNIT\", I_UNIT);\n         (* /!\\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)\n         (\"UPDATE\", I_UPDATE);\n         (\"XOR\", I_XOR);\n         (\"ITER\", I_ITER);\n         (\"LOOP_LEFT\", I_LOOP_LEFT);\n         (\"ADDRESS\", I_ADDRESS);\n         (\"CONTRACT\", I_CONTRACT);\n         (\"ISNAT\", I_ISNAT);\n         (\"CAST\", I_CAST);\n         (\"RENAME\", I_RENAME);\n         (\"bool\", T_bool);\n         (* /!\\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)\n         (\"contract\", T_contract);\n         (\"int\", T_int);\n         (\"key\", T_key);\n         (\"key_hash\", T_key_hash);\n         (\"lambda\", T_lambda);\n         (\"list\", T_list);\n         (\"map\", T_map);\n         (\"big_map\", T_big_map);\n         (\"nat\", T_nat);\n         (\"option\", T_option);\n         (* /!\\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)\n         (\"or\", T_or);\n         (\"pair\", T_pair);\n         (\"set\", T_set);\n         (\"signature\", T_signature);\n         (\"string\", T_string);\n         (\"bytes\", T_bytes);\n         (\"mutez\", T_mutez);\n         (\"timestamp\", T_timestamp);\n         (\"unit\", T_unit);\n         (\"operation\", T_operation);\n         (* /!\\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)\n         (\"address\", T_address);\n         (* Alpha_002 addition *)\n         (\"SLICE\", I_SLICE);\n         (* Alpha_005 addition *)\n         (\"DIG\", I_DIG);\n         (\"DUG\", I_DUG);\n         (\"EMPTY_BIG_MAP\", I_EMPTY_BIG_MAP);\n         (\"APPLY\", I_APPLY);\n         (\"chain_id\", T_chain_id);\n         (\"CHAIN_ID\", I_CHAIN_ID);\n         (* /!\\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)\n         (* Alpha_008 addition *)\n         (\"LEVEL\", I_LEVEL);\n         (\"SELF_ADDRESS\", I_SELF_ADDRESS);\n         (\"never\", T_never);\n         (\"NEVER\", I_NEVER);\n         (\"UNPAIR\", I_UNPAIR);\n         (\"VOTING_POWER\", I_VOTING_POWER);\n         (\"TOTAL_VOTING_POWER\", I_TOTAL_VOTING_POWER);\n         (\"KECCAK\", I_KECCAK);\n         (\"SHA3\", I_SHA3);\n         (* /!\\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)\n         (* Alpha_008 addition *)\n         (\"PAIRING_CHECK\", I_PAIRING_CHECK);\n         (\"bls12_381_g1\", T_bls12_381_g1);\n         (\"bls12_381_g2\", T_bls12_381_g2);\n         (\"bls12_381_fr\", T_bls12_381_fr);\n         (\"sapling_state\", T_sapling_state);\n         (\"sapling_transaction\", T_sapling_transaction);\n         (\"SAPLING_EMPTY_STATE\", I_SAPLING_EMPTY_STATE);\n         (\"SAPLING_VERIFY_UPDATE\", I_SAPLING_VERIFY_UPDATE);\n         (\"ticket\", T_ticket);\n         (* /!\\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)\n         (* Alpha_008 addition *)\n         (\"TICKET\", I_TICKET);\n         (\"READ_TICKET\", I_READ_TICKET);\n         (\"SPLIT_TICKET\", I_SPLIT_TICKET);\n         (\"JOIN_TICKETS\", I_JOIN_TICKETS);\n         (\"GET_AND_UPDATE\", I_GET_AND_UPDATE);\n         (* Alpha_011 addition *)\n         (\"chest\", T_chest);\n         (\"chest_key\", T_chest_key);\n         (\"OPEN_CHEST\", I_OPEN_CHEST);\n         (* /!\\ NEW INSTRUCTIONS MUST BE ADDED AT THE END OF THE STRING_ENUM, FOR BACKWARD COMPATIBILITY OF THE ENCODING. *)\n         (\"VIEW\", I_VIEW);\n         (\"view\", K_view);\n         (\"constant\", H_constant);\n         (* Alpha_012 addition *)\n         (\"SUB_MUTEZ\", I_SUB_MUTEZ);\n         (* New instructions must be added here, for backward compatibility of the encoding. *)\n         (* Keep the comment above at the end of the list *)\n       ]\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.unknown_primitive_name\"\n    ~title:\"Unknown primitive name\"\n    ~description:\"In a script or data expression, a primitive was unknown.\"\n    ~pp:(fun ppf n -> Format.fprintf ppf \"Unknown primitive %s.\" n)\n    Data_encoding.(obj1 (req \"wrong_primitive_name\" string))\n    (function Unknown_primitive_name got -> Some got | _ -> None)\n    (fun got -> Unknown_primitive_name got) ;\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.invalid_primitive_name_case\"\n    ~title:\"Invalid primitive name case\"\n    ~description:\n      \"In a script or data expression, a primitive name is neither uppercase, \\\n       lowercase or capitalized.\"\n    ~pp:(fun ppf n -> Format.fprintf ppf \"Primitive %s has invalid case.\" n)\n    Data_encoding.(obj1 (req \"wrong_primitive_name\" string))\n    (function Invalid_case name -> Some name | _ -> None)\n    (fun name -> Invalid_case name) ;\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.invalid_primitive_name\"\n    ~title:\"Invalid primitive name\"\n    ~description:\n      \"In a script or data expression, a primitive name is unknown or has a \\\n       wrong case.\"\n    ~pp:(fun ppf _ -> Format.fprintf ppf \"Invalid primitive.\")\n    Data_encoding.(\n      obj2\n        (req\n           \"expression\"\n           (Micheline.canonical_encoding ~variant:\"generic\" string))\n        (req \"location\" Micheline.canonical_location_encoding))\n    (function\n      | Invalid_primitive_name (expr, loc) -> Some (expr, loc) | _ -> None)\n    (fun (expr, loc) -> Invalid_primitive_name (expr, loc))\n\nlet string_of_namespace = function\n  | Type_namespace -> \"T\"\n  | Constant_namespace -> \"D\"\n  | Instr_namespace -> \"I\"\n  | Keyword_namespace -> \"K\"\n  | Constant_hash_namespace -> \"H\"\n" ;
                } ;
                { name = "Script_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Defines a Michelson expression representation as a Micheline node with\n    canonical ([int]) location and [Michelson_v1_primitives.prim] as content.\n\n    Types [expr] and [node] both define representation of Michelson\n    expressions and are indeed the same type internally, although this is not\n    visible outside Micheline due to interface abstraction. *)\n\n(** Locations are used by Micheline mostly for error-reporting and pretty-\n    printing expressions. [canonical_location] is simply an [int]. *)\ntype location = Micheline.canonical_location\n\n(** Annotations attached to Michelson expressions. *)\ntype annot = Micheline.annot\n\n(** Represents a Michelson expression as canonical Micheline. *)\ntype expr = Michelson_v1_primitives.prim Micheline.canonical\n\ntype error += Lazy_script_decode (* `Permanent *)\n\n(** A record containing either an underlying serialized representation of an\n    expression or a deserialized one, or both. If either is absent, it will be\n    computed on-demand. *)\ntype lazy_expr = expr Data_encoding.lazy_t\n\ntype 'location michelson_node =\n  ('location, Michelson_v1_primitives.prim) Micheline.node\n\ntype unlocated_michelson_node = unit michelson_node\n\n(** Same as [expr], but used in different contexts, as required by Micheline's\n    abstract interface. *)\ntype node = location michelson_node\n\nval location_encoding : location Data_encoding.t\n\nval expr_encoding : expr Data_encoding.t\n\nval lazy_expr_encoding : lazy_expr Data_encoding.t\n\nval lazy_expr : expr -> lazy_expr\n\n(** Type [t] joins the contract's code and storage in a single record. *)\ntype t = {code : lazy_expr; storage : lazy_expr}\n\nval encoding : t Data_encoding.encoding\n\n(* Basic gas costs of operations related to processing Michelson: *)\n\nval deserialization_cost_estimated_from_bytes : int -> Gas_limit_repr.cost\n\nval deserialized_cost : expr -> Gas_limit_repr.cost\n\nval serialized_cost : bytes -> Gas_limit_repr.cost\n\nval bytes_node_cost : bytes -> Gas_limit_repr.cost\n\n(** Returns (a lower bound on) the cost to deserialize a\n    {!lazy_expr}. If the expression has already been deserialized\n    (i.e. the lazy expression contains the deserialized value or both\n    the bytes representation and the deserialized value) then the cost\n    is {b free}. *)\nval force_decode_cost : lazy_expr -> Gas_limit_repr.cost\n\n(** Like {!force_decode_cost}, excepted that the returned cost does\n    not depend on the internal state of the lazy_expr. This means that\n    the cost is never free (excepted for zero bytes expressions). *)\nval stable_force_decode_cost : lazy_expr -> Gas_limit_repr.cost\n\nval force_decode : lazy_expr -> expr tzresult\n\n(** Returns the cost to serialize a {!lazy_expr}. If the expression\n    has already been deserialized (i.e. le lazy expression contains the\n    bytes representation or both the bytes representation and the\n    deserialized value) then the cost is {b free}. *)\nval force_bytes_cost : lazy_expr -> Gas_limit_repr.cost\n\nval force_bytes : lazy_expr -> bytes tzresult\n\nval unit_parameter : lazy_expr\n\nval is_unit_parameter : lazy_expr -> bool\n\nval strip_annotations : node -> node\n\nval strip_locations_cost : _ michelson_node -> Gas_limit_repr.cost\n\nval strip_annotations_cost : node -> Gas_limit_repr.cost\n\nmodule Micheline_size : sig\n  type t = {\n    nodes : Saturation_repr.may_saturate Saturation_repr.t;\n    string_bytes : Saturation_repr.may_saturate Saturation_repr.t;\n    z_bytes : Saturation_repr.may_saturate Saturation_repr.t;\n  }\n\n  val of_node : node -> t\nend\n\n(** [micheline_nodes root] returns the number of internal nodes in the\n   micheline expression held from [root]. *)\nval micheline_nodes : node -> int\n\n(** [fold node i f] traverses [node] applying [f] on an\n    accumulator initialized by [i]. *)\nval fold : node -> 'c -> ('c -> node -> 'c) -> 'c\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype location = Micheline.canonical_location\n\nlet location_encoding = Micheline.canonical_location_encoding\n\ntype annot = Micheline.annot\n\ntype expr = Michelson_v1_primitives.prim Micheline.canonical\n\ntype lazy_expr = expr Data_encoding.lazy_t\n\ntype 'location michelson_node =\n  ('location, Michelson_v1_primitives.prim) Micheline.node\n\ntype unlocated_michelson_node = unit michelson_node\n\ntype node = location michelson_node\n\nlet expr_encoding =\n  Micheline.canonical_encoding\n    ~variant:\"michelson_v1\"\n    Michelson_v1_primitives.prim_encoding\n\ntype error += Lazy_script_decode (* `Permanent *)\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"invalid_binary_format\"\n    ~title:\"Invalid binary format\"\n    ~description:\n      \"Could not deserialize some piece of data from its binary representation\"\n    Data_encoding.empty\n    (function Lazy_script_decode -> Some () | _ -> None)\n    (fun () -> Lazy_script_decode)\n\nlet lazy_expr_encoding = Data_encoding.lazy_encoding expr_encoding\n\nlet lazy_expr expr = Data_encoding.make_lazy expr_encoding expr\n\ntype t = {code : lazy_expr; storage : lazy_expr}\n\nlet encoding =\n  let open Data_encoding in\n  def \"scripted.contracts\"\n  @@ conv\n       (fun {code; storage} -> (code, storage))\n       (fun (code, storage) -> {code; storage})\n       (obj2 (req \"code\" lazy_expr_encoding) (req \"storage\" lazy_expr_encoding))\n\nmodule S = Saturation_repr\n\nmodule Micheline_size = struct\n  type t = {\n    nodes : S.may_saturate S.t;\n    string_bytes : S.may_saturate S.t;\n    z_bytes : S.may_saturate S.t;\n  }\n\n  let make ~nodes ~string_bytes ~z_bytes = {nodes; string_bytes; z_bytes}\n\n  let zero = {nodes = S.zero; string_bytes = S.zero; z_bytes = S.zero}\n\n  let add_int acc n =\n    let numbits = Z.numbits n in\n    let z_bytes =\n      S.safe_int ((numbits + 7) / 8)\n      (* Compute the number of bytes in a Z.t *)\n    in\n    {\n      nodes = S.succ acc.nodes;\n      string_bytes = acc.string_bytes;\n      z_bytes = S.add acc.z_bytes z_bytes;\n    }\n\n  let add_string acc n =\n    let string_bytes = S.safe_int (String.length n) in\n    {\n      nodes = S.succ acc.nodes;\n      string_bytes = S.add acc.string_bytes string_bytes;\n      z_bytes = acc.z_bytes;\n    }\n\n  let add_bytes acc n =\n    let string_bytes = S.safe_int (Bytes.length n) in\n    {\n      nodes = S.succ acc.nodes;\n      string_bytes = S.add acc.string_bytes string_bytes;\n      z_bytes = acc.z_bytes;\n    }\n\n  let add_node s = {s with nodes = S.succ s.nodes}\n\n  (* We model annotations as Seqs of Strings *)\n  let of_annots acc annots =\n    List.fold_left (fun acc s -> add_string acc s) acc annots\n\n  let[@coq_struct \"nodes\"] rec of_nodes acc nodes more_nodes =\n    let open Micheline in\n    match nodes with\n    | [] -> (\n        match more_nodes with\n        | [] -> acc\n        | nodes :: more_nodes ->\n            (of_nodes [@ocaml.tailcall]) acc nodes more_nodes)\n    | Int (_, n) :: nodes ->\n        let acc = add_int acc n in\n        (of_nodes [@ocaml.tailcall]) acc nodes more_nodes\n    | String (_, s) :: nodes ->\n        let acc = add_string acc s in\n        (of_nodes [@ocaml.tailcall]) acc nodes more_nodes\n    | Bytes (_, s) :: nodes ->\n        let acc = add_bytes acc s in\n        (of_nodes [@ocaml.tailcall]) acc nodes more_nodes\n    | Prim (_, _, args, annots) :: nodes ->\n        let acc = add_node acc in\n        let acc = of_annots acc annots in\n        (of_nodes [@ocaml.tailcall]) acc args (nodes :: more_nodes)\n    | Seq (_, args) :: nodes ->\n        let acc = add_node acc in\n        (of_nodes [@ocaml.tailcall]) acc args (nodes :: more_nodes)\n\n  let of_node node = of_nodes zero [node] []\n\n  let dot_product s1 s2 =\n    S.add\n      (S.mul s1.nodes s2.nodes)\n      (S.add\n         (S.mul s1.string_bytes s2.string_bytes)\n         (S.mul s1.z_bytes s2.z_bytes))\nend\n\n(* Costs pertaining to deserialization of Micheline values (bytes to Micheline).\n   The costs are given in atomic steps (see [Gas_limit_repr]). *)\nmodule Micheline_decoding = struct\n  (* Cost vector allowing to compute decoding costs as a function of the\n     size of the Micheline term *)\n  let micheline_size_dependent_cost =\n    let traversal_cost = S.safe_int 60 in\n    let string_per_byte_cost = S.safe_int 10 in\n    let z_per_byte_cost = S.safe_int 10 in\n    Micheline_size.make\n      ~nodes:traversal_cost\n      ~string_bytes:string_per_byte_cost\n      ~z_bytes:z_per_byte_cost\n\n  let bytes_dependent_cost = S.safe_int 20\nend\n\n(* Costs pertaining to serialization of Micheline values (Micheline to bytes)\n   The costs are given in atomic steps (see [Gas_limit_repr]). *)\nmodule Micheline_encoding = struct\n  (* Cost vector allowing to compute encoding cost as a function of the\n     size of the Micheline term *)\n  let micheline_size_dependent_cost =\n    let traversal_cost = S.safe_int 100 in\n    let string_per_byte_cost = S.safe_int 10 in\n    let z_per_byte_cost = S.safe_int 25 in\n    Micheline_size.make\n      ~nodes:traversal_cost\n      ~string_bytes:string_per_byte_cost\n      ~z_bytes:z_per_byte_cost\n\n  let bytes_dependent_cost = S.safe_int 33\nend\n\nlet expr_size expr = Micheline_size.of_node (Micheline.root expr)\n\n(* Compute the cost of serializing a term of given [size]. *)\nlet serialization_cost size =\n  Gas_limit_repr.atomic_step_cost\n  @@ Micheline_size.dot_product\n       size\n       Micheline_encoding.micheline_size_dependent_cost\n\n(* Compute the cost of deserializing a term of given [size]. *)\nlet deserialization_cost size =\n  Gas_limit_repr.atomic_step_cost\n  @@ Micheline_size.dot_product\n       size\n       Micheline_decoding.micheline_size_dependent_cost\n\n(* Estimate the cost of deserializing a term encoded in [bytes_len] bytes. *)\nlet deserialization_cost_estimated_from_bytes bytes_len =\n  Gas_limit_repr.atomic_step_cost\n  @@ S.mul Micheline_decoding.bytes_dependent_cost (S.safe_int bytes_len)\n\n(* Estimate the cost of serializing a term from its encoded form,\n   having [bytes_len] bytes. *)\nlet serialization_cost_estimated_from_bytes bytes_len =\n  Gas_limit_repr.atomic_step_cost\n  @@ S.mul Micheline_encoding.bytes_dependent_cost (S.safe_int bytes_len)\n\n(* Cost of running [strip_locations] on a term with [size] nodes.\n   Note that [strip_locations] will reallocate a fresh Micheline tree.\n   This only depends on the total number of nodes (not the size of\n   the leaves). *)\nlet cost_micheline_strip_locations size =\n  Gas_limit_repr.atomic_step_cost @@ S.mul (S.safe_int size) (S.safe_int 51)\n\n(* TODO: https://gitlab.com/tezos/tezos/-/issues/2049\n   Plugin benchmarked gas.\n   Replace this definition, copied from [cost_michelines_strip_locations].\n*)\n(* Cost of running [strip_annotations] on a term with [size] nodes.\n   Note that [strip_annotations] will reallocate a fresh Micheline tree.\n   This only depends on the total number of nodes (not the size of\n   the leaves). *)\nlet cost_micheline_strip_annotations size =\n  Gas_limit_repr.atomic_step_cost @@ S.mul (S.safe_int size) (S.safe_int 51)\n\n(* This is currently used to estimate the cost of serializing an operation. *)\nlet bytes_node_cost s = serialization_cost_estimated_from_bytes (Bytes.length s)\n\nlet deserialized_cost expr =\n  Gas_limit_repr.atomic_step_cost @@ deserialization_cost (expr_size expr)\n\nlet serialized_cost bytes =\n  let cost =\n    let size = Bytes.length bytes in\n    S.add (serialization_cost_estimated_from_bytes size)\n    @@ (* N_IConcat_bytes_pair inlined here *)\n    S.add (S.safe_int 65) (S.shift_right (S.safe_int size) 4)\n  in\n  Gas_limit_repr.atomic_step_cost cost\n\nlet force_decode_cost lexpr =\n  Data_encoding.apply_lazy\n    ~fun_value:(fun _ -> Gas_limit_repr.free)\n    ~fun_bytes:(fun b ->\n      deserialization_cost_estimated_from_bytes (Bytes.length b))\n    ~fun_combine:(fun _ _ -> Gas_limit_repr.free)\n    lexpr\n\nlet stable_force_decode_cost lexpr =\n  let has_bytes =\n    Data_encoding.apply_lazy\n      ~fun_value:(fun v -> `Only_value v)\n      ~fun_bytes:(fun b -> `Has_bytes b)\n      ~fun_combine:(fun _v b ->\n        (* When the lazy_expr contains both a deserialized version\n           and a serialized one, we compute the cost from the\n           serialized version because its is cheaper to do. *)\n        b)\n      lexpr\n  in\n  match has_bytes with\n  | `Has_bytes b -> deserialization_cost_estimated_from_bytes (Bytes.length b)\n  | `Only_value v ->\n      (* This code path should not be reached in theory because values that are\n         decoded should have been encoded before.\n         Here we use Data_encoding.Binary.length, which yields the same results\n         as serializing the value and taking the size, without the need to\n         encode (in particular, less allocations).\n      *)\n      deserialization_cost_estimated_from_bytes\n        (Data_encoding.Binary.length expr_encoding v)\n\nlet force_decode lexpr =\n  match Data_encoding.force_decode lexpr with\n  | Some v -> ok v\n  | None -> error Lazy_script_decode\n\nlet force_bytes_cost expr =\n  (* Estimating the cost directly from the bytes would be cheaper, but\n           using [serialized_cost] is more accurate. *)\n  Data_encoding.apply_lazy\n    ~fun_value:(fun v -> serialization_cost (expr_size v))\n    ~fun_bytes:(fun _ -> Gas_limit_repr.free)\n    ~fun_combine:(fun _ _ -> Gas_limit_repr.free)\n    expr\n\nlet force_bytes expr =\n  Error_monad.catch_f\n    (fun () -> Data_encoding.force_bytes expr)\n    (fun _ -> Lazy_script_decode)\n\nlet unit =\n  Micheline.strip_locations (Prim (0, Michelson_v1_primitives.D_Unit, [], []))\n\nlet unit_parameter = lazy_expr unit\n\nlet is_unit_parameter =\n  let unit_bytes = Data_encoding.force_bytes unit_parameter in\n  Data_encoding.apply_lazy\n    ~fun_value:(fun v ->\n      match Micheline.root v with\n      | Prim (_, Michelson_v1_primitives.D_Unit, [], []) -> true\n      | _ -> false)\n    ~fun_bytes:(fun b -> Compare.Bytes.equal b unit_bytes)\n    ~fun_combine:(fun res _ -> res)\n\nlet[@coq_struct \"node\"] rec strip_annotations node =\n  let open Micheline in\n  match node with\n  | (Int (_, _) | String (_, _) | Bytes (_, _)) as leaf -> leaf\n  | Prim (loc, name, args, _) ->\n      Prim (loc, name, List.map strip_annotations args, [])\n  | Seq (loc, args) -> Seq (loc, List.map strip_annotations args)\n\nlet rec micheline_fold_aux node f acc k =\n  match node with\n  | Micheline.Int (_, _) -> k (f acc node)\n  | Micheline.String (_, _) -> k (f acc node)\n  | Micheline.Bytes (_, _) -> k (f acc node)\n  | Micheline.Prim (_, _, subterms, _) ->\n      micheline_fold_nodes subterms f (f acc node) k\n  | Micheline.Seq (_, subterms) ->\n      micheline_fold_nodes subterms f (f acc node) k\n\nand[@coq_mutual_as_notation] [@coq_struct \"subterms\"] micheline_fold_nodes\n    subterms f acc k =\n  match subterms with\n  | [] -> k acc\n  | node :: nodes ->\n      micheline_fold_nodes nodes f acc @@ fun acc ->\n      micheline_fold_aux node f acc k\n\nlet fold node init f = micheline_fold_aux node f init (fun x -> x)\n\nlet micheline_nodes node = fold node 0 @@ fun n _ -> n + 1\n\nlet strip_locations_cost node =\n  let nodes = micheline_nodes node in\n  cost_micheline_strip_locations nodes\n\nlet strip_annotations_cost node =\n  let nodes = micheline_nodes node in\n  cost_micheline_strip_annotations nodes\n" ;
                } ;
                { name = "Cache_memory_helpers" ;
                  interface = None ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** The [Nodes] module is used to count the number of computation steps\n    performed when evaluating the size of the in-memory graph corresponding\n    to an OCaml value.\n\n    In first approximation, the value of type [Nodes.t] threaded through\n    {!expr_size} below and through the module {!Script_typed_ir_size}\n    is meant to match the number of recursive calls in the [traverse]\n    functions of {!Script_typed_ir} and in that of {!node_size}.\n\n    The assumption is that there's a bounded amount of work performed between\n    two such recursive calls, hence that the total work is bounded above\n    by something proportional to the [Nodes.t] accumulator.\n\n    Computations on values of type [Nodes.t] do not overflow, as they\n    are bounded above by the number of nodes traversed when computing\n    an OCaml value.\n *)\nmodule Nodes : sig\n  type t = private int\n\n  val zero : t\n\n  val one : t [@@ocaml.warning \"-32\"]\n\n  val succ : t -> t\n\n  val add : t -> t -> t\n\n  val to_int : t -> int\nend = struct\n  type t = int\n\n  let zero = 0\n\n  let one = 1\n\n  let succ x = x + 1\n\n  let add x y = x + y\n\n  let to_int x = x\nend\n\n(** {2 Helpers to deal with computing the in-memory size of values} *)\n\ntype sint = Saturation_repr.may_saturate Saturation_repr.t\n\ntype nodes_and_size = Nodes.t * sint\n\nlet ( !! ) = Saturation_repr.safe_int\n\nlet ( +! ) = Saturation_repr.add\n\nlet ( +? ) s x = Saturation_repr.add s !!x\n\nlet ( *? ) s x = Saturation_repr.mul s !!x\n\nlet ( /? ) s x = Saturation_repr.ediv s !!x\n\nlet ( ++ ) (n1, s1) (n2, s2) = (Nodes.add n1 n2, s1 +! s2)\n\nlet zero = (Nodes.zero, !!0)\n\nlet word_size = !!8\n\nlet header_size = word_size\n\nlet int64_size = header_size +! (word_size *? 2)\n\nlet h1w = header_size +! word_size\n\nlet h2w = header_size +! (word_size *? 2)\n\nlet h3w = header_size +! (word_size *? 3)\n\nlet h4w = header_size +! (word_size *? 4)\n\nlet h5w = header_size +! (word_size *? 5)\n\nlet hh3w = (word_size *? 3) +! (header_size *? 2)\n\nlet hh6w = (word_size *? 6) +! (header_size *? 2)\n\nlet hh8w = (word_size *? 8) +! (header_size *? 2)\n\nlet z_size z =\n  let numbits = Z.numbits z in\n  if Compare.Int.(numbits <= 62) then !!0 else (word_size *? Z.size z) +? 32\n\nlet string_size_gen len = header_size +? (len + (8 - (len mod 8)))\n\nlet bytes_size b = string_size_gen (Bytes.length b)\n\nlet string_size s = string_size_gen (String.length s)\n\nlet ret_adding (nodes, size) added = (nodes, size +! added)\n\nlet ret_succ_adding (nodes, size) added = (Nodes.succ nodes, size +! added)\n\nlet ret_succ (nodes, size) = (Nodes.succ nodes, size)\n\nlet option_size some x =\n  let some x = h1w +! some x in\n  Option.fold ~none:!!0 ~some x\n\nlet option_size_vec some x =\n  let some x = ret_adding (some x) h1w in\n  Option.fold ~none:zero ~some x\n\nlet list_cell_size elt_size =\n  header_size +! word_size +! word_size +! elt_size\n  [@@ocaml.inline always]\n\nlet list_fold_size elt_size list =\n  List.fold_left\n    (fun accu elt -> ret_succ_adding (accu ++ elt_size elt) h2w)\n    zero\n    list\n\nlet boxed_tup2 x y =\n  header_size +! word_size +! word_size +! x +! y\n  [@@ocaml.inline always]\n\nlet node_size =\n  let open Micheline in\n  let annotation_size a =\n    List.fold_left\n      (fun accu s -> ret_succ_adding accu (h2w +! string_size s))\n      zero\n      a\n  in\n  let internal_node_size = function\n    | Int (_, z) -> (Nodes.one, h2w +! z_size z)\n    | String (_, s) -> (Nodes.one, h2w +! string_size s)\n    | Bytes (_, s) -> (Nodes.one, h2w +! bytes_size s)\n    | Prim (_, _, _, a) -> ret_succ_adding (annotation_size a) h4w\n    | Seq (_, _) -> (Nodes.one, h2w)\n  in\n  fun node ->\n    Script_repr.fold node zero @@ fun accu node ->\n    accu ++ internal_node_size node\n\nlet expr_size expr = node_size (Micheline.root expr)\n" ;
                } ;
                { name = "Contract_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** This module defines identifiers for two basic types of contracts. It also\n    specifies how to compute originated contract's hash from origination\n    nonce. *)\n\n(** A contract is simply an account on the blockchain ledger. There are two\n    types of contracts:\n    - implicit contracts represent accounts of users of the blockchain;\n    - originated are special accounts with a Michelson script attached to\n    them. Every time a transaction is sent to an originated account, its\n    associated script is run in order to trigger some action in response.\n\n    An implicit account is identified by the hash of the public key which was\n    used to create it. The owner of the corresponding private key is the\n    holder of the account. An originated contract's hash is derived from its\n    origination nonce (see below). *)\ntype t = private\n  | Implicit of Signature.Public_key_hash.t\n  | Originated of Contract_hash.t\n\ntype contract = t\n\ninclude Compare.S with type t := contract\n\nval public_key_hash_in_memory_size : Cache_memory_helpers.sint\n\nval in_memory_size : t -> Cache_memory_helpers.sint\n\n(** {2 Implicit contracts} *)\n\nval implicit_contract : Signature.Public_key_hash.t -> contract\n\nval is_implicit : contract -> Signature.Public_key_hash.t option\n\n(** {2 Originated contracts} *)\n\n(** Originated contracts handles are crafted from the hash of the\n    operation that triggered their origination (and nothing else).\n    As a single operation can trigger several originations, the\n    corresponding handles are forged from a deterministic sequence of\n    nonces, initialized with the hash of the operation. *)\ntype origination_nonce\n\nval originated_contract : origination_nonce -> contract\n\nval originated_contracts :\n  since:origination_nonce -> until:origination_nonce -> contract list\n\nval initial_origination_nonce : Operation_hash.t -> origination_nonce\n\nval incr_origination_nonce : origination_nonce -> origination_nonce\n\nval is_originated : contract -> Contract_hash.t option\n\n(** {2 Human readable notation} *)\n\ntype error += Invalid_contract_notation of string (* `Permanent *)\n\nval to_b58check : contract -> string\n\nval of_b58check : string -> contract tzresult\n\nval pp : Format.formatter -> contract -> unit\n\nval pp_short : Format.formatter -> contract -> unit\n\n(** {2 Serializers} *)\n\nval encoding : contract Data_encoding.t\n\nval origination_nonce_encoding : origination_nonce Data_encoding.t\n\nval rpc_arg : contract RPC_arg.arg\n\nmodule Index : Storage_description.INDEX with type t = t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype t =\n  | Implicit of Signature.Public_key_hash.t\n  | Originated of Contract_hash.t\n\ninclude Compare.Make (struct\n  type nonrec t = t\n\n  let compare l1 l2 =\n    match (l1, l2) with\n    | (Implicit pkh1, Implicit pkh2) ->\n        Signature.Public_key_hash.compare pkh1 pkh2\n    | (Originated h1, Originated h2) -> Contract_hash.compare h1 h2\n    | (Implicit _, Originated _) -> -1\n    | (Originated _, Implicit _) -> 1\nend)\n\ntype contract = t\n\nlet blake2b_hash_size =\n  let open Cache_memory_helpers in\n  header_size +! word_size +! string_size_gen 20\n\nlet public_key_hash_in_memory_size =\n  let open Cache_memory_helpers in\n  header_size +! word_size +! blake2b_hash_size\n\nlet in_memory_size =\n  let open Cache_memory_helpers in\n  function\n  | Implicit _ -> header_size +! word_size +! public_key_hash_in_memory_size\n  | Originated _ -> header_size +! word_size +! blake2b_hash_size\n\ntype error += Invalid_contract_notation of string (* `Permanent *)\n\nlet to_b58check = function\n  | Implicit pbk -> Signature.Public_key_hash.to_b58check pbk\n  | Originated h -> Contract_hash.to_b58check h\n\nlet of_b58check s =\n  match Base58.decode s with\n  | Some data -> (\n      match data with\n      | Ed25519.Public_key_hash.Data h -> ok (Implicit (Signature.Ed25519 h))\n      | Secp256k1.Public_key_hash.Data h ->\n          ok (Implicit (Signature.Secp256k1 h))\n      | P256.Public_key_hash.Data h -> ok (Implicit (Signature.P256 h))\n      | Contract_hash.Data h -> ok (Originated h)\n      | _ -> error (Invalid_contract_notation s))\n  | None -> error (Invalid_contract_notation s)\n\nlet pp ppf = function\n  | Implicit pbk -> Signature.Public_key_hash.pp ppf pbk\n  | Originated h -> Contract_hash.pp ppf h\n\nlet pp_short ppf = function\n  | Implicit pbk -> Signature.Public_key_hash.pp_short ppf pbk\n  | Originated h -> Contract_hash.pp_short ppf h\n\nlet encoding =\n  let open Data_encoding in\n  def\n    \"contract_id\"\n    ~title:\"A contract handle\"\n    ~description:\n      \"A contract notation as given to an RPC or inside scripts. Can be a \\\n       base58 implicit contract hash or a base58 originated contract hash.\"\n  @@ splitted\n       ~binary:\n         (union\n            ~tag_size:`Uint8\n            [\n              case\n                (Tag 0)\n                ~title:\"Implicit\"\n                Signature.Public_key_hash.encoding\n                (function Implicit k -> Some k | _ -> None)\n                (fun k -> Implicit k);\n              case\n                (Tag 1)\n                (Fixed.add_padding Contract_hash.encoding 1)\n                ~title:\"Originated\"\n                (function Originated k -> Some k | _ -> None)\n                (fun k -> Originated k);\n            ])\n       ~json:\n         (conv\n            to_b58check\n            (fun s ->\n              match of_b58check s with\n              | Ok s -> s\n              | Error _ -> Json.cannot_destruct \"Invalid contract notation.\")\n            string)\n\nlet () =\n  let open Data_encoding in\n  register_error_kind\n    `Permanent\n    ~id:\"contract.invalid_contract_notation\"\n    ~title:\"Invalid contract notation\"\n    ~pp:(fun ppf x -> Format.fprintf ppf \"Invalid contract notation %S\" x)\n    ~description:\n      \"A malformed contract notation was given to an RPC or in a script.\"\n    (obj1 (req \"notation\" string))\n    (function Invalid_contract_notation loc -> Some loc | _ -> None)\n    (fun loc -> Invalid_contract_notation loc)\n\nlet implicit_contract id = Implicit id\n\nlet is_implicit = function Implicit m -> Some m | Originated _ -> None\n\nlet is_originated = function Implicit _ -> None | Originated h -> Some h\n\ntype origination_nonce = {\n  operation_hash : Operation_hash.t;\n  origination_index : int32;\n}\n\nlet origination_nonce_encoding =\n  let open Data_encoding in\n  conv\n    (fun {operation_hash; origination_index} ->\n      (operation_hash, origination_index))\n    (fun (operation_hash, origination_index) ->\n      {operation_hash; origination_index})\n  @@ obj2 (req \"operation\" Operation_hash.encoding) (dft \"index\" int32 0l)\n\nlet originated_contract nonce =\n  let data =\n    Data_encoding.Binary.to_bytes_exn origination_nonce_encoding nonce\n  in\n  Originated (Contract_hash.hash_bytes [data])\n\nlet originated_contracts\n    ~since:{origination_index = first; operation_hash = first_hash}\n    ~until:\n      ({origination_index = last; operation_hash = last_hash} as\n      origination_nonce) =\n  assert (Operation_hash.equal first_hash last_hash) ;\n  let[@coq_struct \"origination_index\"] rec contracts acc origination_index =\n    if Compare.Int32.(origination_index < first) then acc\n    else\n      let origination_nonce = {origination_nonce with origination_index} in\n      let acc = originated_contract origination_nonce :: acc in\n      contracts acc (Int32.pred origination_index)\n  in\n  contracts [] (Int32.pred last)\n\nlet initial_origination_nonce operation_hash =\n  {operation_hash; origination_index = 0l}\n\nlet incr_origination_nonce nonce =\n  let origination_index = Int32.succ nonce.origination_index in\n  {nonce with origination_index}\n\nlet rpc_arg =\n  let construct = to_b58check in\n  let destruct hash =\n    Result.map_error (fun _ -> \"Cannot parse contract id\") (of_b58check hash)\n  in\n  RPC_arg.make\n    ~descr:\"A contract identifier encoded in b58check.\"\n    ~name:\"contract_id\"\n    ~construct\n    ~destruct\n    ()\n\nmodule Index = struct\n  type t = contract\n\n  let path_length = 1\n\n  let to_path c l =\n    let raw_key = Data_encoding.Binary.to_bytes_exn encoding c in\n    let (`Hex key) = Hex.of_bytes raw_key in\n    key :: l\n\n  let of_path = function\n    | [key] ->\n        Option.bind\n          (Hex.to_bytes (`Hex key))\n          (Data_encoding.Binary.of_bytes_opt encoding)\n    | _ -> None\n\n  let rpc_arg = rpc_arg\n\n  let encoding = encoding\n\n  let compare = compare\nend\n" ;
                } ;
                { name = "Roll_repr_legacy" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype t = private int32\n\ntype roll = t\n\nval encoding : roll Data_encoding.t\n\nval rpc_arg : roll RPC_arg.t\n\nval random : Seed_repr.sequence -> bound:roll -> roll * Seed_repr.sequence\n\nval first : roll\n\nval succ : roll -> roll\n\nval to_int32 : roll -> Int32.t\n\nval ( = ) : roll -> roll -> bool\n\nmodule Index : Storage_description.INDEX with type t = roll\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ninclude Compare.Int32\n\ntype roll = t\n\nlet encoding =\n  Data_encoding.(\n    with_decoding_guard\n      (fun t -> if t >= 0l then Ok () else Error \"Positive int32 required\")\n      int32)\n\nlet first = 0l\n\nlet succ i = Int32.succ i\n\nlet random sequence ~bound = Seed_repr.take_int32 sequence bound\n\nlet rpc_arg = RPC_arg.like RPC_arg.uint31 \"roll\"\n\nlet to_int32 v = v\n\nmodule Index = struct\n  type t = roll\n\n  let path_length = 1\n\n  let to_path roll l = Int32.to_string roll :: l\n\n  let of_path = function s :: _ -> Int32.of_string_opt s | _ -> None\n\n  let rpc_arg = rpc_arg\n\n  let encoding = encoding\n\n  let compare = compare\nend\n" ;
                } ;
                { name = "Vote_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** a protocol change proposal *)\ntype proposal = Protocol_hash.t\n\n(** votes can be for, against or neutral.\n    Neutral serves to count towards a quorum *)\ntype ballot = Yay | Nay | Pass\n\nval ballot_encoding : ballot Data_encoding.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype proposal = Protocol_hash.t\n\ntype ballot = Yay | Nay | Pass\n\nlet ballot_encoding =\n  let of_int8 = function\n    | 0 -> Ok Yay\n    | 1 -> Ok Nay\n    | 2 -> Ok Pass\n    | _ -> Error \"ballot_of_int8\"\n  in\n  let to_int8 = function Yay -> 0 | Nay -> 1 | Pass -> 2 in\n  let open Data_encoding in\n  (* union *)\n  splitted\n    ~binary:(conv_with_guard to_int8 of_int8 int8)\n    ~json:(string_enum [(\"yay\", Yay); (\"nay\", Nay); (\"pass\", Pass)])\n" ;
                } ;
                { name = "Block_header_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Representation of block headers. *)\n\ntype contents = {\n  payload_hash : Block_payload_hash.t;\n  payload_round : Round_repr.t;\n  seed_nonce_hash : Nonce_hash.t option;\n  proof_of_work_nonce : bytes;\n  liquidity_baking_escape_vote : bool;\n      (* set by baker to vote in favor of permanently disabling liquidity baking *)\n}\n\ntype protocol_data = {contents : contents; signature : Signature.t}\n\ntype t = {shell : Block_header.shell_header; protocol_data : protocol_data}\n\ntype block_header = t\n\ntype raw = Block_header.t\n\ntype shell_header = Block_header.shell_header\n\nval raw : block_header -> raw\n\nval encoding : block_header Data_encoding.encoding\n\nval raw_encoding : raw Data_encoding.t\n\nval contents_encoding : contents Data_encoding.t\n\nval unsigned_encoding : (Block_header.shell_header * contents) Data_encoding.t\n\nval protocol_data_encoding : protocol_data Data_encoding.encoding\n\nval shell_header_encoding : shell_header Data_encoding.encoding\n\ntype block_watermark = Block_header of Chain_id.t\n\nval to_watermark : block_watermark -> Signature.watermark\n\nval of_watermark : Signature.watermark -> block_watermark option\n\n(** The maximum size of block headers in bytes *)\nval max_header_length : int\n\nval hash : block_header -> Block_hash.t\n\nval hash_raw : raw -> Block_hash.t\n\ntype error +=\n  | (* Permanent *)\n      Invalid_block_signature of\n      Block_hash.t * Signature.Public_key_hash.t\n  | (* Permanent *) Invalid_stamp\n  | (* Permanent *)\n      Invalid_payload_hash of {\n      expected : Block_payload_hash.t;\n      provided : Block_payload_hash.t;\n    }\n  | (* Permanent *)\n      Locked_round_after_block_round of {\n      locked_round : Round_repr.t;\n      round : Round_repr.t;\n    }\n  | (* Permanent *)\n      Invalid_payload_round of {\n      payload_round : Round_repr.t;\n      round : Round_repr.t;\n    }\n  | (* Permanent *)\n      Insufficient_locked_round_evidence of {\n      voting_power : int;\n      consensus_threshold : int;\n    }\n  | (* Permanent *) Invalid_commitment of {expected : bool}\n\n(** Checks if the header that would be built from the given components\n   is valid for the given difficulty. The signature is not passed as\n   it is does not impact the proof-of-work stamp. The stamp is checked\n   on the hash of a block header whose signature has been\n   zeroed-out. *)\nmodule Proof_of_work : sig\n  val check_hash : Block_hash.t -> int64 -> bool\n\n  val check_header_proof_of_work_stamp :\n    shell_header -> contents -> int64 -> bool\n\n  val check_proof_of_work_stamp :\n    proof_of_work_threshold:int64 -> block_header -> unit tzresult\nend\n\n(** [check_timestamp ctxt timestamp round predecessor_timestamp\n   predecessor_round] verifies that the block's timestamp and round\n   are coherent with the predecessor block's timestamp and\n   round. Fails with an error if that is not the case. *)\nval check_timestamp :\n  Round_repr.Durations.t ->\n  timestamp:Time.t ->\n  round:Round_repr.t ->\n  predecessor_timestamp:Time.t ->\n  predecessor_round:Round_repr.t ->\n  unit tzresult\n\nval check_signature : t -> Chain_id.t -> Signature.Public_key.t -> unit tzresult\n\nval begin_validate_block_header :\n  block_header:t ->\n  chain_id:Chain_id.t ->\n  predecessor_timestamp:Time.t ->\n  predecessor_round:Round_repr.t ->\n  fitness:Fitness_repr.t ->\n  timestamp:Time.t ->\n  delegate_pk:Signature.public_key ->\n  round_durations:Round_repr.Durations.t ->\n  proof_of_work_threshold:int64 ->\n  expected_commitment:bool ->\n  unit tzresult\n\ntype locked_round_evidence = {\n  preendorsement_round : Round_repr.t;\n  preendorsement_count : int;\n}\n\ntype checkable_payload_hash =\n  | No_check\n  | Expected_payload_hash of Block_payload_hash.t\n\nval finalize_validate_block_header :\n  block_header_contents:contents ->\n  round:Round_repr.t ->\n  fitness:Fitness_repr.t ->\n  checkable_payload_hash:checkable_payload_hash ->\n  locked_round_evidence:locked_round_evidence option ->\n  consensus_threshold:int ->\n  unit tzresult\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Block header *)\n\ntype contents = {\n  payload_hash : Block_payload_hash.t;\n  payload_round : Round_repr.t;\n  seed_nonce_hash : Nonce_hash.t option;\n  proof_of_work_nonce : bytes;\n  liquidity_baking_escape_vote : bool;\n}\n\ntype protocol_data = {contents : contents; signature : Signature.t}\n\ntype t = {shell : Block_header.shell_header; protocol_data : protocol_data}\n\ntype block_header = t\n\ntype raw = Block_header.t\n\ntype shell_header = Block_header.shell_header\n\nlet raw_encoding = Block_header.encoding\n\nlet shell_header_encoding = Block_header.shell_header_encoding\n\ntype block_watermark = Block_header of Chain_id.t\n\nlet bytes_of_block_watermark = function\n  | Block_header chain_id ->\n      Bytes.cat (Bytes.of_string \"\\x11\") (Chain_id.to_bytes chain_id)\n\nlet to_watermark b = Signature.Custom (bytes_of_block_watermark b)\n\nlet of_watermark = function\n  | Signature.Custom b ->\n      if Compare.Int.(Bytes.length b > 0) then\n        match Bytes.get b 0 with\n        | '\\x11' ->\n            Option.map\n              (fun chain_id -> Block_header chain_id)\n              (Chain_id.of_bytes_opt (Bytes.sub b 1 (Bytes.length b - 1)))\n        | _ -> None\n      else None\n  | _ -> None\n\nlet contents_encoding =\n  let open Data_encoding in\n  def \"block_header.alpha.unsigned_contents\"\n  @@ conv\n       (fun {\n              payload_hash;\n              payload_round;\n              seed_nonce_hash;\n              proof_of_work_nonce;\n              liquidity_baking_escape_vote;\n            } ->\n         ( payload_hash,\n           payload_round,\n           proof_of_work_nonce,\n           seed_nonce_hash,\n           liquidity_baking_escape_vote ))\n       (fun ( payload_hash,\n              payload_round,\n              proof_of_work_nonce,\n              seed_nonce_hash,\n              liquidity_baking_escape_vote ) ->\n         {\n           payload_hash;\n           payload_round;\n           seed_nonce_hash;\n           proof_of_work_nonce;\n           liquidity_baking_escape_vote;\n         })\n       (obj5\n          (req \"payload_hash\" Block_payload_hash.encoding)\n          (req \"payload_round\" Round_repr.encoding)\n          (req\n             \"proof_of_work_nonce\"\n             (Fixed.bytes Constants_repr.proof_of_work_nonce_size))\n          (opt \"seed_nonce_hash\" Nonce_hash.encoding)\n          (req \"liquidity_baking_escape_vote\" Data_encoding.bool))\n\nlet protocol_data_encoding =\n  let open Data_encoding in\n  def \"block_header.alpha.signed_contents\"\n  @@ conv\n       (fun {contents; signature} -> (contents, signature))\n       (fun (contents, signature) -> {contents; signature})\n       (merge_objs\n          contents_encoding\n          (obj1 (req \"signature\" Signature.encoding)))\n\nlet raw {shell; protocol_data} =\n  let protocol_data =\n    Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data\n  in\n  {Block_header.shell; protocol_data}\n\nlet unsigned_encoding =\n  let open Data_encoding in\n  merge_objs Block_header.shell_header_encoding contents_encoding\n\nlet encoding =\n  let open Data_encoding in\n  def \"block_header.alpha.full_header\"\n  @@ conv\n       (fun {shell; protocol_data} -> (shell, protocol_data))\n       (fun (shell, protocol_data) -> {shell; protocol_data})\n       (merge_objs Block_header.shell_header_encoding protocol_data_encoding)\n\n(** Constants *)\n\nlet max_header_length =\n  let fake_level = Raw_level_repr.root in\n  let fake_round = Round_repr.zero in\n  let fake_fitness =\n    Fitness_repr.create_without_locked_round\n      ~level:fake_level\n      ~predecessor_round:fake_round\n      ~round:fake_round\n  in\n  let fake_shell =\n    {\n      Block_header.level = 0l;\n      proto_level = 0;\n      predecessor = Block_hash.zero;\n      timestamp = Time.of_seconds 0L;\n      validation_passes = 0;\n      operations_hash = Operation_list_list_hash.zero;\n      fitness = Fitness_repr.to_raw fake_fitness;\n      context = Context_hash.zero;\n    }\n  and fake_contents =\n    {\n      payload_hash = Block_payload_hash.zero;\n      payload_round = Round_repr.zero;\n      proof_of_work_nonce =\n        Bytes.make Constants_repr.proof_of_work_nonce_size '0';\n      seed_nonce_hash = Some Nonce_hash.zero;\n      liquidity_baking_escape_vote = false;\n    }\n  in\n  Data_encoding.Binary.length\n    encoding\n    {\n      shell = fake_shell;\n      protocol_data = {contents = fake_contents; signature = Signature.zero};\n    }\n\n(** Header parsing entry point  *)\n\nlet hash_raw = Block_header.hash\n\nlet hash {shell; protocol_data} =\n  Block_header.hash\n    {\n      shell;\n      protocol_data =\n        Data_encoding.Binary.to_bytes_exn protocol_data_encoding protocol_data;\n    }\n\ntype locked_round_evidence = {\n  preendorsement_round : Round_repr.t;\n  preendorsement_count : int;\n}\n\ntype error +=\n  | (* Permanent *)\n      Invalid_block_signature of\n      Block_hash.t * Signature.Public_key_hash.t\n  | (* Permanent *) Invalid_stamp\n  | (* Permanent *)\n      Invalid_payload_hash of {\n      expected : Block_payload_hash.t;\n      provided : Block_payload_hash.t;\n    }\n  | (* Permanent *)\n      Locked_round_after_block_round of {\n      locked_round : Round_repr.t;\n      round : Round_repr.t;\n    }\n  | (* Permanent *)\n      Invalid_payload_round of {\n      payload_round : Round_repr.t;\n      round : Round_repr.t;\n    }\n  | (* Permanent *)\n      Insufficient_locked_round_evidence of {\n      voting_power : int;\n      consensus_threshold : int;\n    }\n  | (* Permanent *) Invalid_commitment of {expected : bool}\n  | (* Permanent *) Wrong_timestamp of Time.t * Time.t\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"block_header.invalid_block_signature\"\n    ~title:\"Invalid block signature\"\n    ~description:\"A block was not signed with the expected private key.\"\n    ~pp:(fun ppf (block, pkh) ->\n      Format.fprintf\n        ppf\n        \"Invalid signature for block %a. Expected: %a.\"\n        Block_hash.pp_short\n        block\n        Signature.Public_key_hash.pp_short\n        pkh)\n    Data_encoding.(\n      obj2\n        (req \"block\" Block_hash.encoding)\n        (req \"expected\" Signature.Public_key_hash.encoding))\n    (function\n      | Invalid_block_signature (block, pkh) -> Some (block, pkh) | _ -> None)\n    (fun (block, pkh) -> Invalid_block_signature (block, pkh)) ;\n  register_error_kind\n    `Permanent\n    ~id:\"block_header.invalid_stamp\"\n    ~title:\"Insufficient block proof-of-work stamp\"\n    ~description:\"The block's proof-of-work stamp is insufficient\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"Insufficient proof-of-work stamp\")\n    Data_encoding.empty\n    (function Invalid_stamp -> Some () | _ -> None)\n    (fun () -> Invalid_stamp) ;\n  register_error_kind\n    `Permanent\n    ~id:\"block_header.invalid_payload_hash\"\n    ~title:\"Invalid payload hash\"\n    ~description:\"Invalid payload hash.\"\n    ~pp:(fun ppf (expected, provided) ->\n      Format.fprintf\n        ppf\n        \"Invalid payload hash (expected: %a, provided: %a).\"\n        Block_payload_hash.pp_short\n        expected\n        Block_payload_hash.pp_short\n        provided)\n    Data_encoding.(\n      obj2\n        (req \"expected\" Block_payload_hash.encoding)\n        (req \"provided\" Block_payload_hash.encoding))\n    (function\n      | Invalid_payload_hash {expected; provided} -> Some (expected, provided)\n      | _ -> None)\n    (fun (expected, provided) -> Invalid_payload_hash {expected; provided}) ;\n  () ;\n  register_error_kind\n    `Permanent\n    ~id:\"block_header.locked_round_after_block_round\"\n    ~title:\"Locked round after block round\"\n    ~description:\"Locked round after block round.\"\n    ~pp:(fun ppf (locked_round, round) ->\n      Format.fprintf\n        ppf\n        \"Locked round (%a) is after the block round (%a).\"\n        Round_repr.pp\n        locked_round\n        Round_repr.pp\n        round)\n    Data_encoding.(\n      obj2\n        (req \"locked_round\" Round_repr.encoding)\n        (req \"round\" Round_repr.encoding))\n    (function\n      | Locked_round_after_block_round {locked_round; round} ->\n          Some (locked_round, round)\n      | _ -> None)\n    (fun (locked_round, round) ->\n      Locked_round_after_block_round {locked_round; round}) ;\n  () ;\n  register_error_kind\n    `Permanent\n    ~id:\"block_header.invalid_payload_round\"\n    ~title:\"Invalid payload round\"\n    ~description:\"The given payload round is invalid.\"\n    ~pp:(fun ppf (payload_round, round) ->\n      Format.fprintf\n        ppf\n        \"The provided payload round (%a) is after the block round (%a).\"\n        Round_repr.pp\n        payload_round\n        Round_repr.pp\n        round)\n    Data_encoding.(\n      obj2\n        (req \"payload_round\" Round_repr.encoding)\n        (req \"round\" Round_repr.encoding))\n    (function\n      | Invalid_payload_round {payload_round; round} ->\n          Some (payload_round, round)\n      | _ -> None)\n    (fun (payload_round, round) -> Invalid_payload_round {payload_round; round}) ;\n  register_error_kind\n    `Permanent\n    ~id:\"block_header.insufficient_locked_round_evidence\"\n    ~title:\"Insufficient locked round evidence\"\n    ~description:\"Insufficient locked round evidence.\"\n    ~pp:(fun ppf (voting_power, consensus_threshold) ->\n      Format.fprintf\n        ppf\n        \"The provided locked round evidence is not sufficient: provided %d \\\n         voting power but was expecting at least %d.\"\n        voting_power\n        consensus_threshold)\n    Data_encoding.(\n      obj2 (req \"voting_power\" int31) (req \"consensus_threshold\" int31))\n    (function\n      | Insufficient_locked_round_evidence {voting_power; consensus_threshold}\n        ->\n          Some (voting_power, consensus_threshold)\n      | _ -> None)\n    (fun (voting_power, consensus_threshold) ->\n      Insufficient_locked_round_evidence {voting_power; consensus_threshold}) ;\n  register_error_kind\n    `Permanent\n    ~id:\"block_header.invalid_commitment\"\n    ~title:\"Invalid commitment in block header\"\n    ~description:\"The block header has invalid commitment.\"\n    ~pp:(fun ppf expected ->\n      if expected then\n        Format.fprintf ppf \"Missing seed's nonce commitment in block header.\"\n      else\n        Format.fprintf ppf \"Unexpected seed's nonce commitment in block header.\")\n    Data_encoding.(obj1 (req \"expected\" bool))\n    (function Invalid_commitment {expected} -> Some expected | _ -> None)\n    (fun expected -> Invalid_commitment {expected}) ;\n  register_error_kind\n    `Permanent\n    ~id:\"block_header.wrong_timestamp\"\n    ~title:\"Wrong timestamp\"\n    ~description:\"Block timestamp not the expected one.\"\n    ~pp:(fun ppf (block_ts, expected_ts) ->\n      Format.fprintf\n        ppf\n        \"Wrong timestamp: block timestamp (%a) not the expected one (%a)\"\n        Time.pp_hum\n        block_ts\n        Time.pp_hum\n        expected_ts)\n    Data_encoding.(\n      obj2\n        (req \"block_timestamp\" Time.encoding)\n        (req \"expected_timestamp\" Time.encoding))\n    (function Wrong_timestamp (t1, t2) -> Some (t1, t2) | _ -> None)\n    (fun (t1, t2) -> Wrong_timestamp (t1, t2))\n\nlet check_signature (block : t) (chain_id : Chain_id.t)\n    (key : Signature.Public_key.t) =\n  let check_signature key ({shell; protocol_data = {contents; signature}} : t) =\n    let unsigned_header =\n      Data_encoding.Binary.to_bytes_exn unsigned_encoding (shell, contents)\n    in\n    Signature.check\n      ~watermark:(to_watermark (Block_header chain_id))\n      key\n      signature\n      unsigned_header\n  in\n  if check_signature key block then ok ()\n  else\n    error (Invalid_block_signature (hash block, Signature.Public_key.hash key))\n\nlet check_payload_round ~round ~payload_round =\n  error_when\n    Round_repr.(payload_round > round)\n    (Invalid_payload_round {payload_round; round})\n\nlet check_timestamp round_durations ~timestamp ~round ~predecessor_timestamp\n    ~predecessor_round =\n  Round_repr.timestamp_of_round\n    round_durations\n    ~predecessor_timestamp\n    ~predecessor_round\n    ~round\n  >>? fun expected_timestamp ->\n  if Time_repr.(expected_timestamp = timestamp) then Error_monad.ok ()\n  else error (Wrong_timestamp (timestamp, expected_timestamp))\n\nmodule Proof_of_work = struct\n  let check_hash hash stamp_threshold =\n    let bytes = Block_hash.to_bytes hash in\n    let word = TzEndian.get_int64 bytes 0 in\n    Compare.Uint64.(word <= stamp_threshold)\n\n  let check_header_proof_of_work_stamp shell contents stamp_threshold =\n    let hash =\n      hash {shell; protocol_data = {contents; signature = Signature.zero}}\n    in\n    check_hash hash stamp_threshold\n\n  let check_proof_of_work_stamp ~proof_of_work_threshold block =\n    if\n      check_header_proof_of_work_stamp\n        block.shell\n        block.protocol_data.contents\n        proof_of_work_threshold\n    then ok ()\n    else error Invalid_stamp\nend\n\nlet begin_validate_block_header ~(block_header : t) ~(chain_id : Chain_id.t)\n    ~(predecessor_timestamp : Time.t) ~(predecessor_round : Round_repr.t)\n    ~(fitness : Fitness_repr.t) ~(timestamp : Time.t)\n    ~(delegate_pk : Signature.Public_key.t)\n    ~(round_durations : Round_repr.Durations.t)\n    ~(proof_of_work_threshold : int64) ~(expected_commitment : bool) =\n  (* Level relationship between current node and the predecessor is\n     done by the shell. We know that level is predecessor level + 1.\n     The predecessor block hash is guaranteed by the shell to be the\n     one in the shell header.  The operations are guaranteed to\n     correspond to the shell_header.operations_hash by the shell *)\n  let {payload_round; seed_nonce_hash; _} =\n    block_header.protocol_data.contents\n  in\n  let raw_level = block_header.shell.level in\n  Proof_of_work.check_proof_of_work_stamp ~proof_of_work_threshold block_header\n  >>? fun () ->\n  Raw_level_repr.of_int32 raw_level >>? fun level ->\n  check_signature block_header chain_id delegate_pk >>? fun () ->\n  let round = Fitness_repr.round fitness in\n  check_payload_round ~round ~payload_round >>? fun () ->\n  check_timestamp\n    round_durations\n    ~predecessor_timestamp\n    ~predecessor_round\n    ~timestamp\n    ~round\n  >>? fun () ->\n  Fitness_repr.check_except_locked_round fitness ~level ~predecessor_round\n  >>? fun () ->\n  let has_commitment =\n    match seed_nonce_hash with None -> false | Some _ -> true\n  in\n  error_unless\n    Compare.Bool.(has_commitment = expected_commitment)\n    (Invalid_commitment {expected = expected_commitment})\n\ntype checkable_payload_hash =\n  | No_check\n  | Expected_payload_hash of Block_payload_hash.t\n\nlet finalize_validate_block_header ~(block_header_contents : contents)\n    ~(round : Round_repr.t)\n    ~(* We have to check the round because in the construction case it was\n        deduced from the time *)\n    (fitness : Fitness_repr.t)\n    ~(checkable_payload_hash : checkable_payload_hash)\n    ~(locked_round_evidence : locked_round_evidence option)\n    ~(consensus_threshold : int) =\n  let {\n    payload_hash = actual_payload_hash;\n    seed_nonce_hash = _;\n    proof_of_work_nonce = _;\n    _;\n  } =\n    block_header_contents\n  in\n  (match checkable_payload_hash with\n  | No_check -> Result.return_unit\n  | Expected_payload_hash bph ->\n      error_unless\n        (Block_payload_hash.equal actual_payload_hash bph)\n        (Invalid_payload_hash {expected = bph; provided = actual_payload_hash}))\n  >>? fun () ->\n  (match locked_round_evidence with\n  | None -> ok None\n  | Some {preendorsement_count; preendorsement_round} ->\n      error_when\n        Round_repr.(preendorsement_round >= round)\n        (Locked_round_after_block_round\n           {locked_round = preendorsement_round; round})\n      >>? fun () ->\n      error_when\n        Compare.Int.(preendorsement_count < consensus_threshold)\n        (Insufficient_locked_round_evidence\n           {voting_power = preendorsement_count; consensus_threshold})\n      >>? fun () -> ok (Some preendorsement_round))\n  >>? fun locked_round -> Fitness_repr.check_locked_round fitness ~locked_round\n" ;
                } ;
                { name = "Operation_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Tezos Protocol Implementation - Low level Repr. of Operations\n\n    Defines kinds of operations that can be performed on chain:\n    - preendorsement\n    - endorsement\n    - double baking evidence\n    - double preendorsing evidence\n    - double endorsing evidence\n    - seed nonce revelation\n    - account activation\n    - proposal (see: [Voting_repr])\n    - ballot (see: [Voting_repr])\n    - failing noop\n    - manager operation (which in turn has several types):\n      - revelation\n      - transaction\n      - origination\n      - delegation\n      - set deposits limitation\n\n    Each of them can be encoded as raw bytes. Operations are distinguished at\n    type level using phantom type parameters. [packed_operation] type allows\n    for unifying them when required, for instance to put them on a single\n    list. *)\n\nmodule Kind : sig\n  type preendorsement_consensus_kind = Preendorsement_consensus_kind\n\n  type endorsement_consensus_kind = Endorsement_consensus_kind\n\n  type 'a consensus =\n    | Preendorsement_kind : preendorsement_consensus_kind consensus\n    | Endorsement_kind : endorsement_consensus_kind consensus\n\n  type preendorsement = preendorsement_consensus_kind consensus\n\n  type endorsement = endorsement_consensus_kind consensus\n\n  type seed_nonce_revelation = Seed_nonce_revelation_kind\n\n  type 'a double_consensus_operation_evidence =\n    | Double_consensus_operation_evidence\n\n  type double_endorsement_evidence =\n    endorsement_consensus_kind double_consensus_operation_evidence\n\n  type double_preendorsement_evidence =\n    preendorsement_consensus_kind double_consensus_operation_evidence\n\n  type double_baking_evidence = Double_baking_evidence_kind\n\n  type activate_account = Activate_account_kind\n\n  type proposals = Proposals_kind\n\n  type ballot = Ballot_kind\n\n  type reveal = Reveal_kind\n\n  type transaction = Transaction_kind\n\n  type origination = Origination_kind\n\n  type delegation = Delegation_kind\n\n  type set_deposits_limit = Set_deposits_limit_kind\n\n  type failing_noop = Failing_noop_kind\n\n  type register_global_constant = Register_global_constant_kind\n\n  type 'a manager =\n    | Reveal_manager_kind : reveal manager\n    | Transaction_manager_kind : transaction manager\n    | Origination_manager_kind : origination manager\n    | Delegation_manager_kind : delegation manager\n    | Register_global_constant_manager_kind : register_global_constant manager\n    | Set_deposits_limit_manager_kind : set_deposits_limit manager\nend\n\ntype 'a consensus_operation_type =\n  | Endorsement : Kind.endorsement consensus_operation_type\n  | Preendorsement : Kind.preendorsement consensus_operation_type\n\nval pp_operation_kind :\n  Format.formatter -> 'kind consensus_operation_type -> unit\n\ntype consensus_content = {\n  slot : Slot_repr.t;\n  (* By convention, this is the validator's first slot. *)\n  level : Raw_level_repr.t;\n  (* The level of (pre)endorsed block. *)\n  round : Round_repr.t;\n  (* The round of (pre)endorsed block. *)\n  block_payload_hash : Block_payload_hash.t;\n      (* The payload hash of (pre)endorsed block. *)\n}\n\nval consensus_content_encoding : consensus_content Data_encoding.t\n\nval pp_consensus_content : Format.formatter -> consensus_content -> unit\n\ntype consensus_watermark =\n  | Endorsement of Chain_id.t\n  | Preendorsement of Chain_id.t\n\nval to_watermark : consensus_watermark -> Signature.watermark\n\nval of_watermark : Signature.watermark -> consensus_watermark option\n\ntype raw = Operation.t = {shell : Operation.shell_header; proto : bytes}\n\nval raw_encoding : raw Data_encoding.t\n\ntype 'kind operation = {\n  shell : Operation.shell_header;\n  protocol_data : 'kind protocol_data;\n}\n\nand 'kind protocol_data = {\n  contents : 'kind contents_list;\n  signature : Signature.t option;\n}\n\nand _ contents_list =\n  | Single : 'kind contents -> 'kind contents_list\n  | Cons :\n      'kind Kind.manager contents * 'rest Kind.manager contents_list\n      -> ('kind * 'rest) Kind.manager contents_list\n\nand _ contents =\n  | Preendorsement : consensus_content -> Kind.preendorsement contents\n  | Endorsement : consensus_content -> Kind.endorsement contents\n  | Seed_nonce_revelation : {\n      level : Raw_level_repr.t;\n      nonce : Seed_repr.nonce;\n    }\n      -> Kind.seed_nonce_revelation contents\n  | Double_preendorsement_evidence : {\n      op1 : Kind.preendorsement operation;\n      op2 : Kind.preendorsement operation;\n    }\n      -> Kind.double_preendorsement_evidence contents\n  | Double_endorsement_evidence : {\n      op1 : Kind.endorsement operation;\n      op2 : Kind.endorsement operation;\n    }\n      -> Kind.double_endorsement_evidence contents\n  | Double_baking_evidence : {\n      bh1 : Block_header_repr.t;\n      bh2 : Block_header_repr.t;\n    }\n      -> Kind.double_baking_evidence contents\n  | Activate_account : {\n      id : Ed25519.Public_key_hash.t;\n      activation_code : Blinded_public_key_hash.activation_code;\n    }\n      -> Kind.activate_account contents\n  | Proposals : {\n      source : Signature.Public_key_hash.t;\n      period : int32;\n      proposals : Protocol_hash.t list;\n    }\n      -> Kind.proposals contents\n  | Ballot : {\n      source : Signature.Public_key_hash.t;\n      period : int32;\n      proposal : Protocol_hash.t;\n      ballot : Vote_repr.ballot;\n    }\n      -> Kind.ballot contents\n  | Failing_noop : string -> Kind.failing_noop contents\n  | Manager_operation : {\n      source : Signature.Public_key_hash.t;\n      fee : Tez_repr.tez;\n      counter : counter;\n      operation : 'kind manager_operation;\n      gas_limit : Gas_limit_repr.Arith.integral;\n      storage_limit : Z.t;\n    }\n      -> 'kind Kind.manager contents\n\nand _ manager_operation =\n  | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation\n  | Transaction : {\n      amount : Tez_repr.tez;\n      parameters : Script_repr.lazy_expr;\n      entrypoint : string;\n      destination : Contract_repr.contract;\n    }\n      -> Kind.transaction manager_operation\n  | Origination : {\n      delegate : Signature.Public_key_hash.t option;\n      script : Script_repr.t;\n      credit : Tez_repr.tez;\n      preorigination : Contract_repr.t option;\n    }\n      -> Kind.origination manager_operation\n  | Delegation :\n      Signature.Public_key_hash.t option\n      -> Kind.delegation manager_operation\n  | Register_global_constant : {\n      value : Script_repr.lazy_expr;\n    }\n      -> Kind.register_global_constant manager_operation\n  | Set_deposits_limit :\n      Tez_repr.t option\n      -> Kind.set_deposits_limit manager_operation\n\nand counter = Z.t\n\ntype 'kind internal_operation = {\n  source : Contract_repr.contract;\n  operation : 'kind manager_operation;\n  nonce : int;\n}\n\ntype packed_manager_operation =\n  | Manager : 'kind manager_operation -> packed_manager_operation\n\ntype packed_contents = Contents : 'kind contents -> packed_contents\n\ntype packed_contents_list =\n  | Contents_list : 'kind contents_list -> packed_contents_list\n\nval of_list : packed_contents list -> packed_contents_list tzresult\n\nval to_list : packed_contents_list -> packed_contents list\n\ntype packed_protocol_data =\n  | Operation_data : 'kind protocol_data -> packed_protocol_data\n\ntype packed_operation = {\n  shell : Operation.shell_header;\n  protocol_data : packed_protocol_data;\n}\n\nval pack : 'kind operation -> packed_operation\n\ntype packed_internal_operation =\n  | Internal_operation : 'kind internal_operation -> packed_internal_operation\n\nval manager_kind : 'kind manager_operation -> 'kind Kind.manager\n\nval encoding : packed_operation Data_encoding.t\n\nval contents_encoding : packed_contents Data_encoding.t\n\nval contents_list_encoding : packed_contents_list Data_encoding.t\n\nval protocol_data_encoding : packed_protocol_data Data_encoding.t\n\nval unsigned_operation_encoding :\n  (Operation.shell_header * packed_contents_list) Data_encoding.t\n\nval raw : _ operation -> raw\n\nval hash_raw : raw -> Operation_hash.t\n\nval hash : _ operation -> Operation_hash.t\n\nval hash_packed : packed_operation -> Operation_hash.t\n\nval acceptable_passes : packed_operation -> int list\n\ntype error += Missing_signature (* `Permanent *)\n\ntype error += Invalid_signature (* `Permanent *)\n\nval check_signature :\n  Signature.Public_key.t -> Chain_id.t -> _ operation -> unit tzresult\n\nval internal_operation_encoding : packed_internal_operation Data_encoding.t\n\ntype ('a, 'b) eq = Eq : ('a, 'a) eq\n\nval equal : 'a operation -> 'b operation -> ('a, 'b) eq option\n\nval packed_internal_operation_in_memory_size :\n  packed_internal_operation -> Cache_memory_helpers.nodes_and_size\n\nmodule Encoding : sig\n  type 'b case =\n    | Case : {\n        tag : int;\n        name : string;\n        encoding : 'a Data_encoding.t;\n        select : packed_contents -> 'b contents option;\n        proj : 'b contents -> 'a;\n        inj : 'a -> 'b contents;\n      }\n        -> 'b case\n\n  val preendorsement_case : Kind.preendorsement case\n\n  val endorsement_case : Kind.endorsement case\n\n  val seed_nonce_revelation_case : Kind.seed_nonce_revelation case\n\n  val double_preendorsement_evidence_case :\n    Kind.double_preendorsement_evidence case\n\n  val double_endorsement_evidence_case : Kind.double_endorsement_evidence case\n\n  val double_baking_evidence_case : Kind.double_baking_evidence case\n\n  val activate_account_case : Kind.activate_account case\n\n  val proposals_case : Kind.proposals case\n\n  val ballot_case : Kind.ballot case\n\n  val failing_noop_case : Kind.failing_noop case\n\n  val reveal_case : Kind.reveal Kind.manager case\n\n  val transaction_case : Kind.transaction Kind.manager case\n\n  val origination_case : Kind.origination Kind.manager case\n\n  val delegation_case : Kind.delegation Kind.manager case\n\n  val register_global_constant_case :\n    Kind.register_global_constant Kind.manager case\n\n  val set_deposits_limit_case : Kind.set_deposits_limit Kind.manager case\n\n  module Manager_operations : sig\n    type 'b case =\n      | MCase : {\n          tag : int;\n          name : string;\n          encoding : 'a Data_encoding.t;\n          select : packed_manager_operation -> 'kind manager_operation option;\n          proj : 'kind manager_operation -> 'a;\n          inj : 'a -> 'kind manager_operation;\n        }\n          -> 'kind case\n\n    val reveal_case : Kind.reveal case\n\n    val transaction_case : Kind.transaction case\n\n    val origination_case : Kind.origination case\n\n    val delegation_case : Kind.delegation case\n\n    val register_global_constant_case : Kind.register_global_constant case\n\n    val set_deposits_limit_case : Kind.set_deposits_limit case\n  end\nend\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(* Tezos Protocol Implementation - Low level Repr. of Operations *)\n\nmodule Kind = struct\n  type preendorsement_consensus_kind = Preendorsement_consensus_kind\n\n  type endorsement_consensus_kind = Endorsement_consensus_kind\n\n  type 'a consensus =\n    | Preendorsement_kind : preendorsement_consensus_kind consensus\n    | Endorsement_kind : endorsement_consensus_kind consensus\n\n  type preendorsement = preendorsement_consensus_kind consensus\n\n  type endorsement = endorsement_consensus_kind consensus\n\n  type seed_nonce_revelation = Seed_nonce_revelation_kind\n\n  type 'a double_consensus_operation_evidence =\n    | Double_consensus_operation_evidence\n\n  type double_endorsement_evidence =\n    endorsement_consensus_kind double_consensus_operation_evidence\n\n  type double_preendorsement_evidence =\n    preendorsement_consensus_kind double_consensus_operation_evidence\n\n  type double_baking_evidence = Double_baking_evidence_kind\n\n  type activate_account = Activate_account_kind\n\n  type proposals = Proposals_kind\n\n  type ballot = Ballot_kind\n\n  type reveal = Reveal_kind\n\n  type transaction = Transaction_kind\n\n  type origination = Origination_kind\n\n  type delegation = Delegation_kind\n\n  type set_deposits_limit = Set_deposits_limit_kind\n\n  type failing_noop = Failing_noop_kind\n\n  type register_global_constant = Register_global_constant_kind\n\n  type 'a manager =\n    | Reveal_manager_kind : reveal manager\n    | Transaction_manager_kind : transaction manager\n    | Origination_manager_kind : origination manager\n    | Delegation_manager_kind : delegation manager\n    | Register_global_constant_manager_kind : register_global_constant manager\n    | Set_deposits_limit_manager_kind : set_deposits_limit manager\nend\n\ntype 'a consensus_operation_type =\n  | Endorsement : Kind.endorsement consensus_operation_type\n  | Preendorsement : Kind.preendorsement consensus_operation_type\n\nlet pp_operation_kind (type kind) ppf\n    (operation_kind : kind consensus_operation_type) =\n  match operation_kind with\n  | Endorsement -> Format.fprintf ppf \"Endorsement\"\n  | Preendorsement -> Format.fprintf ppf \"Preendorsement\"\n\ntype consensus_content = {\n  slot : Slot_repr.t;\n  level : Raw_level_repr.t;\n  (* The level is not required to validate an endorsement when it corresponds\n     to the current payload, but if we want to filter endorsements, we need\n     the level. *)\n  round : Round_repr.t;\n  block_payload_hash : Block_payload_hash.t;\n      (* NOTE: This could be just the hash of the set of operations (the\n         actual payload). The grandfather block hash should already be\n         fixed by the operation.shell.branch field.  This is not really\n         important but could make things easier for debugging *)\n}\n\nlet consensus_content_encoding =\n  let open Data_encoding in\n  conv\n    (fun {slot; level; round; block_payload_hash} ->\n      (slot, level, round, block_payload_hash))\n    (fun (slot, level, round, block_payload_hash) ->\n      {slot; level; round; block_payload_hash})\n    (obj4\n       (req \"slot\" Slot_repr.encoding)\n       (req \"level\" Raw_level_repr.encoding)\n       (req \"round\" Round_repr.encoding)\n       (req \"block_payload_hash\" Block_payload_hash.encoding))\n\nlet pp_consensus_content ppf content =\n  Format.fprintf\n    ppf\n    \"(%ld, %a, %a, %a)\"\n    (Raw_level_repr.to_int32 content.level)\n    Round_repr.pp\n    content.round\n    Slot_repr.pp\n    content.slot\n    Block_payload_hash.pp_short\n    content.block_payload_hash\n\ntype consensus_watermark =\n  | Endorsement of Chain_id.t\n  | Preendorsement of Chain_id.t\n\nlet bytes_of_consensus_watermark = function\n  | Preendorsement chain_id ->\n      Bytes.cat (Bytes.of_string \"\\x12\") (Chain_id.to_bytes chain_id)\n  | Endorsement chain_id ->\n      Bytes.cat (Bytes.of_string \"\\x13\") (Chain_id.to_bytes chain_id)\n\nlet to_watermark w = Signature.Custom (bytes_of_consensus_watermark w)\n\nlet of_watermark = function\n  | Signature.Custom b ->\n      if Compare.Int.(Bytes.length b > 0) then\n        match Bytes.get b 0 with\n        | '\\x12' ->\n            Option.map\n              (fun chain_id -> Endorsement chain_id)\n              (Chain_id.of_bytes_opt (Bytes.sub b 1 (Bytes.length b - 1)))\n        | '\\x13' ->\n            Option.map\n              (fun chain_id -> Preendorsement chain_id)\n              (Chain_id.of_bytes_opt (Bytes.sub b 1 (Bytes.length b - 1)))\n        | _ -> None\n      else None\n  | _ -> None\n\ntype raw = Operation.t = {shell : Operation.shell_header; proto : bytes}\n\nlet raw_encoding = Operation.encoding\n\ntype 'kind operation = {\n  shell : Operation.shell_header;\n  protocol_data : 'kind protocol_data;\n}\n\nand 'kind protocol_data = {\n  contents : 'kind contents_list;\n  signature : Signature.t option;\n}\n\nand _ contents_list =\n  | Single : 'kind contents -> 'kind contents_list\n  | Cons :\n      'kind Kind.manager contents * 'rest Kind.manager contents_list\n      -> ('kind * 'rest) Kind.manager contents_list\n\nand _ contents =\n  | Preendorsement : consensus_content -> Kind.preendorsement contents\n  | Endorsement : consensus_content -> Kind.endorsement contents\n  | Seed_nonce_revelation : {\n      level : Raw_level_repr.t;\n      nonce : Seed_repr.nonce;\n    }\n      -> Kind.seed_nonce_revelation contents\n  | Double_preendorsement_evidence : {\n      op1 : Kind.preendorsement operation;\n      op2 : Kind.preendorsement operation;\n    }\n      -> Kind.double_preendorsement_evidence contents\n  | Double_endorsement_evidence : {\n      op1 : Kind.endorsement operation;\n      op2 : Kind.endorsement operation;\n    }\n      -> Kind.double_endorsement_evidence contents\n  | Double_baking_evidence : {\n      bh1 : Block_header_repr.t;\n      bh2 : Block_header_repr.t;\n    }\n      -> Kind.double_baking_evidence contents\n  | Activate_account : {\n      id : Ed25519.Public_key_hash.t;\n      activation_code : Blinded_public_key_hash.activation_code;\n    }\n      -> Kind.activate_account contents\n  | Proposals : {\n      source : Signature.Public_key_hash.t;\n      period : int32;\n      proposals : Protocol_hash.t list;\n    }\n      -> Kind.proposals contents\n  | Ballot : {\n      source : Signature.Public_key_hash.t;\n      period : int32;\n      proposal : Protocol_hash.t;\n      ballot : Vote_repr.ballot;\n    }\n      -> Kind.ballot contents\n  | Failing_noop : string -> Kind.failing_noop contents\n  | Manager_operation : {\n      source : Signature.public_key_hash;\n      fee : Tez_repr.tez;\n      counter : counter;\n      operation : 'kind manager_operation;\n      gas_limit : Gas_limit_repr.Arith.integral;\n      storage_limit : Z.t;\n    }\n      -> 'kind Kind.manager contents\n\nand _ manager_operation =\n  | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation\n  | Transaction : {\n      amount : Tez_repr.tez;\n      parameters : Script_repr.lazy_expr;\n      entrypoint : string;\n      destination : Contract_repr.contract;\n    }\n      -> Kind.transaction manager_operation\n  | Origination : {\n      delegate : Signature.Public_key_hash.t option;\n      script : Script_repr.t;\n      credit : Tez_repr.tez;\n      preorigination : Contract_repr.t option;\n    }\n      -> Kind.origination manager_operation\n  | Delegation :\n      Signature.Public_key_hash.t option\n      -> Kind.delegation manager_operation\n  | Register_global_constant : {\n      value : Script_repr.lazy_expr;\n    }\n      -> Kind.register_global_constant manager_operation\n  | Set_deposits_limit :\n      Tez_repr.t option\n      -> Kind.set_deposits_limit manager_operation\n\nand counter = Z.t\n\nlet manager_kind : type kind. kind manager_operation -> kind Kind.manager =\n  function\n  | Reveal _ -> Kind.Reveal_manager_kind\n  | Transaction _ -> Kind.Transaction_manager_kind\n  | Origination _ -> Kind.Origination_manager_kind\n  | Delegation _ -> Kind.Delegation_manager_kind\n  | Register_global_constant _ -> Kind.Register_global_constant_manager_kind\n  | Set_deposits_limit _ -> Kind.Set_deposits_limit_manager_kind\n\ntype 'kind internal_operation = {\n  source : Contract_repr.contract;\n  operation : 'kind manager_operation;\n  nonce : int;\n}\n\ntype packed_manager_operation =\n  | Manager : 'kind manager_operation -> packed_manager_operation\n\ntype packed_contents = Contents : 'kind contents -> packed_contents\n\ntype packed_contents_list =\n  | Contents_list : 'kind contents_list -> packed_contents_list\n\ntype packed_protocol_data =\n  | Operation_data : 'kind protocol_data -> packed_protocol_data\n\ntype packed_operation = {\n  shell : Operation.shell_header;\n  protocol_data : packed_protocol_data;\n}\n\nlet pack ({shell; protocol_data} : _ operation) : packed_operation =\n  {shell; protocol_data = Operation_data protocol_data}\n\ntype packed_internal_operation =\n  | Internal_operation : 'kind internal_operation -> packed_internal_operation\n\nlet rec to_list = function\n  | Contents_list (Single o) -> [Contents o]\n  | Contents_list (Cons (o, os)) -> Contents o :: to_list (Contents_list os)\n\n(* This first version of of_list has the type (_, string) result expected by\n   the conv_with_guard combinator of Data_encoding. For a more conventional\n   return type see [of_list] below. *)\nlet rec of_list_internal = function\n  | [] -> Error \"Operation lists should not be empty.\"\n  | [Contents o] -> Ok (Contents_list (Single o))\n  | Contents o :: os -> (\n      of_list_internal os >>? fun (Contents_list os) ->\n      match (o, os) with\n      | (Manager_operation _, Single (Manager_operation _)) ->\n          Ok (Contents_list (Cons (o, os)))\n      | (Manager_operation _, Cons _) -> Ok (Contents_list (Cons (o, os)))\n      | _ ->\n          Error\n            \"Operation list of length > 1 should only contains manager \\\n             operations.\")\n\ntype error += Contents_list_error of string (* `Permanent *)\n\nlet of_list l =\n  match of_list_internal l with\n  | Ok contents -> Ok contents\n  | Error s -> error @@ Contents_list_error s\n\nmodule Encoding = struct\n  open Data_encoding\n\n  let case tag name args proj inj =\n    case\n      tag\n      ~title:(String.capitalize_ascii name)\n      (merge_objs (obj1 (req \"kind\" (constant name))) args)\n      (fun x -> match proj x with None -> None | Some x -> Some ((), x))\n      (fun ((), x) -> inj x)\n\n  module Manager_operations = struct\n    type 'kind case =\n      | MCase : {\n          tag : int;\n          name : string;\n          encoding : 'a Data_encoding.t;\n          select : packed_manager_operation -> 'kind manager_operation option;\n          proj : 'kind manager_operation -> 'a;\n          inj : 'a -> 'kind manager_operation;\n        }\n          -> 'kind case\n    [@@coq_force_gadt]\n\n    let[@coq_axiom_with_reason \"gadt\"] reveal_case =\n      MCase\n        {\n          tag = 0;\n          name = \"reveal\";\n          encoding = obj1 (req \"public_key\" Signature.Public_key.encoding);\n          select = (function Manager (Reveal _ as op) -> Some op | _ -> None);\n          proj = (function Reveal pkh -> pkh);\n          inj = (fun pkh -> Reveal pkh);\n        }\n\n    let entrypoint_encoding =\n      def\n        ~title:\"entrypoint\"\n        ~description:\"Named entrypoint to a Michelson smart contract\"\n        \"entrypoint\"\n      @@\n      let builtin_case tag name =\n        Data_encoding.case\n          (Tag tag)\n          ~title:name\n          (constant name)\n          (fun n -> if Compare.String.(n = name) then Some () else None)\n          (fun () -> name)\n      in\n      union\n        [\n          builtin_case 0 \"default\";\n          builtin_case 1 \"root\";\n          builtin_case 2 \"do\";\n          builtin_case 3 \"set_delegate\";\n          builtin_case 4 \"remove_delegate\";\n          Data_encoding.case\n            (Tag 255)\n            ~title:\"named\"\n            (Bounded.string 31)\n            (fun s -> Some s)\n            (fun s -> s);\n        ]\n\n    let[@coq_axiom_with_reason \"gadt\"] transaction_case =\n      MCase\n        {\n          tag = 1;\n          name = \"transaction\";\n          encoding =\n            obj3\n              (req \"amount\" Tez_repr.encoding)\n              (req \"destination\" Contract_repr.encoding)\n              (opt\n                 \"parameters\"\n                 (obj2\n                    (req \"entrypoint\" entrypoint_encoding)\n                    (req \"value\" Script_repr.lazy_expr_encoding)));\n          select =\n            (function Manager (Transaction _ as op) -> Some op | _ -> None);\n          proj =\n            (function\n            | Transaction {amount; destination; parameters; entrypoint} ->\n                let parameters =\n                  if\n                    Script_repr.is_unit_parameter parameters\n                    && Compare.String.(entrypoint = \"default\")\n                  then None\n                  else Some (entrypoint, parameters)\n                in\n                (amount, destination, parameters));\n          inj =\n            (fun (amount, destination, parameters) ->\n              let (entrypoint, parameters) =\n                match parameters with\n                | None -> (\"default\", Script_repr.unit_parameter)\n                | Some (entrypoint, value) -> (entrypoint, value)\n              in\n              Transaction {amount; destination; parameters; entrypoint});\n        }\n\n    let[@coq_axiom_with_reason \"gadt\"] origination_case =\n      MCase\n        {\n          tag = 2;\n          name = \"origination\";\n          encoding =\n            obj3\n              (req \"balance\" Tez_repr.encoding)\n              (opt \"delegate\" Signature.Public_key_hash.encoding)\n              (req \"script\" Script_repr.encoding);\n          select =\n            (function Manager (Origination _ as op) -> Some op | _ -> None);\n          proj =\n            (function\n            | Origination\n                {\n                  credit;\n                  delegate;\n                  script;\n                  preorigination =\n                    _\n                    (* the hash is only used internally\n                               when originating from smart\n                               contracts, don't serialize it *);\n                } ->\n                (credit, delegate, script));\n          inj =\n            (fun (credit, delegate, script) ->\n              Origination {credit; delegate; script; preorigination = None});\n        }\n\n    let[@coq_axiom_with_reason \"gadt\"] delegation_case =\n      MCase\n        {\n          tag = 3;\n          name = \"delegation\";\n          encoding = obj1 (opt \"delegate\" Signature.Public_key_hash.encoding);\n          select =\n            (function Manager (Delegation _ as op) -> Some op | _ -> None);\n          proj = (function Delegation key -> key);\n          inj = (fun key -> Delegation key);\n        }\n\n    let[@coq_axiom_with_reason \"gadt\"] register_global_constant_case =\n      MCase\n        {\n          tag = 4;\n          name = \"register_global_constant\";\n          encoding = obj1 (req \"value\" Script_repr.lazy_expr_encoding);\n          select =\n            (function\n            | Manager (Register_global_constant _ as op) -> Some op | _ -> None);\n          proj = (function Register_global_constant {value} -> value);\n          inj = (fun value -> Register_global_constant {value});\n        }\n\n    let[@coq_axiom_with_reason \"gadt\"] set_deposits_limit_case =\n      MCase\n        {\n          tag = 5;\n          name = \"set_deposits_limit\";\n          encoding = obj1 (opt \"limit\" Tez_repr.encoding);\n          select =\n            (function\n            | Manager (Set_deposits_limit _ as op) -> Some op | _ -> None);\n          proj = (function Set_deposits_limit key -> key);\n          inj = (fun key -> Set_deposits_limit key);\n        }\n\n    let encoding =\n      let make (MCase {tag; name; encoding; select; proj; inj}) =\n        case\n          (Tag tag)\n          name\n          encoding\n          (fun o ->\n            match select o with None -> None | Some o -> Some (proj o))\n          (fun x -> Manager (inj x))\n      in\n      union\n        ~tag_size:`Uint8\n        [\n          make reveal_case;\n          make transaction_case;\n          make origination_case;\n          make delegation_case;\n          make register_global_constant_case;\n          make set_deposits_limit_case;\n        ]\n  end\n\n  type 'b case =\n    | Case : {\n        tag : int;\n        name : string;\n        encoding : 'a Data_encoding.t;\n        select : packed_contents -> 'b contents option;\n        proj : 'b contents -> 'a;\n        inj : 'a -> 'b contents;\n      }\n        -> 'b case\n\n  let preendorsement_case =\n    Case\n      {\n        tag = 20;\n        (* Preendorsement where added after *)\n        name = \"preendorsement\";\n        encoding = consensus_content_encoding;\n        select =\n          (function Contents (Preendorsement _ as op) -> Some op | _ -> None);\n        proj = (fun (Preendorsement preendorsement) -> preendorsement);\n        inj = (fun preendorsement -> Preendorsement preendorsement);\n      }\n\n  (* Defined before endorsement encoding because this is used there *)\n  let preendorsement_encoding =\n    let make (Case {tag; name; encoding; select = _; proj; inj}) =\n      case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x)\n    in\n    let to_list : Kind.preendorsement contents_list -> _ = function\n      | Single o -> o\n    in\n    let of_list : Kind.preendorsement contents -> _ = function\n      | o -> Single o\n    in\n    def \"inlined.preendorsement\"\n    @@ conv\n         (fun ({shell; protocol_data = {contents; signature}} : _ operation) ->\n           (shell, (contents, signature)))\n         (fun (shell, (contents, signature)) : _ operation ->\n           {shell; protocol_data = {contents; signature}})\n         (merge_objs\n            Operation.shell_header_encoding\n            (obj2\n               (req\n                  \"operations\"\n                  (conv to_list of_list\n                  @@ def \"inlined.preendorsement.contents\"\n                  @@ union [make preendorsement_case]))\n               (varopt \"signature\" Signature.encoding)))\n\n  let endorsement_encoding =\n    obj4\n      (req \"slot\" Slot_repr.encoding)\n      (req \"level\" Raw_level_repr.encoding)\n      (req \"round\" Round_repr.encoding)\n      (req \"block_payload_hash\" Block_payload_hash.encoding)\n\n  let endorsement_case =\n    Case\n      {\n        tag = 21;\n        name = \"endorsement\";\n        encoding = endorsement_encoding;\n        select =\n          (function Contents (Endorsement _ as op) -> Some op | _ -> None);\n        proj =\n          (fun [@coq_match_with_default] (Endorsement consensus_content) ->\n            ( consensus_content.slot,\n              consensus_content.level,\n              consensus_content.round,\n              consensus_content.block_payload_hash ));\n        inj =\n          (fun (slot, level, round, block_payload_hash) ->\n            Endorsement {slot; level; round; block_payload_hash});\n      }\n\n  let[@coq_axiom_with_reason \"gadt\"] endorsement_encoding =\n    let make (Case {tag; name; encoding; select = _; proj; inj}) =\n      case (Tag tag) name encoding (fun o -> Some (proj o)) (fun x -> inj x)\n    in\n    let to_list : Kind.endorsement contents_list -> _ = fun (Single o) -> o in\n    let of_list : Kind.endorsement contents -> _ = fun o -> Single o in\n    def \"inlined.endorsement\"\n    @@ conv\n         (fun ({shell; protocol_data = {contents; signature}} : _ operation) ->\n           (shell, (contents, signature)))\n         (fun (shell, (contents, signature)) : _ operation ->\n           {shell; protocol_data = {contents; signature}})\n         (merge_objs\n            Operation.shell_header_encoding\n            (obj2\n               (req\n                  \"operations\"\n                  (conv to_list of_list\n                  @@ def \"inlined.endorsement_mempool.contents\"\n                  @@ union [make endorsement_case]))\n               (varopt \"signature\" Signature.encoding)))\n\n  let[@coq_axiom_with_reason \"gadt\"] seed_nonce_revelation_case =\n    Case\n      {\n        tag = 1;\n        name = \"seed_nonce_revelation\";\n        encoding =\n          obj2\n            (req \"level\" Raw_level_repr.encoding)\n            (req \"nonce\" Seed_repr.nonce_encoding);\n        select =\n          (function\n          | Contents (Seed_nonce_revelation _ as op) -> Some op | _ -> None);\n        proj = (fun (Seed_nonce_revelation {level; nonce}) -> (level, nonce));\n        inj = (fun (level, nonce) -> Seed_nonce_revelation {level; nonce});\n      }\n\n  let[@coq_axiom_with_reason \"gadt\"] double_preendorsement_evidence_case :\n      Kind.double_preendorsement_evidence case =\n    Case\n      {\n        tag = 7;\n        name = \"double_preendorsement_evidence\";\n        encoding =\n          obj2\n            (req \"op1\" (dynamic_size preendorsement_encoding))\n            (req \"op2\" (dynamic_size preendorsement_encoding));\n        select =\n          (function\n          | Contents (Double_preendorsement_evidence _ as op) -> Some op\n          | _ -> None);\n        proj = (fun (Double_preendorsement_evidence {op1; op2}) -> (op1, op2));\n        inj = (fun (op1, op2) -> Double_preendorsement_evidence {op1; op2});\n      }\n\n  let[@coq_axiom_with_reason \"gadt\"] double_endorsement_evidence_case :\n      Kind.double_endorsement_evidence case =\n    Case\n      {\n        tag = 2;\n        name = \"double_endorsement_evidence\";\n        encoding =\n          obj2\n            (req \"op1\" (dynamic_size endorsement_encoding))\n            (req \"op2\" (dynamic_size endorsement_encoding));\n        select =\n          (function\n          | Contents (Double_endorsement_evidence _ as op) -> Some op\n          | _ -> None);\n        proj = (fun (Double_endorsement_evidence {op1; op2}) -> (op1, op2));\n        inj = (fun (op1, op2) -> Double_endorsement_evidence {op1; op2});\n      }\n\n  let[@coq_axiom_with_reason \"gadt\"] double_baking_evidence_case =\n    Case\n      {\n        tag = 3;\n        name = \"double_baking_evidence\";\n        encoding =\n          obj2\n            (req \"bh1\" (dynamic_size Block_header_repr.encoding))\n            (req \"bh2\" (dynamic_size Block_header_repr.encoding));\n        select =\n          (function\n          | Contents (Double_baking_evidence _ as op) -> Some op | _ -> None);\n        proj = (fun (Double_baking_evidence {bh1; bh2}) -> (bh1, bh2));\n        inj = (fun (bh1, bh2) -> Double_baking_evidence {bh1; bh2});\n      }\n\n  let[@coq_axiom_with_reason \"gadt\"] activate_account_case =\n    Case\n      {\n        tag = 4;\n        name = \"activate_account\";\n        encoding =\n          obj2\n            (req \"pkh\" Ed25519.Public_key_hash.encoding)\n            (req \"secret\" Blinded_public_key_hash.activation_code_encoding);\n        select =\n          (function\n          | Contents (Activate_account _ as op) -> Some op | _ -> None);\n        proj =\n          (fun (Activate_account {id; activation_code}) ->\n            (id, activation_code));\n        inj =\n          (fun (id, activation_code) -> Activate_account {id; activation_code});\n      }\n\n  let[@coq_axiom_with_reason \"gadt\"] proposals_case =\n    Case\n      {\n        tag = 5;\n        name = \"proposals\";\n        encoding =\n          obj3\n            (req \"source\" Signature.Public_key_hash.encoding)\n            (req \"period\" int32)\n            (req \"proposals\" (list Protocol_hash.encoding));\n        select =\n          (function Contents (Proposals _ as op) -> Some op | _ -> None);\n        proj =\n          (fun (Proposals {source; period; proposals}) ->\n            (source, period, proposals));\n        inj =\n          (fun (source, period, proposals) ->\n            Proposals {source; period; proposals});\n      }\n\n  let[@coq_axiom_with_reason \"gadt\"] ballot_case =\n    Case\n      {\n        tag = 6;\n        name = \"ballot\";\n        encoding =\n          obj4\n            (req \"source\" Signature.Public_key_hash.encoding)\n            (req \"period\" int32)\n            (req \"proposal\" Protocol_hash.encoding)\n            (req \"ballot\" Vote_repr.ballot_encoding);\n        select = (function Contents (Ballot _ as op) -> Some op | _ -> None);\n        proj =\n          (function\n          | Ballot {source; period; proposal; ballot} ->\n              (source, period, proposal, ballot));\n        inj =\n          (fun (source, period, proposal, ballot) ->\n            Ballot {source; period; proposal; ballot});\n      }\n\n  let failing_noop_case =\n    Case\n      {\n        tag = 17;\n        name = \"failing_noop\";\n        encoding = obj1 (req \"arbitrary\" Data_encoding.string);\n        select =\n          (function Contents (Failing_noop _ as op) -> Some op | _ -> None);\n        proj =\n          (function[@coq_match_with_default] Failing_noop message -> message);\n        inj = (function message -> Failing_noop message);\n      }\n\n  let manager_encoding =\n    obj5\n      (req \"source\" Signature.Public_key_hash.encoding)\n      (req \"fee\" Tez_repr.encoding)\n      (req \"counter\" (check_size 10 n))\n      (req \"gas_limit\" (check_size 10 Gas_limit_repr.Arith.n_integral_encoding))\n      (req \"storage_limit\" (check_size 10 n))\n\n  let extract : type kind. kind Kind.manager contents -> _ =\n    function[@coq_match_with_default]\n    | Manager_operation\n        {source; fee; counter; gas_limit; storage_limit; operation = _} ->\n        (source, fee, counter, gas_limit, storage_limit)\n\n  let rebuild (source, fee, counter, gas_limit, storage_limit) operation =\n    Manager_operation\n      {source; fee; counter; gas_limit; storage_limit; operation}\n\n  let[@coq_axiom_with_reason \"gadt\"] make_manager_case tag (type kind)\n      (Manager_operations.MCase mcase : kind Manager_operations.case) =\n    Case\n      {\n        tag;\n        name = mcase.name;\n        encoding = merge_objs manager_encoding mcase.encoding;\n        select =\n          (function\n          | Contents (Manager_operation ({operation; _} as op)) -> (\n              match mcase.select (Manager operation) with\n              | None -> None\n              | Some operation -> Some (Manager_operation {op with operation}))\n          | _ -> None);\n        proj =\n          (function\n          | Manager_operation {operation; _} as op ->\n              (extract op, mcase.proj operation));\n        inj = (fun (op, contents) -> rebuild op (mcase.inj contents));\n      }\n\n  let reveal_case = make_manager_case 107 Manager_operations.reveal_case\n\n  let transaction_case =\n    make_manager_case 108 Manager_operations.transaction_case\n\n  let origination_case =\n    make_manager_case 109 Manager_operations.origination_case\n\n  let delegation_case = make_manager_case 110 Manager_operations.delegation_case\n\n  let register_global_constant_case =\n    make_manager_case 111 Manager_operations.register_global_constant_case\n\n  let set_deposits_limit_case =\n    make_manager_case 112 Manager_operations.set_deposits_limit_case\n\n  let contents_encoding =\n    let make (Case {tag; name; encoding; select; proj; inj}) =\n      case\n        (Tag tag)\n        name\n        encoding\n        (fun o -> match select o with None -> None | Some o -> Some (proj o))\n        (fun x -> Contents (inj x))\n    in\n    def \"operation.alpha.contents\"\n    @@ union\n         [\n           make endorsement_case;\n           make preendorsement_case;\n           make seed_nonce_revelation_case;\n           make double_endorsement_evidence_case;\n           make double_preendorsement_evidence_case;\n           make double_baking_evidence_case;\n           make activate_account_case;\n           make proposals_case;\n           make ballot_case;\n           make reveal_case;\n           make transaction_case;\n           make origination_case;\n           make delegation_case;\n           make set_deposits_limit_case;\n           make failing_noop_case;\n           make register_global_constant_case;\n         ]\n\n  let contents_list_encoding =\n    conv_with_guard to_list of_list_internal (Variable.list contents_encoding)\n\n  let optional_signature_encoding =\n    conv\n      (function Some s -> s | None -> Signature.zero)\n      (fun s -> if Signature.equal s Signature.zero then None else Some s)\n      Signature.encoding\n\n  let protocol_data_encoding =\n    def \"operation.alpha.contents_and_signature\"\n    @@ conv\n         (fun (Operation_data {contents; signature}) ->\n           (Contents_list contents, signature))\n         (fun (Contents_list contents, signature) ->\n           Operation_data {contents; signature})\n         (obj2\n            (req \"contents\" contents_list_encoding)\n            (req \"signature\" optional_signature_encoding))\n\n  let operation_encoding =\n    conv\n      (fun {shell; protocol_data} -> (shell, protocol_data))\n      (fun (shell, protocol_data) -> {shell; protocol_data})\n      (merge_objs Operation.shell_header_encoding protocol_data_encoding)\n\n  let unsigned_operation_encoding =\n    def \"operation.alpha.unsigned_operation\"\n    @@ merge_objs\n         Operation.shell_header_encoding\n         (obj1 (req \"contents\" contents_list_encoding))\n\n  let internal_operation_encoding =\n    def \"operation.alpha.internal_operation\"\n    @@ conv\n         (fun (Internal_operation {source; operation; nonce}) ->\n           ((source, nonce), Manager operation))\n         (fun ((source, nonce), Manager operation) ->\n           Internal_operation {source; operation; nonce})\n         (merge_objs\n            (obj2 (req \"source\" Contract_repr.encoding) (req \"nonce\" uint16))\n            Manager_operations.encoding)\nend\n\nlet encoding = Encoding.operation_encoding\n\nlet contents_encoding = Encoding.contents_encoding\n\nlet contents_list_encoding = Encoding.contents_list_encoding\n\nlet protocol_data_encoding = Encoding.protocol_data_encoding\n\nlet unsigned_operation_encoding = Encoding.unsigned_operation_encoding\n\nlet internal_operation_encoding = Encoding.internal_operation_encoding\n\nlet raw ({shell; protocol_data} : _ operation) =\n  let proto =\n    Data_encoding.Binary.to_bytes_exn\n      protocol_data_encoding\n      (Operation_data protocol_data)\n  in\n  {Operation.shell; proto}\n\nlet acceptable_passes (op : packed_operation) =\n  let (Operation_data protocol_data) = op.protocol_data in\n  match protocol_data.contents with\n  | Single (Failing_noop _) -> []\n  | Single (Preendorsement _) -> [0]\n  | Single (Endorsement _) -> [0]\n  | Single (Proposals _) -> [1]\n  | Single (Ballot _) -> [1]\n  | Single (Seed_nonce_revelation _) -> [2]\n  | Single (Double_endorsement_evidence _) -> [2]\n  | Single (Double_preendorsement_evidence _) -> [2]\n  | Single (Double_baking_evidence _) -> [2]\n  | Single (Activate_account _) -> [2]\n  | Single (Manager_operation _) -> [3]\n  | Cons (Manager_operation _, _ops) -> [3]\n\ntype error += Invalid_signature (* `Permanent *)\n\ntype error += Missing_signature (* `Permanent *)\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"operation.invalid_signature\"\n    ~title:\"Invalid operation signature\"\n    ~description:\n      \"The operation signature is ill-formed or has been made with the wrong \\\n       public key\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"The operation signature is invalid\")\n    Data_encoding.unit\n    (function Invalid_signature -> Some () | _ -> None)\n    (fun () -> Invalid_signature) ;\n  register_error_kind\n    `Permanent\n    ~id:\"operation.missing_signature\"\n    ~title:\"Missing operation signature\"\n    ~description:\n      \"The operation is of a kind that must be signed, but the signature is \\\n       missing\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"The operation requires a signature\")\n    Data_encoding.unit\n    (function Missing_signature -> Some () | _ -> None)\n    (fun () -> Missing_signature) ;\n  register_error_kind\n    `Permanent\n    ~id:\"operation.contents_list_error\"\n    ~title:\"Invalid list of operation contents.\"\n    ~description:\n      \"An operation contents list has an unexpected shape; it should be either \\\n       a single operation or a non-empty list of manager operations\"\n    ~pp:(fun ppf s ->\n      Format.fprintf\n        ppf\n        \"An operation contents list has an unexpected shape: %s\"\n        s)\n    Data_encoding.(obj1 (req \"message\" string))\n    (function Contents_list_error s -> Some s | _ -> None)\n    (fun s -> Contents_list_error s)\n\nlet check_signature (type kind) key chain_id\n    ({shell; protocol_data} : kind operation) =\n  let check ~watermark contents signature =\n    let unsigned_operation =\n      Data_encoding.Binary.to_bytes_exn\n        unsigned_operation_encoding\n        (shell, contents)\n    in\n    if Signature.check ~watermark key signature unsigned_operation then Ok ()\n    else error Invalid_signature\n  in\n  match protocol_data.signature with\n  | None -> error Missing_signature\n  | Some signature -> (\n      match protocol_data.contents with\n      | Single (Preendorsement _) as contents ->\n          check\n            ~watermark:(to_watermark (Preendorsement chain_id))\n            (Contents_list contents)\n            signature\n      | Single (Endorsement _) as contents ->\n          check\n            ~watermark:(to_watermark (Endorsement chain_id))\n            (Contents_list contents)\n            signature\n      | Single\n          ( Failing_noop _ | Proposals _ | Ballot _ | Seed_nonce_revelation _\n          | Double_endorsement_evidence _ | Double_preendorsement_evidence _\n          | Double_baking_evidence _ | Activate_account _ | Manager_operation _\n            ) ->\n          check\n            ~watermark:Generic_operation\n            (Contents_list protocol_data.contents)\n            signature\n      | Cons (Manager_operation _, _ops) ->\n          check\n            ~watermark:Generic_operation\n            (Contents_list protocol_data.contents)\n            signature)\n\nlet hash_raw = Operation.hash\n\nlet hash (o : _ operation) =\n  let proto =\n    Data_encoding.Binary.to_bytes_exn\n      protocol_data_encoding\n      (Operation_data o.protocol_data)\n  in\n  Operation.hash {shell = o.shell; proto}\n\nlet hash_packed (o : packed_operation) =\n  let proto =\n    Data_encoding.Binary.to_bytes_exn protocol_data_encoding o.protocol_data\n  in\n  Operation.hash {shell = o.shell; proto}\n\ntype ('a, 'b) eq = Eq : ('a, 'a) eq [@@coq_force_gadt]\n\nlet equal_manager_operation_kind :\n    type a b. a manager_operation -> b manager_operation -> (a, b) eq option =\n fun op1 op2 ->\n  match (op1, op2) with\n  | (Reveal _, Reveal _) -> Some Eq\n  | (Reveal _, _) -> None\n  | (Transaction _, Transaction _) -> Some Eq\n  | (Transaction _, _) -> None\n  | (Origination _, Origination _) -> Some Eq\n  | (Origination _, _) -> None\n  | (Delegation _, Delegation _) -> Some Eq\n  | (Delegation _, _) -> None\n  | (Register_global_constant _, Register_global_constant _) -> Some Eq\n  | (Register_global_constant _, _) -> None\n  | (Set_deposits_limit _, Set_deposits_limit _) -> Some Eq\n  | (Set_deposits_limit _, _) -> None\n\nlet equal_contents_kind : type a b. a contents -> b contents -> (a, b) eq option\n    =\n fun op1 op2 ->\n  match (op1, op2) with\n  | (Preendorsement _, Preendorsement _) -> Some Eq\n  | (Preendorsement _, _) -> None\n  | (Endorsement _, Endorsement _) -> Some Eq\n  | (Endorsement _, _) -> None\n  | (Seed_nonce_revelation _, Seed_nonce_revelation _) -> Some Eq\n  | (Seed_nonce_revelation _, _) -> None\n  | (Double_endorsement_evidence _, Double_endorsement_evidence _) -> Some Eq\n  | (Double_endorsement_evidence _, _) -> None\n  | (Double_preendorsement_evidence _, Double_preendorsement_evidence _) ->\n      Some Eq\n  | (Double_preendorsement_evidence _, _) -> None\n  | (Double_baking_evidence _, Double_baking_evidence _) -> Some Eq\n  | (Double_baking_evidence _, _) -> None\n  | (Activate_account _, Activate_account _) -> Some Eq\n  | (Activate_account _, _) -> None\n  | (Proposals _, Proposals _) -> Some Eq\n  | (Proposals _, _) -> None\n  | (Ballot _, Ballot _) -> Some Eq\n  | (Ballot _, _) -> None\n  | (Failing_noop _, Failing_noop _) -> Some Eq\n  | (Failing_noop _, _) -> None\n  | (Manager_operation op1, Manager_operation op2) -> (\n      match equal_manager_operation_kind op1.operation op2.operation with\n      | None -> None\n      | Some Eq -> Some Eq)\n  | (Manager_operation _, _) -> None\n\nlet rec equal_contents_kind_list :\n    type a b. a contents_list -> b contents_list -> (a, b) eq option =\n fun op1 op2 ->\n  match (op1, op2) with\n  | (Single op1, Single op2) -> equal_contents_kind op1 op2\n  | (Single _, Cons _) -> None\n  | (Cons _, Single _) -> None\n  | (Cons (op1, ops1), Cons (op2, ops2)) -> (\n      match equal_contents_kind op1 op2 with\n      | None -> None\n      | Some Eq -> (\n          match equal_contents_kind_list ops1 ops2 with\n          | None -> None\n          | Some Eq -> Some Eq))\n\nlet equal : type a b. a operation -> b operation -> (a, b) eq option =\n fun op1 op2 ->\n  if not (Operation_hash.equal (hash op1) (hash op2)) then None\n  else\n    equal_contents_kind_list\n      op1.protocol_data.contents\n      op2.protocol_data.contents\n\nopen Cache_memory_helpers\n\nlet script_lazy_expr_size (expr : Script_repr.lazy_expr) =\n  let fun_value expr = ret_adding (expr_size expr) word_size in\n  let fun_bytes bytes = (Nodes.zero, word_size +! bytes_size bytes) in\n  let fun_combine expr_size bytes_size = expr_size ++ bytes_size in\n  ret_adding\n    (Data_encoding.apply_lazy ~fun_value ~fun_bytes ~fun_combine expr)\n    header_size\n\nlet script_repr_size ({code; storage} : Script_repr.t) =\n  ret_adding (script_lazy_expr_size code ++ script_lazy_expr_size storage) h2w\n\nlet internal_manager_operation_size (type a) (op : a manager_operation) =\n  match op with\n  | Transaction {amount = _; parameters; entrypoint; destination} ->\n      ret_adding\n        (script_lazy_expr_size parameters)\n        (h4w +! int64_size\n        +! string_size_gen (String.length entrypoint)\n        +! Contract_repr.in_memory_size destination)\n  | Origination {delegate; script; credit = _; preorigination} ->\n      ret_adding\n        (script_repr_size script)\n        (h4w\n        +! option_size\n             (fun _ -> Contract_repr.public_key_hash_in_memory_size)\n             delegate\n        +! int64_size\n        +! option_size Contract_repr.in_memory_size preorigination)\n  | Delegation pkh_opt ->\n      ( Nodes.zero,\n        h1w\n        +! option_size\n             (fun _ -> Contract_repr.public_key_hash_in_memory_size)\n             pkh_opt )\n  | Reveal _ ->\n      (* Reveals can't occur as internal operations *)\n      assert false\n  | Register_global_constant _ ->\n      (* Global constant registrations can't occur as internal operations *)\n      assert false\n  | Set_deposits_limit _ ->\n      (* Set_deposits_limit can't occur as internal operations *)\n      assert false\n\nlet packed_internal_operation_in_memory_size :\n    packed_internal_operation -> nodes_and_size = function\n  | Internal_operation iop ->\n      let {source; operation; nonce = _} = iop in\n      let source_size = Contract_repr.in_memory_size source in\n      let nonce_size = word_size in\n      ret_adding\n        (internal_manager_operation_size operation)\n        (h2w +! source_size +! nonce_size)\n" ;
                } ;
                { name = "Manager_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(* Tezos Protocol Implementation - Low level Repr. of Managers' keys *)\n\n(** The public key of the manager of a contract is reveled only after the\n    first operation. At Origination time, the manager provides only the hash\n    of its public key that is stored in the contract. When the public key\n    is actually revealed, the public key instead of the hash of the key *)\ntype manager_key =\n  | Hash of Signature.Public_key_hash.t\n  | Public_key of Signature.Public_key.t\n\ntype t = manager_key\n\nval encoding : t Data_encoding.encoding\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(* Tezos Protocol Implementation - Low level Repr. of Managers' keys *)\n\ntype manager_key =\n  | Hash of Signature.Public_key_hash.t\n  | Public_key of Signature.Public_key.t\n\ntype t = manager_key\n\nopen Data_encoding\n\nlet hash_case tag =\n  case\n    tag\n    ~title:\"Public_key_hash\"\n    Signature.Public_key_hash.encoding\n    (function Hash hash -> Some hash | _ -> None)\n    (fun hash -> Hash hash)\n\nlet pubkey_case tag =\n  case\n    tag\n    ~title:\"Public_key\"\n    Signature.Public_key.encoding\n    (function Public_key hash -> Some hash | _ -> None)\n    (fun hash -> Public_key hash)\n\nlet encoding = union [hash_case (Tag 0); pubkey_case (Tag 1)]\n" ;
                } ;
                { name = "Commitment_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype t = {\n  blinded_public_key_hash : Blinded_public_key_hash.t;\n  amount : Tez_repr.t;\n}\n\nval encoding : t Data_encoding.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype t = {\n  blinded_public_key_hash : Blinded_public_key_hash.t;\n  amount : Tez_repr.t;\n}\n\nlet encoding =\n  let open Data_encoding in\n  conv\n    (fun {blinded_public_key_hash; amount} -> (blinded_public_key_hash, amount))\n    (fun (blinded_public_key_hash, amount) -> {blinded_public_key_hash; amount})\n    (tup2 Blinded_public_key_hash.encoding Tez_repr.encoding)\n" ;
                } ;
                { name = "Parameters_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** This module defines protocol parameters, i.e. constants regulating the\n    behaviour of the blockchain under the protocol. *)\n\n(** An implict contract (account) initially existing on a chain since genesis. *)\ntype bootstrap_account = {\n  public_key_hash : Signature.Public_key_hash.t;\n  public_key : Signature.Public_key.t option;\n  amount : Tez_repr.t;\n}\n\n(** An originated contract initially existing on a chain since genesis. *)\ntype bootstrap_contract = {\n  delegate : Signature.Public_key_hash.t option;\n  amount : Tez_repr.t;\n  script : Script_repr.t;\n}\n\n(** Protocol parameters define some constants regulating behaviour of the\n    chain. *)\ntype t = {\n  bootstrap_accounts : bootstrap_account list;\n  bootstrap_contracts : bootstrap_contract list;\n  commitments : Commitment_repr.t list;\n  constants : Constants_repr.parametric;\n  security_deposit_ramp_up_cycles : int option;\n  no_reward_cycles : int option;\n}\n\nval encoding : t Data_encoding.t\n\nval check_params : t -> unit tzresult\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype bootstrap_account = {\n  public_key_hash : Signature.Public_key_hash.t;\n  public_key : Signature.Public_key.t option;\n  amount : Tez_repr.t;\n}\n\ntype bootstrap_contract = {\n  delegate : Signature.Public_key_hash.t option;\n  amount : Tez_repr.t;\n  script : Script_repr.t;\n}\n\ntype t = {\n  bootstrap_accounts : bootstrap_account list;\n  bootstrap_contracts : bootstrap_contract list;\n  commitments : Commitment_repr.t list;\n  constants : Constants_repr.parametric;\n  security_deposit_ramp_up_cycles : int option;\n  no_reward_cycles : int option;\n}\n\nlet bootstrap_account_encoding =\n  let open Data_encoding in\n  union\n    [\n      case\n        (Tag 0)\n        ~title:\"Public_key_known\"\n        (tup2 Signature.Public_key.encoding Tez_repr.encoding)\n        (function\n          | {public_key_hash; public_key = Some public_key; amount} ->\n              assert (\n                Signature.Public_key_hash.equal\n                  (Signature.Public_key.hash public_key)\n                  public_key_hash) ;\n              Some (public_key, amount)\n          | {public_key = None; _} -> None)\n        (fun (public_key, amount) ->\n          {\n            public_key = Some public_key;\n            public_key_hash = Signature.Public_key.hash public_key;\n            amount;\n          });\n      case\n        (Tag 1)\n        ~title:\"Public_key_unknown\"\n        (tup2 Signature.Public_key_hash.encoding Tez_repr.encoding)\n        (function\n          | {public_key_hash; public_key = None; amount} ->\n              Some (public_key_hash, amount)\n          | {public_key = Some _; _} -> None)\n        (fun (public_key_hash, amount) ->\n          {public_key = None; public_key_hash; amount});\n    ]\n\nlet bootstrap_contract_encoding =\n  let open Data_encoding in\n  conv\n    (fun {delegate; amount; script} -> (delegate, amount, script))\n    (fun (delegate, amount, script) -> {delegate; amount; script})\n    (obj3\n       (opt \"delegate\" Signature.Public_key_hash.encoding)\n       (req \"amount\" Tez_repr.encoding)\n       (req \"script\" Script_repr.encoding))\n\nlet encoding =\n  let open Data_encoding in\n  conv\n    (fun {\n           bootstrap_accounts;\n           bootstrap_contracts;\n           commitments;\n           constants;\n           security_deposit_ramp_up_cycles;\n           no_reward_cycles;\n         } ->\n      ( ( bootstrap_accounts,\n          bootstrap_contracts,\n          commitments,\n          security_deposit_ramp_up_cycles,\n          no_reward_cycles ),\n        constants ))\n    (fun ( ( bootstrap_accounts,\n             bootstrap_contracts,\n             commitments,\n             security_deposit_ramp_up_cycles,\n             no_reward_cycles ),\n           constants ) ->\n      {\n        bootstrap_accounts;\n        bootstrap_contracts;\n        commitments;\n        constants;\n        security_deposit_ramp_up_cycles;\n        no_reward_cycles;\n      })\n    (merge_objs\n       (obj5\n          (req \"bootstrap_accounts\" (list bootstrap_account_encoding))\n          (dft \"bootstrap_contracts\" (list bootstrap_contract_encoding) [])\n          (dft \"commitments\" (list Commitment_repr.encoding) [])\n          (opt \"security_deposit_ramp_up_cycles\" int31)\n          (opt \"no_reward_cycles\" int31))\n       Constants_repr.parametric_encoding)\n\nlet check_params params = Constants_repr.check_constants params.constants\n" ;
                } ;
                { name = "Sapling_repr" ;
                  interface = None ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2019-2020 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype transaction = Sapling.UTXO.transaction\n\nlet transaction_encoding = Sapling.UTXO.transaction_encoding\n\n(* The two data structures in the state are all ordered by position, a diff\n   contains the elements starting from an offset position up to the most recent\n   position. A diff can be applied to a state stored in a context to obtain a\n   new state.\n   Diffs are used by the Michelson interpreter during the evaluation of smart\n   contracts to keep a temporary state that may be discarded.\n   Diffs are also returned by an RPC to allow a client to synchronize its own\n   state with the chain.\n *)\ntype diff = {\n  commitments_and_ciphertexts :\n    (Sapling.Commitment.t * Sapling.Ciphertext.t) list;\n  nullifiers : Sapling.Nullifier.t list;\n}\n\nlet diff_encoding =\n  let open Data_encoding in\n  conv\n    (fun d -> (d.commitments_and_ciphertexts, d.nullifiers))\n    (fun (commitments_and_ciphertexts, nullifiers) ->\n      (match commitments_and_ciphertexts with\n      | [] -> ()\n      | (_cm_hd, ct_hd) :: rest ->\n          let memo_size = Sapling.Ciphertext.get_memo_size ct_hd in\n          List.iter\n            (fun (_cm, ct) ->\n              assert (\n                Compare.Int.(Sapling.Ciphertext.get_memo_size ct = memo_size)))\n            rest) ;\n      {commitments_and_ciphertexts; nullifiers})\n    (obj2\n       (req\n          \"commitments_and_ciphertexts\"\n          (list (tup2 Sapling.Commitment.encoding Sapling.Ciphertext.encoding)))\n       (req \"nullifiers\" (list Sapling.Nullifier.encoding)))\n\nmodule Memo_size = struct\n  type t = int\n\n  let encoding = Data_encoding.uint16\n\n  let equal = Compare.Int.( = )\n\n  let max_uint16 = 0xffff\n\n  let max_uint16_z = Z.of_int max_uint16\n\n  let err =\n    Error\n      (\"a positive 16-bit integer (between 0 and \" ^ string_of_int max_uint16\n     ^ \")\")\n\n  let parse_z z =\n    if Compare.Z.(Z.zero <= z) && Compare.Z.(z <= max_uint16_z) then\n      Ok (Z.to_int z)\n    else err\n\n  let unparse_to_z = Z.of_int\nend\n\nlet transaction_get_memo_size (transaction : Sapling.UTXO.transaction) =\n  match transaction.outputs with\n  | [] -> None\n  | {ciphertext; _} :: _ ->\n      (* Encoding ensures all ciphertexts have the same memo size. *)\n      Some (Sapling.Ciphertext.get_memo_size ciphertext)\n\nopen Cache_memory_helpers\n\n(* This should be exported by [lib_sapling] rather than implemented here. *)\nlet input_in_memory_size =\n  (* type input =\n   *   Sapling.UTXO.input = {\n   *   cv : Sapling.CV.t;\n   *   nf : Sapling.Nullifier.t;\n   *   rk : Sapling.UTXO.rk;\n   *   proof_i : Sapling.UTXO.spend_proof;\n   *   signature : Sapling.UTXO.spend_sig;\n   * } *)\n  let cv_size = string_size_gen 32 in\n  let nf_size = string_size_gen 32 in\n  let rk_size = string_size_gen 32 in\n  let proof_i_size = string_size_gen @@ (48 + 96 + 48) in\n  let signature_size = string_size_gen 64 in\n  header_size +! (word_size *? 5) +! cv_size +! nf_size +! rk_size\n  +! proof_i_size +! signature_size\n\nlet ciphertext_size =\n  (* type t = {\n   *   cv : CV.t;\n   *   epk : DH.epk;\n   *   payload_enc : Bytes.t;\n   *   nonce_enc : Crypto_box.nonce;\n   *   payload_out : Bytes.t;\n   *   nonce_out : Crypto_box.nonce;\n   * } *)\n  let cv_size = string_size_gen 32 in\n  let epk_size = string_size_gen 32 in\n  let nonce_enc_size =\n    string_size_gen 24\n    (* from lib_hacl_glue/unix/hacl.ml:Nonce.size *)\n  in\n  let payload_out_size =\n    string_size_gen (32 + 32 + 16)\n    (* from lib_sapling/core.ml:Ciphertext.encoding *)\n  in\n  let nonce_out_size = string_size_gen 24 in\n  let fixed_payload_data_size =\n    11 + 8 + 32 + 16 + 4\n    (* from lib_sapling/core.ml:Ciphertext.get_memo_size *)\n  in\n\n  fun memo_size ->\n    let payload_size = string_size_gen (memo_size + fixed_payload_data_size) in\n    header_size +! (word_size *? 6) +! cv_size +! epk_size +! payload_size\n    +! nonce_enc_size +! payload_out_size +! nonce_out_size\n\nlet output_in_memory_size =\n  (* type output = {\n   *   cm : Commitment.t;\n   *   proof_o : output_proof;\n   *   ciphertext : Ciphertext.t;\n   * } *)\n  let cm_size = string_size_gen 32 in\n  let proof_o_size = string_size_gen @@ (48 + 96 + 48) in\n  let ciphertext_size = ciphertext_size in\n\n  fun memo_size ->\n    header_size +! (word_size *? 3) +! cm_size +! proof_o_size\n    +! ciphertext_size memo_size\n\n(** Returns an approximation of the in-memory size of a Sapling transaction.  *)\nlet transaction_in_memory_size (transaction : Sapling.UTXO.transaction) =\n  (* type transaction =\n   *   transaction = {\n   *   inputs : Sapling.UTXO.input list;\n   *   outputs : Sapling.UTXO.output list;\n   *   binding_sig : Sapling.UTXO.binding_sig;\n   *   balance : int64;\n   *   root : Sapling.Hash.t;\n   * } *)\n  let binding_sig_size = string_size_gen 64 in\n  let balance_size = int64_size in\n  let root_size = string_size_gen 32 in\n  let inputs = List.length transaction.inputs in\n  let outputs = List.length transaction.outputs in\n  let memo_size =\n    Option.value ~default:0 (transaction_get_memo_size transaction)\n  in\n  header_size +! (word_size *? 5)\n  +! (list_cell_size input_in_memory_size *? inputs)\n  +! (list_cell_size (output_in_memory_size memo_size) *? outputs)\n  +! binding_sig_size +! balance_size +! root_size\n\n(** Returns an approximation of the in-memory size of a Sapling diff.  *)\nlet diff_in_memory_size ({commitments_and_ciphertexts; nullifiers} : diff) =\n  let cms_and_cts = List.length commitments_and_ciphertexts in\n  let nfs = List.length nullifiers in\n  let cm_size = string_size_gen 32 in\n  let nf_size = string_size_gen 32 in\n  let memo_size =\n    (* All memo_size in a diff should be equal (see invariant enforced by\n       [diff] encoding above) *)\n    match commitments_and_ciphertexts with\n    | [] -> 0\n    | (_, ct) :: _ -> Sapling.Ciphertext.get_memo_size ct\n  in\n  header_size +! (word_size *? 2)\n  +! list_cell_size (boxed_tup2 cm_size (ciphertext_size memo_size))\n     *? cms_and_cts\n  +! (list_cell_size nf_size *? nfs)\n" ;
                } ;
                { name = "Lazy_storage_kind" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2020 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(**\n  Lazy_storage offers a unified interface for specific Michelson datatype that\n  behave somewhat lazily, because they are intended to be quite big.\n  Instead of serializing/deserializing the whole value to/from the storage,\n  only an identifier is used. The identifier acts like a pointer.\n  When using the value in a Michelson script, some part of it may be read from\n  the storage, and a lightweight diff is computed.\n  The diff is effectively applied to the storage at the end of the execution.\n\n  This module defines the different kinds of lazy storages and their basic\n  properties. See also [Lazy_storage_diff].\n\n  Lazy storage types are:\n   - Big_map\n*)\n\n(**\n  Lazy storage ids are kept as abstract as possible to avoid mixing them up.\n\n  Behind the scene they are [Z.t]s but, within the protocol, only [parse_data]/\n  [unparse_data] are allowed convert from/to it.\n\n  Temporary ids may be used to pass values between contracts that won't be kept\n  longer than the lifetime of the operation.\n  Behind the scene, temporary ids are negative [Z.t]s.\n*)\nmodule type ID = sig\n  type t\n\n  val compare : t -> t -> int\n\n  val encoding : t Data_encoding.t\n\n  val rpc_arg : t RPC_arg.arg\n\n  (** Initial value for ids: zero. *)\n  val init : t\n\n  (** In the protocol, to be used in parse_data only *)\n  val parse_z : Z.t -> t\n\n  (** In the protocol, to be used in unparse_data only *)\n  val unparse_to_z : t -> Z.t\n\n  val next : t -> t\n\n  val is_temp : t -> bool\n\n  (* To be removed once legacy big map diff is removed: *)\n\n  val of_legacy_USE_ONLY_IN_Legacy_big_map_diff : Z.t -> t\n\n  val to_legacy_USE_ONLY_IN_Legacy_big_map_diff : t -> Z.t\n\n  (* To be used in storage: *)\n\n  include Path_encoding.S with type t := t\nend\n\nmodule Big_map : sig\n  val title : string\n\n  module Id : ID\n\n  type alloc = {key_type : Script_repr.expr; value_type : Script_repr.expr}\n\n  type update = {\n    key : Script_repr.expr;\n        (** The key is ignored by [apply_update] but is shown in the receipt,\n            as specified in [print_big_map_diff]. *)\n    key_hash : Script_expr_hash.t;\n    value : Script_repr.expr option;\n  }\n\n  type updates = update list\n\n  val alloc_encoding : alloc Data_encoding.t\n\n  val updates_encoding : updates Data_encoding.t\nend\n\nmodule Sapling_state : sig\n  val title : string\n\n  module Id : ID\n\n  type alloc = {memo_size : Sapling_repr.Memo_size.t}\n\n  type updates = Sapling_repr.diff\n\n  val alloc_encoding : alloc Data_encoding.t\n\n  val updates_encoding : updates Data_encoding.t\nend\n\n(**\n  Kinds of lazy storage.\n  The GADT ensures operations are properly applied to the correct kind.\n\n  ['id] the abstract type for the identifier of the kind.\n  ['alloc] is the type used to construct a new value.\n  ['updates] is the type used to update a value.\n*)\ntype ('id, 'alloc, 'updates) t =\n  | Big_map : (Big_map.Id.t, Big_map.alloc, Big_map.updates) t\n  | Sapling_state\n      : (Sapling_state.Id.t, Sapling_state.alloc, Sapling_state.updates) t\n\ntype ex = Ex_Kind : (_, _, _) t -> ex\n\nval all : (int * ex) list\n\ntype (_, _) cmp = Eq : ('a, 'a) cmp | Neq\n\nval equal :\n  ('i1, 'a1, 'u1) t ->\n  ('i2, 'a2, 'u2) t ->\n  ('i1 * 'a1 * 'u1, 'i2 * 'a2 * 'u2) cmp\n\ntype ('i, 'a, 'u) kind = ('i, 'a, 'u) t\n\n(**\n  Type to manage temporary ids.\n  Used only in the context.\n*)\nmodule Temp_ids : sig\n  type t\n\n  val init : t\n\n  val fresh : ('i, 'a, 'u) kind -> t -> t * 'i\n\n  val fold_s :\n    ('i, 'a, 'u) kind -> ('acc -> 'i -> 'acc Lwt.t) -> t -> 'acc -> 'acc Lwt.t\nend\n\nmodule IdSet : sig\n  type t\n\n  type 'acc fold_f = {f : 'i 'a 'u. ('i, 'a, 'u) kind -> 'i -> 'acc -> 'acc}\n\n  val empty : t\n\n  val mem : ('i, 'a, 'u) kind -> 'i -> t -> bool\n\n  val add : ('i, 'a, 'u) kind -> 'i -> t -> t\n\n  val diff : t -> t -> t\n\n  val fold : ('i, 'a, 'u) kind -> ('i -> 'acc -> 'acc) -> t -> 'acc -> 'acc\n\n  val fold_all : 'acc fold_f -> t -> 'acc -> 'acc\nend\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2020 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nmodule type TEMP_ID = sig\n  type t\n\n  val equal : t -> t -> bool\n\n  val init : t\n\n  val next : t -> t\nend\n\nmodule type ID = sig\n  type t\n\n  val compare : t -> t -> int\n\n  val encoding : t Data_encoding.t\n\n  val rpc_arg : t RPC_arg.arg\n\n  val init : t\n\n  (** In the protocol, to be used in parse_data only *)\n  val parse_z : Z.t -> t\n\n  (** In the protocol, to be used in unparse_data only *)\n  val unparse_to_z : t -> Z.t\n\n  val next : t -> t\n\n  val is_temp : t -> bool\n\n  val of_legacy_USE_ONLY_IN_Legacy_big_map_diff : Z.t -> t\n\n  val to_legacy_USE_ONLY_IN_Legacy_big_map_diff : t -> Z.t\n\n  include Path_encoding.S with type t := t\nend\n\nmodule type Title = sig\n  val title : string\nend\n\nmodule type TitleWithId = sig\n  val title : string\n\n  module Id : ID\n\n  module Temp_id : TEMP_ID with type t = private Id.t\n\n  module IdSet : Set.S with type elt = Id.t\nend\n\nmodule MakeId (Title : Title) : TitleWithId = struct\n  let title = Title.title\n\n  let title_words = String.map (function '_' -> ' ' | c -> c) title\n\n  let rpc_arg_error = Format.sprintf \"Cannot parse %s id\" title_words\n\n  let description = Format.sprintf \"A %s identifier\" title_words\n\n  let name = title ^ \"_id\"\n\n  let encoding_title = String.capitalize_ascii title_words ^ \" identifier\"\n\n  module Id = struct\n    type t = Z.t\n\n    let compare = Z.compare\n\n    let encoding =\n      Data_encoding.def name ~title:encoding_title ~description Data_encoding.z\n\n    let rpc_arg =\n      let construct = Z.to_string in\n      let destruct hash =\n        Result.catch_f (fun () -> Z.of_string hash) (fun _ -> rpc_arg_error)\n      in\n      RPC_arg.make ~descr:description ~name ~construct ~destruct ()\n\n    let init = Z.zero\n\n    let parse_z (z : Z.t) : t = z\n\n    let unparse_to_z (z : t) : Z.t = z\n\n    let next = Z.succ\n\n    let of_legacy_USE_ONLY_IN_Legacy_big_map_diff (z : Z.t) : t = z\n\n    let to_legacy_USE_ONLY_IN_Legacy_big_map_diff (z : t) : Z.t = z\n\n    let is_temp z = Compare.Z.(z < Z.zero)\n\n    let path_length = 1\n\n    let to_path z l = Z.to_string z :: l\n\n    let of_path = function\n      | [] | _ :: _ :: _ -> None\n      | [z] -> Some (Z.of_string z)\n  end\n\n  module Temp_id = struct\n    type t = Id.t\n\n    let equal = Z.equal\n\n    let init = Z.of_int ~-1\n\n    let next z = Z.sub z Z.one\n  end\n\n  module IdSet = Set.Make (Id)\nend\n\nmodule Big_map = struct\n  include MakeId (struct\n    let title = \"big_map\"\n  end)\n\n  type alloc = {key_type : Script_repr.expr; value_type : Script_repr.expr}\n\n  type update = {\n    key : Script_repr.expr;\n        (** The key is ignored by [apply_update] but is shown in the receipt,\n            as specified in [print_big_map_diff]. *)\n    key_hash : Script_expr_hash.t;\n    value : Script_repr.expr option;\n  }\n\n  type updates = update list\n\n  let alloc_encoding =\n    let open Data_encoding in\n    conv\n      (fun {key_type; value_type} -> (key_type, value_type))\n      (fun (key_type, value_type) -> {key_type; value_type})\n      (obj2\n         (req \"key_type\" Script_repr.expr_encoding)\n         (req \"value_type\" Script_repr.expr_encoding))\n\n  let update_encoding =\n    let open Data_encoding in\n    conv\n      (fun {key_hash; key; value} -> (key_hash, key, value))\n      (fun (key_hash, key, value) -> {key_hash; key; value})\n      (obj3\n         (req \"key_hash\" Script_expr_hash.encoding)\n         (req \"key\" Script_repr.expr_encoding)\n         (opt \"value\" Script_repr.expr_encoding))\n\n  let updates_encoding = Data_encoding.list update_encoding\nend\n\nmodule Sapling_state = struct\n  include MakeId (struct\n    let title = \"sapling_state\"\n  end)\n\n  type alloc = {memo_size : Sapling_repr.Memo_size.t}\n\n  type updates = Sapling_repr.diff\n\n  let alloc_encoding =\n    let open Data_encoding in\n    conv\n      (fun {memo_size} -> memo_size)\n      (fun memo_size -> {memo_size})\n      (obj1 (req \"memo_size\" Sapling_repr.Memo_size.encoding))\n\n  let updates_encoding = Sapling_repr.diff_encoding\nend\n\n(*\n  When adding cases to this type, grep for [new lazy storage kind] in the code\n  for locations to update.\n  It must be:\n    - the value [all] right below,\n    - modules [Temp_ids], [IdSet] below,\n    - the rest should be guided by type errors.\n*)\ntype ('id, 'alloc, 'updates) t =\n  | Big_map : (Big_map.Id.t, Big_map.alloc, Big_map.updates) t\n  | Sapling_state\n      : (Sapling_state.Id.t, Sapling_state.alloc, Sapling_state.updates) t\n\ntype ex = Ex_Kind : (_, _, _) t -> ex\n\n(* /!\\ Don't forget to add new lazy storage kinds here. /!\\ *)\nlet all = [(0, Ex_Kind Big_map); (1, Ex_Kind Sapling_state)]\n\ntype (_, _) cmp = Eq : ('a, 'a) cmp | Neq\n\nlet equal :\n    type i1 a1 u1 i2 a2 u2.\n    (i1, a1, u1) t -> (i2, a2, u2) t -> (i1 * a1 * u1, i2 * a2 * u2) cmp =\n fun k1 k2 ->\n  match (k1, k2) with\n  | (Big_map, Big_map) -> Eq\n  | (Sapling_state, Sapling_state) -> Eq\n  | (Big_map, _) -> Neq\n  | (_, Big_map) -> Neq\n\ntype ('i, 'a, 'u) kind = ('i, 'a, 'u) t\n\nmodule Temp_ids = struct\n  type t = {\n    big_map : Big_map.Temp_id.t;\n    sapling_state : Sapling_state.Temp_id.t;\n  }\n\n  let init =\n    {big_map = Big_map.Temp_id.init; sapling_state = Sapling_state.Temp_id.init}\n\n  let fresh : type i a u. (i, a, u) kind -> t -> t * i =\n   fun kind temp_ids ->\n    match kind with\n    | Big_map ->\n        let big_map = Big_map.Temp_id.next temp_ids.big_map in\n        ({temp_ids with big_map}, (temp_ids.big_map :> Big_map.Id.t))\n    | Sapling_state ->\n        let sapling_state = Sapling_state.Temp_id.next temp_ids.sapling_state in\n        ( {temp_ids with sapling_state},\n          (temp_ids.sapling_state :> Sapling_state.Id.t) )\n   [@@coq_axiom_with_reason \"gadt\"]\n\n  let fold_s :\n      type i a u.\n      (i, a, u) kind -> ('acc -> i -> 'acc Lwt.t) -> t -> 'acc -> 'acc Lwt.t =\n   fun kind f temp_ids acc ->\n    let helper (type j) (module Temp_id : TEMP_ID with type t = j) ~last f =\n      let rec aux acc id =\n        if Temp_id.equal id last then Lwt.return acc\n        else f acc id >>= fun acc -> aux acc (Temp_id.next id)\n      in\n      aux acc Temp_id.init\n    in\n    match kind with\n    | Big_map ->\n        helper\n          (module Big_map.Temp_id)\n          ~last:temp_ids.big_map\n          (fun acc temp_id -> f acc (temp_id :> i))\n    | Sapling_state ->\n        helper\n          (module Sapling_state.Temp_id)\n          ~last:temp_ids.sapling_state\n          (fun acc temp_id -> f acc (temp_id :> i))\n   [@@coq_axiom_with_reason \"gadt\"]\nend\n\nmodule IdSet = struct\n  type t = {big_map : Big_map.IdSet.t; sapling_state : Sapling_state.IdSet.t}\n\n  type 'acc fold_f = {f : 'i 'a 'u. ('i, 'a, 'u) kind -> 'i -> 'acc -> 'acc}\n\n  let empty =\n    {big_map = Big_map.IdSet.empty; sapling_state = Sapling_state.IdSet.empty}\n\n  let mem (type i a u) (kind : (i, a, u) kind) (id : i) set =\n    match (kind, set) with\n    | (Big_map, {big_map; _}) -> Big_map.IdSet.mem id big_map\n    | (Sapling_state, {sapling_state; _}) ->\n        Sapling_state.IdSet.mem id sapling_state\n    [@@coq_axiom_with_reason \"gadt\"]\n\n  let add (type i a u) (kind : (i, a, u) kind) (id : i) set =\n    match (kind, set) with\n    | (Big_map, {big_map; _}) ->\n        let big_map = Big_map.IdSet.add id big_map in\n        {set with big_map}\n    | (Sapling_state, {sapling_state; _}) ->\n        let sapling_state = Sapling_state.IdSet.add id sapling_state in\n        {set with sapling_state}\n    [@@coq_axiom_with_reason \"gadt\"]\n\n  let diff set1 set2 =\n    let big_map = Big_map.IdSet.diff set1.big_map set2.big_map in\n    let sapling_state =\n      Sapling_state.IdSet.diff set1.sapling_state set2.sapling_state\n    in\n    {big_map; sapling_state}\n    [@@coq_axiom_with_reason \"gadt\"]\n\n  let fold (type i a u) (kind : (i, a, u) kind) (f : i -> 'acc -> 'acc) set\n      (acc : 'acc) =\n    match (kind, set) with\n    | (Big_map, {big_map; _}) -> Big_map.IdSet.fold f big_map acc\n    | (Sapling_state, {sapling_state; _}) ->\n        Sapling_state.IdSet.fold f sapling_state acc\n    [@@coq_axiom_with_reason \"gadt\"]\n\n  let fold_all f set acc =\n    List.fold_left\n      (fun acc (_, Ex_Kind kind) -> fold kind (f.f kind) set acc)\n      acc\n      all\n    [@@coq_axiom_with_reason \"gadt\"]\nend\n" ;
                } ;
                { name = "Receipt_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Places where tez can be found in the ledger's state. *)\ntype balance =\n  | Contract of Contract_repr.t\n  | Legacy_rewards of Signature.Public_key_hash.t * Cycle_repr.t\n  | Block_fees\n  | Legacy_deposits of Signature.Public_key_hash.t * Cycle_repr.t\n  | Deposits of Signature.Public_key_hash.t\n  | Nonce_revelation_rewards\n  | Double_signing_evidence_rewards\n  | Endorsing_rewards\n  | Baking_rewards\n  | Baking_bonuses\n  | Legacy_fees of Signature.Public_key_hash.t * Cycle_repr.t\n  | Storage_fees\n  | Double_signing_punishments\n  | Lost_endorsing_rewards of Signature.Public_key_hash.t * bool * bool\n  | Liquidity_baking_subsidies\n  | Burned\n  | Commitments of Blinded_public_key_hash.t\n  | Bootstrap\n  | Invoice\n  | Initial_commitments\n  | Minted\n\n(** Compares two balances. *)\nval compare_balance : balance -> balance -> int\n\n(** A credit or debit of tez to a balance. *)\ntype balance_update = Debited of Tez_repr.t | Credited of Tez_repr.t\n\n(** An origin of a balance update *)\ntype update_origin =\n  | Block_application  (** Update from a block application *)\n  | Protocol_migration  (** Update from a protocol migration *)\n  | Subsidy  (** Update from an inflationary subsidy  *)\n  | Simulation  (** Simulation of an operation **)\n\n(** Compares two origins. *)\nval compare_update_origin : update_origin -> update_origin -> int\n\n(** A list of balance updates. Duplicates may happen.\n    For example, an entry of the form [(Rewards (b,c), Credited am, ...)]\n    indicates that the balance of frozen rewards has been increased by [am]\n    for baker [b] and cycle [c]. *)\ntype balance_updates = (balance * balance_update * update_origin) list\n\n(** The property [Json.destruct (Json.construct balance_updates) = balance_updates]\n    does not always hold for [balance_updates_encoding] when [balance_updates]\n    contains entries of the form [(_, _ Tez_repr.zero, _)]. This is because the\n    [balance_update] [(_ Tez_repr.zero)] always decodes into [(Credited Tez_repr.zero)]. *)\nval balance_updates_encoding : balance_updates Data_encoding.t\n\n(** Group updates by (balance x origin), and remove zero-valued balances. *)\nval group_balance_updates : balance_updates -> balance_updates tzresult\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype balance =\n  | Contract of Contract_repr.t\n  | Legacy_rewards of Signature.Public_key_hash.t * Cycle_repr.t\n  | Block_fees\n  | Legacy_deposits of Signature.Public_key_hash.t * Cycle_repr.t\n  | Deposits of Signature.Public_key_hash.t\n  | Nonce_revelation_rewards\n  | Double_signing_evidence_rewards\n  | Endorsing_rewards\n  | Baking_rewards\n  | Baking_bonuses\n  | Legacy_fees of Signature.Public_key_hash.t * Cycle_repr.t\n  | Storage_fees\n  | Double_signing_punishments\n  | Lost_endorsing_rewards of Signature.Public_key_hash.t * bool * bool\n  | Liquidity_baking_subsidies\n  | Burned\n  | Commitments of Blinded_public_key_hash.t\n  | Bootstrap\n  | Invoice\n  | Initial_commitments\n  | Minted\n\nlet balance_encoding =\n  let open Data_encoding in\n  def \"operation_metadata.alpha.balance\"\n  @@ union\n       [\n         case\n           (Tag 0)\n           ~title:\"Contract\"\n           (obj2\n              (req \"kind\" (constant \"contract\"))\n              (req \"contract\" Contract_repr.encoding))\n           (function Contract c -> Some ((), c) | _ -> None)\n           (fun ((), c) -> Contract c);\n         case\n           (Tag 1)\n           ~title:\"Legacy_rewards\"\n           (obj4\n              (req \"kind\" (constant \"freezer\"))\n              (req \"category\" (constant \"legacy_rewards\"))\n              (req \"delegate\" Signature.Public_key_hash.encoding)\n              (req \"cycle\" Cycle_repr.encoding))\n           (function Legacy_rewards (d, l) -> Some ((), (), d, l) | _ -> None)\n           (fun ((), (), d, l) -> Legacy_rewards (d, l));\n         case\n           (Tag 2)\n           ~title:\"Block_fees\"\n           (obj2\n              (req \"kind\" (constant \"accumulator\"))\n              (req \"category\" (constant \"block fees\")))\n           (function Block_fees -> Some ((), ()) | _ -> None)\n           (fun ((), ()) -> Block_fees);\n         case\n           (Tag 3)\n           ~title:\"Legacy_deposits\"\n           (obj4\n              (req \"kind\" (constant \"freezer\"))\n              (req \"category\" (constant \"legacy_deposits\"))\n              (req \"delegate\" Signature.Public_key_hash.encoding)\n              (req \"cycle\" Cycle_repr.encoding))\n           (function\n             | Legacy_deposits (d, l) -> Some ((), (), d, l) | _ -> None)\n           (fun ((), (), d, l) -> Legacy_deposits (d, l));\n         case\n           (Tag 4)\n           ~title:\"Deposits\"\n           (obj3\n              (req \"kind\" (constant \"freezer\"))\n              (req \"category\" (constant \"deposits\"))\n              (req \"delegate\" Signature.Public_key_hash.encoding))\n           (function Deposits d -> Some ((), (), d) | _ -> None)\n           (fun ((), (), d) -> Deposits d);\n         case\n           (Tag 5)\n           ~title:\"Nonce_revelation_rewards\"\n           (obj2\n              (req \"kind\" (constant \"minted\"))\n              (req \"category\" (constant \"nonce revelation rewards\")))\n           (function Nonce_revelation_rewards -> Some ((), ()) | _ -> None)\n           (fun ((), ()) -> Nonce_revelation_rewards);\n         case\n           (Tag 6)\n           ~title:\"Double_signing_evidence_rewards\"\n           (obj2\n              (req \"kind\" (constant \"minted\"))\n              (req \"category\" (constant \"double signing evidence rewards\")))\n           (function\n             | Double_signing_evidence_rewards -> Some ((), ()) | _ -> None)\n           (fun ((), ()) -> Double_signing_evidence_rewards);\n         case\n           (Tag 7)\n           ~title:\"Endorsing_rewards\"\n           (obj2\n              (req \"kind\" (constant \"minted\"))\n              (req \"category\" (constant \"endorsing rewards\")))\n           (function Endorsing_rewards -> Some ((), ()) | _ -> None)\n           (fun ((), ()) -> Endorsing_rewards);\n         case\n           (Tag 8)\n           ~title:\"Baking_rewards\"\n           (obj2\n              (req \"kind\" (constant \"minted\"))\n              (req \"category\" (constant \"baking rewards\")))\n           (function Baking_rewards -> Some ((), ()) | _ -> None)\n           (fun ((), ()) -> Baking_rewards);\n         case\n           (Tag 9)\n           ~title:\"Baking_bonuses\"\n           (obj2\n              (req \"kind\" (constant \"minted\"))\n              (req \"category\" (constant \"baking bonuses\")))\n           (function Baking_bonuses -> Some ((), ()) | _ -> None)\n           (fun ((), ()) -> Baking_bonuses);\n         case\n           (Tag 10)\n           ~title:\"Legacy_fees\"\n           (obj4\n              (req \"kind\" (constant \"freezer\"))\n              (req \"category\" (constant \"legacy_fees\"))\n              (req \"delegate\" Signature.Public_key_hash.encoding)\n              (req \"cycle\" Cycle_repr.encoding))\n           (function Legacy_fees (d, l) -> Some ((), (), d, l) | _ -> None)\n           (fun ((), (), d, l) -> Legacy_fees (d, l));\n         case\n           (Tag 11)\n           ~title:\"Storage_fees\"\n           (obj2\n              (req \"kind\" (constant \"burned\"))\n              (req \"category\" (constant \"storage fees\")))\n           (function Storage_fees -> Some ((), ()) | _ -> None)\n           (fun ((), ()) -> Storage_fees);\n         case\n           (Tag 12)\n           ~title:\"Double_signing_punishments\"\n           (obj2\n              (req \"kind\" (constant \"burned\"))\n              (req \"category\" (constant \"punishments\")))\n           (function Double_signing_punishments -> Some ((), ()) | _ -> None)\n           (fun ((), ()) -> Double_signing_punishments);\n         case\n           (Tag 13)\n           ~title:\"Lost_endorsing_rewards\"\n           (obj5\n              (req \"kind\" (constant \"burned\"))\n              (req \"category\" (constant \"lost endorsing rewards\"))\n              (req \"delegate\" Signature.Public_key_hash.encoding)\n              (req \"participation\" Data_encoding.bool)\n              (req \"revelation\" Data_encoding.bool))\n           (function\n             | Lost_endorsing_rewards (d, p, r) -> Some ((), (), d, p, r)\n             | _ -> None)\n           (fun ((), (), d, p, r) -> Lost_endorsing_rewards (d, p, r));\n         case\n           (Tag 14)\n           ~title:\"Liquidity_baking_subsidies\"\n           (obj2\n              (req \"kind\" (constant \"minted\"))\n              (req \"category\" (constant \"subsidy\")))\n           (function Liquidity_baking_subsidies -> Some ((), ()) | _ -> None)\n           (fun ((), ()) -> Liquidity_baking_subsidies);\n         case\n           (Tag 15)\n           ~title:\"Burned\"\n           (obj2\n              (req \"kind\" (constant \"burned\"))\n              (req \"category\" (constant \"burned\")))\n           (function Burned -> Some ((), ()) | _ -> None)\n           (fun ((), ()) -> Burned);\n         case\n           (Tag 16)\n           ~title:\"Commitments\"\n           (obj3\n              (req \"kind\" (constant \"commitment\"))\n              (req \"category\" (constant \"commitment\"))\n              (req \"committer\" Blinded_public_key_hash.encoding))\n           (function Commitments bpkh -> Some ((), (), bpkh) | _ -> None)\n           (fun ((), (), bpkh) -> Commitments bpkh);\n         case\n           (Tag 17)\n           ~title:\"Bootstrap\"\n           (obj2\n              (req \"kind\" (constant \"minted\"))\n              (req \"category\" (constant \"bootstrap\")))\n           (function Bootstrap -> Some ((), ()) | _ -> None)\n           (fun ((), ()) -> Bootstrap);\n         case\n           (Tag 18)\n           ~title:\"Invoice\"\n           (obj2\n              (req \"kind\" (constant \"minted\"))\n              (req \"category\" (constant \"invoice\")))\n           (function Invoice -> Some ((), ()) | _ -> None)\n           (fun ((), ()) -> Invoice);\n         case\n           (Tag 19)\n           ~title:\"Initial_commitments\"\n           (obj2\n              (req \"kind\" (constant \"minted\"))\n              (req \"category\" (constant \"commitment\")))\n           (function Initial_commitments -> Some ((), ()) | _ -> None)\n           (fun ((), ()) -> Initial_commitments);\n         case\n           (Tag 20)\n           ~title:\"Minted\"\n           (obj2\n              (req \"kind\" (constant \"minted\"))\n              (req \"category\" (constant \"minted\")))\n           (function Minted -> Some ((), ()) | _ -> None)\n           (fun ((), ()) -> Minted);\n       ]\n\nlet is_not_zero c = not (Compare.Int.equal c 0)\n\nlet compare_balance ba bb =\n  match (ba, bb) with\n  | (Contract ca, Contract cb) -> Contract_repr.compare ca cb\n  | (Legacy_rewards (pkha, ca), Legacy_rewards (pkhb, cb)) ->\n      let c = Signature.Public_key_hash.compare pkha pkhb in\n      if is_not_zero c then c else Cycle_repr.compare ca cb\n  | (Legacy_deposits (pkha, ca), Legacy_deposits (pkhb, cb)) ->\n      let c = Signature.Public_key_hash.compare pkha pkhb in\n      if is_not_zero c then c else Cycle_repr.compare ca cb\n  | (Deposits pkha, Deposits pkhb) ->\n      Signature.Public_key_hash.compare pkha pkhb\n  | ( Lost_endorsing_rewards (pkha, pa, ra),\n      Lost_endorsing_rewards (pkhb, pb, rb) ) ->\n      let c = Signature.Public_key_hash.compare pkha pkhb in\n      if is_not_zero c then c\n      else\n        let c = Compare.Bool.compare pa pb in\n        if is_not_zero c then c else Compare.Bool.compare ra rb\n  | (Commitments bpkha, Commitments bpkhb) ->\n      Blinded_public_key_hash.compare bpkha bpkhb\n  | (Legacy_fees (pkha, ca), Legacy_fees (pkhb, cb)) ->\n      let c = Signature.Public_key_hash.compare pkha pkhb in\n      if is_not_zero c then c else Cycle_repr.compare ca cb\n  | (_, _) ->\n      let index b =\n        match b with\n        | Contract _ -> 0\n        | Legacy_rewards _ -> 1\n        | Block_fees -> 2\n        | Legacy_deposits _ -> 3\n        | Deposits _ -> 4\n        | Nonce_revelation_rewards -> 5\n        | Double_signing_evidence_rewards -> 6\n        | Endorsing_rewards -> 7\n        | Baking_rewards -> 8\n        | Baking_bonuses -> 9\n        | Legacy_fees _ -> 10\n        | Storage_fees -> 11\n        | Double_signing_punishments -> 12\n        | Lost_endorsing_rewards _ -> 13\n        | Liquidity_baking_subsidies -> 14\n        | Burned -> 15\n        | Commitments _ -> 16\n        | Bootstrap -> 17\n        | Invoice -> 18\n        | Initial_commitments -> 19\n        | Minted -> 20\n        (* don't forget to add parameterized cases in the first part of the function *)\n      in\n      Compare.Int.compare (index ba) (index bb)\n\ntype balance_update = Debited of Tez_repr.t | Credited of Tez_repr.t\n\nlet balance_update_encoding =\n  let open Data_encoding in\n  def \"operation_metadata.alpha.balance_update\"\n  @@ obj1\n       (req\n          \"change\"\n          (conv\n             (function\n               | Credited v -> Tez_repr.to_mutez v\n               | Debited v -> Int64.neg (Tez_repr.to_mutez v))\n             ( Json.wrap_error @@ fun v ->\n               if Compare.Int64.(v < 0L) then\n                 match Tez_repr.of_mutez (Int64.neg v) with\n                 | Some v -> Debited v\n                 | None -> assert false (* [of_mutez z] is [None] iff [z < 0] *)\n               else\n                 match Tez_repr.of_mutez v with\n                 | Some v -> Credited v\n                 | None -> assert false (* same *) )\n             int64))\n\ntype update_origin =\n  | Block_application\n  | Protocol_migration\n  | Subsidy\n  | Simulation\n\nlet compare_update_origin oa ob =\n  let index o =\n    match o with\n    | Block_application -> 0\n    | Protocol_migration -> 1\n    | Subsidy -> 2\n    | Simulation -> 3\n  in\n  Compare.Int.compare (index oa) (index ob)\n\nlet update_origin_encoding =\n  let open Data_encoding in\n  def \"operation_metadata.alpha.update_origin\"\n  @@ obj1 @@ req \"origin\"\n  @@ union\n       [\n         case\n           (Tag 0)\n           ~title:\"Block_application\"\n           (constant \"block\")\n           (function Block_application -> Some () | _ -> None)\n           (fun () -> Block_application);\n         case\n           (Tag 1)\n           ~title:\"Protocol_migration\"\n           (constant \"migration\")\n           (function Protocol_migration -> Some () | _ -> None)\n           (fun () -> Protocol_migration);\n         case\n           (Tag 2)\n           ~title:\"Subsidy\"\n           (constant \"subsidy\")\n           (function Subsidy -> Some () | _ -> None)\n           (fun () -> Subsidy);\n         case\n           (Tag 3)\n           ~title:\"Simulation\"\n           (constant \"simulation\")\n           (function Simulation -> Some () | _ -> None)\n           (fun () -> Simulation);\n       ]\n\ntype balance_updates = (balance * balance_update * update_origin) list\n\nlet balance_updates_encoding =\n  let open Data_encoding in\n  def \"operation_metadata.alpha.balance_updates\"\n  @@ list\n       (conv\n          (function\n            | (balance, balance_update, update_origin) ->\n                ((balance, balance_update), update_origin))\n          (fun ((balance, balance_update), update_origin) ->\n            (balance, balance_update, update_origin))\n          (merge_objs\n             (merge_objs balance_encoding balance_update_encoding)\n             update_origin_encoding))\n\nmodule BalanceMap = Map.Make (struct\n  type t = balance * update_origin\n\n  let compare (ba, ua) (bb, ub) =\n    let c = compare_balance ba bb in\n    if is_not_zero c then c else compare_update_origin ua ub\nend)\n\nlet group_balance_updates balance_updates =\n  List.fold_left_e\n    (fun acc (b, update, o) ->\n      (match BalanceMap.find (b, o) acc with\n      | None -> ok update\n      | Some present -> (\n          match (present, update) with\n          | (Credited a, Debited b) | (Debited b, Credited a) ->\n              if Tez_repr.(a >= b) then\n                Tez_repr.(a -? b) >>? fun update -> ok (Credited update)\n              else Tez_repr.(b -? a) >>? fun update -> ok (Debited update)\n          | (Credited a, Credited b) ->\n              Tez_repr.(a +? b) >>? fun update -> ok (Credited update)\n          | (Debited a, Debited b) ->\n              Tez_repr.(a +? b) >>? fun update -> ok (Debited update)))\n      >>? function\n      | Credited update when Tez_repr.(update = zero) ->\n          ok (BalanceMap.remove (b, o) acc)\n      | update -> ok (BalanceMap.add (b, o) update acc))\n    BalanceMap.empty\n    balance_updates\n  >>? fun map ->\n  ok (BalanceMap.fold (fun (b, o) u acc -> (b, u, o) :: acc) map [])\n" ;
                } ;
                { name = "Migration_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Tocqueville Group, Inc. <contact@tezos.com>            *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Dupe of `Kind.origination successful_manager_operation_result` for use\n    inside Alpha_context. Converted in Apply_results.\n\n    Doesn't consume gas and omits lazy_storage_diff field since it would\n    require copying Script_ir_translator functions to work on Raw_context.\n *)\ntype origination_result = {\n  balance_updates : Receipt_repr.balance_updates;\n  originated_contracts : Contract_repr.t list;\n  storage_size : Z.t;\n  paid_storage_size_diff : Z.t;\n}\n\nval origination_result_list_encoding : origination_result list Data_encoding.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Tocqueville Group, Inc. <contact@tezos.com>            *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype origination_result = {\n  balance_updates : Receipt_repr.balance_updates;\n  originated_contracts : Contract_repr.t list;\n  storage_size : Z.t;\n  paid_storage_size_diff : Z.t;\n}\n\nlet origination_result_list_encoding =\n  let open Data_encoding in\n  def \"operation.alpha.origination_result\"\n  @@ list\n       (conv\n          (fun {\n                 balance_updates;\n                 originated_contracts;\n                 storage_size;\n                 paid_storage_size_diff;\n               } ->\n            ( balance_updates,\n              originated_contracts,\n              storage_size,\n              paid_storage_size_diff ))\n          (fun ( balance_updates,\n                 originated_contracts,\n                 storage_size,\n                 paid_storage_size_diff ) ->\n            {\n              balance_updates;\n              originated_contracts;\n              storage_size;\n              paid_storage_size_diff;\n            })\n          (obj4\n             (dft \"balance_updates\" Receipt_repr.balance_updates_encoding [])\n             (dft \"originated_contracts\" (list Contract_repr.encoding) [])\n             (dft \"storage_size\" z Z.zero)\n             (dft \"paid_storage_size_diff\" z Z.zero)))\n" ;
                } ;
                { name = "Raw_context_intf" ;
                  interface = None ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2018-2021 Tarides <contact@tarides.com>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** All context manipulation functions. This signature is included\n    as-is for direct context accesses, and used in {!Storage_functors}\n    to provide restricted views to the context. *)\n\nmodule type VIEW = sig\n  (* Same as [Environment_context.VIEW] but with extra getters and\n     setters functions. *)\n\n  (** The type for context handler. *)\n  type t\n\n  (** The type for context trees. *)\n  type tree\n\n  (** The type for context keys. *)\n  type key = string list\n\n  (** The type for context values. *)\n  type value = bytes\n\n  (** {2 Getters} *)\n\n  (** [mem t k] is an Lwt promise that resolves to [true] iff [k] is bound\n      to a value in [t]. *)\n  val mem : t -> key -> bool Lwt.t\n\n  (** [mem_tree t k] is like {!mem} but for trees. *)\n  val mem_tree : t -> key -> bool Lwt.t\n\n  (** [get t k] is an Lwt promise that resolves to [Ok v] if [k] is\n      bound to the value [v] in [t] and {!Storage_Error Missing_key}\n      otherwise. *)\n  val get : t -> key -> value tzresult Lwt.t\n\n  (** [get_tree] is like {!get} but for trees. *)\n  val get_tree : t -> key -> tree tzresult Lwt.t\n\n  (** [find t k] is an Lwt promise that resolves to [Some v] if [k] is\n      bound to the value [v] in [t] and [None] otherwise. *)\n  val find : t -> key -> value option Lwt.t\n\n  (** [find_tree t k] is like {!find} but for trees. *)\n  val find_tree : t -> key -> tree option Lwt.t\n\n  (** [list t key] is the list of files and sub-nodes stored under [k] in [t].\n      The result order is not specified but is stable.\n\n      [offset] and [length] are used for pagination. *)\n  val list :\n    t -> ?offset:int -> ?length:int -> key -> (string * tree) list Lwt.t\n\n  (** {2 Setters} *)\n\n  (** [init t k v] is an Lwt promise that resolves to [Ok c] if:\n\n      - [k] is unbound in [t];\n      - [k] is bound to [v] in [c];\n      - and [c] is similar to [t] otherwise.\n\n      It is {!Storage_error Existing_key} if [k] is already bound in [t]. *)\n  val init : t -> key -> value -> t tzresult Lwt.t\n\n  (** [init_tree] is like {!init} but for trees. *)\n  val init_tree : t -> key -> tree -> t tzresult Lwt.t\n\n  (** [update t k v] is an Lwt promise that resolves to [Ok c] if:\n\n      - [k] is bound in [t];\n      - [k] is bound to [v] in [c];\n      - and [c] is similar to [t] otherwise.\n\n      It is {!Storage_error Missing_key} if [k] is not already bound in [t]. *)\n  val update : t -> key -> value -> t tzresult Lwt.t\n\n  (** [update_tree] is like {!update} but for trees. *)\n  val update_tree : t -> key -> tree -> t tzresult Lwt.t\n\n  (** [add t k v] is an Lwt promise that resolves to [c] such that:\n\n    - [k] is bound to [v] in [c];\n    - and [c] is similar to [t] otherwise.\n\n    If [k] was already bound in [t] to a value that is physically equal\n    to [v], the result of the function is a promise that resolves to\n    [t]. Otherwise, the previous binding of [k] in [t] disappears. *)\n  val add : t -> key -> value -> t Lwt.t\n\n  (** [add_tree] is like {!add} but for trees. *)\n  val add_tree : t -> key -> tree -> t Lwt.t\n\n  (** [remove t k v] is an Lwt promise that resolves to [c] such that:\n\n    - [k] is unbound in [c];\n    - and [c] is similar to [t] otherwise. *)\n  val remove : t -> key -> t Lwt.t\n\n  (** [remove_existing t k v] is an Lwt promise that resolves to [Ok c] if:\n\n      - [k] is bound in [t] to a value;\n      - [k] is unbound in [c];\n      - and [c] is similar to [t] otherwise.*)\n  val remove_existing : t -> key -> t tzresult Lwt.t\n\n  (** [remove_existing_tree t k v] is an Lwt promise that reolves to [Ok c] if:\n\n      - [k] is bound in [t] to a tree;\n      - [k] is unbound in [c];\n      - and [c] is similar to [t] otherwise.*)\n  val remove_existing_tree : t -> key -> t tzresult Lwt.t\n\n  (** [add_or_remove t k v] is:\n\n      - [add t k x] if [v] is [Some x];\n      - [remove t k] otherwise. *)\n  val add_or_remove : t -> key -> value option -> t Lwt.t\n\n  (** [add_or_remove_tree t k v] is:\n\n      - [add_tree t k x] if [v] is [Some x];\n      - [remove t k] otherwise. *)\n  val add_or_remove_tree : t -> key -> tree option -> t Lwt.t\n\n  (** {2 Folds} *)\n\n  (** [fold ?depth t root ~init ~f] recursively folds over the trees\n      and values of [t]. The [f] callbacks are called with a key relative\n      to [root]. [f] is never called with an empty key for values; i.e.,\n      folding over a value is a no-op.\n\n      Elements are traversed in lexical order of keys.\n\n      The depth is 0-indexed. If [depth] is set (by default it is not), then [f]\n      is only called when the conditions described by the parameter is true:\n\n      - [Eq d] folds over nodes and contents of depth exactly [d].\n      - [Lt d] folds over nodes and contents of depth strictly less than [d].\n      - [Le d] folds over nodes and contents of depth less than or equal to [d].\n      - [Gt d] folds over nodes and contents of depth strictly more than [d].\n      - [Ge d] folds over nodes and contents of depth more than or equal to [d]. *)\n  val fold :\n    ?depth:[`Eq of int | `Le of int | `Lt of int | `Ge of int | `Gt of int] ->\n    t ->\n    key ->\n    order:[`Sorted | `Undefined] ->\n    init:'a ->\n    f:(key -> tree -> 'a -> 'a Lwt.t) ->\n    'a Lwt.t\nend\n\nmodule type TREE = sig\n  (** [Tree] provides immutable, in-memory partial mirror of the\n      context, with lazy reads and delayed writes. The trees are Merkle\n      trees that carry the same hash as the part of the context they\n      mirror.\n\n      Trees are immutable and non-persistent (they disappear if the\n      host crash), held in memory for efficiency, where reads are done\n      lazily and writes are done only when needed, e.g. on\n      [Context.commit]. If a key is modified twice, only the last\n      value will be written to disk on commit. *)\n\n  (** The type for context views. *)\n  type t\n\n  (** The type for context trees. *)\n  type tree\n\n  include VIEW with type t := tree and type tree := tree\n\n  (** [empty _] is the empty tree. *)\n  val empty : t -> tree\n\n  (** [is_empty t] is true iff [t] is [empty _]. *)\n  val is_empty : tree -> bool\n\n  (** [kind t] is [t]'s kind. It's either a tree node or a leaf\n      value. *)\n  val kind : tree -> [`Value | `Tree]\n\n  (** [to_value t] is [Some v] is [t] is a leaf tree and [None] otherwise. *)\n  val to_value : tree -> value option Lwt.t\n\n  (** [hash t] is [t]'s Merkle hash. *)\n  val hash : tree -> Context_hash.t\n\n  (** [equal x y] is true iff [x] and [y] have the same Merkle hash. *)\n  val equal : tree -> tree -> bool\n\n  (** {2 Caches} *)\n\n  (** [clear ?depth t] clears all caches in the tree [t] for subtrees with a\n      depth higher than [depth]. If [depth] is not set, all of the subtrees are\n      cleared. *)\n  val clear : ?depth:int -> tree -> unit\nend\n\nmodule type T = sig\n  (** The type for root contexts. *)\n  type root\n\n  include VIEW\n\n  module Tree :\n    TREE\n      with type t := t\n       and type key := key\n       and type value := value\n       and type tree := tree\n\n  (** Internally used in {!Storage_functors} to escape from a view. *)\n  val project : t -> root\n\n  (** Internally used in {!Storage_functors} to retrieve a full key\n      from partial key relative a view. *)\n  val absolute_key : t -> key -> key\n\n  (** Raised if block gas quota is exhausted during gas\n     consumption. *)\n  type error += Block_quota_exceeded\n\n  (** Raised if operation gas quota is exhausted during gas\n     consumption. *)\n  type error += Operation_quota_exceeded\n\n  (** Internally used in {!Storage_functors} to consume gas from\n     within a view. May raise {!Block_quota_exceeded} or\n     {!Operation_quota_exceeded}. *)\n  val consume_gas : t -> Gas_limit_repr.cost -> t tzresult\n\n  (** Check if consume_gas will fail *)\n  val check_enough_gas : t -> Gas_limit_repr.cost -> unit tzresult\n\n  val description : t Storage_description.t\nend\n" ;
                } ;
                { name = "Raw_context" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** {1 Errors} *)\n\ntype error += Too_many_internal_operations (* `Permanent *)\n\ntype missing_key_kind = Get | Set | Del | Copy\n\n(** An internal storage error that should not happen *)\ntype storage_error =\n  | Incompatible_protocol_version of string\n  | Missing_key of string list * missing_key_kind\n  | Existing_key of string list\n  | Corrupted_data of string list\n\ntype error += Storage_error of storage_error\n\ntype error += Failed_to_parse_parameter of bytes\n\ntype error += Failed_to_decode_parameter of Data_encoding.json * string\n\nval storage_error : storage_error -> 'a tzresult\n\n(** {1 Abstract Context} *)\n\n(** Abstract view of the context.\n    Includes a handle to the functional key-value database\n    ({!Context.t}) along with some in-memory values (gas, etc.). *)\ntype t\n\ntype root = t\n\n(** Retrieves the state of the database and gives its abstract view.\n    It also returns wether this is the first block validated\n    with this version of the protocol. *)\nval prepare :\n  level:Int32.t ->\n  predecessor_timestamp:Time.t ->\n  timestamp:Time.t ->\n  Context.t ->\n  t tzresult Lwt.t\n\ntype previous_protocol = Genesis of Parameters_repr.t | Hangzhou_011\n\nval prepare_first_block :\n  level:int32 ->\n  timestamp:Time.t ->\n  Context.t ->\n  (previous_protocol * t) tzresult Lwt.t\n\nval activate : t -> Protocol_hash.t -> t Lwt.t\n\n(** Returns the state of the database resulting of operations on its\n    abstract view *)\nval recover : t -> Context.t\n\nval current_level : t -> Level_repr.t\n\nval predecessor_timestamp : t -> Time.t\n\nval current_timestamp : t -> Time.t\n\nval constants : t -> Constants_repr.parametric\n\nval patch_constants :\n  t -> (Constants_repr.parametric -> Constants_repr.parametric) -> t Lwt.t\n\nval round_durations : t -> Round_repr.Durations.t\n\n(** Retrieve the cycle eras. *)\nval cycle_eras : t -> Level_repr.cycle_eras\n\n(** Increment the current block fee stash that will be credited to the payload\n    producer's account at finalize_application *)\nval credit_collected_fees_only_call_from_token : t -> Tez_repr.t -> t tzresult\n\n(** Decrement the current block fee stash that will be credited to the payload\n    producer's account at finalize_application *)\nval spend_collected_fees_only_call_from_token : t -> Tez_repr.t -> t tzresult\n\n(** Returns the current block fee stash that will be credited to the payload\n    producer's account at finalize_application *)\nval get_collected_fees : t -> Tez_repr.t\n\ntype error += Gas_limit_too_high (* `Permanent *)\n\nval check_gas_limit_is_valid : t -> 'a Gas_limit_repr.Arith.t -> unit tzresult\n\nval consume_gas_limit_in_block : t -> 'a Gas_limit_repr.Arith.t -> t tzresult\n\nval set_gas_limit : t -> 'a Gas_limit_repr.Arith.t -> t\n\nval set_gas_unlimited : t -> t\n\nval gas_level : t -> Gas_limit_repr.t\n\nval gas_consumed : since:t -> until:t -> Gas_limit_repr.Arith.fp\n\nval remaining_operation_gas : t -> Gas_limit_repr.Arith.fp\n\nval update_remaining_operation_gas : t -> Gas_limit_repr.Arith.fp -> t\n\nval block_gas_level : t -> Gas_limit_repr.Arith.fp\n\nval update_remaining_block_gas : t -> Gas_limit_repr.Arith.fp -> t\n\ntype error += Undefined_operation_nonce (* `Permanent *)\n\nval init_origination_nonce : t -> Operation_hash.t -> t\n\nval get_origination_nonce : t -> Contract_repr.origination_nonce tzresult\n\nval increment_origination_nonce :\n  t -> (t * Contract_repr.origination_nonce) tzresult\n\nval unset_origination_nonce : t -> t\n\n(** {1 Generic accessors} *)\n\ntype key = string list\n\ntype value = bytes\n\ntype tree\n\nmodule type T =\n  Raw_context_intf.T\n    with type root := root\n     and type key := key\n     and type value := value\n     and type tree := tree\n\ninclude T with type t := t\n\n(** Initialize the local nonce used for preventing a script to\n    duplicate an internal operation to replay it. *)\nval reset_internal_nonce : t -> t\n\n(** Increments the internal operation nonce. *)\nval fresh_internal_nonce : t -> (t * int) tzresult\n\n(** Mark an internal operation nonce as taken. *)\nval record_internal_nonce : t -> int -> t\n\n(** Check is the internal operation nonce has been taken. *)\nval internal_nonce_already_recorded : t -> int -> bool\n\nval fold_map_temporary_lazy_storage_ids :\n  t ->\n  (Lazy_storage_kind.Temp_ids.t -> Lazy_storage_kind.Temp_ids.t * 'res) ->\n  t * 'res\n\nval map_temporary_lazy_storage_ids_s :\n  t ->\n  (Lazy_storage_kind.Temp_ids.t -> (t * Lazy_storage_kind.Temp_ids.t) Lwt.t) ->\n  t Lwt.t\n\nmodule Cache :\n  Context.CACHE\n    with type t := t\n     and type size := int\n     and type index := int\n     and type identifier := string\n     and type key = Context.Cache.key\n     and type value = Context.Cache.value\n\n(* Hashes of non-consensus operations are stored so that, when\n   finalizing the block, we can compute the block's payload hash. *)\nval record_non_consensus_operation_hash : t -> Operation_hash.t -> t\n\nval non_consensus_operations : t -> Operation_hash.t list\n\n(** [set_sampler_for_cycle ctxt cycle sampler] evaluates to\n    [Ok c] with [c] verifying [sampler_for_cycle c cycle = sampler]\n    if no sampler was set for the same [cycle] beforehand.\n    In the other case, it returns [Error `Sampler_already_set]. *)\nval set_sampler_for_cycle :\n  t ->\n  Cycle_repr.t ->\n  Seed_repr.seed * (Signature.public_key * Signature.public_key_hash) Sampler.t ->\n  (t, [`Sampler_already_set]) result\n\n(** [sampler_for_cycle ctxt cycle] evaluates to [Ok sampler] if a sampler was\n    set for [cycle] using [set_sampler_for_cycle].\n    Otherwise, it returns [Error `Sampler_not_set]. *)\nval sampler_for_cycle :\n  t ->\n  Cycle_repr.t ->\n  ( Seed_repr.seed * (Signature.public_key * Signature.public_key_hash) Sampler.t,\n    [`Sampler_not_set] )\n  result\n\n(* The stake distribution is stored both in [t] and in the cache. It\n   may be sufficient to only store it in the cache. *)\nval stake_distribution_for_current_cycle :\n  t -> Tez_repr.t Signature.Public_key_hash.Map.t tzresult\n\nval init_stake_distribution_for_current_cycle :\n  t -> Tez_repr.t Signature.Public_key_hash.Map.t -> t\n\nmodule type CONSENSUS = sig\n  type t\n\n  type 'value slot_map\n\n  type slot_set\n\n  type slot\n\n  type round\n\n  (** Returns a map where each endorser's pkh is associated to the\n     list of its endorsing slots (in decreasing order) for a given\n     level. *)\n  val allowed_endorsements :\n    t -> (Signature.Public_key.t * Signature.Public_key_hash.t * int) slot_map\n\n  (** Returns a map where each endorser's pkh is associated to the\n     list of its endorsing slots (in decreasing order) for a given\n     level. *)\n  val allowed_preendorsements :\n    t -> (Signature.Public_key.t * Signature.Public_key_hash.t * int) slot_map\n\n  (** [endorsement power ctx] returns the endorsement power of the\n     current block. *)\n  val current_endorsement_power : t -> int\n\n  (** Initializes the map of allowed endorsements and preendorsements,\n     this function must be called only once and before applying\n     any consensus operation.  *)\n  val initialize_consensus_operation :\n    t ->\n    allowed_endorsements:\n      (Signature.Public_key.t * Signature.Public_key_hash.t * int) slot_map ->\n    allowed_preendorsements:\n      (Signature.Public_key.t * Signature.Public_key_hash.t * int) slot_map ->\n    t\n\n  (** [record_grand_parent_endorsement ctx pkh] records an\n      grand_parent_endorsement for the current block. This is only\n      useful for the partial construction mode. *)\n  val record_grand_parent_endorsement :\n    t -> Signature.Public_key_hash.t -> t tzresult\n\n  (** [record_endorsement ctx ~initial_slot ~power] records an\n     endorsement for the current block.\n\n      The endorsement should be valid in the sense that\n      [Int_map.find_opt initial_slot allowed_endorsement ctx = Some\n      (pkh, power)].  *)\n  val record_endorsement : t -> initial_slot:slot -> power:int -> t tzresult\n\n  (** [record_preendorsement ctx ~initial_slot ~power round\n     payload_hash power] records a preendorsement for a proposal at\n     [round] with payload [payload_hash].\n\n      The preendorsement should be valid in the sense that\n     [Int_map.find_opt initial_slot allowed_preendorsement ctx = Some\n     (pkh, power)].  *)\n  val record_preendorsement :\n    t -> initial_slot:slot -> power:int -> round -> t tzresult\n\n  val endorsements_seen : t -> slot_set\n\n  (** [get_preendorsements_quorum_round ctx] returns [None] if no\n     preendorsement are included in the current block. Otherwise,\n     return [Some r] where [r] is the round of the preendorsements\n     included in the block. *)\n  val get_preendorsements_quorum_round : t -> round option\n\n  (** [set_preendorsements_quorum_round ctx round] sets the round for\n     preendorsements included in this block. This function should be\n     called only once.\n\n      This function is only used in [Full_construction] mode.  *)\n  val set_preendorsements_quorum_round : t -> round -> t\n\n  (** [locked_round_evidence ctx] returns the round of the recorded\n     preendorsements as well as their power. *)\n  val locked_round_evidence : t -> (round * int) option\n\n  val set_endorsement_branch : t -> Block_hash.t * Block_payload_hash.t -> t\n\n  val endorsement_branch : t -> (Block_hash.t * Block_payload_hash.t) option\n\n  val set_grand_parent_branch : t -> Block_hash.t * Block_payload_hash.t -> t\n\n  val grand_parent_branch : t -> (Block_hash.t * Block_payload_hash.t) option\nend\n\nmodule Consensus :\n  CONSENSUS\n    with type t := t\n     and type slot := Slot_repr.t\n     and type 'a slot_map := 'a Slot_repr.Map.t\n     and type slot_set := Slot_repr.Set.t\n     and type round := Round_repr.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nmodule Int_set = Set.Make (Compare.Int)\n\n(*\n\n   Gas levels maintenance\n   =======================\n\n   The context maintains two levels of gas, one corresponds to the gas\n   available for the current operation while the other is the gas\n   available for the current block. Both levels are maintained\n   independently: [consume_gas] only decreases the operation level,\n   and block level should be updated with [consume_gas_limit_in_block].\n\n   A layered context\n   =================\n\n   Updating the context [remaining_operation_gas] is a critical routine\n   called very frequently by the operations performed by the protocol.\n   On the contrary, other fields are less frequently updated.\n\n   In a previous version of the context datatype definition, all\n   the fields were represented at the toplevel. To update the remaining\n   gas, we had to copy ~25 fields (that is 200 bytes).\n\n   With the following layered representation, we only have to\n   copy 2 fields (16 bytes) during [remaining_operation_gas] update.\n   This has a significant impact on the Michelson runtime efficiency.\n\n   Here are the fields on the [back] of the context:\n\n *)\n\nmodule Raw_consensus = struct\n  (** Consensus operations are indexed by their [initial slots]. Given\n      a delegate, the [initial slot] is the lowest slot assigned to\n      this delegate. *)\n\n  type t = {\n    current_endorsement_power : int;\n        (** Number of endorsement slots recorded for the current block. *)\n    allowed_endorsements :\n      (Signature.Public_key.t * Signature.Public_key_hash.t * int)\n      Slot_repr.Map.t;\n        (** Endorsements rights for the current block. Only an endorsement\n            for the lowest slot in the block can be recorded. The map\n            associates to each initial slot the [pkh] associated to this\n            slot with its power. *)\n    allowed_preendorsements :\n      (Signature.Public_key.t * Signature.Public_key_hash.t * int)\n      Slot_repr.Map.t;\n        (** Preendorsements rights for the current block. Only a preendorsement\n            for the lowest slot in the block can be recorded. The map\n            associates to each initial slot the [pkh] associated to this\n            slot with its power. *)\n    grand_parent_endorsements_seen : Signature.Public_key_hash.Set.t;\n        (** Record the endorsements already seen for the grand\n            parent. This only useful for the partial construction mode. *)\n    endorsements_seen : Slot_repr.Set.t;\n        (** Record the endorsements already seen. Only initial slots are indexed. *)\n    preendorsements_seen : Slot_repr.Set.t;\n        (** Record the preendorsements already seen. Only initial slots\n            are indexed. *)\n    locked_round_evidence : (Round_repr.t * int) option;\n        (** Record the preendorsement power for a locked round. *)\n    preendorsements_quorum_round : Round_repr.t option;\n        (** in block construction mode, record the round of preendorsements\n            included in a block. *)\n    endorsement_branch : (Block_hash.t * Block_payload_hash.t) option;\n    grand_parent_branch : (Block_hash.t * Block_payload_hash.t) option;\n  }\n\n  (** Invariant:\n\n      - [slot \\in endorsements_seen => Int_map.mem slot allowed_endorsements]\n\n      - [slot \\in preendorsements_seen => Int_map.mem slot allowed_preendorsements]\n\n      - [ |endorsements_seen| > 0 => |included endorsements| > 0]\n\n  *)\n\n  let empty : t =\n    {\n      current_endorsement_power = 0;\n      allowed_endorsements = Slot_repr.Map.empty;\n      allowed_preendorsements = Slot_repr.Map.empty;\n      grand_parent_endorsements_seen = Signature.Public_key_hash.Set.empty;\n      endorsements_seen = Slot_repr.Set.empty;\n      preendorsements_seen = Slot_repr.Set.empty;\n      locked_round_evidence = None;\n      preendorsements_quorum_round = None;\n      endorsement_branch = None;\n      grand_parent_branch = None;\n    }\n\n  type error += Double_inclusion_of_consensus_operation\n\n  let () =\n    register_error_kind\n      `Branch\n      ~id:\"operation.double_inclusion_of_consensus_operation\"\n      ~title:\"double inclusion of consensus operation\"\n      ~description:\"double inclusion of consensus operation\"\n      ~pp:(fun ppf () ->\n        Format.fprintf ppf \"Double inclusion of consensus operation\")\n      Data_encoding.empty\n      (function\n        | Double_inclusion_of_consensus_operation -> Some () | _ -> None)\n      (fun () -> Double_inclusion_of_consensus_operation)\n\n  let record_grand_parent_endorsement t pkh =\n    error_when\n      (Signature.Public_key_hash.Set.mem pkh t.grand_parent_endorsements_seen)\n      Double_inclusion_of_consensus_operation\n    >|? fun () ->\n    {\n      t with\n      grand_parent_endorsements_seen =\n        Signature.Public_key_hash.Set.add pkh t.grand_parent_endorsements_seen;\n    }\n\n  let record_endorsement t ~initial_slot ~power =\n    error_when\n      (Slot_repr.Set.mem initial_slot t.endorsements_seen)\n      Double_inclusion_of_consensus_operation\n    >|? fun () ->\n    {\n      t with\n      current_endorsement_power = t.current_endorsement_power + power;\n      endorsements_seen = Slot_repr.Set.add initial_slot t.endorsements_seen;\n    }\n\n  let record_preendorsement ~initial_slot ~power round t =\n    error_when\n      (Slot_repr.Set.mem initial_slot t.preendorsements_seen)\n      Double_inclusion_of_consensus_operation\n    >|? fun () ->\n    let locked_round_evidence =\n      match t.locked_round_evidence with\n      | None -> Some (round, power)\n      | Some (_stored_round, evidences) ->\n          (* In mempool mode, round and stored_round can be different.\n             It doesn't matter in that case since quorum certificates\n             are not used in mempool.\n             For other cases [Apply.check_round] verifies it. *)\n          Some (round, evidences + power)\n    in\n    {\n      t with\n      locked_round_evidence;\n      preendorsements_seen =\n        Slot_repr.Set.add initial_slot t.preendorsements_seen;\n    }\n\n  let set_preendorsements_quorum_round round t =\n    match t.preendorsements_quorum_round with\n    | Some round' ->\n        (* If the rounds are different, an error should have already\n           been raised. *)\n        assert (Round_repr.equal round round') ;\n        t\n    | None -> {t with preendorsements_quorum_round = Some round}\n\n  let initialize_with_endorsements_and_preendorsements ~allowed_endorsements\n      ~allowed_preendorsements t =\n    {t with allowed_endorsements; allowed_preendorsements}\n\n  let locked_round_evidence t = t.locked_round_evidence\n\n  let endorsement_branch t = t.endorsement_branch\n\n  let grand_parent_branch t = t.grand_parent_branch\n\n  let set_endorsement_branch t endorsement_branch =\n    {t with endorsement_branch = Some endorsement_branch}\n\n  let set_grand_parent_branch t grand_parent_branch =\n    {t with grand_parent_branch = Some grand_parent_branch}\nend\n\ntype back = {\n  context : Context.t;\n  constants : Constants_repr.parametric;\n  round_durations : Round_repr.Durations.t;\n  cycle_eras : Level_repr.cycle_eras;\n  level : Level_repr.t;\n  predecessor_timestamp : Time.t;\n  timestamp : Time.t;\n  fees : Tez_repr.t;\n  origination_nonce : Contract_repr.origination_nonce option;\n  temporary_lazy_storage_ids : Lazy_storage_kind.Temp_ids.t;\n  internal_nonce : int;\n  internal_nonces_used : Int_set.t;\n  remaining_block_gas : Gas_limit_repr.Arith.fp;\n  unlimited_operation_gas : bool;\n  consensus : Raw_consensus.t;\n  non_consensus_operations : Operation_hash.t list;\n  sampler_state :\n    (Seed_repr.seed\n    * (Signature.Public_key.t * Signature.Public_key_hash.t) Sampler.t)\n    Cycle_repr.Map.t;\n  stake_distribution_for_current_cycle :\n    Tez_repr.t Signature.Public_key_hash.Map.t option;\n}\n\n(*\n\n   The context is simply a record with two fields which\n   limits the cost of updating the [remaining_operation_gas].\n\n*)\ntype t = {remaining_operation_gas : Gas_limit_repr.Arith.fp; back : back}\n\ntype root = t\n\n(*\n\n   Context fields accessors\n   ========================\n\n   To have the context related code more robust to evolutions,\n   we introduce accessors to get and to update the context\n   components.\n\n*)\nlet[@inline] context ctxt = ctxt.back.context\n\nlet[@inline] current_level ctxt = ctxt.back.level\n\nlet[@inline] predecessor_timestamp ctxt = ctxt.back.predecessor_timestamp\n\nlet[@inline] current_timestamp ctxt = ctxt.back.timestamp\n\nlet[@inline] round_durations ctxt = ctxt.back.round_durations\n\nlet[@inline] cycle_eras ctxt = ctxt.back.cycle_eras\n\nlet[@inline] constants ctxt = ctxt.back.constants\n\nlet[@inline] recover ctxt = ctxt.back.context\n\nlet[@inline] fees ctxt = ctxt.back.fees\n\nlet[@inline] origination_nonce ctxt = ctxt.back.origination_nonce\n\nlet[@inline] internal_nonce ctxt = ctxt.back.internal_nonce\n\nlet[@inline] internal_nonces_used ctxt = ctxt.back.internal_nonces_used\n\nlet[@inline] remaining_block_gas ctxt = ctxt.back.remaining_block_gas\n\nlet[@inline] unlimited_operation_gas ctxt = ctxt.back.unlimited_operation_gas\n\nlet[@inline] temporary_lazy_storage_ids ctxt =\n  ctxt.back.temporary_lazy_storage_ids\n\nlet[@inline] remaining_operation_gas ctxt = ctxt.remaining_operation_gas\n\nlet[@inline] non_consensus_operations ctxt = ctxt.back.non_consensus_operations\n\nlet[@inline] sampler_state ctxt = ctxt.back.sampler_state\n\nlet[@inline] update_back ctxt back = {ctxt with back}\n\nlet[@inline] update_remaining_block_gas ctxt remaining_block_gas =\n  update_back ctxt {ctxt.back with remaining_block_gas}\n\nlet[@inline] update_remaining_operation_gas ctxt remaining_operation_gas =\n  {ctxt with remaining_operation_gas}\n\nlet[@inline] update_unlimited_operation_gas ctxt unlimited_operation_gas =\n  update_back ctxt {ctxt.back with unlimited_operation_gas}\n\nlet[@inline] update_context ctxt context =\n  update_back ctxt {ctxt.back with context}\n\nlet[@inline] update_constants ctxt constants =\n  update_back ctxt {ctxt.back with constants}\n\nlet[@inline] update_origination_nonce ctxt origination_nonce =\n  update_back ctxt {ctxt.back with origination_nonce}\n\nlet[@inline] update_internal_nonce ctxt internal_nonce =\n  update_back ctxt {ctxt.back with internal_nonce}\n\nlet[@inline] update_internal_nonces_used ctxt internal_nonces_used =\n  update_back ctxt {ctxt.back with internal_nonces_used}\n\nlet[@inline] update_fees ctxt fees = update_back ctxt {ctxt.back with fees}\n\nlet[@inline] update_temporary_lazy_storage_ids ctxt temporary_lazy_storage_ids =\n  update_back ctxt {ctxt.back with temporary_lazy_storage_ids}\n\nlet[@inline] update_non_consensus_operations ctxt non_consensus_operations =\n  update_back ctxt {ctxt.back with non_consensus_operations}\n\nlet[@inline] update_sampler_state ctxt sampler_state =\n  update_back ctxt {ctxt.back with sampler_state}\n\ntype error += Too_many_internal_operations (* `Permanent *)\n\ntype error += Block_quota_exceeded (* `Temporary *)\n\ntype error += Operation_quota_exceeded (* `Temporary *)\n\ntype error += Stake_distribution_not_set (* `Branch *)\n\nlet () =\n  let open Data_encoding in\n  register_error_kind\n    `Permanent\n    ~id:\"too_many_internal_operations\"\n    ~title:\"Too many internal operations\"\n    ~description:\n      \"A transaction exceeded the hard limit of internal operations it can emit\"\n    empty\n    (function Too_many_internal_operations -> Some () | _ -> None)\n    (fun () -> Too_many_internal_operations) ;\n  register_error_kind\n    `Temporary\n    ~id:\"gas_exhausted.operation\"\n    ~title:\"Gas quota exceeded for the operation\"\n    ~description:\n      \"A script or one of its callee took more time than the operation said it \\\n       would\"\n    empty\n    (function Operation_quota_exceeded -> Some () | _ -> None)\n    (fun () -> Operation_quota_exceeded) ;\n  register_error_kind\n    `Temporary\n    ~id:\"gas_exhausted.block\"\n    ~title:\"Gas quota exceeded for the block\"\n    ~description:\n      \"The sum of gas consumed by all the operations in the block exceeds the \\\n       hard gas limit per block\"\n    empty\n    (function Block_quota_exceeded -> Some () | _ -> None)\n    (fun () -> Block_quota_exceeded) ;\n  register_error_kind\n    `Permanent\n    ~id:\"delegate.stake_distribution_not_set\"\n    ~title:\"Stake distribution not set\"\n    ~description:\"The stake distribution for the current cycle is not set.\"\n    ~pp:(fun ppf () ->\n      Format.fprintf\n        ppf\n        \"The stake distribution for the current cycle is not set.\")\n    Data_encoding.(empty)\n    (function Stake_distribution_not_set -> Some () | _ -> None)\n    (fun () -> Stake_distribution_not_set)\n\nlet fresh_internal_nonce ctxt =\n  if Compare.Int.(internal_nonce ctxt >= 65_535) then\n    error Too_many_internal_operations\n  else\n    ok\n      (update_internal_nonce ctxt (internal_nonce ctxt + 1), internal_nonce ctxt)\n\nlet reset_internal_nonce ctxt =\n  let ctxt = update_internal_nonce ctxt 0 in\n  update_internal_nonces_used ctxt Int_set.empty\n\nlet record_internal_nonce ctxt k =\n  update_internal_nonces_used ctxt (Int_set.add k (internal_nonces_used ctxt))\n\nlet internal_nonce_already_recorded ctxt k =\n  Int_set.mem k (internal_nonces_used ctxt)\n\nlet get_collected_fees ctxt = fees ctxt\n\nlet credit_collected_fees_only_call_from_token ctxt fees' =\n  let previous = get_collected_fees ctxt in\n  Tez_repr.(previous +? fees') >|? fun fees -> update_fees ctxt fees\n\nlet spend_collected_fees_only_call_from_token ctxt fees' =\n  let previous = get_collected_fees ctxt in\n  Tez_repr.(previous -? fees') >|? fun fees -> update_fees ctxt fees\n\ntype error += Undefined_operation_nonce (* `Permanent *)\n\nlet () =\n  let open Data_encoding in\n  register_error_kind\n    `Permanent\n    ~id:\"undefined_operation_nonce\"\n    ~title:\"Ill timed access to the origination nonce\"\n    ~description:\n      \"An origination was attempted out of the scope of a manager operation\"\n    empty\n    (function Undefined_operation_nonce -> Some () | _ -> None)\n    (fun () -> Undefined_operation_nonce)\n\nlet init_origination_nonce ctxt operation_hash =\n  let origination_nonce =\n    Some (Contract_repr.initial_origination_nonce operation_hash)\n  in\n  update_origination_nonce ctxt origination_nonce\n\nlet increment_origination_nonce ctxt =\n  match origination_nonce ctxt with\n  | None -> error Undefined_operation_nonce\n  | Some cur_origination_nonce ->\n      let origination_nonce =\n        Some (Contract_repr.incr_origination_nonce cur_origination_nonce)\n      in\n      let ctxt = update_origination_nonce ctxt origination_nonce in\n      ok (ctxt, cur_origination_nonce)\n\nlet get_origination_nonce ctxt =\n  match origination_nonce ctxt with\n  | None -> error Undefined_operation_nonce\n  | Some origination_nonce -> ok origination_nonce\n\nlet unset_origination_nonce ctxt = update_origination_nonce ctxt None\n\ntype error += Gas_limit_too_high (* `Permanent *)\n\nlet () =\n  let open Data_encoding in\n  register_error_kind\n    `Permanent\n    ~id:\"gas_limit_too_high\"\n    ~title:\"Gas limit out of protocol hard bounds\"\n    ~description:\"A transaction tried to exceed the hard limit on gas\"\n    empty\n    (function Gas_limit_too_high -> Some () | _ -> None)\n    (fun () -> Gas_limit_too_high)\n\nlet gas_level ctxt =\n  let open Gas_limit_repr in\n  if unlimited_operation_gas ctxt then Unaccounted\n  else Limited {remaining = remaining_operation_gas ctxt}\n\nlet block_gas_level = remaining_block_gas\n\nlet check_gas_limit_is_valid ctxt (remaining : 'a Gas_limit_repr.Arith.t) =\n  if\n    Gas_limit_repr.Arith.(\n      remaining > (constants ctxt).hard_gas_limit_per_operation\n      || remaining < zero)\n  then error Gas_limit_too_high\n  else Result.return_unit\n\nlet consume_gas_limit_in_block ctxt (limit : 'a Gas_limit_repr.Arith.t) =\n  let open Gas_limit_repr in\n  check_gas_limit_is_valid ctxt limit >>? fun () ->\n  let block_gas = block_gas_level ctxt in\n  let limit = Arith.fp limit in\n  if Arith.(limit > block_gas) then error Block_quota_exceeded\n  else\n    let level = Arith.sub (block_gas_level ctxt) limit in\n    let ctxt = update_remaining_block_gas ctxt level in\n    Ok ctxt\n\nlet set_gas_limit ctxt (remaining : 'a Gas_limit_repr.Arith.t) =\n  let open Gas_limit_repr in\n  let remaining_operation_gas = Arith.fp remaining in\n  let ctxt = update_unlimited_operation_gas ctxt false in\n  {ctxt with remaining_operation_gas}\n\nlet set_gas_unlimited ctxt = update_unlimited_operation_gas ctxt true\n\nlet consume_gas ctxt cost =\n  match Gas_limit_repr.raw_consume (remaining_operation_gas ctxt) cost with\n  | Some gas_counter -> Ok (update_remaining_operation_gas ctxt gas_counter)\n  | None ->\n      if unlimited_operation_gas ctxt then ok ctxt\n      else error Operation_quota_exceeded\n\nlet check_enough_gas ctxt cost =\n  consume_gas ctxt cost >>? fun _ -> Result.return_unit\n\nlet gas_consumed ~since ~until =\n  match (gas_level since, gas_level until) with\n  | (Limited {remaining = before}, Limited {remaining = after}) ->\n      Gas_limit_repr.Arith.sub before after\n  | (_, _) -> Gas_limit_repr.Arith.zero\n\ntype missing_key_kind = Get | Set | Del | Copy\n\ntype storage_error =\n  | Incompatible_protocol_version of string\n  | Missing_key of string list * missing_key_kind\n  | Existing_key of string list\n  | Corrupted_data of string list\n\nlet storage_error_encoding =\n  let open Data_encoding in\n  union\n    [\n      case\n        (Tag 0)\n        ~title:\"Incompatible_protocol_version\"\n        (obj1 (req \"incompatible_protocol_version\" string))\n        (function Incompatible_protocol_version arg -> Some arg | _ -> None)\n        (fun arg -> Incompatible_protocol_version arg);\n      case\n        (Tag 1)\n        ~title:\"Missing_key\"\n        (obj2\n           (req \"missing_key\" (list string))\n           (req\n              \"function\"\n              (string_enum\n                 [(\"get\", Get); (\"set\", Set); (\"del\", Del); (\"copy\", Copy)])))\n        (function Missing_key (key, f) -> Some (key, f) | _ -> None)\n        (fun (key, f) -> Missing_key (key, f));\n      case\n        (Tag 2)\n        ~title:\"Existing_key\"\n        (obj1 (req \"existing_key\" (list string)))\n        (function Existing_key key -> Some key | _ -> None)\n        (fun key -> Existing_key key);\n      case\n        (Tag 3)\n        ~title:\"Corrupted_data\"\n        (obj1 (req \"corrupted_data\" (list string)))\n        (function Corrupted_data key -> Some key | _ -> None)\n        (fun key -> Corrupted_data key);\n    ]\n\nlet pp_storage_error ppf = function\n  | Incompatible_protocol_version version ->\n      Format.fprintf\n        ppf\n        \"Found a context with an unexpected version '%s'.\"\n        version\n  | Missing_key (key, Get) ->\n      Format.fprintf ppf \"Missing key '%s'.\" (String.concat \"/\" key)\n  | Missing_key (key, Set) ->\n      Format.fprintf\n        ppf\n        \"Cannot set undefined key '%s'.\"\n        (String.concat \"/\" key)\n  | Missing_key (key, Del) ->\n      Format.fprintf\n        ppf\n        \"Cannot delete undefined key '%s'.\"\n        (String.concat \"/\" key)\n  | Missing_key (key, Copy) ->\n      Format.fprintf\n        ppf\n        \"Cannot copy undefined key '%s'.\"\n        (String.concat \"/\" key)\n  | Existing_key key ->\n      Format.fprintf\n        ppf\n        \"Cannot initialize defined key '%s'.\"\n        (String.concat \"/\" key)\n  | Corrupted_data key ->\n      Format.fprintf\n        ppf\n        \"Failed to parse the data at '%s'.\"\n        (String.concat \"/\" key)\n\ntype error += Storage_error of storage_error\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"context.storage_error\"\n    ~title:\"Storage error (fatal internal error)\"\n    ~description:\n      \"An error that should never happen unless something has been deleted or \\\n       corrupted in the database.\"\n    ~pp:(fun ppf err ->\n      Format.fprintf ppf \"@[<v 2>Storage error:@ %a@]\" pp_storage_error err)\n    storage_error_encoding\n    (function Storage_error err -> Some err | _ -> None)\n    (fun err -> Storage_error err)\n\nlet storage_error err = error (Storage_error err)\n\n(* Initialization *********************************************************)\n\n(* This key should always be populated for every version of the\n   protocol.  It's absence meaning that the context is empty. *)\nlet version_key = [\"version\"]\n\n(* This value is set by the snapshot_alpha.sh script, don't change it. *)\nlet version_value = \"ithaca_012\"\n\nlet version = \"v1\"\n\nlet cycle_eras_key = [version; \"cycle_eras\"]\n\nlet constants_key = [version; \"constants\"]\n\nlet protocol_param_key = [\"protocol_parameters\"]\n\nlet get_cycle_eras ctxt =\n  Context.find ctxt cycle_eras_key >|= function\n  | None -> storage_error (Missing_key (cycle_eras_key, Get))\n  | Some bytes -> (\n      match\n        Data_encoding.Binary.of_bytes_opt Level_repr.cycle_eras_encoding bytes\n      with\n      | None -> storage_error (Corrupted_data cycle_eras_key)\n      | Some cycle_eras -> ok cycle_eras)\n\nlet set_cycle_eras ctxt cycle_eras =\n  let bytes =\n    Data_encoding.Binary.to_bytes_exn Level_repr.cycle_eras_encoding cycle_eras\n  in\n  Context.add ctxt cycle_eras_key bytes >|= ok\n\ntype error += Failed_to_parse_parameter of bytes\n\ntype error += Failed_to_decode_parameter of Data_encoding.json * string\n\nlet () =\n  register_error_kind\n    `Temporary\n    ~id:\"context.failed_to_parse_parameter\"\n    ~title:\"Failed to parse parameter\"\n    ~description:\"The protocol parameters are not valid JSON.\"\n    ~pp:(fun ppf bytes ->\n      Format.fprintf\n        ppf\n        \"@[<v 2>Cannot parse the protocol parameter:@ %s@]\"\n        (Bytes.to_string bytes))\n    Data_encoding.(obj1 (req \"contents\" bytes))\n    (function Failed_to_parse_parameter data -> Some data | _ -> None)\n    (fun data -> Failed_to_parse_parameter data) ;\n  register_error_kind\n    `Temporary\n    ~id:\"context.failed_to_decode_parameter\"\n    ~title:\"Failed to decode parameter\"\n    ~description:\"Unexpected JSON object.\"\n    ~pp:(fun ppf (json, msg) ->\n      Format.fprintf\n        ppf\n        \"@[<v 2>Cannot decode the protocol parameter:@ %s@ %a@]\"\n        msg\n        Data_encoding.Json.pp\n        json)\n    Data_encoding.(obj2 (req \"contents\" json) (req \"error\" string))\n    (function\n      | Failed_to_decode_parameter (json, msg) -> Some (json, msg) | _ -> None)\n    (fun (json, msg) -> Failed_to_decode_parameter (json, msg))\n\nlet get_proto_param ctxt =\n  Context.find ctxt protocol_param_key >>= function\n  | None -> failwith \"Missing protocol parameters.\"\n  | Some bytes -> (\n      match Data_encoding.Binary.of_bytes_opt Data_encoding.json bytes with\n      | None -> fail (Failed_to_parse_parameter bytes)\n      | Some json -> (\n          Context.remove ctxt protocol_param_key >|= fun ctxt ->\n          match Data_encoding.Json.destruct Parameters_repr.encoding json with\n          | exception (Data_encoding.Json.Cannot_destruct _ as exn) ->\n              Format.kasprintf\n                failwith\n                \"Invalid protocol_parameters: %a %a\"\n                (fun ppf -> Data_encoding.Json.print_error ppf)\n                exn\n                Data_encoding.Json.pp\n                json\n          | param ->\n              Parameters_repr.check_params param >>? fun () -> ok (param, ctxt))\n      )\n\nlet add_constants ctxt constants =\n  let bytes =\n    Data_encoding.Binary.to_bytes_exn\n      Constants_repr.parametric_encoding\n      constants\n  in\n  Context.add ctxt constants_key bytes\n\nlet get_constants ctxt =\n  Context.find ctxt constants_key >|= function\n  | None -> failwith \"Internal error: cannot read constants in context.\"\n  | Some bytes -> (\n      match\n        Data_encoding.Binary.of_bytes_opt\n          Constants_repr.parametric_encoding\n          bytes\n      with\n      | None -> failwith \"Internal error: cannot parse constants in context.\"\n      | Some constants -> ok constants)\n\nlet patch_constants ctxt f =\n  let constants = f (constants ctxt) in\n  add_constants (context ctxt) constants >|= fun context ->\n  let ctxt = update_context ctxt context in\n  update_constants ctxt constants\n\nlet check_inited ctxt =\n  Context.find ctxt version_key >|= function\n  | None -> failwith \"Internal error: un-initialized context.\"\n  | Some bytes ->\n      let s = Bytes.to_string bytes in\n      if Compare.String.(s = version_value) then Result.return_unit\n      else storage_error (Incompatible_protocol_version s)\n\nlet check_cycle_eras (cycle_eras : Level_repr.cycle_eras)\n    (constants : Constants_repr.parametric) =\n  let current_era = Level_repr.current_era cycle_eras in\n  assert (\n    Compare.Int32.(current_era.blocks_per_cycle = constants.blocks_per_cycle)) ;\n  assert (\n    Compare.Int32.(\n      current_era.blocks_per_commitment = constants.blocks_per_commitment))\n\nlet prepare ~level ~predecessor_timestamp ~timestamp ctxt =\n  Raw_level_repr.of_int32 level >>?= fun level ->\n  check_inited ctxt >>=? fun () ->\n  get_constants ctxt >>=? fun constants ->\n  Round_repr.Durations.create\n    ~first_round_duration:constants.minimal_block_delay\n    ~delay_increment_per_round:constants.delay_increment_per_round\n  >>?= fun round_durations ->\n  get_cycle_eras ctxt >|=? fun cycle_eras ->\n  check_cycle_eras cycle_eras constants ;\n  let level = Level_repr.from_raw ~cycle_eras level in\n  {\n    remaining_operation_gas = Gas_limit_repr.Arith.zero;\n    back =\n      {\n        context = ctxt;\n        constants;\n        level;\n        predecessor_timestamp;\n        timestamp;\n        round_durations;\n        cycle_eras;\n        fees = Tez_repr.zero;\n        origination_nonce = None;\n        temporary_lazy_storage_ids = Lazy_storage_kind.Temp_ids.init;\n        internal_nonce = 0;\n        internal_nonces_used = Int_set.empty;\n        remaining_block_gas =\n          Gas_limit_repr.Arith.fp\n            constants.Constants_repr.hard_gas_limit_per_block;\n        unlimited_operation_gas = true;\n        consensus = Raw_consensus.empty;\n        non_consensus_operations = [];\n        sampler_state = Cycle_repr.Map.empty;\n        stake_distribution_for_current_cycle = None;\n      };\n  }\n\ntype previous_protocol = Genesis of Parameters_repr.t | Hangzhou_011\n\nlet check_and_update_protocol_version ctxt =\n  (Context.find ctxt version_key >>= function\n   | None ->\n       failwith \"Internal error: un-initialized context in check_first_block.\"\n   | Some bytes ->\n       let s = Bytes.to_string bytes in\n       if Compare.String.(s = version_value) then\n         failwith \"Internal error: previously initialized context.\"\n       else if Compare.String.(s = \"genesis\") then\n         get_proto_param ctxt >|=? fun (param, ctxt) -> (Genesis param, ctxt)\n       else if Compare.String.(s = \"hangzhou_011\") then\n         return (Hangzhou_011, ctxt)\n       else Lwt.return @@ storage_error (Incompatible_protocol_version s))\n  >>=? fun (previous_proto, ctxt) ->\n  Context.add ctxt version_key (Bytes.of_string version_value) >|= fun ctxt ->\n  ok (previous_proto, ctxt)\n\n(* only for the migration *)\nlet[@warning \"-32\"] get_previous_protocol_constants ctxt =\n  Context.find ctxt constants_key >>= function\n  | None ->\n      failwith\n        \"Internal error: cannot read previous protocol constants in context.\"\n  | Some bytes -> (\n      match\n        Data_encoding.Binary.of_bytes_opt\n          Constants_repr.Proto_previous.parametric_encoding\n          bytes\n      with\n      | None ->\n          failwith\n            \"Internal error: cannot parse previous protocol constants in \\\n             context.\"\n      | Some constants -> Lwt.return constants)\n\n(* You should ensure that if the type `Constant_repr.parametric` is\n   different from the previous protocol or the value of these\n   constants is modified, is changed from the previous protocol, then\n   you `propagate` these constants to the new protocol by writing them\n   onto the context via the function `add_constants` or\n   `patch_constants`.\n\n   This migration can be achieved also implicitly by modifying the\n   encoding directly in a way which is compatible with the previous\n   protocol. However, by doing so, you do not change the value of\n   these constants inside the context. *)\nlet prepare_first_block ~level ~timestamp ctxt =\n  check_and_update_protocol_version ctxt >>=? fun (previous_proto, ctxt) ->\n  (match previous_proto with\n  | Genesis param ->\n      Raw_level_repr.of_int32 level >>?= fun first_level ->\n      let cycle_era =\n        {\n          Level_repr.first_level;\n          first_cycle = Cycle_repr.root;\n          blocks_per_cycle = param.constants.blocks_per_cycle;\n          blocks_per_commitment = param.constants.blocks_per_commitment;\n        }\n      in\n      Level_repr.create_cycle_eras [cycle_era] >>?= fun cycle_eras ->\n      set_cycle_eras ctxt cycle_eras >>=? fun ctxt ->\n      add_constants ctxt param.constants >|= ok\n  | Hangzhou_011 ->\n      get_previous_protocol_constants ctxt >>= fun c ->\n      let minimal_block_delay = c.minimal_block_delay in\n      let minimal_block_delay_s = Period_repr.to_seconds minimal_block_delay in\n      (if Compare.Int64.(minimal_block_delay_s = 30L) then\n       (* that's the mainnet value of the constant; so we're\n          probably on the mainnet: do no inherit this constant's\n          value (as done in the else case below) *)\n       Period_repr.of_seconds 15L\n      else\n        match c.time_between_blocks with\n        | first_time_between_blocks :: _ ->\n            let delay_increment_per_round_s =\n              let m =\n                Int64.sub\n                  (Period_repr.to_seconds first_time_between_blocks)\n                  minimal_block_delay_s\n              in\n              if Compare.Int64.(m < 1L) then 1L else m\n            in\n            Period_repr.of_seconds delay_increment_per_round_s\n        | [] -> ok minimal_block_delay)\n      >>?= fun delay_increment_per_round ->\n      let constants =\n        let consensus_committee_size = 7000 in\n        let Constants_repr.Generated.\n              {\n                consensus_threshold;\n                baking_reward_fixed_portion;\n                baking_reward_bonus_per_slot;\n                endorsing_reward_per_slot;\n              } =\n          Constants_repr.Generated.generate\n            ~consensus_committee_size\n            ~blocks_per_minute:\n              {numerator = 60; denominator = Int64.to_int minimal_block_delay_s}\n        in\n        Constants_repr.\n          {\n            preserved_cycles = c.preserved_cycles;\n            blocks_per_cycle = c.blocks_per_cycle;\n            blocks_per_commitment = c.blocks_per_commitment;\n            blocks_per_stake_snapshot = c.blocks_per_roll_snapshot;\n            blocks_per_voting_period = c.blocks_per_voting_period;\n            hard_gas_limit_per_operation = c.hard_gas_limit_per_operation;\n            hard_gas_limit_per_block = c.hard_gas_limit_per_block;\n            proof_of_work_threshold = c.proof_of_work_threshold;\n            tokens_per_roll =\n              (* NB: the old value is used during the migration, and\n                 changed to a new value there *)\n              c.tokens_per_roll;\n            seed_nonce_revelation_tip = c.seed_nonce_revelation_tip;\n            origination_size = c.origination_size;\n            (* Same value as in the previous protocol. *)\n            max_operations_time_to_live = 120;\n            baking_reward_fixed_portion;\n            baking_reward_bonus_per_slot;\n            endorsing_reward_per_slot;\n            cost_per_byte = c.cost_per_byte;\n            hard_storage_limit_per_operation =\n              c.hard_storage_limit_per_operation;\n            quorum_min = c.quorum_min;\n            quorum_max = c.quorum_max;\n            min_proposal_quorum = c.min_proposal_quorum;\n            liquidity_baking_subsidy = c.liquidity_baking_subsidy;\n            liquidity_baking_sunset_level =\n              (* preserve a lower level for testnets *)\n              (if Compare.Int32.(c.liquidity_baking_sunset_level = 2_244_609l)\n              then 3_063_809l\n              else c.liquidity_baking_sunset_level);\n            liquidity_baking_escape_ema_threshold = 666_667l;\n            minimal_block_delay;\n            delay_increment_per_round;\n            consensus_committee_size;\n            consensus_threshold;\n            minimal_participation_ratio = {numerator = 2; denominator = 3};\n            max_slashing_period = 2;\n            frozen_deposits_percentage = 10;\n            double_baking_punishment = Tez_repr.(mul_exn one 640);\n            ratio_of_frozen_deposits_slashed_per_double_endorsement =\n              {numerator = 1; denominator = 2};\n            delegate_selection = Random;\n          }\n      in\n      add_constants ctxt constants >>= fun ctxt -> return ctxt)\n  >>=? fun ctxt ->\n  prepare ctxt ~level ~predecessor_timestamp:timestamp ~timestamp\n  >|=? fun ctxt -> (previous_proto, ctxt)\n\nlet activate ctxt h = Updater.activate (context ctxt) h >|= update_context ctxt\n\n(* Generic context ********************************************************)\n\ntype key = string list\n\ntype value = bytes\n\ntype tree = Context.tree\n\nmodule type T =\n  Raw_context_intf.T\n    with type root := root\n     and type key := key\n     and type value := value\n     and type tree := tree\n\nlet mem ctxt k = Context.mem (context ctxt) k\n\nlet mem_tree ctxt k = Context.mem_tree (context ctxt) k\n\nlet get ctxt k =\n  Context.find (context ctxt) k >|= function\n  | None -> storage_error (Missing_key (k, Get))\n  | Some v -> ok v\n\nlet get_tree ctxt k =\n  Context.find_tree (context ctxt) k >|= function\n  | None -> storage_error (Missing_key (k, Get))\n  | Some v -> ok v\n\nlet find ctxt k = Context.find (context ctxt) k\n\nlet find_tree ctxt k = Context.find_tree (context ctxt) k\n\nlet add ctxt k v = Context.add (context ctxt) k v >|= update_context ctxt\n\nlet add_tree ctxt k v =\n  Context.add_tree (context ctxt) k v >|= update_context ctxt\n\nlet init ctxt k v =\n  Context.mem (context ctxt) k >>= function\n  | true -> Lwt.return @@ storage_error (Existing_key k)\n  | _ ->\n      Context.add (context ctxt) k v >|= fun context ->\n      ok (update_context ctxt context)\n\nlet init_tree ctxt k v : _ tzresult Lwt.t =\n  Context.mem_tree (context ctxt) k >>= function\n  | true -> Lwt.return @@ storage_error (Existing_key k)\n  | _ ->\n      Context.add_tree (context ctxt) k v >|= fun context ->\n      ok (update_context ctxt context)\n\nlet update ctxt k v =\n  Context.mem (context ctxt) k >>= function\n  | false -> Lwt.return @@ storage_error (Missing_key (k, Set))\n  | _ ->\n      Context.add (context ctxt) k v >|= fun context ->\n      ok (update_context ctxt context)\n\nlet update_tree ctxt k v =\n  Context.mem_tree (context ctxt) k >>= function\n  | false -> Lwt.return @@ storage_error (Missing_key (k, Set))\n  | _ ->\n      Context.add_tree (context ctxt) k v >|= fun context ->\n      ok (update_context ctxt context)\n\n(* Verify that the key is present before deleting *)\nlet remove_existing ctxt k =\n  Context.mem (context ctxt) k >>= function\n  | false -> Lwt.return @@ storage_error (Missing_key (k, Del))\n  | _ ->\n      Context.remove (context ctxt) k >|= fun context ->\n      ok (update_context ctxt context)\n\n(* Verify that the key is present before deleting *)\nlet remove_existing_tree ctxt k =\n  Context.mem_tree (context ctxt) k >>= function\n  | false -> Lwt.return @@ storage_error (Missing_key (k, Del))\n  | _ ->\n      Context.remove (context ctxt) k >|= fun context ->\n      ok (update_context ctxt context)\n\n(* Do not verify before deleting *)\nlet remove ctxt k = Context.remove (context ctxt) k >|= update_context ctxt\n\nlet add_or_remove ctxt k = function\n  | None -> remove ctxt k\n  | Some v -> add ctxt k v\n\nlet add_or_remove_tree ctxt k = function\n  | None -> remove ctxt k\n  | Some v -> add_tree ctxt k v\n\nlet list ctxt ?offset ?length k = Context.list (context ctxt) ?offset ?length k\n\nlet fold ?depth ctxt k ~order ~init ~f =\n  Context.fold ?depth (context ctxt) k ~order ~init ~f\n\nmodule Tree :\n  Raw_context_intf.TREE\n    with type t := t\n     and type key := key\n     and type value := value\n     and type tree := tree = struct\n  include Context.Tree\n\n  let empty ctxt = Context.Tree.empty (context ctxt)\n\n  let get t k =\n    find t k >|= function\n    | None -> storage_error (Missing_key (k, Get))\n    | Some v -> ok v\n\n  let get_tree t k =\n    find_tree t k >|= function\n    | None -> storage_error (Missing_key (k, Get))\n    | Some v -> ok v\n\n  let init t k v =\n    mem t k >>= function\n    | true -> Lwt.return @@ storage_error (Existing_key k)\n    | _ -> add t k v >|= ok\n\n  let init_tree t k v =\n    mem_tree t k >>= function\n    | true -> Lwt.return @@ storage_error (Existing_key k)\n    | _ -> add_tree t k v >|= ok\n\n  let update t k v =\n    mem t k >>= function\n    | false -> Lwt.return @@ storage_error (Missing_key (k, Set))\n    | _ -> add t k v >|= ok\n\n  let update_tree t k v =\n    mem_tree t k >>= function\n    | false -> Lwt.return @@ storage_error (Missing_key (k, Set))\n    | _ -> add_tree t k v >|= ok\n\n  (* Verify that the key is present before deleting *)\n  let remove_existing t k =\n    mem t k >>= function\n    | false -> Lwt.return @@ storage_error (Missing_key (k, Del))\n    | _ -> remove t k >|= ok\n\n  (* Verify that the key is present before deleting *)\n  let remove_existing_tree t k =\n    mem_tree t k >>= function\n    | false -> Lwt.return @@ storage_error (Missing_key (k, Del))\n    | _ -> remove t k >|= ok\n\n  let add_or_remove t k = function None -> remove t k | Some v -> add t k v\n\n  let add_or_remove_tree t k = function\n    | None -> remove t k\n    | Some v -> add_tree t k v\nend\n\nlet project x = x\n\nlet absolute_key _ k = k\n\nlet description = Storage_description.create ()\n\nlet fold_map_temporary_lazy_storage_ids ctxt f =\n  f (temporary_lazy_storage_ids ctxt) |> fun (temporary_lazy_storage_ids, x) ->\n  (update_temporary_lazy_storage_ids ctxt temporary_lazy_storage_ids, x)\n\nlet map_temporary_lazy_storage_ids_s ctxt f =\n  f (temporary_lazy_storage_ids ctxt)\n  >|= fun (ctxt, temporary_lazy_storage_ids) ->\n  update_temporary_lazy_storage_ids ctxt temporary_lazy_storage_ids\n\nmodule Cache = struct\n  type key = Context.Cache.key\n\n  type value = Context.Cache.value = ..\n\n  let key_of_identifier = Context.Cache.key_of_identifier\n\n  let identifier_of_key = Context.Cache.identifier_of_key\n\n  let pp fmt ctxt = Context.Cache.pp fmt (context ctxt)\n\n  let find c k = Context.Cache.find (context c) k\n\n  let set_cache_layout c layout =\n    Context.Cache.set_cache_layout (context c) layout >>= fun ctxt ->\n    Lwt.return (update_context c ctxt)\n\n  let update c k v = Context.Cache.update (context c) k v |> update_context c\n\n  let sync c ~cache_nonce =\n    Context.Cache.sync (context c) ~cache_nonce >>= fun ctxt ->\n    Lwt.return (update_context c ctxt)\n\n  let clear c = Context.Cache.clear (context c) |> update_context c\n\n  let list_keys c ~cache_index =\n    Context.Cache.list_keys (context c) ~cache_index\n\n  let key_rank c key = Context.Cache.key_rank (context c) key\n\n  let cache_size_limit c ~cache_index =\n    Context.Cache.cache_size_limit (context c) ~cache_index\n\n  let cache_size c ~cache_index =\n    Context.Cache.cache_size (context c) ~cache_index\n\n  let future_cache_expectation c ~time_in_blocks =\n    Context.Cache.future_cache_expectation (context c) ~time_in_blocks\n    |> update_context c\nend\n\nlet record_non_consensus_operation_hash ctxt operation_hash =\n  update_non_consensus_operations\n    ctxt\n    (operation_hash :: non_consensus_operations ctxt)\n\nlet non_consensus_operations ctxt = List.rev (non_consensus_operations ctxt)\n\nlet set_sampler_for_cycle ctxt cycle sampler_with_seed =\n  let map = sampler_state ctxt in\n  if Cycle_repr.Map.mem cycle map then Error `Sampler_already_set\n  else\n    let map = Cycle_repr.Map.add cycle sampler_with_seed map in\n    Ok (update_sampler_state ctxt map)\n\nlet sampler_for_cycle ctxt cycle =\n  let map = sampler_state ctxt in\n  match Cycle_repr.Map.find cycle map with\n  | None -> Error `Sampler_not_set\n  | Some sampler -> Ok sampler\n\nlet stake_distribution_for_current_cycle ctxt =\n  match ctxt.back.stake_distribution_for_current_cycle with\n  | None -> error Stake_distribution_not_set\n  | Some s -> ok s\n\nlet init_stake_distribution_for_current_cycle ctxt\n    stake_distribution_for_current_cycle =\n  update_back\n    ctxt\n    {\n      ctxt.back with\n      stake_distribution_for_current_cycle =\n        Some stake_distribution_for_current_cycle;\n    }\n\nmodule type CONSENSUS = sig\n  type t\n\n  type 'value slot_map\n\n  type slot_set\n\n  type slot\n\n  type round\n\n  val allowed_endorsements :\n    t -> (Signature.Public_key.t * Signature.Public_key_hash.t * int) slot_map\n\n  val allowed_preendorsements :\n    t -> (Signature.Public_key.t * Signature.Public_key_hash.t * int) slot_map\n\n  val current_endorsement_power : t -> int\n\n  val initialize_consensus_operation :\n    t ->\n    allowed_endorsements:\n      (Signature.Public_key.t * Signature.Public_key_hash.t * int) slot_map ->\n    allowed_preendorsements:\n      (Signature.Public_key.t * Signature.Public_key_hash.t * int) slot_map ->\n    t\n\n  val record_grand_parent_endorsement :\n    t -> Signature.Public_key_hash.t -> t tzresult\n\n  val record_endorsement : t -> initial_slot:slot -> power:int -> t tzresult\n\n  val record_preendorsement :\n    t -> initial_slot:slot -> power:int -> round -> t tzresult\n\n  val endorsements_seen : t -> slot_set\n\n  val get_preendorsements_quorum_round : t -> round option\n\n  val set_preendorsements_quorum_round : t -> round -> t\n\n  val locked_round_evidence : t -> (round * int) option\n\n  val set_endorsement_branch : t -> Block_hash.t * Block_payload_hash.t -> t\n\n  val endorsement_branch : t -> (Block_hash.t * Block_payload_hash.t) option\n\n  val set_grand_parent_branch : t -> Block_hash.t * Block_payload_hash.t -> t\n\n  val grand_parent_branch : t -> (Block_hash.t * Block_payload_hash.t) option\nend\n\nmodule Consensus :\n  CONSENSUS\n    with type t := t\n     and type slot := Slot_repr.t\n     and type 'a slot_map := 'a Slot_repr.Map.t\n     and type slot_set := Slot_repr.Set.t\n     and type round := Round_repr.t = struct\n  let[@inline] allowed_endorsements ctxt =\n    ctxt.back.consensus.allowed_endorsements\n\n  let[@inline] allowed_preendorsements ctxt =\n    ctxt.back.consensus.allowed_preendorsements\n\n  let[@inline] current_endorsement_power ctxt =\n    ctxt.back.consensus.current_endorsement_power\n\n  let[@inline] get_preendorsements_quorum_round ctxt =\n    ctxt.back.consensus.preendorsements_quorum_round\n\n  let[@inline] locked_round_evidence ctxt =\n    Raw_consensus.locked_round_evidence ctxt.back.consensus\n\n  let[@inline] update_consensus_with ctxt f =\n    {ctxt with back = {ctxt.back with consensus = f ctxt.back.consensus}}\n\n  let[@inline] update_consensus_with_tzresult ctxt f =\n    f ctxt.back.consensus >|? fun consensus ->\n    {ctxt with back = {ctxt.back with consensus}}\n\n  let[@inline] initialize_consensus_operation ctxt ~allowed_endorsements\n      ~allowed_preendorsements =\n    update_consensus_with\n      ctxt\n      (Raw_consensus.initialize_with_endorsements_and_preendorsements\n         ~allowed_endorsements\n         ~allowed_preendorsements)\n\n  let[@inline] record_grand_parent_endorsement ctxt pkh =\n    update_consensus_with_tzresult ctxt (fun ctxt ->\n        Raw_consensus.record_grand_parent_endorsement ctxt pkh)\n\n  let[@inline] record_preendorsement ctxt ~initial_slot ~power round =\n    update_consensus_with_tzresult\n      ctxt\n      (Raw_consensus.record_preendorsement ~initial_slot ~power round)\n\n  let[@inline] record_endorsement ctxt ~initial_slot ~power =\n    update_consensus_with_tzresult\n      ctxt\n      (Raw_consensus.record_endorsement ~initial_slot ~power)\n\n  let[@inline] endorsements_seen ctxt = ctxt.back.consensus.endorsements_seen\n\n  let[@inline] set_preendorsements_quorum_round ctxt round =\n    update_consensus_with\n      ctxt\n      (Raw_consensus.set_preendorsements_quorum_round round)\n\n  let[@inline] endorsement_branch ctxt =\n    Raw_consensus.endorsement_branch ctxt.back.consensus\n\n  let[@inline] set_endorsement_branch ctxt branch =\n    update_consensus_with ctxt (fun ctxt ->\n        Raw_consensus.set_endorsement_branch ctxt branch)\n\n  let[@inline] grand_parent_branch ctxt =\n    Raw_consensus.grand_parent_branch ctxt.back.consensus\n\n  let[@inline] set_grand_parent_branch ctxt branch =\n    update_consensus_with ctxt (fun ctxt ->\n        Raw_consensus.set_grand_parent_branch ctxt branch)\nend\n" ;
                } ;
                { name = "Storage_costs" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2020 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Cost of reading [read_bytes] at a key of length [path_length]. *)\nval read_access : path_length:int -> read_bytes:int -> Gas_limit_repr.cost\n\n(** Cost of performing a single write access, writing [written_bytes] bytes. *)\nval write_access : written_bytes:int -> Gas_limit_repr.cost\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2020 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(* The model for read accesses is the following:\n\n   cost(path_length, read_bytes) = 200_000 + 5000 * path_length + 2 * read_bytes\n*)\nlet read_access ~path_length ~read_bytes =\n  let open Saturation_repr in\n  let base_cost = safe_int (200_000 + (5000 * path_length)) in\n  Gas_limit_repr.atomic_step_cost\n    (add base_cost (mul (safe_int 2) (safe_int read_bytes)))\n\n(* The model for write accesses is the following:\n\n   cost(written_bytes) = 200_000 + 4 * written_bytes\n*)\nlet write_access ~written_bytes =\n  let open Saturation_repr in\n  Gas_limit_repr.atomic_step_cost\n    (add (safe_int 200_000) (mul (safe_int 4) (safe_int written_bytes)))\n" ;
                } ;
                { name = "Storage_sigs" ;
                  interface = None ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2019-2020 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** {1 Entity Accessor Signatures} *)\n\n(** The generic signature of a single data accessor (a single value\n    bound to a specific key in the hierarchical (key x value)\n    database). *)\nmodule type Single_data_storage = sig\n  type t\n\n  type context = t\n\n  (** The type of the value *)\n  type value\n\n  (** Tells if the data is already defined *)\n  val mem : context -> bool Lwt.t\n\n  (** Retrieve the value from the storage bucket ; returns a\n      {!Storage_error} if the key is not set or if the deserialisation\n      fails *)\n  val get : context -> value tzresult Lwt.t\n\n  (** Retrieves the value from the storage bucket ; returns [None] if\n      the data is not initialized, or {!Storage_helpers.Storage_error}\n      if the deserialisation fails *)\n  val find : context -> value option tzresult Lwt.t\n\n  (** Allocates the storage bucket and initializes it ; returns a\n      {!Storage_error Existing_key} if the bucket exists *)\n  val init : context -> value -> Raw_context.t tzresult Lwt.t\n\n  (** Updates the content of the bucket ; returns a {!Storage_Error\n      Missing_key} if the value does not exists *)\n  val update : context -> value -> Raw_context.t tzresult Lwt.t\n\n  (** Allocates the data and initializes it with a value ; just\n      updates it if the bucket exists *)\n  val add : context -> value -> Raw_context.t Lwt.t\n\n  (** When the value is [Some v], allocates the data and initializes\n      it with [v] ; just updates it if the bucket exists. When the\n      value is [None], delete the storage bucket when the value ; does\n      nothing if the bucket does not exists. *)\n  val add_or_remove : context -> value option -> Raw_context.t Lwt.t\n\n  (** Delete the storage bucket ; returns a {!Storage_error\n      Missing_key} if the bucket does not exists *)\n  val remove_existing : context -> Raw_context.t tzresult Lwt.t\n\n  (** Removes the storage bucket and its contents ; does nothing if\n      the bucket does not exists *)\n  val remove : context -> Raw_context.t Lwt.t\nend\n[@@coq_precise_signature]\n\n(** Restricted version of {!Indexed_data_storage} w/o iterators. *)\nmodule type Non_iterable_indexed_data_storage = sig\n  type t\n\n  type context = t\n\n  (** An abstract type for keys *)\n  type key\n\n  (** The type of values *)\n  type value\n\n  (** Tells if a given key is already bound to a storage bucket *)\n  val mem : context -> key -> bool Lwt.t\n\n  (** Retrieve a value from the storage bucket at a given key ;\n      returns {!Storage_error Missing_key} if the key is not set ;\n      returns {!Storage_error Corrupted_data} if the deserialisation\n      fails. *)\n  val get : context -> key -> value tzresult Lwt.t\n\n  (** Retrieve a value from the storage bucket at a given key ;\n      returns [None] if the value is not set ; returns {!Storage_error\n      Corrupted_data} if the deserialisation fails. *)\n  val find : context -> key -> value option tzresult Lwt.t\n\n  (** Updates the content of a bucket ; returns A {!Storage_Error\n      Missing_key} if the value does not exists. *)\n  val update : context -> key -> value -> Raw_context.t tzresult Lwt.t\n\n  (** Allocates a storage bucket at the given key and initializes it ;\n      returns a {!Storage_error Existing_key} if the bucket exists. *)\n  val init : context -> key -> value -> Raw_context.t tzresult Lwt.t\n\n  (** Allocates a storage bucket at the given key and initializes it\n      with a value ; just updates it if the bucket exists. *)\n  val add : context -> key -> value -> Raw_context.t Lwt.t\n\n  (** When the value is [Some v], allocates the data and initializes\n      it with [v] ; just updates it if the bucket exists. When the\n      value is [None], delete the storage bucket when the value ; does\n      nothing if the bucket does not exists. *)\n  val add_or_remove : context -> key -> value option -> Raw_context.t Lwt.t\n\n  (** Delete a storage bucket and its contents ; returns a\n      {!Storage_error Missing_key} if the bucket does not exists. *)\n  val remove_existing : context -> key -> Raw_context.t tzresult Lwt.t\n\n  (** Removes a storage bucket and its contents ; does nothing if the\n      bucket does not exists. *)\n  val remove : context -> key -> Raw_context.t Lwt.t\nend\n[@@coq_precise_signature]\n\n(** Variant of {!Non_iterable_indexed_data_storage} with gas accounting. *)\nmodule type Non_iterable_indexed_carbonated_data_storage = sig\n  type t\n\n  type context = t\n\n  (** An abstract type for keys *)\n  type key\n\n  (** The type of values *)\n  type value\n\n  (** Tells if a given key is already bound to a storage bucket.\n      Consumes [Gas_repr.read_bytes_cost Z.zero]. *)\n  val mem : context -> key -> (Raw_context.t * bool) tzresult Lwt.t\n\n  (** Retrieve a value from the storage bucket at a given key ;\n      returns {!Storage_error Missing_key} if the key is not set ;\n      returns {!Storage_error Corrupted_data} if the deserialisation\n      fails.\n      Consumes [Gas_repr.read_bytes_cost <size of the value>]. *)\n  val get : context -> key -> (Raw_context.t * value) tzresult Lwt.t\n\n  (** Retrieve a value from the storage bucket at a given key ;\n      returns [None] if the value is not set ; returns {!Storage_error\n      Corrupted_data} if the deserialisation fails.\n      Consumes [Gas_repr.read_bytes_cost <size of the value>] if present\n      or [Gas_repr.read_bytes_cost Z.zero]. *)\n  val find : context -> key -> (Raw_context.t * value option) tzresult Lwt.t\n\n  (** Updates the content of a bucket ; returns A {!Storage_Error\n      Missing_key} if the value does not exists.\n      Consumes serialization cost.\n      Consumes [Gas_repr.write_bytes_cost <size of the new value>].\n      Returns the difference from the old to the new size. *)\n  val update : context -> key -> value -> (Raw_context.t * int) tzresult Lwt.t\n\n  (** Allocates a storage bucket at the given key and initializes it ;\n      returns a {!Storage_error Existing_key} if the bucket exists.\n      Consumes serialization cost.\n      Consumes [Gas_repr.write_bytes_cost <size of the value>].\n      Returns the size. *)\n  val init : context -> key -> value -> (Raw_context.t * int) tzresult Lwt.t\n\n  (** Allocates a storage bucket at the given key and initializes it\n      with a value ; just updates it if the bucket exists.\n      Consumes serialization cost.\n      Consumes [Gas_repr.write_bytes_cost <size of the new value>].\n      Returns the difference from the old (maybe 0) to the new size, and a boolean\n      indicating if a value was already associated to this key. *)\n  val add :\n    context -> key -> value -> (Raw_context.t * int * bool) tzresult Lwt.t\n\n  (** When the value is [Some v], allocates the data and initializes\n      it with [v] ; just updates it if the bucket exists. When the\n      value is [None], delete the storage bucket when the value ; does\n      nothing if the bucket does not exists.\n      Consumes serialization cost.\n      Consumes the same gas cost as either {!remove} or {!init_set}.\n      Returns the difference from the old (maybe 0) to the new size, and a boolean\n      indicating if a value was already associated to this key. *)\n  val add_or_remove :\n    context ->\n    key ->\n    value option ->\n    (Raw_context.t * int * bool) tzresult Lwt.t\n\n  (** Delete a storage bucket and its contents ; returns a\n      {!Storage_error Missing_key} if the bucket does not exists.\n      Consumes [Gas_repr.write_bytes_cost Z.zero].\n      Returns the freed size. *)\n  val remove_existing : context -> key -> (Raw_context.t * int) tzresult Lwt.t\n\n  (** Removes a storage bucket and its contents ; does nothing if the\n      bucket does not exists.\n      Consumes [Gas_repr.write_bytes_cost Z.zero].\n      Returns the freed size, and a boolean\n      indicating if a value was already associated to this key. *)\n  val remove : context -> key -> (Raw_context.t * int * bool) tzresult Lwt.t\nend\n[@@coq_precise_signature]\n\nmodule type Non_iterable_indexed_carbonated_data_storage_with_values = sig\n  include Non_iterable_indexed_carbonated_data_storage\n\n  (* HACK *)\n  val list_values :\n    ?offset:int ->\n    ?length:int ->\n    t ->\n    (Raw_context.t * value list) tzresult Lwt.t\nend\n\nmodule type Non_iterable_indexed_carbonated_data_storage_INTERNAL = sig\n  include Non_iterable_indexed_carbonated_data_storage_with_values\n\n  val fold_keys_unaccounted :\n    context ->\n    order:[`Sorted | `Undefined] ->\n    init:'a ->\n    f:(key -> 'a -> 'a Lwt.t) ->\n    'a Lwt.t\nend\n\n(** The generic signature of indexed data accessors (a set of values\n    of the same type indexed by keys of the same form in the\n    hierarchical (key x value) database). *)\nmodule type Indexed_data_storage = sig\n  include Non_iterable_indexed_data_storage\n\n  (** Empties all the keys and associated data. *)\n  val clear : context -> Raw_context.t Lwt.t\n\n  (** Lists all the keys. *)\n  val keys : context -> key list Lwt.t\n\n  (** Lists all the keys and associated data. *)\n  val bindings : context -> (key * value) list Lwt.t\n\n  (** Iterates over all the keys and associated data. *)\n  val fold :\n    context ->\n    order:[`Sorted | `Undefined] ->\n    init:'a ->\n    f:(key -> value -> 'a -> 'a Lwt.t) ->\n    'a Lwt.t\n\n  (** Iterate over all the keys. *)\n  val fold_keys :\n    context ->\n    order:[`Sorted | `Undefined] ->\n    init:'a ->\n    f:(key -> 'a -> 'a Lwt.t) ->\n    'a Lwt.t\nend\n\nmodule type Indexed_data_snapshotable_storage = sig\n  type snapshot\n\n  type key\n\n  include Indexed_data_storage with type key := key\n\n  module Snapshot :\n    Indexed_data_storage\n      with type key = snapshot * key\n       and type value = value\n       and type t = t\n\n  val snapshot_exists : context -> snapshot -> bool Lwt.t\n\n  val snapshot : context -> snapshot -> Raw_context.t tzresult Lwt.t\n\n  val fold_snapshot :\n    context ->\n    snapshot ->\n    order:[`Sorted | `Undefined] ->\n    init:'a ->\n    f:(key -> value -> 'a -> 'a tzresult Lwt.t) ->\n    'a tzresult Lwt.t\n\n  val delete_snapshot : context -> snapshot -> Raw_context.t Lwt.t\nend\n\n(** The generic signature of a data set accessor (a set of values\n    bound to a specific key prefix in the hierarchical (key x value)\n    database). *)\nmodule type Data_set_storage = sig\n  type t\n\n  type context = t\n\n  (** The type of elements. *)\n  type elt\n\n  (** Tells if a elt is a member of the set *)\n  val mem : context -> elt -> bool Lwt.t\n\n  (** Adds a elt is a member of the set *)\n  val add : context -> elt -> Raw_context.t Lwt.t\n\n  (** Removes a elt of the set ; does nothing if not a member *)\n  val remove : context -> elt -> Raw_context.t Lwt.t\n\n  (** Returns the elements of the set, deserialized in a list in no\n      particular order. *)\n  val elements : context -> elt list Lwt.t\n\n  (** Iterates over the elements of the set. *)\n  val fold :\n    context ->\n    order:[`Sorted | `Undefined] ->\n    init:'a ->\n    f:(elt -> 'a -> 'a Lwt.t) ->\n    'a Lwt.t\n\n  (** Removes all elements in the set *)\n  val clear : context -> Raw_context.t Lwt.t\nend\n\n(** Variant of {!Data_set_storage} with gas accounting. *)\nmodule type Carbonated_data_set_storage = sig\n  type t\n\n  type context = t\n\n  (** The type of elements. *)\n  type elt\n\n  (** Tells whether an elt is a member of the set.\n      Consumes [Gas_repr.read_bytes_cost Z.zero] *)\n  val mem : context -> elt -> (Raw_context.t * bool) tzresult Lwt.t\n\n  (** Adds an elt as a member of the set.\n      Consumes [Gas_repr.write_bytes_cost <size of the new value>].\n      Returns the the new size. *)\n  val init : context -> elt -> (Raw_context.t * int) tzresult Lwt.t\n\n  (** Removes an elt from the set ; does nothing if not a member.\n      Consumes [Gas_repr.write_bytes_cost Z.zero].\n      Returns the freed size, and a boolean\n      indicating if a value was already associated to this key. *)\n  val remove : context -> elt -> (Raw_context.t * int * bool) tzresult Lwt.t\n\n  val fold_keys_unaccounted :\n    context ->\n    order:[`Sorted | `Undefined] ->\n    init:'acc ->\n    f:(elt -> 'acc -> 'acc Lwt.t) ->\n    'acc Lwt.t\nend\n\nmodule type NAME = sig\n  val name : Raw_context.key\nend\n\nmodule type VALUE = sig\n  type t\n\n  val encoding : t Data_encoding.t\nend\n\nmodule type REGISTER = sig\n  val ghost : bool\nend\n\nmodule type Indexed_raw_context = sig\n  type t\n\n  type context = t\n\n  type key\n\n  type 'a ipath\n\n  val clear : context -> Raw_context.t Lwt.t\n\n  val fold_keys :\n    context ->\n    order:[`Sorted | `Undefined] ->\n    init:'a ->\n    f:(key -> 'a -> 'a Lwt.t) ->\n    'a Lwt.t\n\n  val keys : context -> key list Lwt.t\n\n  val remove : context -> key -> context Lwt.t\n\n  val copy : context -> from:key -> to_:key -> context tzresult Lwt.t\n\n  module Make_set (_ : REGISTER) (_ : NAME) :\n    Data_set_storage with type t = t and type elt = key\n\n  module Make_map (_ : NAME) (V : VALUE) :\n    Indexed_data_storage with type t = t and type key = key and type value = V.t\n\n  module Make_carbonated_map (_ : NAME) (V : VALUE) :\n    Non_iterable_indexed_carbonated_data_storage\n      with type t = t\n       and type key = key\n       and type value = V.t\n\n  module Raw_context : Raw_context.T with type t = t ipath\nend\n" ;
                } ;
                { name = "Storage_functors" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2019-2020 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Tezos Protocol Implementation - Typed storage builders.\n\n  @see [Make_subcontext]\n *)\n\nopen Storage_sigs\n\nmodule Registered : REGISTER\n\nmodule Ghost : REGISTER\n\n(** Given a [Raw_context], return a new [Raw_context] that projects into\n    a given subtree. Similar to a {i functional lens}.\n *)\nmodule Make_subcontext (_ : REGISTER) (C : Raw_context.T) (_ : NAME) :\n  Raw_context.T with type t = C.t\n\nmodule Make_single_data_storage\n    (_ : REGISTER)\n    (C : Raw_context.T)\n    (_ : NAME)\n    (V : VALUE) : Single_data_storage with type t = C.t and type value = V.t\n\n(** A type that can be serialized as a [string list], and used\n    as a prefix in the typed datastore.\n\n    Useful to implement storage of maps and sets.\n *)\nmodule type INDEX = sig\n  type t\n\n  include Path_encoding.S with type t := t\n\n  type 'a ipath\n\n  val args : ('a, t, 'a ipath) Storage_description.args\nend\n\nmodule Pair (I1 : INDEX) (I2 : INDEX) : INDEX with type t = I1.t * I2.t\n\n(** Create storage for a compound type. *)\nmodule Make_data_set_storage (C : Raw_context.T) (I : INDEX) :\n  Data_set_storage with type t = C.t and type elt = I.t\n\n(** Like [Make_data_set_storage], adding tracking of storage cost. *)\nmodule Make_carbonated_data_set_storage (C : Raw_context.T) (I : INDEX) :\n  Carbonated_data_set_storage with type t = C.t and type elt = I.t\n\n(** This functor creates storage for types with a notion of an index. *)\nmodule Make_indexed_data_storage (C : Raw_context.T) (I : INDEX) (V : VALUE) :\n  Indexed_data_storage with type t = C.t and type key = I.t and type value = V.t\n\n(** Like [Make_indexed_data_storage], adding tracking of storage cost. *)\nmodule Make_indexed_carbonated_data_storage\n    (C : Raw_context.T)\n    (I : INDEX)\n    (V : VALUE) :\n  Non_iterable_indexed_carbonated_data_storage_with_values\n    with type t = C.t\n     and type key = I.t\n     and type value = V.t\n\nmodule Make_indexed_data_snapshotable_storage\n    (C : Raw_context.T)\n    (Snapshot : INDEX)\n    (I : INDEX)\n    (V : VALUE) :\n  Indexed_data_snapshotable_storage\n    with type t = C.t\n     and type snapshot = Snapshot.t\n     and type key = I.t\n     and type value = V.t\n\nmodule Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) :\n  Indexed_raw_context\n    with type t = C.t\n     and type key = I.t\n     and type 'a ipath = 'a I.ipath\n\nmodule type WRAPPER = sig\n  type t\n\n  type key\n\n  val wrap : t -> key\n\n  val unwrap : key -> t option\nend\n\nmodule Wrap_indexed_data_storage\n    (C : Indexed_data_storage)\n    (K : WRAPPER with type key := C.key) :\n  Indexed_data_storage\n    with type t = C.t\n     and type key = K.t\n     and type value = C.value\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2019-2020 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Storage_sigs\n\nmodule Registered = struct\n  let ghost = false\nend\n\nmodule Ghost = struct\n  let ghost = true\nend\n\nmodule type ENCODER = sig\n  type t\n\n  val of_bytes : key:(unit -> string list) -> bytes -> t tzresult\n\n  val to_bytes : t -> bytes\nend\n\nmodule Make_encoder (V : VALUE) : ENCODER with type t := V.t = struct\n  let of_bytes ~key b =\n    match Data_encoding.Binary.of_bytes_opt V.encoding b with\n    | None -> error (Raw_context.Storage_error (Corrupted_data (key ())))\n    | Some v -> Ok v\n\n  let to_bytes v =\n    match Data_encoding.Binary.to_bytes_opt V.encoding v with\n    | Some b -> b\n    | None -> Bytes.empty\nend\n\nlet len_name = \"len\"\n\nlet data_name = \"data\"\n\nlet encode_len_value bytes =\n  let length = Bytes.length bytes in\n  Data_encoding.(Binary.to_bytes_exn int31) length\n\nlet decode_len_value key len =\n  match Data_encoding.(Binary.of_bytes_opt int31) len with\n  | None -> error (Raw_context.Storage_error (Corrupted_data key))\n  | Some len -> ok len\n\nmodule Make_subcontext (R : REGISTER) (C : Raw_context.T) (N : NAME) :\n  Raw_context.T with type t = C.t = struct\n  type t = C.t\n\n  let to_key k = N.name @ k\n\n  let mem t k = C.mem t (to_key k)\n\n  let mem_tree t k = C.mem_tree t (to_key k)\n\n  let get t k = C.get t (to_key k)\n\n  let get_tree t k = C.get_tree t (to_key k)\n\n  let find t k = C.find t (to_key k)\n\n  let find_tree t k = C.find_tree t (to_key k)\n\n  let add t k v = C.add t (to_key k) v\n\n  let add_tree t k v = C.add_tree t (to_key k) v\n\n  let init t k v = C.init t (to_key k) v\n\n  let init_tree t k v = C.init_tree t (to_key k) v\n\n  let update t k v = C.update t (to_key k) v\n\n  let update_tree t k v = C.update_tree t (to_key k) v\n\n  let add_or_remove t k v = C.add_or_remove t (to_key k) v\n\n  let add_or_remove_tree t k v = C.add_or_remove_tree t (to_key k) v\n\n  let remove_existing t k = C.remove_existing t (to_key k)\n\n  let remove_existing_tree t k = C.remove_existing_tree t (to_key k)\n\n  let remove t k = C.remove t (to_key k)\n\n  let list t ?offset ?length k = C.list t ?offset ?length (to_key k)\n\n  let fold ?depth t k ~order ~init ~f =\n    C.fold ?depth t (to_key k) ~order ~init ~f\n\n  module Tree = C.Tree\n\n  let project = C.project\n\n  let absolute_key c k = C.absolute_key c (to_key k)\n\n  type error += Block_quota_exceeded = C.Block_quota_exceeded\n\n  type error += Operation_quota_exceeded = C.Operation_quota_exceeded\n\n  let consume_gas = C.consume_gas\n\n  let check_enough_gas = C.check_enough_gas\n\n  let description =\n    let description =\n      if R.ghost then Storage_description.create () else C.description\n    in\n    Storage_description.register_named_subcontext description N.name\nend\n\nmodule Make_single_data_storage\n    (R : REGISTER)\n    (C : Raw_context.T)\n    (N : NAME)\n    (V : VALUE) : Single_data_storage with type t = C.t and type value = V.t =\nstruct\n  type t = C.t\n\n  type context = t\n\n  type value = V.t\n\n  let mem t = C.mem t N.name\n\n  include Make_encoder (V)\n\n  let get t =\n    C.get t N.name >>=? fun b ->\n    let key () = C.absolute_key t N.name in\n    Lwt.return (of_bytes ~key b)\n\n  let find t =\n    C.find t N.name >|= function\n    | None -> Result.return_none\n    | Some b ->\n        let key () = C.absolute_key t N.name in\n        of_bytes ~key b >|? fun v -> Some v\n\n  let init t v = C.init t N.name (to_bytes v) >|=? fun t -> C.project t\n\n  let update t v = C.update t N.name (to_bytes v) >|=? fun t -> C.project t\n\n  let add t v = C.add t N.name (to_bytes v) >|= fun t -> C.project t\n\n  let add_or_remove t v =\n    C.add_or_remove t N.name (Option.map to_bytes v) >|= fun t -> C.project t\n\n  let remove t = C.remove t N.name >|= fun t -> C.project t\n\n  let remove_existing t = C.remove_existing t N.name >|=? fun t -> C.project t\n\n  let () =\n    let open Storage_description in\n    let description =\n      if R.ghost then Storage_description.create () else C.description\n    in\n    register_value\n      ~get:find\n      (register_named_subcontext description N.name)\n      V.encoding\n    [@@coq_axiom_with_reason \"stack overflow in Coq\"]\nend\n\nmodule type INDEX = sig\n  type t\n\n  include Path_encoding.S with type t := t\n\n  type 'a ipath\n\n  val args : ('a, t, 'a ipath) Storage_description.args\nend\n\nmodule Pair (I1 : INDEX) (I2 : INDEX) : INDEX with type t = I1.t * I2.t = struct\n  type t = I1.t * I2.t\n\n  let path_length = I1.path_length + I2.path_length\n\n  let to_path (x, y) l = I1.to_path x (I2.to_path y l)\n\n  let of_path l =\n    match Misc.take I1.path_length l with\n    | None -> None\n    | Some (l1, l2) -> (\n        match (I1.of_path l1, I2.of_path l2) with\n        | (Some x, Some y) -> Some (x, y)\n        | _ -> None)\n\n  type 'a ipath = 'a I1.ipath I2.ipath\n\n  let args = Storage_description.Pair (I1.args, I2.args)\nend\n\nmodule Make_data_set_storage (C : Raw_context.T) (I : INDEX) :\n  Data_set_storage with type t = C.t and type elt = I.t = struct\n  type t = C.t\n\n  type context = t\n\n  type elt = I.t\n\n  let inited = Bytes.of_string \"inited\"\n\n  let mem s i = C.mem s (I.to_path i [])\n\n  let add s i = C.add s (I.to_path i []) inited >|= fun t -> C.project t\n\n  let remove s i = C.remove s (I.to_path i []) >|= fun t -> C.project t\n\n  let clear s = C.remove s [] >|= fun t -> C.project t\n\n  let fold s ~order ~init ~f =\n    C.fold ~depth:(`Eq I.path_length) s [] ~order ~init ~f:(fun file tree acc ->\n        match C.Tree.kind tree with\n        | `Value -> (\n            match I.of_path file with None -> assert false | Some p -> f p acc)\n        | `Tree -> Lwt.return acc)\n\n  let elements s =\n    fold s ~order:`Sorted ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))\n\n  let () =\n    let open Storage_description in\n    let unpack = unpack I.args in\n    register_value (* TODO fixme 'elements...' *)\n      ~get:(fun c ->\n        let (c, k) = unpack c in\n        mem c k >>= function true -> return_some true | false -> return_none)\n      (register_indexed_subcontext\n         ~list:(fun c -> elements c >|= ok)\n         C.description\n         I.args)\n      Data_encoding.bool\n    [@@coq_axiom_with_reason \"stack overflow in Coq\"]\nend\n\nmodule Make_indexed_data_storage (C : Raw_context.T) (I : INDEX) (V : VALUE) :\n  Indexed_data_storage with type t = C.t and type key = I.t and type value = V.t =\nstruct\n  type t = C.t\n\n  type context = t\n\n  type key = I.t\n\n  type value = V.t\n\n  include Make_encoder (V)\n\n  let mem s i = C.mem s (I.to_path i [])\n\n  let get s i =\n    C.get s (I.to_path i []) >>=? fun b ->\n    let key () = C.absolute_key s (I.to_path i []) in\n    Lwt.return (of_bytes ~key b)\n\n  let find s i =\n    C.find s (I.to_path i []) >|= function\n    | None -> Result.return_none\n    | Some b ->\n        let key () = C.absolute_key s (I.to_path i []) in\n        of_bytes ~key b >|? fun v -> Some v\n\n  let update s i v =\n    C.update s (I.to_path i []) (to_bytes v) >|=? fun t -> C.project t\n\n  let init s i v =\n    C.init s (I.to_path i []) (to_bytes v) >|=? fun t -> C.project t\n\n  let add s i v = C.add s (I.to_path i []) (to_bytes v) >|= fun t -> C.project t\n\n  let add_or_remove s i v =\n    C.add_or_remove s (I.to_path i []) (Option.map to_bytes v) >|= fun t ->\n    C.project t\n\n  let remove s i = C.remove s (I.to_path i []) >|= fun t -> C.project t\n\n  let remove_existing s i =\n    C.remove_existing s (I.to_path i []) >|=? fun t -> C.project t\n\n  let clear s = C.remove s [] >|= fun t -> C.project t\n\n  let fold s ~order ~init ~f =\n    C.fold ~depth:(`Eq I.path_length) s [] ~order ~init ~f:(fun file tree acc ->\n        C.Tree.to_value tree >>= function\n        | Some v -> (\n            match I.of_path file with\n            | None -> assert false\n            | Some path -> (\n                let key () = C.absolute_key s file in\n                match of_bytes ~key v with\n                | Ok v -> f path v acc\n                | Error _ -> Lwt.return acc))\n        | None -> Lwt.return acc)\n\n  let fold_keys s ~order ~init ~f =\n    fold s ~order ~init ~f:(fun k _ acc -> f k acc)\n\n  let bindings s =\n    fold s ~order:`Sorted ~init:[] ~f:(fun p v acc ->\n        Lwt.return ((p, v) :: acc))\n\n  let keys s =\n    fold_keys s ~order:`Sorted ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))\n\n  let () =\n    let open Storage_description in\n    let unpack = unpack I.args in\n    register_value\n      ~get:(fun c ->\n        let (c, k) = unpack c in\n        find c k)\n      (register_indexed_subcontext\n         ~list:(fun c -> keys c >|= ok)\n         C.description\n         I.args)\n      V.encoding\n    [@@coq_axiom_with_reason \"stack overflow in Coq\"]\nend\n\n(* Internal-use-only version of {!Make_indexed_carbonated_data_storage} to\n   expose fold_keys_unaccounted *)\nmodule Make_indexed_carbonated_data_storage_INTERNAL\n    (C : Raw_context.T)\n    (I : INDEX)\n    (V : VALUE) :\n  Non_iterable_indexed_carbonated_data_storage_INTERNAL\n    with type t = C.t\n     and type key = I.t\n     and type value = V.t = struct\n  type t = C.t\n\n  type context = t\n\n  type key = I.t\n\n  type value = V.t\n\n  include Make_encoder (V)\n\n  let data_key i = I.to_path i [data_name]\n\n  let len_key i = I.to_path i [len_name]\n\n  let consume_mem_gas c key =\n    C.consume_gas\n      c\n      (Storage_costs.read_access ~path_length:(List.length key) ~read_bytes:0)\n\n  let existing_size c i =\n    C.find c (len_key i) >|= function\n    | None -> ok (0, false)\n    | Some len -> decode_len_value (len_key i) len >|? fun len -> (len, true)\n\n  let consume_read_gas get c i =\n    let len_key = len_key i in\n    get c len_key >>=? fun len ->\n    Lwt.return\n      ( decode_len_value len_key len >>? fun read_bytes ->\n        let cost =\n          Storage_costs.read_access\n            ~path_length:(List.length len_key)\n            ~read_bytes\n        in\n        C.consume_gas c cost )\n\n  (* For the future: here, we bill a generic cost for encoding the value\n     to bytes. It would be cleaner for users of this functor to provide\n     gas costs for the encoding. *)\n  let consume_serialize_write_gas set c i v =\n    let bytes = to_bytes v in\n    let len = Bytes.length bytes in\n    C.consume_gas c (Gas_limit_repr.alloc_mbytes_cost len) >>?= fun c ->\n    let cost = Storage_costs.write_access ~written_bytes:len in\n    C.consume_gas c cost >>?= fun c ->\n    set c (len_key i) (encode_len_value bytes) >|=? fun c -> (c, bytes)\n\n  let consume_remove_gas del c i =\n    C.consume_gas c (Storage_costs.write_access ~written_bytes:0) >>?= fun c ->\n    del c (len_key i)\n\n  let mem s i =\n    let key = data_key i in\n    consume_mem_gas s key >>?= fun s ->\n    C.mem s key >|= fun exists -> ok (C.project s, exists)\n\n  let get_unprojected s i =\n    consume_read_gas C.get s i >>=? fun s ->\n    C.get s (data_key i) >>=? fun b ->\n    let key () = C.absolute_key s (data_key i) in\n    Lwt.return (of_bytes ~key b >|? fun v -> (s, v))\n\n  let get s i = get_unprojected s i >|=? fun (s, v) -> (C.project s, v)\n\n  let find s i =\n    let key = data_key i in\n    consume_mem_gas s key >>?= fun s ->\n    C.mem s key >>= fun exists ->\n    if exists then get s i >|=? fun (s, v) -> (s, Some v)\n    else return (C.project s, None)\n\n  let update s i v =\n    existing_size s i >>=? fun (prev_size, _) ->\n    consume_serialize_write_gas C.update s i v >>=? fun (s, bytes) ->\n    C.update s (data_key i) bytes >|=? fun t ->\n    let size_diff = Bytes.length bytes - prev_size in\n    (C.project t, size_diff)\n\n  let init s i v =\n    consume_serialize_write_gas C.init s i v >>=? fun (s, bytes) ->\n    C.init s (data_key i) bytes >|=? fun t ->\n    let size = Bytes.length bytes in\n    (C.project t, size)\n\n  let add s i v =\n    let add s i v = C.add s i v >|= ok in\n    existing_size s i >>=? fun (prev_size, existed) ->\n    consume_serialize_write_gas add s i v >>=? fun (s, bytes) ->\n    add s (data_key i) bytes >|=? fun t ->\n    let size_diff = Bytes.length bytes - prev_size in\n    (C.project t, size_diff, existed)\n\n  let remove s i =\n    let remove s i = C.remove s i >|= ok in\n    existing_size s i >>=? fun (prev_size, existed) ->\n    consume_remove_gas remove s i >>=? fun s ->\n    remove s (data_key i) >|=? fun t -> (C.project t, prev_size, existed)\n\n  let remove_existing s i =\n    existing_size s i >>=? fun (prev_size, _) ->\n    consume_remove_gas C.remove_existing s i >>=? fun s ->\n    C.remove_existing s (data_key i) >|=? fun t -> (C.project t, prev_size)\n\n  let add_or_remove s i v =\n    match v with None -> remove s i | Some v -> add s i v\n\n  (** Because big map values are not stored under some common key,\n      we have no choice but to fold over all nodes with a path of length\n      [I.path_length] to retrieve actual keys and then paginate.\n\n      While this is inefficient and will traverse the whole tree ([O(n)]), there\n      currently isn't a better decent alternative.\n\n      Once https://gitlab.com/tezos/tezos/-/merge_requests/2771 which flattens paths is done,\n      {!C.list} could be used instead here. *)\n  let list_values ?(offset = 0) ?(length = max_int) s =\n    let root = [] in\n    let depth = `Eq I.path_length in\n    C.fold\n      s\n      root\n      ~depth\n      ~order:`Sorted\n      ~init:(ok (s, [], offset, length))\n      ~f:(fun file tree acc ->\n        match (C.Tree.kind tree, acc) with\n        | (`Tree, Ok (s, rev_values, offset, length)) -> (\n            if Compare.Int.(length <= 0) then\n              (* Keep going until the end, we have no means of short-circuiting *)\n              Lwt.return acc\n            else if Compare.Int.(offset > 0) then\n              (* Offset (first element) not reached yet *)\n              let offset = pred offset in\n              Lwt.return (Ok (s, rev_values, offset, length))\n            else\n              (* Nominal case *)\n              match I.of_path file with\n              | None -> assert false\n              | Some key ->\n                  get_unprojected s key >|=? fun (s, value) ->\n                  (s, value :: rev_values, 0, pred length))\n        | _ -> Lwt.return acc)\n    >|=? fun (s, rev_values, _offset, _length) ->\n    (C.project s, List.rev rev_values)\n\n  let fold_keys_unaccounted s ~order ~init ~f =\n    C.fold ~depth:(`Eq I.path_length) s [] ~order ~init ~f:(fun file tree acc ->\n        match C.Tree.kind tree with\n        | `Value -> (\n            match List.rev file with\n            | last :: _ when Compare.String.(last = len_name) -> Lwt.return acc\n            | last :: rest when Compare.String.(last = data_name) -> (\n                let file = List.rev rest in\n                match I.of_path file with\n                | None -> assert false\n                | Some path -> f path acc)\n            | _ -> assert false)\n        | `Tree -> Lwt.return acc)\n\n  let keys_unaccounted s =\n    fold_keys_unaccounted s ~order:`Sorted ~init:[] ~f:(fun p acc ->\n        Lwt.return (p :: acc))\n\n  let () =\n    let open Storage_description in\n    let unpack = unpack I.args in\n    register_value (* TODO export consumed gas ?? *)\n      ~get:(fun c ->\n        let (c, k) = unpack c in\n        find c k >|=? fun (_, v) -> v)\n      (register_indexed_subcontext\n         ~list:(fun c -> keys_unaccounted c >|= ok)\n         C.description\n         I.args)\n      V.encoding\n    [@@coq_axiom_with_reason \"stack overflow in Coq\"]\nend\n\nmodule Make_indexed_carbonated_data_storage : functor\n  (C : Raw_context.T)\n  (I : INDEX)\n  (V : VALUE)\n  ->\n  Non_iterable_indexed_carbonated_data_storage_with_values\n    with type t = C.t\n     and type key = I.t\n     and type value = V.t =\n  Make_indexed_carbonated_data_storage_INTERNAL\n\nmodule Make_carbonated_data_set_storage (C : Raw_context.T) (I : INDEX) :\n  Carbonated_data_set_storage with type t = C.t and type elt = I.t = struct\n  module V = struct\n    type t = unit\n\n    let encoding = Data_encoding.unit\n  end\n\n  module M = Make_indexed_carbonated_data_storage_INTERNAL (C) (I) (V)\n\n  type t = M.t\n\n  type context = t\n\n  type elt = I.t\n\n  let mem = M.mem\n\n  let init s i = M.init s i ()\n\n  let remove s i = M.remove s i\n\n  let fold_keys_unaccounted = M.fold_keys_unaccounted\nend\n\nmodule Make_indexed_data_snapshotable_storage\n    (C : Raw_context.T)\n    (Snapshot_index : INDEX)\n    (I : INDEX)\n    (V : VALUE) :\n  Indexed_data_snapshotable_storage\n    with type t = C.t\n     and type snapshot = Snapshot_index.t\n     and type key = I.t\n     and type value = V.t = struct\n  type snapshot = Snapshot_index.t\n\n  let data_name = [\"current\"]\n\n  let snapshot_name = [\"snapshot\"]\n\n  module C_data =\n    Make_subcontext (Registered) (C)\n      (struct\n        let name = data_name\n      end)\n\n  module C_snapshot =\n    Make_subcontext (Registered) (C)\n      (struct\n        let name = snapshot_name\n      end)\n\n  module V_encoder = Make_encoder (V)\n  include Make_indexed_data_storage (C_data) (I) (V)\n  module Snapshot =\n    Make_indexed_data_storage (C_snapshot) (Pair (Snapshot_index) (I)) (V)\n\n  let snapshot_path id = snapshot_name @ Snapshot_index.to_path id []\n\n  let snapshot_exists s id = C.mem_tree s (snapshot_path id)\n\n  let err_missing_key key = Raw_context.storage_error (Missing_key (key, Copy))\n\n  let snapshot s id =\n    C.find_tree s data_name >>= function\n    | None -> Lwt.return (err_missing_key data_name)\n    | Some tree ->\n        C.add_tree s (snapshot_path id) tree >|= (fun t -> C.project t) >|= ok\n\n  let fold_snapshot s id ~order ~init ~f =\n    C.find_tree s (snapshot_path id) >>= function\n    | None -> Lwt.return (err_missing_key data_name)\n    | Some tree ->\n        C_data.Tree.fold\n          tree\n          ~depth:(`Eq I.path_length)\n          []\n          ~order\n          ~init:(Ok init)\n          ~f:(fun file tree acc ->\n            acc >>?= fun acc ->\n            C.Tree.to_value tree >>= function\n            | Some v -> (\n                match I.of_path file with\n                | None -> assert false\n                | Some path -> (\n                    let key () = C.absolute_key s file in\n                    match V_encoder.of_bytes ~key v with\n                    | Ok v -> f path v acc\n                    | Error _ -> return acc))\n            | None -> return acc)\n\n  let delete_snapshot s id =\n    C.remove s (snapshot_path id) >|= fun t -> C.project t\nend\n\nmodule Make_indexed_subcontext (C : Raw_context.T) (I : INDEX) :\n  Indexed_raw_context\n    with type t = C.t\n     and type key = I.t\n     and type 'a ipath = 'a I.ipath = struct\n  type t = C.t\n\n  type context = t\n\n  type key = I.t\n\n  type 'a ipath = 'a I.ipath\n\n  let clear t = C.remove t [] >|= fun t -> C.project t\n\n  let fold_keys t ~order ~init ~f =\n    C.fold ~depth:(`Eq I.path_length) t [] ~order ~init ~f:(fun path tree acc ->\n        match C.Tree.kind tree with\n        | `Tree -> (\n            match I.of_path path with\n            | None -> assert false\n            | Some path -> f path acc)\n        | `Value -> Lwt.return acc)\n\n  let keys t =\n    fold_keys t ~order:`Sorted ~init:[] ~f:(fun i acc -> Lwt.return (i :: acc))\n\n  let err_missing_key key = Raw_context.storage_error (Missing_key (key, Copy))\n\n  let copy t ~from ~to_ =\n    let from = I.to_path from [] in\n    let to_ = I.to_path to_ [] in\n    C.find_tree t from >>= function\n    | None -> Lwt.return (err_missing_key from)\n    | Some tree -> C.add_tree t to_ tree >|= ok\n\n  let remove t k = C.remove t (I.to_path k [])\n\n  let description =\n    Storage_description.register_indexed_subcontext\n      ~list:(fun c -> keys c >|= ok)\n      C.description\n      I.args\n\n  let unpack = Storage_description.unpack I.args\n\n  let pack = Storage_description.pack I.args\n\n  module Raw_context : Raw_context.T with type t = C.t I.ipath = struct\n    type t = C.t I.ipath\n\n    let to_key i k = I.to_path i k\n\n    let mem c k =\n      let (t, i) = unpack c in\n      C.mem t (to_key i k)\n\n    let mem_tree c k =\n      let (t, i) = unpack c in\n      C.mem_tree t (to_key i k)\n\n    let get c k =\n      let (t, i) = unpack c in\n      C.get t (to_key i k)\n\n    let get_tree c k =\n      let (t, i) = unpack c in\n      C.get_tree t (to_key i k)\n\n    let find c k =\n      let (t, i) = unpack c in\n      C.find t (to_key i k)\n\n    let find_tree c k =\n      let (t, i) = unpack c in\n      C.find_tree t (to_key i k)\n\n    let list c ?offset ?length k =\n      let (t, i) = unpack c in\n      C.list t ?offset ?length (to_key i k)\n\n    let init c k v =\n      let (t, i) = unpack c in\n      C.init t (to_key i k) v >|=? fun t -> pack t i\n\n    let init_tree c k v =\n      let (t, i) = unpack c in\n      C.init_tree t (to_key i k) v >|=? fun t -> pack t i\n\n    let update c k v =\n      let (t, i) = unpack c in\n      C.update t (to_key i k) v >|=? fun t -> pack t i\n\n    let update_tree c k v =\n      let (t, i) = unpack c in\n      C.update_tree t (to_key i k) v >|=? fun t -> pack t i\n\n    let add c k v =\n      let (t, i) = unpack c in\n      C.add t (to_key i k) v >|= fun t -> pack t i\n\n    let add_tree c k v =\n      let (t, i) = unpack c in\n      C.add_tree t (to_key i k) v >|= fun t -> pack t i\n\n    let add_or_remove c k v =\n      let (t, i) = unpack c in\n      C.add_or_remove t (to_key i k) v >|= fun t -> pack t i\n\n    let add_or_remove_tree c k v =\n      let (t, i) = unpack c in\n      C.add_or_remove_tree t (to_key i k) v >|= fun t -> pack t i\n\n    let remove_existing c k =\n      let (t, i) = unpack c in\n      C.remove_existing t (to_key i k) >|=? fun t -> pack t i\n\n    let remove_existing_tree c k =\n      let (t, i) = unpack c in\n      C.remove_existing_tree t (to_key i k) >|=? fun t -> pack t i\n\n    let remove c k =\n      let (t, i) = unpack c in\n      C.remove t (to_key i k) >|= fun t -> pack t i\n\n    let fold ?depth c k ~order ~init ~f =\n      let (t, i) = unpack c in\n      C.fold ?depth t (to_key i k) ~order ~init ~f\n\n    module Tree = struct\n      include C.Tree\n\n      let empty c =\n        let (t, _) = unpack c in\n        C.Tree.empty t\n    end\n\n    let project c =\n      let (t, _) = unpack c in\n      C.project t\n\n    let absolute_key c k =\n      let (t, i) = unpack c in\n      C.absolute_key t (to_key i k)\n\n    type error += Block_quota_exceeded = C.Block_quota_exceeded\n\n    type error += Operation_quota_exceeded = C.Operation_quota_exceeded\n\n    let consume_gas c g =\n      let (t, i) = unpack c in\n      C.consume_gas t g >>? fun t -> ok (pack t i)\n\n    let check_enough_gas c g =\n      let (t, _i) = unpack c in\n      C.check_enough_gas t g\n\n    let description = description\n  end\n\n  module Make_set (R : REGISTER) (N : NAME) :\n    Data_set_storage with type t = t and type elt = key = struct\n    type t = C.t\n\n    type context = t\n\n    type elt = I.t\n\n    let inited = Bytes.of_string \"inited\"\n\n    let mem s i = Raw_context.mem (pack s i) N.name\n\n    let add s i =\n      Raw_context.add (pack s i) N.name inited >|= fun c ->\n      let (s, _) = unpack c in\n      C.project s\n\n    let remove s i =\n      Raw_context.remove (pack s i) N.name >|= fun c ->\n      let (s, _) = unpack c in\n      C.project s\n\n    let clear s =\n      fold_keys s ~init:s ~order:`Sorted ~f:(fun i s ->\n          Raw_context.remove (pack s i) N.name >|= fun c ->\n          let (s, _) = unpack c in\n          s)\n      >|= fun t -> C.project t\n\n    let fold s ~order ~init ~f =\n      fold_keys s ~order ~init ~f:(fun i acc ->\n          mem s i >>= function true -> f i acc | false -> Lwt.return acc)\n\n    let elements s =\n      fold s ~order:`Sorted ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))\n\n    let () =\n      let open Storage_description in\n      let unpack = unpack I.args in\n      let description =\n        if R.ghost then Storage_description.create ()\n        else Raw_context.description\n      in\n      register_value\n        ~get:(fun c ->\n          let (c, k) = unpack c in\n          mem c k >>= function true -> return_some true | false -> return_none)\n        (register_named_subcontext description N.name)\n        Data_encoding.bool\n      [@@coq_axiom_with_reason \"stack overflow in Coq\"]\n  end\n\n  module Make_map (N : NAME) (V : VALUE) :\n    Indexed_data_storage with type t = t and type key = key and type value = V.t =\n  struct\n    type t = C.t\n\n    type context = t\n\n    type key = I.t\n\n    type value = V.t\n\n    include Make_encoder (V)\n\n    let mem s i = Raw_context.mem (pack s i) N.name\n\n    let get s i =\n      Raw_context.get (pack s i) N.name >>=? fun b ->\n      let key () = Raw_context.absolute_key (pack s i) N.name in\n      Lwt.return (of_bytes ~key b)\n\n    let find s i =\n      Raw_context.find (pack s i) N.name >|= function\n      | None -> Result.return_none\n      | Some b ->\n          let key () = Raw_context.absolute_key (pack s i) N.name in\n          of_bytes ~key b >|? fun v -> Some v\n\n    let update s i v =\n      Raw_context.update (pack s i) N.name (to_bytes v) >|=? fun c ->\n      let (s, _) = unpack c in\n      C.project s\n\n    let init s i v =\n      Raw_context.init (pack s i) N.name (to_bytes v) >|=? fun c ->\n      let (s, _) = unpack c in\n      C.project s\n\n    let add s i v =\n      Raw_context.add (pack s i) N.name (to_bytes v) >|= fun c ->\n      let (s, _) = unpack c in\n      C.project s\n\n    let add_or_remove s i v =\n      Raw_context.add_or_remove (pack s i) N.name (Option.map to_bytes v)\n      >|= fun c ->\n      let (s, _) = unpack c in\n      C.project s\n\n    let remove s i =\n      Raw_context.remove (pack s i) N.name >|= fun c ->\n      let (s, _) = unpack c in\n      C.project s\n\n    let remove_existing s i =\n      Raw_context.remove_existing (pack s i) N.name >|=? fun c ->\n      let (s, _) = unpack c in\n      C.project s\n\n    let clear s =\n      fold_keys s ~order:`Sorted ~init:s ~f:(fun i s ->\n          Raw_context.remove (pack s i) N.name >|= fun c ->\n          let (s, _) = unpack c in\n          s)\n      >|= fun t -> C.project t\n\n    let fold s ~order ~init ~f =\n      fold_keys s ~order ~init ~f:(fun i acc ->\n          get s i >>= function Error _ -> Lwt.return acc | Ok v -> f i v acc)\n\n    let bindings s =\n      fold s ~order:`Sorted ~init:[] ~f:(fun p v acc ->\n          Lwt.return ((p, v) :: acc))\n\n    let fold_keys s ~order ~init ~f =\n      fold_keys s ~order ~init ~f:(fun i acc ->\n          mem s i >>= function false -> Lwt.return acc | true -> f i acc)\n\n    let keys s =\n      fold_keys s ~order:`Sorted ~init:[] ~f:(fun p acc ->\n          Lwt.return (p :: acc))\n\n    let () =\n      let open Storage_description in\n      let unpack = unpack I.args in\n      register_value\n        ~get:(fun c ->\n          let (c, k) = unpack c in\n          find c k)\n        (register_named_subcontext Raw_context.description N.name)\n        V.encoding\n      [@@coq_axiom_with_reason \"stack overflow in Coq\"]\n  end\n\n  module Make_carbonated_map (N : NAME) (V : VALUE) :\n    Non_iterable_indexed_carbonated_data_storage\n      with type t = t\n       and type key = key\n       and type value = V.t = struct\n    type t = C.t\n\n    type context = t\n\n    type key = I.t\n\n    type value = V.t\n\n    include Make_encoder (V)\n\n    let len_name = len_name :: N.name\n\n    let data_name = data_name :: N.name\n\n    let path_length = List.length N.name + 1\n\n    let consume_mem_gas c =\n      Raw_context.consume_gas\n        c\n        (Storage_costs.read_access ~path_length ~read_bytes:0)\n\n    let existing_size c =\n      Raw_context.find c len_name >|= function\n      | None -> ok (0, false)\n      | Some len -> decode_len_value len_name len >|? fun len -> (len, true)\n\n    let consume_read_gas get c =\n      get c len_name >>=? fun len ->\n      Lwt.return\n        ( decode_len_value len_name len >>? fun read_bytes ->\n          Raw_context.consume_gas\n            c\n            (Storage_costs.read_access ~path_length ~read_bytes) )\n\n    let consume_write_gas set c v =\n      let bytes = to_bytes v in\n      let len = Bytes.length bytes in\n      Raw_context.consume_gas c (Storage_costs.write_access ~written_bytes:len)\n      >>?= fun c ->\n      set c len_name (encode_len_value bytes) >|=? fun c -> (c, bytes)\n\n    let consume_remove_gas del c =\n      Raw_context.consume_gas c (Storage_costs.write_access ~written_bytes:0)\n      >>?= fun c -> del c len_name\n\n    let mem s i =\n      consume_mem_gas (pack s i) >>?= fun c ->\n      Raw_context.mem c data_name >|= fun res -> ok (Raw_context.project c, res)\n\n    let get s i =\n      consume_read_gas Raw_context.get (pack s i) >>=? fun c ->\n      Raw_context.get c data_name >>=? fun b ->\n      let key () = Raw_context.absolute_key c data_name in\n      Lwt.return (of_bytes ~key b >|? fun v -> (Raw_context.project c, v))\n\n    let find s i =\n      consume_mem_gas (pack s i) >>?= fun c ->\n      let (s, _) = unpack c in\n      Raw_context.mem (pack s i) data_name >>= fun exists ->\n      if exists then get s i >|=? fun (s, v) -> (s, Some v)\n      else return (C.project s, None)\n\n    let update s i v =\n      existing_size (pack s i) >>=? fun (prev_size, _) ->\n      consume_write_gas Raw_context.update (pack s i) v >>=? fun (c, bytes) ->\n      Raw_context.update c data_name bytes >|=? fun c ->\n      let size_diff = Bytes.length bytes - prev_size in\n      (Raw_context.project c, size_diff)\n\n    let init s i v =\n      consume_write_gas Raw_context.init (pack s i) v >>=? fun (c, bytes) ->\n      Raw_context.init c data_name bytes >|=? fun c ->\n      let size = Bytes.length bytes in\n      (Raw_context.project c, size)\n\n    let add s i v =\n      let add c k v = Raw_context.add c k v >|= ok in\n      existing_size (pack s i) >>=? fun (prev_size, existed) ->\n      consume_write_gas add (pack s i) v >>=? fun (c, bytes) ->\n      add c data_name bytes >|=? fun c ->\n      let size_diff = Bytes.length bytes - prev_size in\n      (Raw_context.project c, size_diff, existed)\n\n    let remove s i =\n      let remove c k = Raw_context.remove c k >|= ok in\n      existing_size (pack s i) >>=? fun (prev_size, existed) ->\n      consume_remove_gas remove (pack s i) >>=? fun c ->\n      remove c data_name >|=? fun c ->\n      (Raw_context.project c, prev_size, existed)\n\n    let remove_existing s i =\n      existing_size (pack s i) >>=? fun (prev_size, _) ->\n      consume_remove_gas Raw_context.remove_existing (pack s i) >>=? fun c ->\n      Raw_context.remove_existing c data_name >|=? fun c ->\n      (Raw_context.project c, prev_size)\n\n    let add_or_remove s i v =\n      match v with None -> remove s i | Some v -> add s i v\n\n    let () =\n      let open Storage_description in\n      let unpack = unpack I.args in\n      register_value\n        ~get:(fun c ->\n          let (c, k) = unpack c in\n          find c k >|=? fun (_, v) -> v)\n        (register_named_subcontext Raw_context.description N.name)\n        V.encoding\n      [@@coq_axiom_with_reason \"stack overflow in Coq\"]\n  end\nend\n\nmodule type WRAPPER = sig\n  type t\n\n  type key\n\n  val wrap : t -> key\n\n  val unwrap : key -> t option\nend\n\nmodule Wrap_indexed_data_storage\n    (C : Indexed_data_storage)\n    (K : WRAPPER with type key := C.key) :\n  Indexed_data_storage\n    with type t = C.t\n     and type key = K.t\n     and type value = C.value = struct\n  type t = C.t\n\n  type context = C.t\n\n  type key = K.t\n\n  type value = C.value\n\n  let mem ctxt k = C.mem ctxt (K.wrap k)\n\n  let get ctxt k = C.get ctxt (K.wrap k)\n\n  let find ctxt k = C.find ctxt (K.wrap k)\n\n  let update ctxt k v = C.update ctxt (K.wrap k) v\n\n  let init ctxt k v = C.init ctxt (K.wrap k) v\n\n  let add ctxt k v = C.add ctxt (K.wrap k) v\n\n  let add_or_remove ctxt k v = C.add_or_remove ctxt (K.wrap k) v\n\n  let remove_existing ctxt k = C.remove_existing ctxt (K.wrap k)\n\n  let remove ctxt k = C.remove ctxt (K.wrap k)\n\n  let clear ctxt = C.clear ctxt\n\n  let fold ctxt ~order ~init ~f =\n    C.fold ctxt ~order ~init ~f:(fun k v acc ->\n        match K.unwrap k with None -> Lwt.return acc | Some k -> f k v acc)\n\n  let bindings s =\n    fold s ~order:`Sorted ~init:[] ~f:(fun p v acc ->\n        Lwt.return ((p, v) :: acc))\n\n  let fold_keys s ~order ~init ~f =\n    C.fold_keys s ~order ~init ~f:(fun k acc ->\n        match K.unwrap k with None -> Lwt.return acc | Some k -> f k acc)\n\n  let keys s =\n    fold_keys s ~order:`Sorted ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))\nend\n" ;
                } ;
                { name = "Storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Tezos Protocol Implementation - Typed storage\n\n    This module hides the hierarchical (key x value) database under\n    pre-allocated typed accessors for all persistent entities of the\n    tezos context.\n\n    This interface enforces no invariant on the contents of the\n    database. Its goal is to centralize all accessors in order to have\n    a complete view over the database contents and avoid key\n    collisions. *)\n\nopen Storage_sigs\n\nmodule type Simple_single_data_storage = sig\n  type value\n\n  val get : Raw_context.t -> value tzresult Lwt.t\n\n  val update : Raw_context.t -> value -> Raw_context.t tzresult Lwt.t\n\n  val init : Raw_context.t -> value -> Raw_context.t tzresult Lwt.t\nend\n\nmodule Legacy_block_priority : Simple_single_data_storage with type value = int\n\nmodule Block_round : Simple_single_data_storage with type value = Round_repr.t\n\nmodule Roll_legacy : sig\n  (** Storage from this submodule must only be accessed through the\n      module `Roll_legacy`. *)\n\n  module Owner :\n    Indexed_data_snapshotable_storage\n      with type key = Roll_repr_legacy.t\n       and type snapshot = Cycle_repr.t * int\n       and type value = Signature.Public_key.t\n       and type t := Raw_context.t\n\n  val clear : Raw_context.t -> Raw_context.t Lwt.t\n\n  (** The next roll to be allocated. *)\n  module Next :\n    Single_data_storage\n      with type value = Roll_repr_legacy.t\n       and type t := Raw_context.t\n\n  (** Rolls linked lists represent both account owned and free rolls.\n      All rolls belongs either to the limbo list or to an owned list. *)\n\n  (** Head of the linked list of rolls in limbo *)\n  module Limbo :\n    Single_data_storage\n      with type value = Roll_repr_legacy.t\n       and type t := Raw_context.t\n\n  (** Rolls associated to contracts, a linked list per contract *)\n  module Delegate_roll_list :\n    Indexed_data_storage\n      with type key = Signature.Public_key_hash.t\n       and type value = Roll_repr_legacy.t\n       and type t := Raw_context.t\n\n  (** Use this to iter on a linked list of rolls *)\n  module Successor :\n    Indexed_data_storage\n      with type key = Roll_repr_legacy.t\n       and type value = Roll_repr_legacy.t\n       and type t := Raw_context.t\n\n  (** The tez of a contract that are not assigned to rolls *)\n  module Delegate_change :\n    Indexed_data_storage\n      with type key = Signature.Public_key_hash.t\n       and type value = Tez_repr.t\n       and type t := Raw_context.t\n\n  (** Index of the randomly selected roll snapshot of a given cycle. *)\n  module Snapshot_for_cycle :\n    Indexed_data_storage\n      with type key = Cycle_repr.t\n       and type value = int\n       and type t := Raw_context.t\n\n  (** Last roll in the snapshoted roll allocation of a given cycle. *)\n  module Last_for_snapshot :\n    Indexed_data_storage\n      with type key = int\n       and type value = Roll_repr_legacy.t\n       and type t = Raw_context.t * Cycle_repr.t\nend\n\ntype deposits = {initial_amount : Tez_repr.t; current_amount : Tez_repr.t}\n\ntype missed_endorsements_info = {remaining_slots : int; missed_levels : int}\n\nmodule Contract : sig\n  (** Storage from this submodule must only be accessed through the\n      module `Contract`. *)\n\n  module Global_counter : Simple_single_data_storage with type value = Z.t\n\n  (** The domain of alive contracts *)\n  val fold :\n    Raw_context.t ->\n    order:[`Sorted | `Undefined] ->\n    init:'a ->\n    f:(Contract_repr.t -> 'a -> 'a Lwt.t) ->\n    'a Lwt.t\n\n  val list : Raw_context.t -> Contract_repr.t list Lwt.t\n\n  (** The tez possessed by a contract and that can be used. A contract\n     may also possess tez in frozen deposits. Empty balances (of zero\n     tez) are only allowed for originated contracts, not for implicit\n     ones. *)\n  module Balance :\n    Indexed_data_storage\n      with type key = Contract_repr.t\n       and type value = Tez_repr.t\n       and type t := Raw_context.t\n\n  (** If the value is not set, the delegate didn't miss any endorsing\n     opportunity.  If it is set, this value is a record of type\n     [missed_endorsements_info], where:\n   - [remaining_slots] is the difference between the maximum number of\n     slots that can be missed and the number of missed slots;\n     therefore, when the number is positive, it represents the number\n     of slots that a delegate can still miss before forfeiting its\n     endorsing rewards for the current cycle; when the number is zero\n     it means rewards are not lost, but no further slots can be\n     missed anymore;\n   - [missed_levels] represents the number of missed levels (for\n     endorsing). *)\n  module Missed_endorsements :\n    Indexed_data_storage\n      with type key = Contract_repr.t\n       and type value = missed_endorsements_info\n       and type t := Raw_context.t\n\n  (** Frozen balance, see 'delegate_storage.mli' for more explanation.\n      Always update `Delegates_with_frozen_balance` accordingly.\n\n      Deprecated only used for migration\n  *)\n  module Legacy_frozen_deposits :\n    Indexed_data_storage\n      with type key = Cycle_repr.t\n       and type value = Tez_repr.t\n       and type t = Raw_context.t * Contract_repr.t\n\n  (** Deprecated only used for migration *)\n  module Legacy_frozen_fees :\n    Indexed_data_storage\n      with type key = Cycle_repr.t\n       and type value = Tez_repr.t\n       and type t = Raw_context.t * Contract_repr.t\n\n  (** Deprecated only used for migration *)\n  module Legacy_frozen_rewards :\n    Indexed_data_storage\n      with type key = Cycle_repr.t\n       and type value = Tez_repr.t\n       and type t = Raw_context.t * Contract_repr.t\n\n  (** The manager of a contract *)\n  module Manager :\n    Indexed_data_storage\n      with type key = Contract_repr.t\n       and type value = Manager_repr.t\n       and type t := Raw_context.t\n\n  (** The delegate of a contract, if any. *)\n  module Delegate :\n    Indexed_data_storage\n      with type key = Contract_repr.t\n       and type value = Signature.Public_key_hash.t\n       and type t := Raw_context.t\n\n  (** All contracts (implicit and originated) that are delegated, if any  *)\n  module Delegated :\n    Data_set_storage\n      with type elt = Contract_repr.t\n       and type t = Raw_context.t * Contract_repr.t\n\n  (** The part of a delegate balance that can't be used. The total\n     balance is frozen_deposits.current_amount + balance. It also stores\n     the initial frozen balance in frozen_deposits.initial_amount. We\n     have current_amount <= initial_amount and current_amount <\n     initial_amount iff the delegate was slashed. *)\n  module Frozen_deposits :\n    Indexed_data_storage\n      with type key = Contract_repr.t\n       and type value = deposits\n       and type t := Raw_context.t\n\n  (** If there is a value, the frozen balance for the contract won't\n     exceed it (starting in preserved_cycles + 1). *)\n  module Frozen_deposits_limit :\n    Indexed_data_storage\n      with type key = Contract_repr.t\n       and type value = Tez_repr.t\n       and type t := Raw_context.t\n\n  module Inactive_delegate :\n    Data_set_storage with type elt = Contract_repr.t and type t = Raw_context.t\n\n  (** The last cycle where the delegate is considered active; that is,\n     at the next cycle it will be considered inactive. *)\n  module Delegate_desactivation :\n    Indexed_data_storage\n      with type key = Contract_repr.t\n       and type value = Cycle_repr.t\n       and type t := Raw_context.t\n\n  module Counter :\n    Indexed_data_storage\n      with type key = Contract_repr.t\n       and type value = Z.t\n       and type t := Raw_context.t\n\n  module Code :\n    Non_iterable_indexed_carbonated_data_storage\n      with type key = Contract_repr.t\n       and type value = Script_repr.lazy_expr\n       and type t := Raw_context.t\n\n  module Storage :\n    Non_iterable_indexed_carbonated_data_storage\n      with type key = Contract_repr.t\n       and type value = Script_repr.lazy_expr\n       and type t := Raw_context.t\n\n  (** Current storage space in bytes.\n      Includes code, global storage and big map elements. *)\n  module Used_storage_space :\n    Indexed_data_storage\n      with type key = Contract_repr.t\n       and type value = Z.t\n       and type t := Raw_context.t\n\n  (** Maximal space available without needing to burn new fees. *)\n  module Paid_storage_space :\n    Indexed_data_storage\n      with type key = Contract_repr.t\n       and type value = Z.t\n       and type t := Raw_context.t\nend\n\nmodule Big_map : sig\n  type id = Lazy_storage_kind.Big_map.Id.t\n\n  module Next : sig\n    val incr : Raw_context.t -> (Raw_context.t * id) tzresult Lwt.t\n\n    val init : Raw_context.t -> Raw_context.t tzresult Lwt.t\n  end\n\n  (** The domain of alive big maps *)\n  val fold :\n    Raw_context.t ->\n    order:[`Sorted | `Undefined] ->\n    init:'a ->\n    f:(id -> 'a -> 'a Lwt.t) ->\n    'a Lwt.t\n\n  val list : Raw_context.t -> id list Lwt.t\n\n  val remove : Raw_context.t -> id -> Raw_context.t Lwt.t\n\n  val copy : Raw_context.t -> from:id -> to_:id -> Raw_context.t tzresult Lwt.t\n\n  type key = Raw_context.t * id\n\n  val rpc_arg : id RPC_arg.t\n\n  module Contents : sig\n    include\n      Non_iterable_indexed_carbonated_data_storage\n        with type key = Script_expr_hash.t\n         and type value = Script_repr.expr\n         and type t := key\n\n    (** HACK *)\n    val list_values :\n      ?offset:int ->\n      ?length:int ->\n      Raw_context.t * id ->\n      (Raw_context.t * Script_repr.expr list) tzresult Lwt.t\n  end\n\n  module Total_bytes :\n    Indexed_data_storage\n      with type key = id\n       and type value = Z.t\n       and type t := Raw_context.t\n\n  module Key_type :\n    Indexed_data_storage\n      with type key = id\n       and type value = Script_repr.expr\n       and type t := Raw_context.t\n\n  module Value_type :\n    Indexed_data_storage\n      with type key = id\n       and type value = Script_repr.expr\n       and type t := Raw_context.t\nend\n\nmodule Sapling : sig\n  type id = Lazy_storage_kind.Sapling_state.Id.t\n\n  val rpc_arg : id RPC_arg.t\n\n  module Next : sig\n    val incr : Raw_context.t -> (Raw_context.t * id) tzresult Lwt.t\n\n    val init : Raw_context.t -> Raw_context.t tzresult Lwt.t\n  end\n\n  val copy : Raw_context.t -> from:id -> to_:id -> Raw_context.t tzresult Lwt.t\n\n  val remove : Raw_context.t -> id -> Raw_context.t Lwt.t\n\n  module Total_bytes :\n    Indexed_data_storage\n      with type key = id\n       and type value = Z.t\n       and type t := Raw_context.t\n\n  (* Used by both Commitments and Ciphertexts *)\n  module Commitments_size :\n    Single_data_storage with type t := Raw_context.t * id and type value = int64\n\n  module Memo_size :\n    Single_data_storage with type t := Raw_context.t * id and type value = int\n\n  module Commitments :\n    Non_iterable_indexed_carbonated_data_storage\n      with type t := Raw_context.t * id\n       and type key = int64\n       and type value = Sapling.Hash.t\n\n  val commitments_init : Raw_context.t -> id -> Raw_context.t Lwt.t\n\n  module Ciphertexts :\n    Non_iterable_indexed_carbonated_data_storage\n      with type t := Raw_context.t * id\n       and type key = int64\n       and type value = Sapling.Ciphertext.t\n\n  val ciphertexts_init : Raw_context.t -> id -> Raw_context.t Lwt.t\n\n  module Nullifiers_size :\n    Single_data_storage with type t := Raw_context.t * id and type value = int64\n\n  module Nullifiers_ordered :\n    Non_iterable_indexed_data_storage\n      with type t := Raw_context.t * id\n       and type key = int64\n       and type value = Sapling.Nullifier.t\n\n  module Nullifiers_hashed :\n    Carbonated_data_set_storage\n      with type t := Raw_context.t * id\n       and type elt = Sapling.Nullifier.t\n\n  val nullifiers_init : Raw_context.t -> id -> Raw_context.t Lwt.t\n\n  module Roots :\n    Non_iterable_indexed_data_storage\n      with type t := Raw_context.t * id\n       and type key = int32\n       and type value = Sapling.Hash.t\n\n  module Roots_pos :\n    Single_data_storage with type t := Raw_context.t * id and type value = int32\n\n  module Roots_level :\n    Single_data_storage\n      with type t := Raw_context.t * id\n       and type value = Raw_level_repr.t\nend\n\n(** Set of all registered delegates. *)\nmodule Delegates :\n  Data_set_storage\n    with type t := Raw_context.t\n     and type elt = Signature.Public_key_hash.t\n\ntype slashed_level = {for_double_endorsing : bool; for_double_baking : bool}\n\n(** Set used to avoid slashing multiple times the same event *)\nmodule Slashed_deposits :\n  Indexed_data_storage\n    with type t := Raw_context.t * Cycle_repr.t\n     and type key = Raw_level_repr.t * Signature.Public_key_hash.t\n     and type value = slashed_level\n\n(** Set of all active delegates with rolls. *)\nmodule Legacy_active_delegates_with_rolls :\n  Data_set_storage\n    with type t := Raw_context.t\n     and type elt = Signature.Public_key_hash.t\n\nmodule Stake : sig\n  (** The map of all the staking balances of all delegates, including\n     those with less than one roll. It might be large *)\n  module Staking_balance :\n    Indexed_data_snapshotable_storage\n      with type key = Signature.Public_key_hash.t\n       and type value = Tez_repr.t\n       and type snapshot = int\n       and type t := Raw_context.t\n\n  (** This is a set, encoded in a map with value unit. This should be\n     fairly small compared to staking balance *)\n  module Active_delegate_with_one_roll :\n    Indexed_data_snapshotable_storage\n      with type key = Signature.Public_key_hash.t\n       and type value = unit\n       and type snapshot = int\n       and type t := Raw_context.t\n\n  module Last_snapshot :\n    Single_data_storage with type value = int and type t := Raw_context.t\n\n  (** List of active stake *)\n  module Selected_distribution_for_cycle :\n    Indexed_data_storage\n      with type key = Cycle_repr.t\n       and type value = (Signature.Public_key_hash.t * Tez_repr.t) list\n       and type t := Raw_context.t\nend\n\n(** Sum of the active stakes of all the delegates with rolls *)\nmodule Total_active_stake :\n  Indexed_data_storage\n    with type key = Cycle_repr.t\n     and type value = Tez_repr.t\n     and type t := Raw_context.t\n\n(** State of the sampler used to select delegates. Managed synchronously\n    with [Stake.Selected_distribution_for_cycle]. *)\nmodule Delegate_sampler_state :\n  Indexed_data_storage\n    with type key = Cycle_repr.t\n     and type value =\n          (Signature.Public_key.t * Signature.Public_key_hash.t) Sampler.t\n     and type t := Raw_context.t\n\n(** Set of all the delegates with frozen rewards/deposits/fees for a given cycle.\n    Deprecated: This is now only used for stitching while migrating from an\n    emmy protocol. This is to be removed in the next version.\n\n    This table must be cleaned after migration. *)\nmodule Legacy_delegates_with_frozen_balance :\n  Data_set_storage\n    with type t = Raw_context.t * Cycle_repr.t\n     and type elt = Signature.Public_key_hash.t\n\n(** Votes *)\n\nmodule Vote : sig\n  module Pred_period_kind :\n    Single_data_storage\n      with type value = Voting_period_repr.kind\n       and type t := Raw_context.t\n\n  module Current_period :\n    Single_data_storage\n      with type value = Voting_period_repr.t\n       and type t := Raw_context.t\n\n  (** Participation exponential moving average, in centile of percentage *)\n  module Participation_ema :\n    Single_data_storage with type value = int32 and type t := Raw_context.t\n\n  module Current_proposal :\n    Single_data_storage\n      with type value = Protocol_hash.t\n       and type t := Raw_context.t\n\n  (** Sum of all rolls of all delegates. *)\n  module Listings_size :\n    Single_data_storage with type value = int32 and type t := Raw_context.t\n\n  (** Contains all delegates with their assigned number of rolls. *)\n  module Listings :\n    Indexed_data_storage\n      with type key = Signature.Public_key_hash.t\n       and type value = int32\n       and type t := Raw_context.t\n\n  (** Set of protocol proposal with corresponding proposer delegate *)\n  module Proposals :\n    Data_set_storage\n      with type elt = Protocol_hash.t * Signature.Public_key_hash.t\n       and type t := Raw_context.t\n\n  (** Keeps for each delegate the number of proposed protocols *)\n  module Proposals_count :\n    Indexed_data_storage\n      with type key = Signature.Public_key_hash.t\n       and type value = int\n       and type t := Raw_context.t\n\n  (** Contains for each delegate its ballot *)\n  module Ballots :\n    Indexed_data_storage\n      with type key = Signature.Public_key_hash.t\n       and type value = Vote_repr.ballot\n       and type t := Raw_context.t\nend\n\nmodule type FOR_CYCLE = sig\n  val init :\n    Raw_context.t ->\n    Cycle_repr.t ->\n    Seed_repr.seed ->\n    Raw_context.t tzresult Lwt.t\n\n  val mem : Raw_context.t -> Cycle_repr.t -> bool Lwt.t\n\n  val get : Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t\n\n  val remove_existing :\n    Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t\nend\n\n(** Seed *)\n\nmodule Seed : sig\n  (** Storage from this submodule must only be accessed through the\n      module `Seed`. *)\n\n  type unrevealed_nonce = {\n    nonce_hash : Nonce_hash.t;\n    delegate : Signature.Public_key_hash.t;\n  }\n\n  type nonce_status =\n    | Unrevealed of unrevealed_nonce\n    | Revealed of Seed_repr.nonce\n\n  module Nonce :\n    Non_iterable_indexed_data_storage\n      with type key := Level_repr.t\n       and type value := nonce_status\n       and type t := Raw_context.t\n\n  module Nonce_legacy :\n    Non_iterable_indexed_data_storage\n      with type key := Level_repr.t\n       and type value := nonce_status\n       and type t := Raw_context.t\n\n  module For_cycle : FOR_CYCLE\nend\n\n(** Commitments *)\n\nmodule Commitments :\n  Indexed_data_storage\n    with type key = Blinded_public_key_hash.t\n     and type value = Tez_repr.t\n     and type t := Raw_context.t\n\n(** Ramp up rewards *)\nmodule Ramp_up : sig\n  type reward = {\n    baking_reward_fixed_portion : Tez_repr.t;\n    baking_reward_bonus_per_slot : Tez_repr.t;\n    endorsing_reward_per_slot : Tez_repr.t;\n  }\n\n  module Rewards :\n    Indexed_data_storage\n      with type key = Cycle_repr.t\n       and type value := reward\n       and type t := Raw_context.t\nend\n\nmodule Pending_migration : sig\n  module Balance_updates :\n    Single_data_storage\n      with type value = Receipt_repr.balance_updates\n       and type t := Raw_context.t\n\n  module Operation_results :\n    Single_data_storage\n      with type value = Migration_repr.origination_result list\n       and type t := Raw_context.t\n\n  val remove :\n    Raw_context.t ->\n    (Raw_context.t\n    * Receipt_repr.balance_updates\n    * Migration_repr.origination_result list)\n    tzresult\n    Lwt.t\nend\n\nmodule Liquidity_baking : sig\n  (** Exponential moving average (ema) of flags set in protocol_data.contents.\n    If at any block it's above the threshold set in constants,\n    liquidity baking permanently shuts off. **)\n  module Escape_ema :\n    Single_data_storage with type t := Raw_context.t and type value = Int32.t\n\n  (** Constant product market maker contract that receives liquidity baking subsidy. **)\n  module Cpmm_address :\n    Single_data_storage\n      with type t := Raw_context.t\n       and type value = Contract_repr.t\nend\n\n(** A map of [Script_repr.expr] values, indexed by their hash ([Script_expr_hash.t]).\n    Values from this map can be incorporated by any contract via the primitive\n    [Michelson_v1_primitives.H_constant]. *)\nmodule Global_constants : sig\n  module Map :\n    Non_iterable_indexed_carbonated_data_storage\n      with type t := Raw_context.t\n       and type key = Script_expr_hash.t\n       and type value = Script_repr.expr\nend\n\n(** This module exposes a balance table for tracking ticket ownership.\n    The table is a mapping from keys to values where the keys consist of a\n    hashed representation of:\n      - A ticketer, i.e. the creator of the ticket\n      - The content of a the ticket\n      - The contract that owns some amount of the ticket\n    The values of the table are the amounts owned by each key.\n *)\nmodule Ticket_balance : sig\n  module Table :\n    Non_iterable_indexed_carbonated_data_storage\n      with type t := Raw_context.t\n       and type key = Script_expr_hash.t\n       and type value = Z.t\nend\n\n(** Tenderbake *)\n\nmodule Tenderbake : sig\n  module First_level :\n    Single_data_storage\n      with type t := Raw_context.t\n       and type value = Raw_level_repr.t\n\n  (** [Endorsement_branch] stores a single value composed of the\n      grandparent hash and the predecessor's payload (computed with\n      the grandparent hash) used to verify the validity of\n      endorsements. *)\n  module Endorsement_branch :\n    Single_data_storage\n      with type value = Block_hash.t * Block_payload_hash.t\n       and type t := Raw_context.t\n\n  (** [Grand_parent_branch] stores a single value composed of the\n      great-grand parent hash and the grand parent's payload *)\n  module Grand_parent_branch :\n    Single_data_storage\n      with type value = Block_hash.t * Block_payload_hash.t\n       and type t := Raw_context.t\nend\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Storage_functors\nopen Storage_sigs\n\nmodule Encoding = struct\n  module UInt16 = struct\n    type t = int\n\n    let encoding = Data_encoding.uint16\n  end\n\n  module Int32 = struct\n    type t = Int32.t\n\n    let encoding = Data_encoding.int32\n  end\n\n  module Int64 = struct\n    type t = Int64.t\n\n    let encoding = Data_encoding.int64\n  end\n\n  module Z = struct\n    type t = Z.t\n\n    let encoding = Data_encoding.z\n  end\nend\n\nmodule Int31_index : sig\n  include INDEX with type t = int\nend = struct\n  type t = int\n\n  let path_length = 1\n\n  let to_path c l = string_of_int c :: l\n\n  let of_path = function [] | _ :: _ :: _ -> None | [c] -> int_of_string_opt c\n\n  type 'a ipath = 'a * t\n\n  let args =\n    Storage_description.One\n      {\n        rpc_arg = RPC_arg.int;\n        encoding = Data_encoding.int31;\n        compare = Compare.Int.compare;\n      }\nend\n\nmodule Make_index (H : Storage_description.INDEX) :\n  INDEX with type t = H.t and type 'a ipath = 'a * H.t = struct\n  include H\n\n  type 'a ipath = 'a * t\n\n  let args = Storage_description.One {rpc_arg; encoding; compare}\nend\n\nmodule type Simple_single_data_storage = sig\n  type value\n\n  val get : Raw_context.t -> value tzresult Lwt.t\n\n  val update : Raw_context.t -> value -> Raw_context.t tzresult Lwt.t\n\n  val init : Raw_context.t -> value -> Raw_context.t tzresult Lwt.t\nend\n\nmodule Legacy_block_priority :\n  Simple_single_data_storage with type value = int =\n  Make_single_data_storage (Registered) (Raw_context)\n    (struct\n      let name = [\"block_priority\"]\n    end)\n    (Encoding.UInt16)\n\nmodule Block_round : Simple_single_data_storage with type value = Round_repr.t =\n  Make_single_data_storage (Registered) (Raw_context)\n    (struct\n      let name = [\"block_round\"]\n    end)\n    (Round_repr)\n\nmodule Tenderbake = struct\n  module First_level =\n    Make_single_data_storage (Registered) (Raw_context)\n      (struct\n        let name = [\"first_level_of_Tenderbake\"]\n      end)\n      (Raw_level_repr)\n\n  module Branch = struct\n    type t = Block_hash.t * Block_payload_hash.t\n\n    let encoding =\n      Data_encoding.(\n        obj2\n          (req \"grand_parent_hash\" Block_hash.encoding)\n          (req \"predecessor_payload\" Block_payload_hash.encoding))\n  end\n\n  module Endorsement_branch =\n    Make_single_data_storage (Registered) (Raw_context)\n      (struct\n        let name = [\"endorsement_branch\"]\n      end)\n      (Branch)\n\n  module Grand_parent_branch =\n    Make_single_data_storage (Registered) (Raw_context)\n      (struct\n        let name = [\"grand_parent_branch\"]\n      end)\n      (Branch)\nend\n\n(** Contracts handling *)\n\ntype deposits = {initial_amount : Tez_repr.t; current_amount : Tez_repr.t}\n\nmodule Deposits = struct\n  type t = deposits\n\n  let encoding =\n    let open Data_encoding in\n    conv\n      (fun {initial_amount; current_amount} -> (initial_amount, current_amount))\n      (fun (initial_amount, current_amount) -> {initial_amount; current_amount})\n      (obj2\n         (req \"initial_amount\" Tez_repr.encoding)\n         (req \"actual_amount\" Tez_repr.encoding))\nend\n\ntype missed_endorsements_info = {remaining_slots : int; missed_levels : int}\n\nmodule Missed_endorsements_info = struct\n  type t = missed_endorsements_info\n\n  let encoding =\n    let open Data_encoding in\n    conv\n      (fun {remaining_slots; missed_levels} -> (remaining_slots, missed_levels))\n      (fun (remaining_slots, missed_levels) -> {remaining_slots; missed_levels})\n      (obj2 (req \"remaining_slots\" int31) (req \"missed_levels\" int31))\nend\n\nmodule Contract = struct\n  module Raw_context =\n    Make_subcontext (Registered) (Raw_context)\n      (struct\n        let name = [\"contracts\"]\n      end)\n\n  module Global_counter : Simple_single_data_storage with type value = Z.t =\n    Make_single_data_storage (Registered) (Raw_context)\n      (struct\n        let name = [\"global_counter\"]\n      end)\n      (Encoding.Z)\n\n  module Indexed_context =\n    Make_indexed_subcontext\n      (Make_subcontext (Registered) (Raw_context)\n         (struct\n           let name = [\"index\"]\n         end))\n         (Make_index (Contract_repr.Index))\n\n  let fold = Indexed_context.fold_keys\n\n  let list = Indexed_context.keys\n\n  module Balance =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"balance\"]\n      end)\n      (Tez_repr)\n\n  module Missed_endorsements =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"missed_endorsements\"]\n      end)\n      (Missed_endorsements_info)\n\n  module Legacy_frozen_balance_index =\n    Make_indexed_subcontext\n      (Make_subcontext (Ghost) (Indexed_context.Raw_context)\n         (struct\n           let name = [\"frozen_balance\"]\n         end))\n         (Make_index (Cycle_repr.Index))\n\n  module Legacy_frozen_deposits =\n    Legacy_frozen_balance_index.Make_map\n      (struct\n        let name = [\"deposits\"]\n      end)\n      (Tez_repr)\n\n  module Legacy_frozen_fees =\n    Legacy_frozen_balance_index.Make_map\n      (struct\n        let name = [\"fees\"]\n      end)\n      (Tez_repr)\n\n  module Legacy_frozen_rewards =\n    Legacy_frozen_balance_index.Make_map\n      (struct\n        let name = [\"rewards\"]\n      end)\n      (Tez_repr)\n\n  module Manager =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"manager\"]\n      end)\n      (Manager_repr)\n\n  module Delegate =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"delegate\"]\n      end)\n      (Signature.Public_key_hash)\n\n  module Inactive_delegate =\n    Indexed_context.Make_set\n      (Registered)\n      (struct\n        let name = [\"inactive_delegate\"]\n      end)\n\n  module Delegate_desactivation =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"delegate_desactivation\"]\n      end)\n      (Cycle_repr)\n\n  module Delegated =\n    Make_data_set_storage\n      (Make_subcontext (Registered) (Indexed_context.Raw_context)\n         (struct\n           let name = [\"delegated\"]\n         end))\n         (Make_index (Contract_repr.Index))\n\n  module Counter =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"counter\"]\n      end)\n      (Encoding.Z)\n\n  (* Consume gas for serialization and deserialization of expr in this\n     module *)\n  module Make_carbonated_map_expr (N : Storage_sigs.NAME) :\n    Storage_sigs.Non_iterable_indexed_carbonated_data_storage\n      with type key = Contract_repr.t\n       and type value = Script_repr.lazy_expr\n       and type t := Raw_context.t = struct\n    module I =\n      Indexed_context.Make_carbonated_map\n        (N)\n        (struct\n          type t = Script_repr.lazy_expr\n\n          let encoding = Script_repr.lazy_expr_encoding\n        end)\n\n    type context = I.context\n\n    type key = I.key\n\n    type value = I.value\n\n    let mem = I.mem\n\n    let remove_existing = I.remove_existing\n\n    let remove = I.remove\n\n    let consume_deserialize_gas ctxt value =\n      Raw_context.consume_gas ctxt (Script_repr.force_decode_cost value)\n\n    let consume_serialize_gas ctxt value =\n      Raw_context.consume_gas ctxt (Script_repr.force_bytes_cost value)\n\n    let get ctxt contract =\n      I.get ctxt contract >>=? fun (ctxt, value) ->\n      Lwt.return\n        (consume_deserialize_gas ctxt value >|? fun ctxt -> (ctxt, value))\n\n    let find ctxt contract =\n      I.find ctxt contract >>=? fun (ctxt, value_opt) ->\n      Lwt.return\n      @@\n      match value_opt with\n      | None -> ok (ctxt, None)\n      | Some value ->\n          consume_deserialize_gas ctxt value >|? fun ctxt -> (ctxt, value_opt)\n\n    let update ctxt contract value =\n      consume_serialize_gas ctxt value >>?= fun ctxt ->\n      I.update ctxt contract value\n\n    let add_or_remove ctxt contract value_opt =\n      match value_opt with\n      | None -> I.add_or_remove ctxt contract None\n      | Some value ->\n          consume_serialize_gas ctxt value >>?= fun ctxt ->\n          I.add_or_remove ctxt contract value_opt\n\n    let init ctxt contract value =\n      consume_serialize_gas ctxt value >>?= fun ctxt ->\n      I.init ctxt contract value\n\n    let add ctxt contract value =\n      consume_serialize_gas ctxt value >>?= fun ctxt ->\n      I.add ctxt contract value\n  end\n\n  module Code = Make_carbonated_map_expr (struct\n    let name = [\"code\"]\n  end)\n\n  module Storage = Make_carbonated_map_expr (struct\n    let name = [\"storage\"]\n  end)\n\n  module Paid_storage_space =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"paid_bytes\"]\n      end)\n      (Encoding.Z)\n\n  module Used_storage_space =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"used_bytes\"]\n      end)\n      (Encoding.Z)\n\n  module Roll_list_legacy =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"roll_list\"]\n      end)\n      (Roll_repr_legacy)\n\n  module Change_legacy =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"change\"]\n      end)\n      (Tez_repr)\n\n  module Frozen_deposits =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"frozen_deposits\"]\n      end)\n      (Deposits)\n\n  module Frozen_deposits_limit =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"frozen_deposits_limit\"]\n      end)\n      (Tez_repr)\nend\n\nmodule type NEXT = sig\n  type id\n\n  val init : Raw_context.t -> Raw_context.t tzresult Lwt.t\n\n  val incr : Raw_context.t -> (Raw_context.t * id) tzresult Lwt.t\nend\n\nmodule Global_constants = struct\n  module Map =\n    Make_indexed_carbonated_data_storage\n      (Make_subcontext (Registered) (Raw_context)\n         (struct\n           let name = [\"global_constant\"]\n         end))\n         (Make_index (Script_expr_hash))\n         (struct\n           type t = Script_repr.expr\n\n           let encoding = Script_repr.expr_encoding\n         end)\nend\n\n(** Big maps handling *)\n\nmodule Big_map = struct\n  type id = Lazy_storage_kind.Big_map.Id.t\n\n  module Raw_context =\n    Make_subcontext (Registered) (Raw_context)\n      (struct\n        let name = [\"big_maps\"]\n      end)\n\n  module Next : NEXT with type id := id = struct\n    module Storage =\n      Make_single_data_storage (Registered) (Raw_context)\n        (struct\n          let name = [\"next\"]\n        end)\n        (Lazy_storage_kind.Big_map.Id)\n\n    let incr ctxt =\n      Storage.get ctxt >>=? fun i ->\n      Storage.update ctxt (Lazy_storage_kind.Big_map.Id.next i) >|=? fun ctxt ->\n      (ctxt, i)\n\n    let init ctxt = Storage.init ctxt Lazy_storage_kind.Big_map.Id.init\n  end\n\n  module Index = Lazy_storage_kind.Big_map.Id\n\n  module Indexed_context =\n    Make_indexed_subcontext\n      (Make_subcontext (Registered) (Raw_context)\n         (struct\n           let name = [\"index\"]\n         end))\n         (Make_index (Index))\n\n  let rpc_arg = Index.rpc_arg\n\n  let fold = Indexed_context.fold_keys\n\n  let list = Indexed_context.keys\n\n  let remove ctxt n = Indexed_context.remove ctxt n\n\n  let copy ctxt ~from ~to_ = Indexed_context.copy ctxt ~from ~to_\n\n  type key = Raw_context.t * Index.t\n\n  module Total_bytes =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"total_bytes\"]\n      end)\n      (Encoding.Z)\n\n  module Key_type =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"key_type\"]\n      end)\n      (struct\n        type t = Script_repr.expr\n\n        let encoding = Script_repr.expr_encoding\n      end)\n\n  module Value_type =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"value_type\"]\n      end)\n      (struct\n        type t = Script_repr.expr\n\n        let encoding = Script_repr.expr_encoding\n      end)\n\n  module Contents :\n    Non_iterable_indexed_carbonated_data_storage_with_values\n      with type key = Script_expr_hash.t\n       and type value = Script_repr.expr\n       and type t := key = struct\n    module I =\n      Storage_functors.Make_indexed_carbonated_data_storage\n        (Make_subcontext (Registered) (Indexed_context.Raw_context)\n           (struct\n             let name = [\"contents\"]\n           end))\n           (Make_index (Script_expr_hash))\n           (struct\n             type t = Script_repr.expr\n\n             let encoding = Script_repr.expr_encoding\n           end)\n\n    type context = I.context\n\n    type key = I.key\n\n    type value = I.value\n\n    let mem = I.mem\n\n    let remove_existing = I.remove_existing\n\n    let remove = I.remove\n\n    let update = I.update\n\n    let add_or_remove = I.add_or_remove\n\n    let init = I.init\n\n    let add = I.add\n\n    let list_values = I.list_values\n\n    let consume_deserialize_gas ctxt value =\n      Raw_context.consume_gas ctxt (Script_repr.deserialized_cost value)\n\n    let get ctxt contract =\n      I.get ctxt contract >>=? fun (ctxt, value) ->\n      Lwt.return\n        (consume_deserialize_gas ctxt value >|? fun ctxt -> (ctxt, value))\n\n    let find ctxt contract =\n      I.find ctxt contract >>=? fun (ctxt, value_opt) ->\n      Lwt.return\n      @@\n      match value_opt with\n      | None -> ok (ctxt, None)\n      | Some value ->\n          consume_deserialize_gas ctxt value >|? fun ctxt -> (ctxt, value_opt)\n  end\nend\n\nmodule Sapling = struct\n  type id = Lazy_storage_kind.Sapling_state.Id.t\n\n  module Raw_context =\n    Make_subcontext (Registered) (Raw_context)\n      (struct\n        let name = [\"sapling\"]\n      end)\n\n  module Next = struct\n    module Storage =\n      Make_single_data_storage (Registered) (Raw_context)\n        (struct\n          let name = [\"next\"]\n        end)\n        (Lazy_storage_kind.Sapling_state.Id)\n\n    let incr ctxt =\n      Storage.get ctxt >>=? fun i ->\n      Storage.update ctxt (Lazy_storage_kind.Sapling_state.Id.next i)\n      >|=? fun ctxt -> (ctxt, i)\n\n    let init ctxt = Storage.init ctxt Lazy_storage_kind.Sapling_state.Id.init\n  end\n\n  module Index = Lazy_storage_kind.Sapling_state.Id\n\n  let rpc_arg = Index.rpc_arg\n\n  module Indexed_context =\n    Make_indexed_subcontext\n      (Make_subcontext (Registered) (Raw_context)\n         (struct\n           let name = [\"index\"]\n         end))\n         (Make_index (Index))\n\n  let remove ctxt n = Indexed_context.remove ctxt n\n\n  let copy ctxt ~from ~to_ = Indexed_context.copy ctxt ~from ~to_\n\n  module Total_bytes =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"total_bytes\"]\n      end)\n      (Encoding.Z)\n\n  module Commitments_size =\n    Make_single_data_storage (Registered) (Indexed_context.Raw_context)\n      (struct\n        let name = [\"commitments_size\"]\n      end)\n      (Encoding.Int64)\n\n  module Memo_size =\n    Make_single_data_storage (Registered) (Indexed_context.Raw_context)\n      (struct\n        let name = [\"memo_size\"]\n      end)\n      (Sapling_repr.Memo_size)\n\n  module Commitments :\n    Non_iterable_indexed_carbonated_data_storage\n      with type t := Raw_context.t * id\n       and type key = int64\n       and type value = Sapling.Hash.t =\n    Make_indexed_carbonated_data_storage\n      (Make_subcontext (Registered) (Indexed_context.Raw_context)\n         (struct\n           let name = [\"commitments\"]\n         end))\n         (Make_index (struct\n           type t = int64\n\n           let rpc_arg =\n             let construct = Int64.to_string in\n             let destruct hash =\n               Int64.of_string_opt hash\n               |> Result.of_option ~error:\"Cannot parse node position\"\n             in\n             RPC_arg.make\n               ~descr:\"The position of a node in a sapling commitment tree\"\n               ~name:\"sapling_node_position\"\n               ~construct\n               ~destruct\n               ()\n\n           let encoding =\n             Data_encoding.def\n               \"sapling_node_position\"\n               ~title:\"Sapling node position\"\n               ~description:\n                 \"The position of a node in a sapling commitment tree\"\n               Data_encoding.int64\n\n           let compare = Compare.Int64.compare\n\n           let path_length = 1\n\n           let to_path c l = Int64.to_string c :: l\n\n           let of_path = function [c] -> Int64.of_string_opt c | _ -> None\n         end))\n      (Sapling.Hash)\n\n  let commitments_init ctx id =\n    Indexed_context.Raw_context.remove (ctx, id) [\"commitments\"]\n    >|= fun (ctx, _id) -> ctx\n\n  module Ciphertexts :\n    Non_iterable_indexed_carbonated_data_storage\n      with type t := Raw_context.t * id\n       and type key = int64\n       and type value = Sapling.Ciphertext.t =\n    Make_indexed_carbonated_data_storage\n      (Make_subcontext (Registered) (Indexed_context.Raw_context)\n         (struct\n           let name = [\"ciphertexts\"]\n         end))\n         (Make_index (struct\n           type t = int64\n\n           let rpc_arg =\n             let construct = Int64.to_string in\n             let destruct hash =\n               Int64.of_string_opt hash\n               |> Result.of_option ~error:\"Cannot parse ciphertext position\"\n             in\n             RPC_arg.make\n               ~descr:\"The position of a sapling ciphertext\"\n               ~name:\"sapling_ciphertext_position\"\n               ~construct\n               ~destruct\n               ()\n\n           let encoding =\n             Data_encoding.def\n               \"sapling_ciphertext_position\"\n               ~title:\"Sapling ciphertext position\"\n               ~description:\"The position of a sapling ciphertext\"\n               Data_encoding.int64\n\n           let compare = Compare.Int64.compare\n\n           let path_length = 1\n\n           let to_path c l = Int64.to_string c :: l\n\n           let of_path = function [c] -> Int64.of_string_opt c | _ -> None\n         end))\n      (Sapling.Ciphertext)\n\n  let ciphertexts_init ctx id =\n    Indexed_context.Raw_context.remove (ctx, id) [\"commitments\"]\n    >|= fun (ctx, _id) -> ctx\n\n  module Nullifiers_size =\n    Make_single_data_storage (Registered) (Indexed_context.Raw_context)\n      (struct\n        let name = [\"nullifiers_size\"]\n      end)\n      (Encoding.Int64)\n\n  (* For sequential access when building a diff *)\n  module Nullifiers_ordered :\n    Non_iterable_indexed_data_storage\n      with type t := Raw_context.t * id\n       and type key = int64\n       and type value = Sapling.Nullifier.t =\n    Make_indexed_data_storage\n      (Make_subcontext (Registered) (Indexed_context.Raw_context)\n         (struct\n           let name = [\"nullifiers_ordered\"]\n         end))\n         (Make_index (struct\n           type t = int64\n\n           let rpc_arg =\n             let construct = Int64.to_string in\n             let destruct hash =\n               Int64.of_string_opt hash\n               |> Result.of_option ~error:\"Cannot parse nullifier position\"\n             in\n             RPC_arg.make\n               ~descr:\"A sapling nullifier position\"\n               ~name:\"sapling_nullifier_position\"\n               ~construct\n               ~destruct\n               ()\n\n           let encoding =\n             Data_encoding.def\n               \"sapling_nullifier_position\"\n               ~title:\"Sapling nullifier position\"\n               ~description:\"Sapling nullifier position\"\n               Data_encoding.int64\n\n           let compare = Compare.Int64.compare\n\n           let path_length = 1\n\n           let to_path c l = Int64.to_string c :: l\n\n           let of_path = function [c] -> Int64.of_string_opt c | _ -> None\n         end))\n      (Sapling.Nullifier)\n\n  (* Check membership in O(1) for verify_update *)\n  module Nullifiers_hashed =\n    Make_carbonated_data_set_storage\n      (Make_subcontext (Registered) (Indexed_context.Raw_context)\n         (struct\n           let name = [\"nullifiers_hashed\"]\n         end))\n         (Make_index (struct\n           type t = Sapling.Nullifier.t\n\n           let encoding = Sapling.Nullifier.encoding\n\n           let of_string hexstring =\n             Option.bind\n               (Hex.to_bytes (`Hex hexstring))\n               (Data_encoding.Binary.of_bytes_opt encoding)\n             |> Result.of_option ~error:\"Cannot parse sapling nullifier\"\n\n           let to_string nf =\n             let b = Data_encoding.Binary.to_bytes_exn encoding nf in\n             let (`Hex hexstring) = Hex.of_bytes b in\n             hexstring\n\n           let rpc_arg =\n             RPC_arg.make\n               ~descr:\"A sapling nullifier\"\n               ~name:\"sapling_nullifier\"\n               ~construct:to_string\n               ~destruct:of_string\n               ()\n\n           let compare = Sapling.Nullifier.compare\n\n           let path_length = 1\n\n           let to_path c l = to_string c :: l\n\n           let of_path = function\n             | [c] -> Result.to_option (of_string c)\n             | _ -> None\n         end))\n\n  let nullifiers_init ctx id =\n    Nullifiers_size.add (ctx, id) Int64.zero >>= fun ctx ->\n    Indexed_context.Raw_context.remove (ctx, id) [\"nullifiers_ordered\"]\n    >>= fun (ctx, id) ->\n    Indexed_context.Raw_context.remove (ctx, id) [\"nullifiers_hashed\"]\n    >|= fun (ctx, _id) -> ctx\n\n  module Roots :\n    Non_iterable_indexed_data_storage\n      with type t := Raw_context.t * id\n       and type key = int32\n       and type value = Sapling.Hash.t =\n    Make_indexed_data_storage\n      (Make_subcontext (Registered) (Indexed_context.Raw_context)\n         (struct\n           let name = [\"roots\"]\n         end))\n         (Make_index (struct\n           type t = int32\n\n           let rpc_arg =\n             let construct = Int32.to_string in\n             let destruct hash =\n               Int32.of_string_opt hash\n               |> Result.of_option ~error:\"Cannot parse nullifier position\"\n             in\n             RPC_arg.make\n               ~descr:\"A sapling root\"\n               ~name:\"sapling_root\"\n               ~construct\n               ~destruct\n               ()\n\n           let encoding =\n             Data_encoding.def\n               \"sapling_root\"\n               ~title:\"Sapling root\"\n               ~description:\"Sapling root\"\n               Data_encoding.int32\n\n           let compare = Compare.Int32.compare\n\n           let path_length = 1\n\n           let to_path c l = Int32.to_string c :: l\n\n           let of_path = function [c] -> Int32.of_string_opt c | _ -> None\n         end))\n      (Sapling.Hash)\n\n  module Roots_pos =\n    Make_single_data_storage (Registered) (Indexed_context.Raw_context)\n      (struct\n        let name = [\"roots_pos\"]\n      end)\n      (Encoding.Int32)\n\n  module Roots_level =\n    Make_single_data_storage (Registered) (Indexed_context.Raw_context)\n      (struct\n        let name = [\"roots_level\"]\n      end)\n      (Raw_level_repr)\nend\n\nmodule Public_key_hash = struct\n  open Signature\n  include Signature.Public_key_hash\n  module Path_Ed25519 = Path_encoding.Make_hex (Ed25519.Public_key_hash)\n  module Path_Secp256k1 = Path_encoding.Make_hex (Secp256k1.Public_key_hash)\n  module Path_P256 = Path_encoding.Make_hex (P256.Public_key_hash)\n\n  let to_path (key : public_key_hash) l =\n    match key with\n    | Ed25519 h -> (\n        match Path_Ed25519.to_path h l with\n        | [s] -> [\"ed25519\"; s]\n        | _ -> assert false)\n    | Secp256k1 h -> (\n        match Path_Secp256k1.to_path h l with\n        | [s] -> [\"secp256k1\"; s]\n        | _ -> assert false)\n    | P256 h -> (\n        match Path_P256.to_path h l with\n        | [s] -> [\"p256\"; s]\n        | _ -> assert false)\n\n  let of_path : _ -> public_key_hash option = function\n    | \"ed25519\" :: rest -> (\n        match Path_Ed25519.of_path rest with\n        | Some pkh -> Some (Ed25519 pkh)\n        | None -> None)\n    | \"secp256k1\" :: rest -> (\n        match Path_Secp256k1.of_path rest with\n        | Some pkh -> Some (Secp256k1 pkh)\n        | None -> None)\n    | \"p256\" :: rest -> (\n        match Path_P256.of_path rest with\n        | Some pkh -> Some (P256 pkh)\n        | None -> None)\n    | _ -> None\n\n  let path_length =\n    let l1 = Path_Ed25519.path_length\n    and l2 = Path_Secp256k1.path_length\n    and l3 = Path_P256.path_length in\n    assert (match (l1, l2, l3) with (1, 1, 1) -> true | _ -> false) ;\n    2\nend\n\nmodule Public_key_hash_index = Make_index (Public_key_hash)\n\nmodule Protocol_hash = struct\n  include Protocol_hash\n  include Path_encoding.Make_hex (Protocol_hash)\nend\n\nmodule Delegates =\n  Make_data_set_storage\n    (Make_subcontext (Registered) (Raw_context)\n       (struct\n         let name = [\"delegates\"]\n       end))\n       (Public_key_hash_index)\n\nmodule Legacy_active_delegates_with_rolls =\n  Make_data_set_storage\n    (Make_subcontext (Registered) (Raw_context)\n       (struct\n         let name = [\"active_delegates_with_rolls\"]\n       end))\n       (Public_key_hash_index)\n\nmodule Legacy_delegates_with_frozen_balance_index =\n  Make_indexed_subcontext\n    (Make_subcontext (Registered) (Raw_context)\n       (struct\n         let name = [\"delegates_with_frozen_balance\"]\n       end))\n       (Make_index (Cycle_repr.Index))\n\nmodule Legacy_delegates_with_frozen_balance =\n  Make_data_set_storage\n    (Legacy_delegates_with_frozen_balance_index.Raw_context)\n    (Public_key_hash_index)\n\n(** Per cycle storage *)\n\ntype slashed_level = {for_double_endorsing : bool; for_double_baking : bool}\n\nmodule Slashed_level = struct\n  type t = slashed_level\n\n  let encoding =\n    let open Data_encoding in\n    conv\n      (fun {for_double_endorsing; for_double_baking} ->\n        (for_double_endorsing, for_double_baking))\n      (fun (for_double_endorsing, for_double_baking) ->\n        {for_double_endorsing; for_double_baking})\n      (obj2 (req \"for_double_endorsing\" bool) (req \"for_double_baking\" bool))\nend\n\nmodule Cycle = struct\n  module Indexed_context =\n    Make_indexed_subcontext\n      (Make_subcontext (Registered) (Raw_context)\n         (struct\n           let name = [\"cycle\"]\n         end))\n         (Make_index (Cycle_repr.Index))\n\n  module Slashed_deposits =\n    Make_indexed_data_storage\n      (Make_subcontext (Registered) (Indexed_context.Raw_context)\n         (struct\n           let name = [\"slashed_deposits\"]\n         end))\n         (Pair (Make_index (Raw_level_repr.Index)) (Public_key_hash_index))\n            (Slashed_level)\n\n  module Last_roll_legacy =\n    Make_indexed_data_storage\n      (Make_subcontext (Ghost) (Indexed_context.Raw_context)\n         (struct\n           let name = [\"last_roll\"]\n         end))\n         (Int31_index)\n      (Roll_repr_legacy)\n\n  module Roll_snapshot_legacy =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"roll_snapshot\"]\n      end)\n      (Encoding.UInt16)\n\n  module Selected_stake_distribution =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"selected_stake_distribution\"]\n      end)\n      (struct\n        type t = (Signature.Public_key_hash.t * Tez_repr.t) list\n\n        let encoding =\n          Data_encoding.(\n            Variable.list\n              (obj2\n                 (req \"baker\" Signature.Public_key_hash.encoding)\n                 (req \"active_stake\" Tez_repr.encoding)))\n      end)\n\n  module Total_active_stake =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"total_active_stake\"]\n      end)\n      (Tez_repr)\n\n  let public_key_with_ghost_hash_encoding =\n    Data_encoding.conv\n      fst\n      (fun x -> (x, Signature.Public_key.hash x))\n      Signature.Public_key.encoding\n\n  module Delegate_sampler_state =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"delegate_sampler_state\"]\n      end)\n      (struct\n        type t =\n          (Signature.Public_key.t * Signature.Public_key_hash.t) Sampler.t\n\n        let encoding = Sampler.encoding public_key_with_ghost_hash_encoding\n      end)\n\n  type unrevealed_nonce = {\n    nonce_hash : Nonce_hash.t;\n    delegate : Signature.Public_key_hash.t;\n  }\n\n  type nonce_status =\n    | Unrevealed of unrevealed_nonce\n    | Revealed of Seed_repr.nonce\n\n  let nonce_status_encoding =\n    let open Data_encoding in\n    union\n      [\n        case\n          (Tag 0)\n          ~title:\"Unrevealed\"\n          (tup2 Nonce_hash.encoding Signature.Public_key_hash.encoding)\n          (function\n            | Unrevealed {nonce_hash; delegate} -> Some (nonce_hash, delegate)\n            | _ -> None)\n          (fun (nonce_hash, delegate) -> Unrevealed {nonce_hash; delegate});\n        case\n          (Tag 1)\n          ~title:\"Revealed\"\n          Seed_repr.nonce_encoding\n          (function Revealed nonce -> Some nonce | _ -> None)\n          (fun nonce -> Revealed nonce);\n      ]\n\n  module Nonce =\n    Make_indexed_data_storage\n      (Make_subcontext (Registered) (Indexed_context.Raw_context)\n         (struct\n           let name = [\"nonces\"]\n         end))\n         (Make_index (Raw_level_repr.Index))\n         (struct\n           type t = nonce_status\n\n           let encoding = nonce_status_encoding\n         end)\n\n  let nonce_status_encoding_legacy =\n    let open Data_encoding in\n    union\n      [\n        case\n          (Tag 0)\n          ~title:\"Unrevealed\"\n          (tup4\n             Nonce_hash.encoding\n             Signature.Public_key_hash.encoding\n             Tez_repr.encoding\n             Tez_repr.encoding)\n          (function\n            | Unrevealed _ ->\n                assert false (* only used in read only for migration *)\n            | _ -> None)\n          (fun (nonce_hash, delegate, _, _) ->\n            Unrevealed {nonce_hash; delegate});\n        case\n          (Tag 1)\n          ~title:\"Revealed\"\n          Seed_repr.nonce_encoding\n          (function\n            | Revealed _ ->\n                assert false (* only used in read only for migration *)\n            | _ -> None)\n          (fun nonce -> Revealed nonce);\n      ]\n\n  module Nonce_legacy =\n    Make_indexed_data_storage\n      (Make_subcontext (Ghost) (Indexed_context.Raw_context)\n         (struct\n           let name = [\"nonces\"]\n         end))\n         (Make_index (Raw_level_repr.Index))\n         (struct\n           type t = nonce_status\n\n           let encoding = nonce_status_encoding_legacy\n         end)\n\n  module Seed =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"random_seed\"]\n      end)\n      (struct\n        type t = Seed_repr.seed\n\n        let encoding = Seed_repr.seed_encoding\n      end)\nend\n\nmodule Slashed_deposits = Cycle.Slashed_deposits\n\nmodule Stake = struct\n  module Staking_balance =\n    Make_indexed_data_snapshotable_storage\n      (Make_subcontext (Registered) (Raw_context)\n         (struct\n           let name = [\"staking_balance\"]\n         end))\n         (Int31_index)\n      (Public_key_hash_index)\n      (Tez_repr)\n\n  module Active_delegate_with_one_roll =\n    Make_indexed_data_snapshotable_storage\n      (Make_subcontext (Registered) (Raw_context)\n         (struct\n           let name = [\"active_delegate_with_one_roll\"]\n         end))\n         (Int31_index)\n      (Public_key_hash_index)\n      (struct\n        type t = unit\n\n        let encoding = Data_encoding.unit\n      end)\n\n  module Selected_distribution_for_cycle = Cycle.Selected_stake_distribution\n\n  module Last_snapshot =\n    Make_single_data_storage (Registered) (Raw_context)\n      (struct\n        let name = [\"last_snapshot\"]\n      end)\n      (Encoding.UInt16)\nend\n\nmodule Total_active_stake = Cycle.Total_active_stake\nmodule Delegate_sampler_state = Cycle.Delegate_sampler_state\n\nmodule Roll_legacy = struct\n  module Raw_context =\n    Make_subcontext (Ghost) (Raw_context)\n      (struct\n        let name = [\"rolls\"]\n      end)\n\n  module Indexed_context =\n    Make_indexed_subcontext\n      (Make_subcontext (Registered) (Raw_context)\n         (struct\n           let name = [\"index\"]\n         end))\n         (Make_index (Roll_repr_legacy.Index))\n\n  module Next =\n    Make_single_data_storage (Registered) (Raw_context)\n      (struct\n        let name = [\"next\"]\n      end)\n      (Roll_repr_legacy)\n\n  module Limbo =\n    Make_single_data_storage (Registered) (Raw_context)\n      (struct\n        let name = [\"limbo\"]\n      end)\n      (Roll_repr_legacy)\n\n  module Delegate_roll_list =\n    Wrap_indexed_data_storage\n      (Contract.Roll_list_legacy)\n      (struct\n        type t = Signature.Public_key_hash.t\n\n        let wrap = Contract_repr.implicit_contract\n\n        let unwrap = Contract_repr.is_implicit\n      end)\n\n  module Successor =\n    Indexed_context.Make_map\n      (struct\n        let name = [\"successor\"]\n      end)\n      (Roll_repr_legacy)\n\n  module Delegate_change =\n    Wrap_indexed_data_storage\n      (Contract.Change_legacy)\n      (struct\n        type t = Signature.Public_key_hash.t\n\n        let wrap = Contract_repr.implicit_contract\n\n        let unwrap = Contract_repr.is_implicit\n      end)\n\n  module Snapshoted_owner_index : INDEX with type t = Cycle_repr.t * int =\n  struct\n    type t = Cycle_repr.t * int\n\n    let path_length = Cycle_repr.Index.path_length + 1\n\n    let to_path (c, n) s = Cycle_repr.Index.to_path c (string_of_int n :: s)\n\n    let of_path l =\n      match Misc.take Cycle_repr.Index.path_length l with\n      | None | Some (_, ([] | _ :: _ :: _)) -> None\n      | Some (l1, [l2]) -> (\n          match (Cycle_repr.Index.of_path l1, int_of_string_opt l2) with\n          | (None, _) | (_, None) -> None\n          | (Some c, Some i) -> Some (c, i))\n\n    type 'a ipath = ('a * Cycle_repr.t) * int\n\n    let left_args =\n      Storage_description.One\n        {\n          rpc_arg = Cycle_repr.rpc_arg;\n          encoding = Cycle_repr.encoding;\n          compare = Cycle_repr.compare;\n        }\n\n    let right_args =\n      Storage_description.One\n        {\n          rpc_arg = RPC_arg.int;\n          encoding = Data_encoding.int31;\n          compare = Compare.Int.compare;\n        }\n\n    let args = Storage_description.(Pair (left_args, right_args))\n  end\n\n  module Owner =\n    Make_indexed_data_snapshotable_storage\n      (Make_subcontext (Registered) (Raw_context)\n         (struct\n           let name = [\"owner\"]\n         end))\n         (Snapshoted_owner_index)\n      (Make_index (Roll_repr_legacy.Index))\n      (Signature.Public_key)\n\n  module Snapshot_for_cycle = Cycle.Roll_snapshot_legacy\n  module Last_for_snapshot = Cycle.Last_roll_legacy\n\n  let clear = Indexed_context.clear\nend\n\n(** Votes *)\n\nmodule Vote = struct\n  module Raw_context =\n    Make_subcontext (Registered) (Raw_context)\n      (struct\n        let name = [\"votes\"]\n      end)\n\n  module Pred_period_kind =\n    Make_single_data_storage (Registered) (Raw_context)\n      (struct\n        let name = [\"pred_period_kind\"]\n      end)\n      (struct\n        type t = Voting_period_repr.kind\n\n        let encoding = Voting_period_repr.kind_encoding\n      end)\n\n  module Current_period =\n    Make_single_data_storage (Registered) (Raw_context)\n      (struct\n        let name = [\"current_period\"]\n      end)\n      (struct\n        type t = Voting_period_repr.t\n\n        let encoding = Voting_period_repr.encoding\n      end)\n\n  module Participation_ema =\n    Make_single_data_storage (Registered) (Raw_context)\n      (struct\n        let name = [\"participation_ema\"]\n      end)\n      (Encoding.Int32)\n\n  module Current_proposal =\n    Make_single_data_storage (Registered) (Raw_context)\n      (struct\n        let name = [\"current_proposal\"]\n      end)\n      (Protocol_hash)\n\n  module Listings_size =\n    Make_single_data_storage (Registered) (Raw_context)\n      (struct\n        let name = [\"listings_size\"]\n      end)\n      (Encoding.Int32)\n\n  module Listings =\n    Make_indexed_data_storage\n      (Make_subcontext (Registered) (Raw_context)\n         (struct\n           let name = [\"listings\"]\n         end))\n         (Public_key_hash_index)\n      (Encoding.Int32)\n\n  module Proposals =\n    Make_data_set_storage\n      (Make_subcontext (Registered) (Raw_context)\n         (struct\n           let name = [\"proposals\"]\n         end))\n         (Pair (Make_index (Protocol_hash)) (Public_key_hash_index))\n\n  module Proposals_count =\n    Make_indexed_data_storage\n      (Make_subcontext (Registered) (Raw_context)\n         (struct\n           let name = [\"proposals_count\"]\n         end))\n         (Public_key_hash_index)\n      (Encoding.UInt16)\n\n  module Ballots =\n    Make_indexed_data_storage\n      (Make_subcontext (Registered) (Raw_context)\n         (struct\n           let name = [\"ballots\"]\n         end))\n         (Public_key_hash_index)\n      (struct\n        type t = Vote_repr.ballot\n\n        let encoding = Vote_repr.ballot_encoding\n      end)\nend\n\nmodule type FOR_CYCLE = sig\n  val init :\n    Raw_context.t ->\n    Cycle_repr.t ->\n    Seed_repr.seed ->\n    Raw_context.t tzresult Lwt.t\n\n  val mem : Raw_context.t -> Cycle_repr.t -> bool Lwt.t\n\n  val get : Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t\n\n  val remove_existing :\n    Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t\nend\n\n(** Seed *)\n\nmodule Seed = struct\n  type unrevealed_nonce = Cycle.unrevealed_nonce = {\n    nonce_hash : Nonce_hash.t;\n    delegate : Signature.Public_key_hash.t;\n  }\n\n  type nonce_status = Cycle.nonce_status =\n    | Unrevealed of unrevealed_nonce\n    | Revealed of Seed_repr.nonce\n\n  module Nonce :\n    Non_iterable_indexed_data_storage\n      with type key := Level_repr.t\n       and type value := nonce_status\n       and type t := Raw_context.t = struct\n    open Level_repr\n\n    type context = Raw_context.t\n\n    let mem ctxt (l : Level_repr.t) = Cycle.Nonce.mem (ctxt, l.cycle) l.level\n\n    let get ctxt (l : Level_repr.t) = Cycle.Nonce.get (ctxt, l.cycle) l.level\n\n    let find ctxt (l : Level_repr.t) = Cycle.Nonce.find (ctxt, l.cycle) l.level\n\n    let update ctxt (l : Level_repr.t) v =\n      Cycle.Nonce.update (ctxt, l.cycle) l.level v\n\n    let init ctxt (l : Level_repr.t) v =\n      Cycle.Nonce.init (ctxt, l.cycle) l.level v\n\n    let add ctxt (l : Level_repr.t) v =\n      Cycle.Nonce.add (ctxt, l.cycle) l.level v\n\n    let add_or_remove ctxt (l : Level_repr.t) v =\n      Cycle.Nonce.add_or_remove (ctxt, l.cycle) l.level v\n\n    let remove_existing ctxt (l : Level_repr.t) =\n      Cycle.Nonce.remove_existing (ctxt, l.cycle) l.level\n\n    let remove ctxt (l : Level_repr.t) =\n      Cycle.Nonce.remove (ctxt, l.cycle) l.level\n  end\n\n  module Nonce_legacy = struct\n    open Level_repr\n\n    type context = Raw_context.t\n\n    let mem ctxt (l : Level_repr.t) =\n      Cycle.Nonce_legacy.mem (ctxt, l.cycle) l.level\n\n    let get ctxt (l : Level_repr.t) =\n      Cycle.Nonce_legacy.get (ctxt, l.cycle) l.level\n\n    let find ctxt (l : Level_repr.t) =\n      Cycle.Nonce_legacy.find (ctxt, l.cycle) l.level\n\n    let update ctxt (l : Level_repr.t) v =\n      Cycle.Nonce_legacy.update (ctxt, l.cycle) l.level v\n\n    let init ctxt (l : Level_repr.t) v =\n      Cycle.Nonce_legacy.init (ctxt, l.cycle) l.level v\n\n    let add ctxt (l : Level_repr.t) v =\n      Cycle.Nonce_legacy.add (ctxt, l.cycle) l.level v\n\n    let add_or_remove ctxt (l : Level_repr.t) v =\n      Cycle.Nonce_legacy.add_or_remove (ctxt, l.cycle) l.level v\n\n    let remove_existing ctxt (l : Level_repr.t) =\n      Cycle.Nonce_legacy.remove_existing (ctxt, l.cycle) l.level\n\n    let remove ctxt (l : Level_repr.t) =\n      Cycle.Nonce_legacy.remove (ctxt, l.cycle) l.level\n  end\n\n  module For_cycle : FOR_CYCLE = Cycle.Seed\nend\n\n(** Commitments *)\n\nmodule Commitments =\n  Make_indexed_data_storage\n    (Make_subcontext (Registered) (Raw_context)\n       (struct\n         let name = [\"commitments\"]\n       end))\n       (Make_index (Blinded_public_key_hash.Index))\n       (Tez_repr)\n\n(** Ramp up rewards... *)\n\nmodule Ramp_up = struct\n  type reward = {\n    baking_reward_fixed_portion : Tez_repr.t;\n    baking_reward_bonus_per_slot : Tez_repr.t;\n    endorsing_reward_per_slot : Tez_repr.t;\n  }\n\n  module Rewards =\n    Make_indexed_data_storage\n      (Make_subcontext (Registered) (Raw_context)\n         (struct\n           let name = [\"ramp_up\"; \"rewards\"]\n         end))\n         (Make_index (Cycle_repr.Index))\n         (struct\n           type t = reward\n\n           let encoding =\n             Data_encoding.(\n               conv\n                 (fun {\n                        baking_reward_fixed_portion;\n                        baking_reward_bonus_per_slot;\n                        endorsing_reward_per_slot;\n                      } ->\n                   ( baking_reward_fixed_portion,\n                     baking_reward_bonus_per_slot,\n                     endorsing_reward_per_slot ))\n                 (fun ( baking_reward_fixed_portion,\n                        baking_reward_bonus_per_slot,\n                        endorsing_reward_per_slot ) ->\n                   {\n                     baking_reward_fixed_portion;\n                     baking_reward_bonus_per_slot;\n                     endorsing_reward_per_slot;\n                   })\n                 (obj3\n                    (req \"baking_reward_fixed_portion\" Tez_repr.encoding)\n                    (req \"baking_reward_bonus_per_slot\" Tez_repr.encoding)\n                    (req \"endorsing_reward_per_slot\" Tez_repr.encoding)))\n         end)\nend\n\nmodule Pending_migration = struct\n  module Balance_updates =\n    Make_single_data_storage (Registered) (Raw_context)\n      (struct\n        let name = [\"pending_migration_balance_updates\"]\n      end)\n      (struct\n        type t = Receipt_repr.balance_updates\n\n        let encoding = Receipt_repr.balance_updates_encoding\n      end)\n\n  module Operation_results =\n    Make_single_data_storage (Registered) (Raw_context)\n      (struct\n        let name = [\"pending_migration_operation_results\"]\n      end)\n      (struct\n        type t = Migration_repr.origination_result list\n\n        let encoding = Migration_repr.origination_result_list_encoding\n      end)\n\n  let remove ctxt =\n    let balance_updates ctxt =\n      Balance_updates.find ctxt >>=? function\n      | Some balance_updates ->\n          Balance_updates.remove ctxt >>= fun ctxt ->\n          (* When applying balance updates in a migration, we must attach receipts.\n             The balance updates returned from here will be applied in the first\n             block of the new protocol. *)\n          return (ctxt, balance_updates)\n      | None -> return (ctxt, [])\n    in\n    let operation_results ctxt =\n      Operation_results.find ctxt >>=? function\n      | Some operation_results ->\n          Operation_results.remove ctxt >>= fun ctxt ->\n          return (ctxt, operation_results)\n      | None -> return (ctxt, [])\n    in\n    balance_updates ctxt >>=? fun (ctxt, balance_updates) ->\n    operation_results ctxt >>=? fun (ctxt, operation_results) ->\n    return (ctxt, balance_updates, operation_results)\nend\n\nmodule Liquidity_baking = struct\n  module Escape_ema =\n    Make_single_data_storage (Registered) (Raw_context)\n      (struct\n        let name = [\"liquidity_baking_escape_ema\"]\n      end)\n      (Encoding.Int32)\n\n  module Cpmm_address =\n    Make_single_data_storage (Registered) (Raw_context)\n      (struct\n        let name = [\"liquidity_baking_cpmm_address\"]\n      end)\n      (Contract_repr)\nend\n\nmodule Ticket_balance = struct\n  module Name = struct\n    let name = [\"ticket_balance\"]\n  end\n\n  module Sub_context = Make_subcontext (Registered) (Raw_context) (Name)\n  module Index = Make_index (Script_expr_hash)\n  module Table =\n    Make_indexed_carbonated_data_storage (Sub_context) (Index) (Encoding.Z)\nend\n" ;
                } ;
                { name = "Cache_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(**\n\n     Frequently used data should be kept in memory and persisted along a\n     chain of blocks. The caching mechanism allows the economic protocol\n     to declare such data and to rely on a Least Recently Used strategy\n     to keep the cache size under a fixed limit.\n\n     Take a look at {!Environment_cache} and {!Environment_context}\n     for additional implementation details about the protocol cache.\n\n     The protocol has two main kinds of interaction with the cache:\n\n     1. It is responsible for setting up the cache with appropriate\n        parameter values and callbacks. It must also compute cache nonces\n        to give the shell enough information to properly synchronize the\n        in-memory cache with the block contexts and protocol upgrades.\n        A typical place where this happens is {!Apply}.\n        This aspect must be implemented using {!Cache.Admin}.\n\n     2. It can exploit the cache to retrieve, to insert, and to update\n        cached values from the in-memory cache. The basic idea is to\n        avoid recomputing values from scratch at each block when they are\n        frequently used. {!Script_cache} is an example of such usage.\n        This aspect must be implemented using {!Cache.Interface}.\n\n  *)\n\n(** Size for subcaches and values of the cache. *)\ntype size = int\n\n(** Index type to index caches. *)\ntype index = int\n\n(**\n\n     The following module acts on the whole cache, not on a specific\n     sub-cache, unlike {!Interface}. It is used to administrate the\n     protocol cache, e.g., to maintain the cache in a consistent state\n     with respect to the chain. This module is typically used by\n     low-level layers of the protocol and by the shell.\n\n  *)\nmodule Admin : sig\n  (** A key uniquely identifies a cached [value] in some subcache. *)\n  type key\n\n  (** Cached values. *)\n  type value\n\n  (** [pp fmt ctxt] is a pretty printter for the [cache] of [ctxt]. *)\n  val pp : Format.formatter -> Raw_context.t -> unit\n\n  (** [set_cache_layout ctxt layout] sets the caches of [ctxt] to\n     comply with given [layout]. If there was already a cache in\n     [ctxt], it is erased by the new layout.\n\n     In that case, a fresh collection of empty caches is reconstructed\n     from the new [layout]. Notice that cache [key]s are invalidated\n     in that case, i.e. [find t k] will return [None]. *)\n  val set_cache_layout : Raw_context.t -> size list -> Raw_context.t Lwt.t\n\n  (** [sync ctxt ~cache_nonce] updates the context with the domain of\n     the cache computed so far. Such function is expected to be called\n     at the end of the validation of a block, when there is no more\n     accesses to the cache.\n\n     [cache_nonce] identifies the block that introduced new cache\n     entries. The nonce should identify uniquely the block which\n     modifies this value. It cannot be the block hash for circularity\n     reasons: The value of the nonce is stored onto the context and\n     consequently influences the context hash of the very same\n     block. Such nonce cannot be determined by the shell and its\n     computation is delegated to the economic protocol. *)\n  val sync : Raw_context.t -> cache_nonce:Bytes.t -> Raw_context.t Lwt.t\n\n  (** [clear ctxt] removes all cache entries. *)\n  val clear : Raw_context.t -> Raw_context.t\n\n  (** {3 Cache helpers for RPCs} *)\n\n  (** [future_cache_expectation ctxt ~time_in_blocks] returns [ctxt] except\n      that the entries of the caches that are presumably too old to\n      still be in the caches in [n_blocks] are removed.\n\n      This function is based on a heuristic. The context maintains\n      the median of the number of removed entries: this number is\n      multipled by `n_blocks` to determine the entries that are\n      likely to be removed in `n_blocks`. *)\n  val future_cache_expectation :\n    Raw_context.t -> time_in_blocks:int -> Raw_context.t\n\n  (** [cache_size ctxt ~cache_index] returns an overapproximation of\n       the size of the cache. Returns [None] if [cache_index] is\n       greater than the number of subcaches declared by the cache\n       layout. *)\n  val cache_size : Raw_context.t -> cache_index:int -> size option\n\n  (** [cache_size_limit ctxt ~cache_index] returns the maximal size of\n       the cache indexed by [cache_index]. Returns [None] if\n       [cache_index] is greater than the number of subcaches declared\n       by the cache layout. *)\n  val cache_size_limit : Raw_context.t -> cache_index:int -> size option\n\n  (** [value_of_key ctxt k] interprets the functions introduced by\n     [register] to construct a cacheable value for a key [k]. *)\n  val value_of_key :\n    Raw_context.t -> Context.Cache.key -> Context.Cache.value tzresult Lwt.t\nend\n\n(** A client uses a unique namespace (represented as a string\n     without '@') to avoid collision with the keys of other\n     clients. *)\ntype namespace = private string\n\n(** [create_namespace str] creates a valid namespace from [str]\n\n    @raise Invalid_argument if [str] contains '@'\n *)\nval create_namespace : string -> namespace\n\n(** A key is fully determined by a namespace and an identifier. *)\ntype identifier = string\n\n(**\n     To use the cache, a client must implement the [CLIENT]\n     interface.\n\n  *)\nmodule type CLIENT = sig\n  (** The type of value to be stored in the cache. *)\n  type cached_value\n\n  (** The client must declare the index of the subcache where its\n       values shall live. [cache_index] must be between [0] and\n       [List.length Constants_repr.cache_layout - 1]. *)\n  val cache_index : index\n\n  (** The client must declare a namespace. This namespace must\n        be unique. Otherwise, the program stops.\n        A namespace cannot contain '@'. *)\n  val namespace : namespace\n\n  (** [value_of_identifier id] builds the cached value identified by\n       [id]. This function is called when the subcache is loaded into\n       memory from the on-disk representation of its domain.\n\n       An error during the execution of this function is fatal as\n       witnessed by its type: an error embedded in a [tzresult] is not\n       supposed to be caught by the protocol. *)\n  val value_of_identifier :\n    Raw_context.t -> identifier -> cached_value tzresult Lwt.t\nend\n\n(**\n\n     An [INTERFACE] to the subcache where keys live in a given [namespace].\n\n  *)\nmodule type INTERFACE = sig\n  (** The type of value to be stored in the cache. *)\n  type cached_value\n\n  (** [update ctxt i (Some (e, size))] returns a context where the\n       value [e] of given [size] is associated to identifier [i] in\n       the subcache. If [i] is already in the subcache, the cache\n       entry is updated.\n\n        [update ctxt i None] removes [i] from the subcache. *)\n  val update :\n    Raw_context.t ->\n    identifier ->\n    (cached_value * size) option ->\n    Raw_context.t tzresult\n\n  (** [find ctxt i = Some v] if [v] is the value associated to [i]\n       in the subcache. Returns [None] if there is no such value in\n       the subcache. This function is in the Lwt monad because if the\n       value may have not been constructed (see the lazy loading\n       mode in {!Environment_context}), it is constructed on the fly. *)\n  val find : Raw_context.t -> identifier -> cached_value option tzresult Lwt.t\n\n  (** [list_identifiers ctxt] returns the list of the\n       identifiers of the cached values along with their respective\n       size. The returned list is sorted in terms of their age in the\n       cache, the oldest coming first. *)\n  val list_identifiers : Raw_context.t -> (string * int) list\n\n  (** [identifier_rank ctxt identifier] returns the number of cached values\n       older than the one of [identifier]; or, [None] if the [identifier] has\n       no associated value in the subcache. *)\n  val identifier_rank : Raw_context.t -> string -> int option\n\n  (** [size ctxt] returns an overapproximation of the subcache size\n        (in bytes). *)\n  val size : Raw_context.t -> int\n\n  (** [size_limit ctxt] returns the maximal size of the subcache\n        (in bytes). *)\n  val size_limit : Raw_context.t -> int\nend\n\n(** [register_exn client] produces an [Interface] specific to a\n     given [client]. This function can fail if [client] does not\n     respect the invariant declared in the documentation of\n     {!CLIENT}. *)\nval register_exn :\n  (module CLIENT with type cached_value = 'a) ->\n  (module INTERFACE with type cached_value = 'a)\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nmodule Cache_costs = struct\n  module S = Saturation_repr\n\n  (* Computed by typing the contract\n     \"{parameter unit; storage unit; code FAILWITH}\"\n     and evaluating\n     [(8 * Obj.reachable_words (Obj.repr typed_script))]\n     where [typed_script] is of type [ex_script] *)\n  let minimal_size_of_typed_contract_in_bytes = 688\n\n  let approximate_cardinal bytes =\n    S.safe_int (bytes / minimal_size_of_typed_contract_in_bytes)\n\n  let log2 x = S.safe_int (1 + S.numbits x)\n\n  let cache_update_constant = S.safe_int 600\n\n  let cache_update_coeff = S.safe_int 57\n\n  (* Cost of calling [Environment_cache.update]. *)\n  let cache_update ~cache_size_in_bytes =\n    let approx_card = approximate_cardinal cache_size_in_bytes in\n    Gas_limit_repr.atomic_step_cost\n      S.(add cache_update_constant (mul cache_update_coeff (log2 approx_card)))\n\n  (* Cost of calling [Environment_cache.find].\n     This overapproximates [cache_find] slightly. *)\n  let cache_find = cache_update\nend\n\ntype index = int\n\ntype size = int\n\ntype identifier = string\n\ntype namespace = string\n\nlet compare_namespace = Compare.String.compare\n\ntype internal_identifier = {namespace : namespace; id : identifier}\n\nlet separator = '@'\n\nlet sanitize namespace =\n  if String.contains namespace separator then\n    invalid_arg\n      (Format.asprintf\n         \"Invalid cache namespace: '%s'. Character %c is forbidden.\"\n         namespace\n         separator)\n  else namespace\n\nlet create_namespace = sanitize\n\nlet string_of_internal_identifier {namespace; id} =\n  namespace ^ String.make 1 separator ^ id\n\nlet internal_identifier_of_string raw =\n  match String.index_opt raw separator with\n  | None -> assert false\n  | Some index ->\n      {\n        (* We do not need to call sanitize here since we stop at the first '@'\n            from index 0. It is a guarantee that there is no '@' between 0 and\n           (index - 1 ). *)\n        namespace = String.sub raw 0 index;\n        id =\n          (let delim_idx = index + 1 in\n           String.sub raw delim_idx (String.length raw - delim_idx));\n      }\n\nlet internal_identifier_of_key key =\n  let raw = Raw_context.Cache.identifier_of_key key in\n  internal_identifier_of_string raw\n\nlet key_of_internal_identifier ~cache_index identifier =\n  let raw = string_of_internal_identifier identifier in\n  Raw_context.Cache.key_of_identifier ~cache_index raw\n\nlet make_key =\n  let namespaces = ref [] in\n  fun ~cache_index ~namespace ->\n    if List.mem ~equal:String.equal namespace !namespaces then\n      invalid_arg\n        (Format.sprintf \"Cache key namespace %s already exist.\" namespace)\n    else (\n      namespaces := namespace :: !namespaces ;\n      fun ~id ->\n        let identifier = {namespace; id} in\n        key_of_internal_identifier ~cache_index identifier)\n\nmodule NamespaceMap = Map.Make (struct\n  type t = namespace\n\n  let compare = compare_namespace\nend)\n\ntype partial_key_handler =\n  Raw_context.t -> string -> Context.Cache.value tzresult Lwt.t\n\nlet value_of_key_handlers : partial_key_handler NamespaceMap.t ref =\n  ref NamespaceMap.empty\n\nmodule Admin = struct\n  include Raw_context.Cache\n\n  let list_keys context ~cache_index =\n    Raw_context.Cache.list_keys context ~cache_index\n\n  let key_rank context key = Raw_context.Cache.key_rank context key\n\n  let value_of_key ctxt key =\n    (* [value_of_key] is a maintenance operation: it is typically run\n       when a node reboots. For this reason, this operation is not\n       carbonated. *)\n    let ctxt = Raw_context.set_gas_unlimited ctxt in\n    let {namespace; id} = internal_identifier_of_key key in\n    match NamespaceMap.find namespace !value_of_key_handlers with\n    | Some value_of_key -> value_of_key ctxt id\n    | None ->\n        failwith\n          (Format.sprintf \"No handler for key `%s%c%s'\" namespace separator id)\nend\n\nmodule type CLIENT = sig\n  val cache_index : int\n\n  val namespace : namespace\n\n  type cached_value\n\n  val value_of_identifier :\n    Raw_context.t -> identifier -> cached_value tzresult Lwt.t\nend\n\nmodule type INTERFACE = sig\n  type cached_value\n\n  val update :\n    Raw_context.t ->\n    identifier ->\n    (cached_value * int) option ->\n    Raw_context.t tzresult\n\n  val find : Raw_context.t -> identifier -> cached_value option tzresult Lwt.t\n\n  val list_identifiers : Raw_context.t -> (identifier * int) list\n\n  val identifier_rank : Raw_context.t -> identifier -> int option\n\n  val size : Raw_context.t -> size\n\n  val size_limit : Raw_context.t -> size\nend\n\nlet register_exn (type cvalue)\n    (module C : CLIENT with type cached_value = cvalue) :\n    (module INTERFACE with type cached_value = cvalue) =\n  if\n    Compare.Int.(C.cache_index < 0)\n    || Compare.List_length_with.(Constants_repr.cache_layout <= C.cache_index)\n  then invalid_arg \"Cache index is invalid\" ;\n  let mk = make_key ~cache_index:C.cache_index ~namespace:C.namespace in\n  (module struct\n    type cached_value = C.cached_value\n\n    type Admin.value += K of cached_value\n\n    let () =\n      let voi ctxt i =\n        C.value_of_identifier ctxt i >>=? fun v -> return (K v)\n      in\n      value_of_key_handlers :=\n        NamespaceMap.add C.namespace voi !value_of_key_handlers\n\n    let size ctxt =\n      Option.value ~default:max_int\n      @@ Admin.cache_size ctxt ~cache_index:C.cache_index\n\n    let size_limit ctxt =\n      Option.value ~default:max_int\n      @@ Admin.cache_size_limit ctxt ~cache_index:C.cache_index\n\n    let update ctxt id v =\n      let cache_size_in_bytes = size ctxt in\n      Raw_context.consume_gas\n        ctxt\n        (Cache_costs.cache_update ~cache_size_in_bytes)\n      >|? fun ctxt ->\n      let v = Option.map (fun (v, size) -> (K v, size)) v in\n      Admin.update ctxt (mk ~id) v\n\n    let find ctxt id =\n      let cache_size_in_bytes = size ctxt in\n      Raw_context.consume_gas ctxt (Cache_costs.cache_find ~cache_size_in_bytes)\n      >>?= fun ctxt ->\n      Admin.find ctxt (mk ~id) >>= function\n      | None -> return None\n      | Some (K v) -> return (Some v)\n      | _ ->\n          (* This execution path is impossible because all the keys of\n             C's namespace (which is unique to C) are constructed with\n             [K]. This [assert false] could have been pushed into the\n             environment in exchange for extra complexity. The\n             argument that justifies this [assert false] seems\n             simple enough to keep the current design though. *)\n          assert false\n\n    let list_identifiers ctxt =\n      Admin.list_keys ctxt ~cache_index:C.cache_index |> function\n      | None ->\n          (* `cache_index` is valid. *)\n          assert false\n      | Some list ->\n          List.filter_map\n            (fun (key, age) ->\n              let {namespace; id} = internal_identifier_of_key key in\n              if String.equal namespace C.namespace then Some (id, age)\n              else None)\n            list\n\n    let identifier_rank ctxt id = Admin.key_rank ctxt (mk ~id)\n  end)\n" ;
                } ;
                { name = "Constants_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020-2021 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nval preserved_cycles : Raw_context.t -> int\n\nval blocks_per_cycle : Raw_context.t -> int32\n\nval blocks_per_commitment : Raw_context.t -> int32\n\nval blocks_per_stake_snapshot : Raw_context.t -> int32\n\nval blocks_per_voting_period : Raw_context.t -> int32\n\nval hard_gas_limit_per_operation :\n  Raw_context.t -> Gas_limit_repr.Arith.integral\n\nval hard_gas_limit_per_block : Raw_context.t -> Gas_limit_repr.Arith.integral\n\nval cost_per_byte : Raw_context.t -> Tez_repr.t\n\nval hard_storage_limit_per_operation : Raw_context.t -> Z.t\n\nval proof_of_work_threshold : Raw_context.t -> int64\n\nval tokens_per_roll : Raw_context.t -> Tez_repr.t\n\nval seed_nonce_revelation_tip : Raw_context.t -> Tez_repr.t\n\nval origination_size : Raw_context.t -> int\n\nval baking_reward_fixed_portion : Raw_context.t -> Tez_repr.t\n\nval baking_reward_bonus_per_slot : Raw_context.t -> Tez_repr.t\n\nval endorsing_reward_per_slot : Raw_context.t -> Tez_repr.t\n\nval quorum_min : Raw_context.t -> int32\n\nval quorum_max : Raw_context.t -> int32\n\nval min_proposal_quorum : Raw_context.t -> int32\n\nval liquidity_baking_subsidy : Raw_context.t -> Tez_repr.t\n\nval liquidity_baking_sunset_level : Raw_context.t -> int32\n\nval liquidity_baking_escape_ema_threshold : Raw_context.t -> int32\n\nval parametric : Raw_context.t -> Constants_repr.parametric\n\nval consensus_committee_size : Raw_context.t -> int\n\nval consensus_threshold : Raw_context.t -> int\n\nval minimal_participation_ratio : Raw_context.t -> Constants_repr.ratio\n\nval max_slashing_period : Raw_context.t -> int\n\nval frozen_deposits_percentage : Raw_context.t -> int\n\nval double_baking_punishment : Raw_context.t -> Tez_repr.t\n\nval ratio_of_frozen_deposits_slashed_per_double_endorsement :\n  Raw_context.t -> Constants_repr.ratio\n\nval minimal_block_delay : Raw_context.t -> Period_repr.t\n\nval delay_increment_per_round : Raw_context.t -> Period_repr.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nlet preserved_cycles c =\n  let constants = Raw_context.constants c in\n  constants.preserved_cycles\n\nlet blocks_per_cycle c =\n  let constants = Raw_context.constants c in\n  constants.blocks_per_cycle\n\nlet blocks_per_commitment c =\n  let constants = Raw_context.constants c in\n  constants.blocks_per_commitment\n\nlet blocks_per_stake_snapshot c =\n  let constants = Raw_context.constants c in\n  constants.blocks_per_stake_snapshot\n\nlet blocks_per_voting_period c =\n  let constants = Raw_context.constants c in\n  constants.blocks_per_voting_period\n\nlet hard_gas_limit_per_operation c =\n  let constants = Raw_context.constants c in\n  constants.hard_gas_limit_per_operation\n\nlet hard_gas_limit_per_block c =\n  let constants = Raw_context.constants c in\n  constants.hard_gas_limit_per_block\n\nlet cost_per_byte c =\n  let constants = Raw_context.constants c in\n  constants.cost_per_byte\n\nlet hard_storage_limit_per_operation c =\n  let constants = Raw_context.constants c in\n  constants.hard_storage_limit_per_operation\n\nlet proof_of_work_threshold c =\n  let constants = Raw_context.constants c in\n  constants.proof_of_work_threshold\n\nlet tokens_per_roll c =\n  let constants = Raw_context.constants c in\n  constants.tokens_per_roll\n\nlet seed_nonce_revelation_tip c =\n  let constants = Raw_context.constants c in\n  constants.seed_nonce_revelation_tip\n\nlet origination_size c =\n  let constants = Raw_context.constants c in\n  constants.origination_size\n\nlet baking_reward_fixed_portion c =\n  let constants = Raw_context.constants c in\n  constants.baking_reward_fixed_portion\n\nlet baking_reward_bonus_per_slot c =\n  let constants = Raw_context.constants c in\n  constants.baking_reward_bonus_per_slot\n\nlet endorsing_reward_per_slot c =\n  let constants = Raw_context.constants c in\n  constants.endorsing_reward_per_slot\n\nlet quorum_min c =\n  let constants = Raw_context.constants c in\n  constants.quorum_min\n\nlet quorum_max c =\n  let constants = Raw_context.constants c in\n  constants.quorum_max\n\nlet min_proposal_quorum c =\n  let constants = Raw_context.constants c in\n  constants.min_proposal_quorum\n\nlet liquidity_baking_subsidy c =\n  let constants = Raw_context.constants c in\n  constants.liquidity_baking_subsidy\n\nlet liquidity_baking_sunset_level c =\n  let constants = Raw_context.constants c in\n  constants.liquidity_baking_sunset_level\n\nlet liquidity_baking_escape_ema_threshold c =\n  let constants = Raw_context.constants c in\n  constants.liquidity_baking_escape_ema_threshold\n\nlet parametric c = Raw_context.constants c\n\nlet minimal_block_delay c =\n  let constants = Raw_context.constants c in\n  constants.minimal_block_delay\n\nlet delay_increment_per_round c =\n  let constants = Raw_context.constants c in\n  constants.delay_increment_per_round\n\nlet consensus_committee_size c =\n  let constants = Raw_context.constants c in\n  constants.consensus_committee_size\n\nlet consensus_threshold c =\n  let constants = Raw_context.constants c in\n  constants.consensus_threshold\n\nlet minimal_participation_ratio c =\n  let constants = Raw_context.constants c in\n  constants.minimal_participation_ratio\n\nlet max_slashing_period c =\n  let constants = Raw_context.constants c in\n  constants.max_slashing_period\n\nlet frozen_deposits_percentage c =\n  let constants = Raw_context.constants c in\n  constants.frozen_deposits_percentage\n\nlet double_baking_punishment c =\n  let constants = Raw_context.constants c in\n  constants.double_baking_punishment\n\nlet ratio_of_frozen_deposits_slashed_per_double_endorsement c =\n  let constants = Raw_context.constants c in\n  constants.ratio_of_frozen_deposits_slashed_per_double_endorsement\n" ;
                } ;
                { name = "Level_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nval current : Raw_context.t -> Level_repr.t\n\nval previous : Raw_context.t -> Level_repr.t\n\nval root : Raw_context.t -> Level_repr.t\n\nval from_raw : Raw_context.t -> Raw_level_repr.t -> Level_repr.t\n\n(**  Fails with [Negative_level_and_offset_sum] if the sum of the raw_level and the offset is negative. *)\nval from_raw_with_offset :\n  Raw_context.t -> offset:int32 -> Raw_level_repr.t -> Level_repr.t tzresult\n\nval pred : Raw_context.t -> Level_repr.t -> Level_repr.t option\n\nval succ : Raw_context.t -> Level_repr.t -> Level_repr.t\n\n(** [i] must be positive *)\nval add : Raw_context.t -> Level_repr.t -> int -> Level_repr.t\n\n(** [sub c level i] returns None if the level is before the first\n   level of the Alpha family of protocol, otherwise it returns the\n   expected level. [i] must be positive. *)\nval sub : Raw_context.t -> Level_repr.t -> int -> Level_repr.t option\n\nval first_level_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t\n\nval last_level_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t\n\nval levels_in_cycle : Raw_context.t -> Cycle_repr.t -> Level_repr.t list\n\nval levels_in_current_cycle :\n  Raw_context.t -> ?offset:int32 -> unit -> Level_repr.t list\n\nval levels_with_commitments_in_cycle :\n  Raw_context.t -> Cycle_repr.t -> Level_repr.t list\n\nval last_allowed_fork_level : Raw_context.t -> Raw_level_repr.t\n\n(** Returns [Some cycle] if the current level represents the last\n   level of [cycle] and [None] if the level is not the last level of a\n   cycle. *)\nval dawn_of_a_new_cycle : Raw_context.t -> Cycle_repr.t option\n\n(** Returns [true] if the rolls should be snapshot at the current\n   level. *)\nval may_snapshot_rolls : Raw_context.t -> bool\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Level_repr\n\nlet from_raw c l =\n  let cycle_eras = Raw_context.cycle_eras c in\n  Level_repr.from_raw ~cycle_eras l\n\nlet from_raw_with_offset c ~offset l : Level_repr.t tzresult =\n  let cycle_eras = Raw_context.cycle_eras c in\n  Level_repr.from_raw_with_offset ~cycle_eras ~offset l\n\nlet root c = Raw_context.cycle_eras c |> Level_repr.root_level\n\nlet succ c (l : Level_repr.t) = from_raw c (Raw_level_repr.succ l.level)\n\nlet pred c (l : Level_repr.t) =\n  match Raw_level_repr.pred l.Level_repr.level with\n  | None -> None\n  | Some l -> Some (from_raw c l)\n\nlet add c (l : Level_repr.t) n = from_raw c (Raw_level_repr.add l.level n)\n\nlet sub c (l : Level_repr.t) n =\n  match Raw_level_repr.sub l.level n with\n  | None -> None\n  | Some raw_level ->\n      let cycle_eras = Raw_context.cycle_eras c in\n      let root_level = Level_repr.root_level cycle_eras in\n      if Raw_level_repr.(raw_level >= root_level.level) then\n        Some (from_raw c raw_level)\n      else None\n\nlet current ctxt = Raw_context.current_level ctxt\n\nlet previous ctxt =\n  let l = current ctxt in\n  match pred ctxt l with\n  | None -> assert false (* We never validate the Genesis... *)\n  | Some p -> p\n\nlet first_level_in_cycle ctxt cycle =\n  let cycle_eras = Raw_context.cycle_eras ctxt in\n  Level_repr.first_level_in_cycle_from_eras ~cycle_eras cycle\n\nlet last_level_in_cycle ctxt c =\n  match pred ctxt (first_level_in_cycle ctxt (Cycle_repr.succ c)) with\n  | None -> assert false\n  | Some x -> x\n\nlet levels_in_cycle ctxt cycle =\n  let first = first_level_in_cycle ctxt cycle in\n  let[@coq_struct \"n\"] rec loop (n : Level_repr.t) acc =\n    if Cycle_repr.(n.cycle = first.cycle) then loop (succ ctxt n) (n :: acc)\n    else acc\n  in\n  loop first []\n\nlet levels_in_current_cycle ctxt ?(offset = 0l) () =\n  let current_cycle = Cycle_repr.to_int32 (current ctxt).cycle in\n  let cycle = Int32.add current_cycle offset in\n  if Compare.Int32.(cycle < 0l) then []\n  else\n    let cycle = Cycle_repr.of_int32_exn cycle in\n    levels_in_cycle ctxt cycle\n\nlet levels_with_commitments_in_cycle ctxt c =\n  let first = first_level_in_cycle ctxt c in\n  let[@coq_struct \"n\"] rec loop (n : Level_repr.t) acc =\n    if Cycle_repr.(n.cycle = first.cycle) then\n      if n.expected_commitment then loop (succ ctxt n) (n :: acc)\n      else loop (succ ctxt n) acc\n    else acc\n  in\n  loop first []\n\nlet last_allowed_fork_level c =\n  let level = Raw_context.current_level c in\n  let preserved_cycles = Constants_storage.preserved_cycles c in\n  match Cycle_repr.sub level.cycle preserved_cycles with\n  | None -> Raw_level_repr.root\n  | Some cycle -> (first_level_in_cycle c cycle).level\n\nlet last_of_a_cycle ctxt level =\n  let cycle_eras = Raw_context.cycle_eras ctxt in\n  Level_repr.last_of_cycle ~cycle_eras level\n\nlet dawn_of_a_new_cycle ctxt =\n  let level = current ctxt in\n  if last_of_a_cycle ctxt level then Some level.cycle else None\n\nlet may_snapshot_rolls ctxt =\n  let level = current ctxt in\n  let blocks_per_stake_snapshot =\n    Constants_storage.blocks_per_stake_snapshot ctxt\n  in\n  Compare.Int32.equal\n    (Int32.rem level.cycle_position blocks_per_stake_snapshot)\n    (Int32.pred blocks_per_stake_snapshot)\n" ;
                } ;
                { name = "Nonce_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype error +=\n  | Too_late_revelation\n  | Too_early_revelation\n  | Previously_revealed_nonce\n  | Inconsistent_nonce\n\ntype t = Seed_repr.nonce\n\ntype nonce = t\n\nval encoding : nonce Data_encoding.t\n\ntype unrevealed = Storage.Seed.unrevealed_nonce = {\n  nonce_hash : Nonce_hash.t;\n  delegate : Signature.Public_key_hash.t;\n}\n\ntype status = Unrevealed of unrevealed | Revealed of Seed_repr.nonce\n\nval get : Raw_context.t -> Level_repr.t -> status tzresult Lwt.t\n\ntype nonce_presence = No_nonce_expected | Nonce_expected of status\n\nval check : Raw_context.t -> Level_repr.t -> nonce_presence tzresult Lwt.t\n\nval record_hash : Raw_context.t -> unrevealed -> Raw_context.t tzresult Lwt.t\n\nval reveal :\n  Raw_context.t -> Level_repr.t -> nonce -> Raw_context.t tzresult Lwt.t\n\nval of_bytes : bytes -> nonce tzresult\n\nval hash : nonce -> Nonce_hash.t\n\nval check_hash : nonce -> Nonce_hash.t -> bool\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype t = Seed_repr.nonce\n\ntype nonce = t\n\nlet encoding = Seed_repr.nonce_encoding\n\ntype error +=\n  | Too_late_revelation\n  | Too_early_revelation\n  | Previously_revealed_nonce\n  | Inconsistent_nonce\n\nlet () =\n  register_error_kind\n    `Branch\n    ~id:\"nonce.too_late_revelation\"\n    ~title:\"Too late nonce revelation\"\n    ~description:\"Nonce revelation happens too late\"\n    ~pp:(fun ppf () ->\n      Format.fprintf ppf \"This nonce cannot be revealed anymore.\")\n    Data_encoding.unit\n    (function Too_late_revelation -> Some () | _ -> None)\n    (fun () -> Too_late_revelation) ;\n  register_error_kind\n    `Temporary\n    ~id:\"nonce.too_early_revelation\"\n    ~title:\"Too early nonce revelation\"\n    ~description:\"Nonce revelation happens before cycle end\"\n    ~pp:(fun ppf () ->\n      Format.fprintf ppf \"This nonce should not yet be revealed\")\n    Data_encoding.unit\n    (function Too_early_revelation -> Some () | _ -> None)\n    (fun () -> Too_early_revelation) ;\n  register_error_kind\n    `Branch\n    ~id:\"nonce.previously_revealed\"\n    ~title:\"Previously revealed nonce\"\n    ~description:\"Duplicated revelation for a nonce.\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"This nonce was previously revealed\")\n    Data_encoding.unit\n    (function Previously_revealed_nonce -> Some () | _ -> None)\n    (fun () -> Previously_revealed_nonce) ;\n  register_error_kind\n    `Branch\n    ~id:\"nonce.inconsistent\"\n    ~title:\"Inconsistent nonce\"\n    ~description:\n      \"The provided nonce is inconsistent with the committed nonce hash.\"\n    ~pp:(fun ppf () ->\n      Format.fprintf\n        ppf\n        \"This nonce revelation is invalid (inconsistent with the committed \\\n         hash)\")\n    Data_encoding.unit\n    (function Inconsistent_nonce -> Some () | _ -> None)\n    (fun () -> Inconsistent_nonce)\n\n(* checks that the level of a revelation is not too early or too late wrt to the\n   current context and that a nonce has not been already revealed for that level *)\nlet get_unrevealed ctxt (level : Level_repr.t) =\n  let cur_level = Level_storage.current ctxt in\n  match Cycle_repr.pred cur_level.cycle with\n  | None -> fail Too_early_revelation (* no revelations during cycle 0 *)\n  | Some revealed_cycle -> (\n      if Cycle_repr.(revealed_cycle < level.Level_repr.cycle) then\n        fail Too_early_revelation\n      else if Cycle_repr.(level.Level_repr.cycle < revealed_cycle) then\n        fail Too_late_revelation\n      else\n        Storage.Seed.Nonce.get ctxt level >>=? function\n        | Revealed _ -> fail Previously_revealed_nonce\n        | Unrevealed status -> return status)\n\nlet record_hash ctxt unrevealed =\n  let level = Level_storage.current ctxt in\n  Storage.Seed.Nonce.init ctxt level (Unrevealed unrevealed)\n\nlet reveal ctxt level nonce =\n  get_unrevealed ctxt level >>=? fun unrevealed ->\n  error_unless\n    (Seed_repr.check_hash nonce unrevealed.nonce_hash)\n    Inconsistent_nonce\n  >>?= fun () -> Storage.Seed.Nonce.update ctxt level (Revealed nonce)\n\ntype unrevealed = Storage.Seed.unrevealed_nonce = {\n  nonce_hash : Nonce_hash.t;\n  delegate : Signature.Public_key_hash.t;\n}\n\ntype status = Storage.Seed.nonce_status =\n  | Unrevealed of unrevealed\n  | Revealed of Seed_repr.nonce\n\nlet get = Storage.Seed.Nonce.get\n\ntype nonce_presence = No_nonce_expected | Nonce_expected of status\n\nlet check ctxt level =\n  Storage.Seed.Nonce.find ctxt level >>=? function\n  | None -> return No_nonce_expected\n  | Some status -> return (Nonce_expected status)\n\nlet of_bytes = Seed_repr.make_nonce\n\nlet hash = Seed_repr.hash\n\nlet check_hash = Seed_repr.check_hash\n" ;
                } ;
                { name = "Seed_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype error +=\n  | Unknown of {\n      oldest : Cycle_repr.t;\n      cycle : Cycle_repr.t;\n      latest : Cycle_repr.t;\n    }\n\n(* `Permanent *)\n\n(** Generates the first [preserved_cycles+2] seeds for which\n    there are no nonces. *)\nval init : Raw_context.t -> Raw_context.t tzresult Lwt.t\n\nval for_cycle : Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t\n\n(** If it is the end of the cycle, computes and stores the seed of cycle at\n    distance [preserved_cycle+2] in the future using the seed of the previous\n    cycle and the revelations of the current one.  *)\nval cycle_end :\n  Raw_context.t ->\n  Cycle_repr.t ->\n  (Raw_context.t * Nonce_storage.unrevealed list) tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype error +=\n  | Unknown of {\n      oldest : Cycle_repr.t;\n      cycle : Cycle_repr.t;\n      latest : Cycle_repr.t;\n    }\n\n(* `Permanent *)\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"seed.unknown_seed\"\n    ~title:\"Unknown seed\"\n    ~description:\"The requested seed is not available\"\n    ~pp:(fun ppf (oldest, cycle, latest) ->\n      if Cycle_repr.(cycle < oldest) then\n        Format.fprintf\n          ppf\n          \"The seed for cycle %a has been cleared from the context  (oldest \\\n           known seed is for cycle %a)\"\n          Cycle_repr.pp\n          cycle\n          Cycle_repr.pp\n          oldest\n      else\n        Format.fprintf\n          ppf\n          \"The seed for cycle %a has not been computed yet  (latest known seed \\\n           is for cycle %a)\"\n          Cycle_repr.pp\n          cycle\n          Cycle_repr.pp\n          latest)\n    Data_encoding.(\n      obj3\n        (req \"oldest\" Cycle_repr.encoding)\n        (req \"requested\" Cycle_repr.encoding)\n        (req \"latest\" Cycle_repr.encoding))\n    (function\n      | Unknown {oldest; cycle; latest} -> Some (oldest, cycle, latest)\n      | _ -> None)\n    (fun (oldest, cycle, latest) -> Unknown {oldest; cycle; latest})\n\nlet compute_for_cycle c ~revealed cycle =\n  match Cycle_repr.pred cycle with\n  | None -> assert false (* should not happen *)\n  | Some previous_cycle ->\n      let levels = Level_storage.levels_with_commitments_in_cycle c revealed in\n      let combine (c, random_seed, unrevealed) level =\n        Storage.Seed.Nonce.get c level >>=? function\n        | Revealed nonce ->\n            Storage.Seed.Nonce.remove_existing c level >|=? fun c ->\n            (c, Seed_repr.nonce random_seed nonce, unrevealed)\n        | Unrevealed u ->\n            Storage.Seed.Nonce.remove_existing c level >|=? fun c ->\n            (c, random_seed, u :: unrevealed)\n      in\n      Storage.Seed.For_cycle.get c previous_cycle >>=? fun prev_seed ->\n      let seed = Seed_repr.deterministic_seed prev_seed in\n      List.fold_left_es combine (c, seed, []) levels\n      >>=? fun (c, seed, unrevealed) ->\n      Storage.Seed.For_cycle.init c cycle seed >|=? fun c -> (c, unrevealed)\n\nlet for_cycle ctxt cycle =\n  let preserved = Constants_storage.preserved_cycles ctxt in\n  let current_level = Level_storage.current ctxt in\n  let current_cycle = current_level.cycle in\n  let latest =\n    if Cycle_repr.(current_cycle = root) then\n      Cycle_repr.add current_cycle (preserved + 1)\n    else Cycle_repr.add current_cycle preserved\n  in\n  let oldest =\n    match Cycle_repr.sub current_cycle preserved with\n    | None -> Cycle_repr.root\n    | Some oldest -> oldest\n  in\n  error_unless\n    Cycle_repr.(oldest <= cycle && cycle <= latest)\n    (Unknown {oldest; cycle; latest})\n  >>?= fun () -> Storage.Seed.For_cycle.get ctxt cycle\n\nlet init ctxt =\n  let preserved = Constants_storage.preserved_cycles ctxt in\n  List.fold_left_es\n    (fun (c, ctxt) seed ->\n      let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in\n      Storage.Seed.For_cycle.init ctxt cycle seed >|=? fun ctxt -> (c + 1, ctxt))\n    (0, ctxt)\n    (Seed_repr.initial_seeds (preserved + 2))\n  >|=? snd\n\nlet cycle_end ctxt last_cycle =\n  (* NB: the clearing of past seeds is done elsewhere by the caller *)\n  let preserved = Constants_storage.preserved_cycles ctxt in\n  match Cycle_repr.pred last_cycle with\n  | None -> return (ctxt, [])\n  | Some revealed ->\n      (* cycle with revelations *)\n      let inited_seed_cycle = Cycle_repr.add last_cycle (preserved + 1) in\n      compute_for_cycle ctxt ~revealed inited_seed_cycle\n" ;
                } ;
                { name = "Roll_storage_legacy" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2019 Metastate AG <contact@metastate.ch>                    *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(**\n   Basic roll manipulation.\n\n   The storage related to roll (i.e. `Storage.Roll`) is not used outside of\n   this module. And, this interface enforces the invariant that a roll is\n   always either in the limbo list or owned by a delegate.\n*)\n\ntype error +=\n  | (* `Permanent *) Consume_roll_change\n  | (* `Permanent *) No_roll_for_delegate\n  | (* `Permanent *) No_stake_snapshot_for_cycle of Cycle_repr.t\n  | (* `Permanent *) Unregistered_delegate of Signature.Public_key_hash.t\n\n(**\n   [fold ctxt f init] folds [f] on the list of all rolls from [Roll_repr.first]\n   to [Storage.Next.Roll] of the context [ctxt]. Only rolls which have owners\n   are considered, rolls without owners are skipped. The first parameter of [f]\n   is a roll [r], the second parameter of [f] is the owner of [r], and the last\n   parameter is the initial value of the accumulator.\n*)\nval fold :\n  Raw_context.t ->\n  f:(Roll_repr_legacy.roll -> Signature.Public_key.t -> 'a -> 'a tzresult Lwt.t) ->\n  'a ->\n  'a tzresult Lwt.t\n\nmodule Delegate : sig\n  val is_inactive :\n    Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t\n\n  (**\n     [add_amount ctxt dlg am] performs the following actions:\n\n     1. if the delegate [dlg] is inactive, increase its change [chg] by [am],\n     2. if the [dlg] is active, update [dlg]'s number of rolls [nr], and change\n        [chg] so that [dlg]'s number of tokens is increased by [am], and equal\n        to [nr * tokens_per_roll + chg], where [chg < tokens_per_roll].\n  *)\n  val add_amount :\n    Raw_context.t ->\n    Signature.Public_key_hash.t ->\n    Tez_repr.t ->\n    Raw_context.t tzresult Lwt.t\n\n  (**\n     [remove_amount ctxt dlg am] performs the following actions:\n\n     1. if the delegate [dlg] is inactive, decrease its change [chg] by [am],\n     2. if the [dlg] is active, update [dlg]'s number of rolls [nr], and change\n     [chg] so that [dlg]'s number of tokens is decreased by [am], and equal to\n     [nr * tokens_per_roll + chg], where [chg < tokens_per_roll].\n  *)\n  val remove_amount :\n    Raw_context.t ->\n    Signature.Public_key_hash.t ->\n    Tez_repr.t ->\n    Raw_context.t tzresult Lwt.t\n\n  (**\n     [set_inactive ctxt dlg] renders delegate [dlg] inactive and performs the\n     following actions:\n\n     1. empty the list of rolls of [dlg],\n     2. increase the change of [dlg] by [nr * tokens_per_roll], where [nr] is\n        [dlg]'s number of rolls prior to inactivation.\n  *)\n  val set_inactive :\n    Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t\n\n  (**\n     If the delegate [dlg] is already active then [set_active ctxt dlg]\n     performs the following sequence of actions:\n\n     1. if the delegate is not scheduled to become inactive, then schedule the\n        delegate to become inactive after [(preserved_cycles * 2) + 1] cycles,\n     2. if the delegate is already scheduled to become inactive at cycle [ic],\n        then re-schedule it to become inactive at cycle\n        [max ic (cc + preserved_cycles + 1)], where [cc] is the current cycle.\n\n     If [dlg] is inactive then this function puts [dlg] in active state and\n     performs the following actions:\n\n     1. if [dlg] is not scheduled to become inactive, schedule [dlg] to become\n        inactive after [(preserved_cycles * 2) + 1] cycles,\n     2. if the [dlg] is already scheduled to become inactive at cycle [ic],\n        then re-schedule it to become inactive at cycle\n        [max ic (cc + (preserved_cycles * 2) + 1)], where [cc] is the current\n        cycle,\n     3. dispatch [dlg]'s change [chg] into [nr] rolls of size [tokens_per_roll]\n        so that the total amount managed by [dlg] is unchanged and equal to\n        [(nr * tokens_per_roll) + chg], where [chg < tokens_per_roll].\n  *)\n  val set_active :\n    Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t\nend\n\nmodule Contract : sig\n  (**\n     Calls [Delegate.add_amount ctxt contract am] if a delegate is associated\n     to [contract], or returns unchanged [ctxt] otherwise.\n  *)\n  val add_amount :\n    Raw_context.t ->\n    Contract_repr.t ->\n    Tez_repr.t ->\n    Raw_context.t tzresult Lwt.t\n\n  (**\n     Calls [Delegate.remove_amount ctxt contract am] if a delegate is associated\n     to [contract], or returns unchanged [ctxt] otherwise.\n  *)\n  val remove_amount :\n    Raw_context.t ->\n    Contract_repr.t ->\n    Tez_repr.t ->\n    Raw_context.t tzresult Lwt.t\nend\n\n(**\n   [delegate_pubkey ctxt delegate] returns the public key of\n   [delegate] found in context [ctxt] if there exists a registered\n   contract.\n*)\nval delegate_pubkey :\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Signature.Public_key.t tzresult Lwt.t\n\n(**\n   [get_change ctxt delegate] returns the amount of change held by\n   [delegate] in context [ctxt]. The change is the part of the staking\n   balance of a delegate that is not part of a roll, i.e., the amount\n   of staking balance (smaller than the value of a roll) not being\n   taken into account for baking rights computation.\n*)\nval get_change :\n  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t\n\n(**\n   [get_contract_delegate ctxt contract] returns the public key hash\n   of the delegate whose contract is [contract] in context [ctxt].\n*)\nval get_contract_delegate :\n  Raw_context.t ->\n  Contract_repr.t ->\n  Signature.Public_key_hash.t option tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2019 Metastate AG <contact@metastate.ch>                    *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype error +=\n  | (* `Permanent *) Consume_roll_change\n  | (* `Permanent *) No_roll_for_delegate\n  | (* `Permanent *) No_stake_snapshot_for_cycle of Cycle_repr.t\n  | (* `Permanent *) Unregistered_delegate of Signature.Public_key_hash.t\n\nlet () =\n  let open Data_encoding in\n  (* Consume roll change *)\n  register_error_kind\n    `Permanent\n    ~id:\"contract.manager.consume_roll_change\"\n    ~title:\"Consume roll change\"\n    ~description:\"Change is not enough to consume a roll.\"\n    ~pp:(fun ppf () ->\n      Format.fprintf ppf \"Not enough change to consume a roll.\")\n    empty\n    (function Consume_roll_change -> Some () | _ -> None)\n    (fun () -> Consume_roll_change) ;\n  (* No roll for delegate *)\n  register_error_kind\n    `Permanent\n    ~id:\"contract.manager.no_roll_for_delegate\"\n    ~title:\"No roll for delegate\"\n    ~description:\"Delegate has no roll.\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"Delegate has no roll.\")\n    empty\n    (function No_roll_for_delegate -> Some () | _ -> None)\n    (fun () -> No_roll_for_delegate) ;\n  (* No roll snapshot for cycle *)\n  register_error_kind\n    `Permanent\n    ~id:\"contract.manager.no_stake_snapshot_for_cycle\"\n    ~title:\"No roll snapshot for cycle\"\n    ~description:\n      \"A snapshot of the rolls distribution does not exist for this cycle.\"\n    ~pp:(fun ppf c ->\n      Format.fprintf\n        ppf\n        \"A snapshot of the rolls distribution does not exist for cycle %a\"\n        Cycle_repr.pp\n        c)\n    (obj1 (req \"cycle\" Cycle_repr.encoding))\n    (function No_stake_snapshot_for_cycle c -> Some c | _ -> None)\n    (fun c -> No_stake_snapshot_for_cycle c) ;\n  (* Unregistered delegate *)\n  register_error_kind\n    `Permanent\n    ~id:\"contract.manager.unregistered_delegate_legacy\"\n    ~title:\"Unregistered delegate\"\n    ~description:\"A contract cannot be delegated to an unregistered delegate\"\n    ~pp:(fun ppf k ->\n      Format.fprintf\n        ppf\n        \"The provided public key (with hash %a) is not registered as valid \\\n         delegate key.\"\n        Signature.Public_key_hash.pp\n        k)\n    (obj1 (req \"hash\" Signature.Public_key_hash.encoding))\n    (function Unregistered_delegate k -> Some k | _ -> None)\n    (fun k -> Unregistered_delegate k)\n\nlet get_contract_delegate ctxt contract =\n  Storage.Contract.Delegate.find ctxt contract\n\nlet delegate_pubkey ctxt delegate =\n  Storage.Contract.Manager.find ctxt (Contract_repr.implicit_contract delegate)\n  >>=? function\n  | None | Some (Manager_repr.Hash _) -> fail (Unregistered_delegate delegate)\n  | Some (Manager_repr.Public_key pk) -> return pk\n\nlet fold ctxt ~f init =\n  Storage.Roll_legacy.Next.get ctxt >>=? fun last ->\n  let[@coq_struct \"roll\"] rec loop ctxt roll acc =\n    if Roll_repr_legacy.(roll = last) then return acc\n    else\n      Storage.Roll_legacy.Owner.find ctxt roll >>=? function\n      | None -> loop ctxt (Roll_repr_legacy.succ roll) acc\n      | Some delegate ->\n          f roll delegate acc >>=? fun acc ->\n          loop ctxt (Roll_repr_legacy.succ roll) acc\n  in\n  loop ctxt Roll_repr_legacy.first init\n\nlet get_change ctxt delegate =\n  Storage.Roll_legacy.Delegate_change.find ctxt delegate\n  >|=? Option.value ~default:Tez_repr.zero\n\nmodule Delegate = struct\n  let fresh_roll ctxt =\n    Storage.Roll_legacy.Next.get ctxt >>=? fun roll ->\n    Storage.Roll_legacy.Next.update ctxt (Roll_repr_legacy.succ roll)\n    >|=? fun ctxt -> (roll, ctxt)\n\n  let get_limbo_roll ctxt =\n    Storage.Roll_legacy.Limbo.find ctxt >>=? function\n    | None ->\n        fresh_roll ctxt >>=? fun (roll, ctxt) ->\n        Storage.Roll_legacy.Limbo.init ctxt roll >|=? fun ctxt -> (roll, ctxt)\n    | Some roll -> return (roll, ctxt)\n\n  let consume_roll_change ctxt delegate =\n    let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in\n    Storage.Roll_legacy.Delegate_change.get ctxt delegate >>=? fun change ->\n    record_trace Consume_roll_change Tez_repr.(change -? tokens_per_roll)\n    >>?= fun new_change ->\n    Storage.Roll_legacy.Delegate_change.update ctxt delegate new_change\n\n  let recover_roll_change ctxt delegate =\n    let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in\n    Storage.Roll_legacy.Delegate_change.get ctxt delegate >>=? fun change ->\n    Tez_repr.(change +? tokens_per_roll) >>?= fun new_change ->\n    Storage.Roll_legacy.Delegate_change.update ctxt delegate new_change\n\n  let pop_roll_from_delegate ctxt delegate =\n    recover_roll_change ctxt delegate >>=? fun ctxt ->\n    (* beginning:\n       delegate : roll -> successor_roll -> ...\n       limbo : limbo_head -> ...\n    *)\n    Storage.Roll_legacy.Limbo.find ctxt >>=? fun limbo_head ->\n    Storage.Roll_legacy.Delegate_roll_list.find ctxt delegate >>=? function\n    | None -> fail No_roll_for_delegate\n    | Some roll ->\n        Storage.Roll_legacy.Owner.remove_existing ctxt roll >>=? fun ctxt ->\n        Storage.Roll_legacy.Successor.find ctxt roll >>=? fun successor_roll ->\n        Storage.Roll_legacy.Delegate_roll_list.add_or_remove\n          ctxt\n          delegate\n          successor_roll\n        >>= fun ctxt ->\n        (* delegate : successor_roll -> ...\n           roll ------^\n           limbo : limbo_head -> ... *)\n        Storage.Roll_legacy.Successor.add_or_remove ctxt roll limbo_head\n        >>= fun ctxt ->\n        (* delegate : successor_roll -> ...\n           roll ------v\n           limbo : limbo_head -> ... *)\n        Storage.Roll_legacy.Limbo.add ctxt roll >|= fun ctxt ->\n        (* delegate : successor_roll -> ...\n           limbo : roll -> limbo_head -> ... *)\n        ok (roll, ctxt)\n\n  let create_roll_in_delegate ctxt delegate delegate_pk =\n    consume_roll_change ctxt delegate >>=? fun ctxt ->\n    (* beginning:\n       delegate : delegate_head -> ...\n       limbo : roll -> limbo_successor -> ...\n    *)\n    Storage.Roll_legacy.Delegate_roll_list.find ctxt delegate\n    >>=? fun delegate_head ->\n    get_limbo_roll ctxt >>=? fun (roll, ctxt) ->\n    Storage.Roll_legacy.Owner.init ctxt roll delegate_pk >>=? fun ctxt ->\n    Storage.Roll_legacy.Successor.find ctxt roll >>=? fun limbo_successor ->\n    Storage.Roll_legacy.Limbo.add_or_remove ctxt limbo_successor >>= fun ctxt ->\n    (* delegate : delegate_head -> ...\n       roll ------v\n       limbo : limbo_successor -> ... *)\n    Storage.Roll_legacy.Successor.add_or_remove ctxt roll delegate_head\n    >>= fun ctxt ->\n    (* delegate : delegate_head -> ...\n       roll ------^\n       limbo : limbo_successor -> ... *)\n    Storage.Roll_legacy.Delegate_roll_list.add ctxt delegate roll\n    (* delegate : roll -> delegate_head -> ...\n       limbo : limbo_successor -> ... *)\n    >|= ok\n\n  let ensure_inited ctxt delegate =\n    Storage.Roll_legacy.Delegate_change.mem ctxt delegate >>= function\n    | true -> return ctxt\n    | false ->\n        Storage.Roll_legacy.Delegate_change.init ctxt delegate Tez_repr.zero\n\n  let is_inactive ctxt delegate =\n    Storage.Contract.Inactive_delegate.mem\n      ctxt\n      (Contract_repr.implicit_contract delegate)\n    >>= fun inactive ->\n    if inactive then return inactive\n    else\n      Storage.Contract.Delegate_desactivation.find\n        ctxt\n        (Contract_repr.implicit_contract delegate)\n      >|=? function\n      | Some last_active_cycle ->\n          let ({Level_repr.cycle = current_cycle; _} : Level_repr.t) =\n            Raw_context.current_level ctxt\n          in\n          Cycle_repr.(last_active_cycle < current_cycle)\n      | None ->\n          (* This case is only when called from `set_active`, when creating\n             a contract. *)\n          false\n\n  let add_amount ctxt delegate amount =\n    ensure_inited ctxt delegate >>=? fun ctxt ->\n    let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in\n    Storage.Roll_legacy.Delegate_change.get ctxt delegate >>=? fun change ->\n    Tez_repr.(amount +? change) >>?= fun change ->\n    Storage.Roll_legacy.Delegate_change.update ctxt delegate change\n    >>=? fun ctxt ->\n    delegate_pubkey ctxt delegate >>=? fun delegate_pk ->\n    let[@coq_struct \"change\"] rec loop ctxt change =\n      if Tez_repr.(change < tokens_per_roll) then return ctxt\n      else\n        Tez_repr.(change -? tokens_per_roll) >>?= fun change ->\n        create_roll_in_delegate ctxt delegate delegate_pk >>=? fun ctxt ->\n        loop ctxt change\n    in\n    is_inactive ctxt delegate >>=? fun inactive ->\n    if inactive then return ctxt\n    else\n      loop ctxt change >>=? fun ctxt ->\n      Storage.Roll_legacy.Delegate_roll_list.find ctxt delegate\n      >>=? fun rolls ->\n      match rolls with\n      | None -> return ctxt\n      | Some _ ->\n          Storage.Legacy_active_delegates_with_rolls.add ctxt delegate >|= ok\n\n  let remove_amount ctxt delegate amount =\n    let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in\n    let[@coq_struct \"change\"] rec loop ctxt change =\n      if Tez_repr.(amount <= change) then return (ctxt, change)\n      else\n        pop_roll_from_delegate ctxt delegate >>=? fun (_, ctxt) ->\n        Tez_repr.(change +? tokens_per_roll) >>?= fun change -> loop ctxt change\n    in\n    Storage.Roll_legacy.Delegate_change.get ctxt delegate >>=? fun change ->\n    is_inactive ctxt delegate >>=? fun inactive ->\n    (if inactive then return (ctxt, change)\n    else\n      loop ctxt change >>=? fun (ctxt, change) ->\n      Storage.Roll_legacy.Delegate_roll_list.find ctxt delegate\n      >>=? fun rolls ->\n      match rolls with\n      | None ->\n          Storage.Legacy_active_delegates_with_rolls.remove ctxt delegate\n          >|= fun ctxt -> ok (ctxt, change)\n      | Some _ -> return (ctxt, change))\n    >>=? fun (ctxt, change) ->\n    Tez_repr.(change -? amount) >>?= fun change ->\n    Storage.Roll_legacy.Delegate_change.update ctxt delegate change\n\n  let set_inactive ctxt delegate =\n    ensure_inited ctxt delegate >>=? fun ctxt ->\n    let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in\n    Storage.Roll_legacy.Delegate_change.get ctxt delegate >>=? fun change ->\n    Storage.Contract.Inactive_delegate.add\n      ctxt\n      (Contract_repr.implicit_contract delegate)\n    >>= fun ctxt ->\n    Storage.Legacy_active_delegates_with_rolls.remove ctxt delegate\n    >>= fun ctxt ->\n    let[@coq_struct \"change\"] rec loop ctxt change =\n      Storage.Roll_legacy.Delegate_roll_list.find ctxt delegate >>=? function\n      | None -> return (ctxt, change)\n      | Some _roll ->\n          pop_roll_from_delegate ctxt delegate >>=? fun (_, ctxt) ->\n          Tez_repr.(change +? tokens_per_roll) >>?= fun change ->\n          loop ctxt change\n    in\n    loop ctxt change >>=? fun (ctxt, change) ->\n    Storage.Roll_legacy.Delegate_change.update ctxt delegate change\n\n  let set_active ctxt delegate =\n    is_inactive ctxt delegate >>=? fun inactive ->\n    let current_cycle = (Raw_context.current_level ctxt).cycle in\n    let preserved_cycles = Constants_storage.preserved_cycles ctxt in\n    (* When the delegate is new or inactive, she will become active in\n       `1+preserved_cycles`, and we allow `preserved_cycles` for the\n       delegate to start baking. When the delegate is active, we only\n       give her at least `preserved_cycles` after the current cycle\n       before to be deactivated. *)\n    Storage.Contract.Delegate_desactivation.find\n      ctxt\n      (Contract_repr.implicit_contract delegate)\n    >>=? fun current_expiration ->\n    let expiration =\n      match current_expiration with\n      | None -> Cycle_repr.add current_cycle (1 + (2 * preserved_cycles))\n      | Some current_expiration ->\n          let delay =\n            if inactive then 1 + (2 * preserved_cycles)\n            else 1 + preserved_cycles\n          in\n          let updated = Cycle_repr.add current_cycle delay in\n          Cycle_repr.max current_expiration updated\n    in\n    Storage.Contract.Delegate_desactivation.add\n      ctxt\n      (Contract_repr.implicit_contract delegate)\n      expiration\n    >>= fun ctxt ->\n    if not inactive then return ctxt\n    else\n      ensure_inited ctxt delegate >>=? fun ctxt ->\n      let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in\n      Storage.Roll_legacy.Delegate_change.get ctxt delegate >>=? fun change ->\n      Storage.Contract.Inactive_delegate.remove\n        ctxt\n        (Contract_repr.implicit_contract delegate)\n      >>= fun ctxt ->\n      delegate_pubkey ctxt delegate >>=? fun delegate_pk ->\n      let[@coq_struct \"change\"] rec loop ctxt change =\n        if Tez_repr.(change < tokens_per_roll) then return ctxt\n        else\n          Tez_repr.(change -? tokens_per_roll) >>?= fun change ->\n          create_roll_in_delegate ctxt delegate delegate_pk >>=? fun ctxt ->\n          loop ctxt change\n      in\n      loop ctxt change >>=? fun ctxt ->\n      Storage.Roll_legacy.Delegate_roll_list.find ctxt delegate\n      >>=? fun rolls ->\n      match rolls with\n      | None -> return ctxt\n      | Some _ ->\n          Storage.Legacy_active_delegates_with_rolls.add ctxt delegate >|= ok\nend\n\nmodule Contract = struct\n  let add_amount c contract amount =\n    get_contract_delegate c contract >>=? function\n    | None -> return c\n    | Some delegate -> Delegate.add_amount c delegate amount\n\n  let remove_amount c contract amount =\n    get_contract_delegate c contract >>=? function\n    | None -> return c\n    | Some delegate -> Delegate.remove_amount c delegate amount\nend\n" ;
                } ;
                { name = "Contract_manager_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype error +=\n  | (* `Branch *) Unrevealed_manager_key of Contract_repr.t\n  | (* `Permanent *)\n      Inconsistent_hash of {\n      public_key : Signature.Public_key.t;\n      expected_hash : Signature.Public_key_hash.t;\n      provided_hash : Signature.Public_key_hash.t;\n    }\n  | (* `Branch *) Previously_revealed_key of Contract_repr.t\n\n(** [init ctxt contract manager] associates [manager] to [contract]. This\n    function is undefined if [contract] has already a manager associated to it.\n*)\nval init :\n  Raw_context.t ->\n  Contract_repr.t ->\n  Manager_repr.manager_key ->\n  Raw_context.t tzresult Lwt.t\n\nval is_manager_key_revealed :\n  Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t\n\nval reveal_manager_key :\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Signature.Public_key.t ->\n  Raw_context.t tzresult Lwt.t\n\n(** [get_manager_key ?error ctxt pkh] returns the revealed manager key of the\n    contract represented by [pkh]. When [error] is not provided this function\n    fails with \"get_manager_key\" error if [pkh] does not have a manager, and\n    with [Unrevealed_manager_key] error if the manager has not revealed its key.\n    When [error] is provided, the function fails with the provided [error] in\n    both cases. *)\nval get_manager_key :\n  ?error:error ->\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Signature.Public_key.t tzresult Lwt.t\n\nval remove_existing :\n  Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype error +=\n  | (* `Branch *) Unrevealed_manager_key of Contract_repr.t\n  | (* `Permanent *)\n      Inconsistent_hash of {\n      public_key : Signature.Public_key.t;\n      expected_hash : Signature.Public_key_hash.t;\n      provided_hash : Signature.Public_key_hash.t;\n    }\n  | (* `Branch *) Previously_revealed_key of Contract_repr.t\n\nlet () =\n  register_error_kind\n    `Branch\n    ~id:\"contract.unrevealed_key\"\n    ~title:\"Manager operation precedes key revelation\"\n    ~description:\n      \"One tried to apply a manager operation without revealing the manager \\\n       public key\"\n    ~pp:(fun ppf s ->\n      Format.fprintf\n        ppf\n        \"Unrevealed manager key for contract %a.\"\n        Contract_repr.pp\n        s)\n    Data_encoding.(obj1 (req \"contract\" Contract_repr.encoding))\n    (function Unrevealed_manager_key s -> Some s | _ -> None)\n    (fun s -> Unrevealed_manager_key s) ;\n  register_error_kind\n    `Permanent\n    ~id:\"contract.manager.inconsistent_hash\"\n    ~title:\"Inconsistent public key hash\"\n    ~description:\n      \"A revealed manager public key is inconsistent with the announced hash\"\n    ~pp:(fun ppf (k, eh, ph) ->\n      Format.fprintf\n        ppf\n        \"The hash of the manager public key %s is not %a as announced but %a\"\n        (Signature.Public_key.to_b58check k)\n        Signature.Public_key_hash.pp\n        ph\n        Signature.Public_key_hash.pp\n        eh)\n    Data_encoding.(\n      obj3\n        (req \"public_key\" Signature.Public_key.encoding)\n        (req \"expected_hash\" Signature.Public_key_hash.encoding)\n        (req \"provided_hash\" Signature.Public_key_hash.encoding))\n    (function\n      | Inconsistent_hash {public_key; expected_hash; provided_hash} ->\n          Some (public_key, expected_hash, provided_hash)\n      | _ -> None)\n    (fun (public_key, expected_hash, provided_hash) ->\n      Inconsistent_hash {public_key; expected_hash; provided_hash}) ;\n  register_error_kind\n    `Branch\n    ~id:\"contract.previously_revealed_key\"\n    ~title:\"Manager operation already revealed\"\n    ~description:\"One tried to reveal twice a manager public key\"\n    ~pp:(fun ppf s ->\n      Format.fprintf\n        ppf\n        \"Previously revealed manager key for contract %a.\"\n        Contract_repr.pp\n        s)\n    Data_encoding.(obj1 (req \"contract\" Contract_repr.encoding))\n    (function Previously_revealed_key s -> Some s | _ -> None)\n    (fun s -> Previously_revealed_key s)\n\nlet init = Storage.Contract.Manager.init\n\nlet is_manager_key_revealed c manager =\n  let contract = Contract_repr.implicit_contract manager in\n  Storage.Contract.Manager.find c contract >>=? function\n  | None -> return_false\n  | Some (Manager_repr.Hash _) -> return_false\n  | Some (Manager_repr.Public_key _) -> return_true\n\nlet reveal_manager_key c manager public_key =\n  let contract = Contract_repr.implicit_contract manager in\n  Storage.Contract.Manager.get c contract >>=? function\n  | Public_key _ -> fail (Previously_revealed_key contract)\n  | Hash v ->\n      let actual_hash = Signature.Public_key.hash public_key in\n      if Signature.Public_key_hash.equal actual_hash v then\n        let v = Manager_repr.Public_key public_key in\n        Storage.Contract.Manager.update c contract v\n      else\n        fail\n          (Inconsistent_hash\n             {public_key; expected_hash = v; provided_hash = actual_hash})\n\nlet get_manager_key ?error ctxt pkh =\n  let contract = Contract_repr.implicit_contract pkh in\n  Storage.Contract.Manager.find ctxt contract >>=? function\n  | None -> (\n      match error with\n      | None -> failwith \"get_manager_key\"\n      | Some error -> fail error)\n  | Some (Manager_repr.Hash _) -> (\n      match error with\n      | None -> fail (Unrevealed_manager_key contract)\n      | Some error -> fail error)\n  | Some (Manager_repr.Public_key pk) -> return pk\n\nlet remove_existing = Storage.Contract.Manager.remove_existing\n" ;
                } ;
                { name = "Delegate_activation_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nval is_inactive :\n  Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t\n\n(** [grace_period ctxt delegate] is the cycle at which the delegate is\n    scheduled to become inactive. *)\nval grace_period :\n  Raw_context.t -> Signature.Public_key_hash.t -> Cycle_repr.t tzresult Lwt.t\n\nval set_inactive : Raw_context.t -> Contract_repr.t -> Raw_context.t Lwt.t\n\nval set_active :\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  (Raw_context.t * bool) tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nlet is_inactive ctxt delegate =\n  Storage.Contract.Inactive_delegate.mem\n    ctxt\n    (Contract_repr.implicit_contract delegate)\n  >>= fun inactive ->\n  if inactive then return inactive\n  else\n    Storage.Contract.Delegate_desactivation.find\n      ctxt\n      (Contract_repr.implicit_contract delegate)\n    >|=? function\n    | Some last_active_cycle ->\n        let ({Level_repr.cycle = current_cycle; _} : Level_repr.t) =\n          Raw_context.current_level ctxt\n        in\n        Cycle_repr.(last_active_cycle < current_cycle)\n    | None ->\n        (* This case is only when called from `set_active`, when creating\n             a contract. *)\n        false\n\nlet grace_period ctxt delegate =\n  let contract = Contract_repr.implicit_contract delegate in\n  Storage.Contract.Delegate_desactivation.get ctxt contract\n\nlet set_inactive = Storage.Contract.Inactive_delegate.add\n\nlet set_active ctxt delegate =\n  is_inactive ctxt delegate >>=? fun inactive ->\n  let current_cycle = (Raw_context.current_level ctxt).cycle in\n  let preserved_cycles = Constants_storage.preserved_cycles ctxt in\n  (* We allow a number of cycles before a delegate is deactivated as follows:\n     - if the delegate is active, we give it at least `1 + preserved_cycles`\n     after the current cycle before to be deactivated.\n     - if the delegate is new or inactive, we give it additionally\n     `preserved_cycles` because the delegate needs this number of cycles to\n     receive rights, so `1 + 2 * preserved_cycles` in total. *)\n  Storage.Contract.Delegate_desactivation.find\n    ctxt\n    (Contract_repr.implicit_contract delegate)\n  >>=? fun current_last_active_cycle ->\n  let last_active_cycle =\n    match current_last_active_cycle with\n    | None -> Cycle_repr.add current_cycle (1 + (2 * preserved_cycles))\n    | Some current_last_active_cycle ->\n        let delay =\n          if inactive then 1 + (2 * preserved_cycles) else 1 + preserved_cycles\n        in\n        let updated = Cycle_repr.add current_cycle delay in\n        Cycle_repr.max current_last_active_cycle updated\n  in\n  Storage.Contract.Delegate_desactivation.add\n    ctxt\n    (Contract_repr.implicit_contract delegate)\n    last_active_cycle\n  >>= fun ctxt ->\n  if not inactive then return (ctxt, inactive)\n  else\n    Storage.Contract.Inactive_delegate.remove\n      ctxt\n      (Contract_repr.implicit_contract delegate)\n    >>= fun ctxt -> return (ctxt, inactive)\n" ;
                } ;
                { name = "Frozen_deposits_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nval init :\n  Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t\n\nval allocated : Raw_context.t -> Contract_repr.t -> bool Lwt.t\n\nval get : Raw_context.t -> Contract_repr.t -> Storage.deposits tzresult Lwt.t\n\nval find :\n  Raw_context.t -> Contract_repr.t -> Storage.deposits option tzresult Lwt.t\n\nval credit_only_call_from_token :\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Tez_repr.t ->\n  Raw_context.t tzresult Lwt.t\n\nval spend_only_call_from_token :\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Tez_repr.t ->\n  Raw_context.t tzresult Lwt.t\n\nval update_deposits_cap :\n  Raw_context.t ->\n  Contract_repr.t ->\n  Tez_repr.t ->\n  (Raw_context.t * Tez_repr.t) tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nlet init ctxt delegate =\n  Storage.Contract.Frozen_deposits.init\n    ctxt\n    (Contract_repr.implicit_contract delegate)\n    {initial_amount = Tez_repr.zero; current_amount = Tez_repr.zero}\n\nlet allocated = Storage.Contract.Frozen_deposits.mem\n\nlet get = Storage.Contract.Frozen_deposits.get\n\nlet find = Storage.Contract.Frozen_deposits.find\n\nlet update_balance ctxt delegate f amount =\n  let delegate_contract = Contract_repr.implicit_contract delegate in\n  Storage.Contract.Frozen_deposits.get ctxt delegate_contract\n  >>=? fun frozen_deposits ->\n  f frozen_deposits.current_amount amount >>?= fun new_amount ->\n  Storage.Contract.Frozen_deposits.update\n    ctxt\n    delegate_contract\n    {frozen_deposits with current_amount = new_amount}\n\nlet credit_only_call_from_token ctxt delegate amount =\n  update_balance ctxt delegate Tez_repr.( +? ) amount\n\nlet spend_only_call_from_token ctxt delegate amount =\n  update_balance ctxt delegate Tez_repr.( -? ) amount\n\nlet update_deposits_cap ctxt delegate_contract deposits_cap =\n  Storage.Contract.Frozen_deposits.get ctxt delegate_contract\n  >>=? fun frozen_deposits ->\n  Storage.Contract.Frozen_deposits.update\n    ctxt\n    delegate_contract\n    {frozen_deposits with initial_amount = deposits_cap}\n  >|=? fun ctxt -> (ctxt, frozen_deposits.current_amount)\n" ;
                } ;
                { name = "Stake_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nmodule Delegate_sampler_state : sig\n  val init :\n    Raw_context.t ->\n    Cycle_repr.t ->\n    Storage.Delegate_sampler_state.value ->\n    Raw_context.t tzresult Lwt.t\n\n  val get :\n    Raw_context.t ->\n    Cycle_repr.t ->\n    Storage.Delegate_sampler_state.value tzresult Lwt.t\n\n  val remove_existing :\n    Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t\nend\n\nval remove_stake :\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Tez_repr.t ->\n  Raw_context.t tzresult Lwt.t\n\nval add_stake :\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Tez_repr.t ->\n  Raw_context.t tzresult Lwt.t\n\nval deactivate_only_call_from_delegate_storage :\n  Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t Lwt.t\n\nval activate_only_call_from_delegate_storage :\n  Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t\n\nval get_staking_balance :\n  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t\n\nval snapshot : Raw_context.t -> Raw_context.t tzresult Lwt.t\n\nval select_distribution_for_cycle_do_not_call_except_for_migration :\n  Raw_context.t ->\n  Cycle_repr.t ->\n  (Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Signature.Public_key.t tzresult Lwt.t) ->\n  Raw_context.t tzresult Lwt.t\n\nval clear_cycle : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t\n\nval init_first_cycles :\n  Raw_context.t ->\n  (Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Signature.Public_key.t tzresult Lwt.t) ->\n  Raw_context.t tzresult Lwt.t\n\nval fold :\n  Raw_context.t ->\n  f:(Signature.Public_key_hash.t * Tez_repr.t -> 'a -> 'a tzresult Lwt.t) ->\n  order:[`Sorted | `Undefined] ->\n  'a ->\n  'a tzresult Lwt.t\n\nval select_new_distribution_at_cycle_end :\n  Raw_context.t ->\n  new_cycle:Cycle_repr.t ->\n  (Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Signature.Public_key.t tzresult Lwt.t) ->\n  Raw_context.t tzresult Lwt.t\n\nval clear_at_cycle_end :\n  Raw_context.t -> new_cycle:Cycle_repr.t -> Raw_context.t tzresult Lwt.t\n\nval get :\n  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t\n\nval fold_on_active_delegates_with_rolls :\n  Raw_context.t ->\n  order:[`Sorted | `Undefined] ->\n  init:'a ->\n  f:(Signature.Public_key_hash.t -> unit -> 'a -> 'a Lwt.t) ->\n  'a Lwt.t\n\nval get_selected_distribution :\n  Raw_context.t ->\n  Cycle_repr.t ->\n  (Signature.Public_key_hash.t * Tez_repr.t) list tzresult Lwt.t\n\nval find_selected_distribution :\n  Raw_context.t ->\n  Cycle_repr.t ->\n  (Signature.Public_key_hash.t * Tez_repr.t) list option tzresult Lwt.t\n\n(** Copy the stake distribution for the current cycle (from\n   [Storage.Stake.Selected_distribution_for_cycle]) in the raw\n   context. *)\nval prepare_stake_distribution : Raw_context.t -> Raw_context.t tzresult Lwt.t\n\nval get_total_active_stake :\n  Raw_context.t -> Cycle_repr.t -> Tez_repr.t tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Misc\n\nmodule Selected_distribution_for_cycle = struct\n  module Cache_client = struct\n    type cached_value = (Signature.Public_key_hash.t * Tez_repr.t) list\n\n    let namespace = Cache_repr.create_namespace \"stake_distribution\"\n\n    let cache_index = 1\n\n    let value_of_identifier ctxt identifier =\n      let cycle = Cycle_repr.of_string_exn identifier in\n      Storage.Stake.Selected_distribution_for_cycle.get ctxt cycle\n  end\n\n  module Cache = (val Cache_repr.register_exn (module Cache_client))\n\n  let identifier_of_cycle cycle = Format.asprintf \"%a\" Cycle_repr.pp cycle\n\n  let init ctxt cycle stakes =\n    let id = identifier_of_cycle cycle in\n    Storage.Stake.Selected_distribution_for_cycle.init ctxt cycle stakes\n    >>=? fun ctxt ->\n    let size = Constants_repr.stake_distribution_size in\n    Cache.update ctxt id (Some (stakes, size)) >>?= fun ctxt -> return ctxt\n\n  let get ctxt cycle =\n    let id = identifier_of_cycle cycle in\n    Cache.find ctxt id >>=? function\n    | None -> Storage.Stake.Selected_distribution_for_cycle.get ctxt cycle\n    | Some v -> return v\n\n  let remove_existing ctxt cycle =\n    let id = identifier_of_cycle cycle in\n    (Cache.find ctxt id >>=? function\n     | None -> return ctxt\n     | Some _ -> Cache.update ctxt id None |> Lwt.return)\n    >>=? fun ctxt ->\n    Storage.Stake.Selected_distribution_for_cycle.remove_existing ctxt cycle\nend\n\nmodule Delegate_sampler_state = struct\n  module Cache_client = struct\n    type cached_value =\n      (Signature.Public_key.t * Signature.Public_key_hash.t) Sampler.t\n\n    let namespace = Cache_repr.create_namespace \"sampler_state\"\n\n    let cache_index = 2\n\n    let value_of_identifier ctxt identifier =\n      let cycle = Cycle_repr.of_string_exn identifier in\n      Storage.Delegate_sampler_state.get ctxt cycle\n  end\n\n  module Cache = (val Cache_repr.register_exn (module Cache_client))\n\n  let identifier_of_cycle cycle = Format.asprintf \"%a\" Cycle_repr.pp cycle\n\n  let init ctxt cycle sampler_state =\n    let id = identifier_of_cycle cycle in\n    Storage.Delegate_sampler_state.init ctxt cycle sampler_state\n    >>=? fun ctxt ->\n    let size = Constants_repr.sampler_state_size in\n    Cache.update ctxt id (Some (sampler_state, size)) >>?= fun ctxt ->\n    return ctxt\n\n  let get ctxt cycle =\n    let id = identifier_of_cycle cycle in\n    Cache.find ctxt id >>=? function\n    | None -> Storage.Delegate_sampler_state.get ctxt cycle\n    | Some v -> return v\n\n  let remove_existing ctxt cycle =\n    let id = identifier_of_cycle cycle in\n    (Cache.find ctxt id >>=? function\n     | None -> return ctxt\n     | Some _ -> Cache.update ctxt id None |> Lwt.return)\n    >>=? fun ctxt -> Storage.Delegate_sampler_state.remove_existing ctxt cycle\nend\n\nlet get_staking_balance = Storage.Stake.Staking_balance.get\n\nlet ensure_stake_inited ctxt delegate =\n  Storage.Stake.Staking_balance.mem ctxt delegate >>= function\n  | true -> return ctxt\n  | false ->\n      Frozen_deposits_storage.init ctxt delegate >>=? fun ctxt ->\n      Storage.Stake.Staking_balance.init ctxt delegate Tez_repr.zero\n\nlet remove_stake ctxt delegate amount =\n  ensure_stake_inited ctxt delegate >>=? fun ctxt ->\n  let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in\n  get_staking_balance ctxt delegate >>=? fun staking_balance_before ->\n  Tez_repr.(staking_balance_before -? amount) >>?= fun staking_balance ->\n  Storage.Stake.Staking_balance.update ctxt delegate staking_balance\n  >>=? fun ctxt ->\n  Delegate_activation_storage.is_inactive ctxt delegate >>=? fun inactive ->\n  if (not inactive) && Tez_repr.(staking_balance_before >= tokens_per_roll) then\n    if Tez_repr.(staking_balance < tokens_per_roll) then\n      Storage.Stake.Active_delegate_with_one_roll.remove ctxt delegate\n      >>= fun ctxt -> return ctxt\n    else return ctxt\n  else\n    (* The delegate was not in Stake.Active_delegate_with_one_roll,\n       either because it was inactive, or because it did not have a\n       roll, in which case it still does not have a roll. *)\n    return ctxt\n\nlet add_stake ctxt delegate amount =\n  ensure_stake_inited ctxt delegate >>=? fun ctxt ->\n  let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in\n  get_staking_balance ctxt delegate >>=? fun staking_balance_before ->\n  Tez_repr.(amount +? staking_balance_before) >>?= fun staking_balance ->\n  Storage.Stake.Staking_balance.update ctxt delegate staking_balance\n  >>=? fun ctxt ->\n  if Tez_repr.(staking_balance >= tokens_per_roll) then\n    Delegate_activation_storage.is_inactive ctxt delegate >>=? fun inactive ->\n    if inactive || Tez_repr.(staking_balance_before >= tokens_per_roll) then\n      return ctxt\n    else\n      Storage.Stake.Active_delegate_with_one_roll.add ctxt delegate ()\n      >>= fun ctxt -> return ctxt\n  else\n    (* The delegate was not in Stake.Active_delegate_with_one_roll,\n       because it did not have a roll (as otherwise it would have a\n       roll now). *)\n    return ctxt\n\nlet deactivate_only_call_from_delegate_storage ctxt delegate =\n  Storage.Stake.Active_delegate_with_one_roll.remove ctxt delegate\n\nlet activate_only_call_from_delegate_storage ctxt delegate =\n  ensure_stake_inited ctxt delegate >>=? fun ctxt ->\n  get_staking_balance ctxt delegate >>=? fun staking_balance ->\n  let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in\n  if Tez_repr.(staking_balance >= tokens_per_roll) then\n    Storage.Stake.Active_delegate_with_one_roll.add ctxt delegate ()\n    >>= fun ctxt -> return ctxt\n  else return ctxt\n\nlet snapshot ctxt =\n  Storage.Stake.Last_snapshot.get ctxt >>=? fun index ->\n  Storage.Stake.Last_snapshot.update ctxt (index + 1) >>=? fun ctxt ->\n  Storage.Stake.Staking_balance.snapshot ctxt index >>=? fun ctxt ->\n  Storage.Stake.Active_delegate_with_one_roll.snapshot ctxt index\n\nlet select_distribution_for_cycle ctxt cycle pubkey =\n  Storage.Stake.Last_snapshot.get ctxt >>=? fun max_index ->\n  Storage.Seed.For_cycle.get ctxt cycle >>=? fun seed ->\n  let rd = Seed_repr.initialize_new seed [Bytes.of_string \"stake_snapshot\"] in\n  let seq = Seed_repr.sequence rd 0l in\n  let selected_index =\n    Seed_repr.take_int32 seq (Int32.of_int max_index) |> fst |> Int32.to_int\n  in\n  List.fold_left_es\n    (fun ctxt index ->\n      (if Compare.Int.(index = selected_index) then\n       Storage.Stake.Active_delegate_with_one_roll.fold_snapshot\n         ctxt\n         index\n         ~order:`Sorted\n         ~init:([], Tez_repr.zero)\n         ~f:(fun delegate () (acc, total_stake) ->\n           Storage.Stake.Staking_balance.Snapshot.get ctxt (index, delegate)\n           >>=? fun staking_balance ->\n           let delegate_contract = Contract_repr.implicit_contract delegate in\n           Storage.Contract.Frozen_deposits_limit.find ctxt delegate_contract\n           >>=? fun frozen_deposits_limit ->\n           Storage.Contract.Balance.get ctxt delegate_contract\n           >>=? fun balance ->\n           Frozen_deposits_storage.get ctxt delegate_contract\n           >>=? fun frozen_deposits ->\n           Tez_repr.(balance +? frozen_deposits.current_amount)\n           >>?= fun total_balance ->\n           let frozen_deposits_percentage =\n             Constants_storage.frozen_deposits_percentage ctxt\n           in\n           let stake_to_consider =\n             match frozen_deposits_limit with\n             | Some frozen_deposits_limit -> (\n                 try\n                   let max_mutez = Tez_repr.of_mutez_exn Int64.max_int in\n                   let frozen_stake_limit =\n                     if Tez_repr.(frozen_deposits_limit > div_exn max_mutez 100)\n                     then max_mutez\n                     else\n                       Tez_repr.(\n                         div_exn\n                           (mul_exn frozen_deposits_limit 100)\n                           frozen_deposits_percentage)\n                   in\n                   Tez_repr.min staking_balance frozen_stake_limit\n                 with _ -> staking_balance)\n             | None -> staking_balance\n           in\n           let max_staking_capacity =\n             Tez_repr.(\n               div_exn (mul_exn total_balance 100) frozen_deposits_percentage)\n           in\n           let stake_for_cycle =\n             Tez_repr.min stake_to_consider max_staking_capacity\n           in\n           Tez_repr.(total_stake +? stake_for_cycle) >>?= fun total_stake ->\n           return ((delegate, stake_for_cycle) :: acc, total_stake))\n       >>=? fun (stakes, total_stake) ->\n       let stakes =\n         List.sort (fun (_, x) (_, y) -> Tez_repr.compare y x) stakes\n       in\n       Selected_distribution_for_cycle.init ctxt cycle stakes >>=? fun ctxt ->\n       Storage.Total_active_stake.add ctxt cycle total_stake >>= fun ctxt ->\n       List.fold_left_es\n         (fun acc (pkh, stake) ->\n           pubkey ctxt pkh >>=? fun pk ->\n           return (((pk, pkh), Tez_repr.to_mutez stake) :: acc))\n         []\n         stakes\n       >>=? fun stakes_pk ->\n       let state = Sampler.create stakes_pk in\n       Delegate_sampler_state.init ctxt cycle state\n      else return ctxt)\n      >>=? fun ctxt ->\n      Storage.Stake.Staking_balance.delete_snapshot ctxt index >>= fun ctxt ->\n      Storage.Stake.Active_delegate_with_one_roll.delete_snapshot ctxt index\n      >>= fun ctxt -> return ctxt)\n    ctxt\n    Misc.(0 --> (max_index - 1))\n  >>=? fun ctxt -> Storage.Stake.Last_snapshot.update ctxt 0\n\nlet select_distribution_for_cycle_do_not_call_except_for_migration =\n  select_distribution_for_cycle\n\nlet clear_cycle ctxt cycle =\n  Storage.Total_active_stake.remove_existing ctxt cycle >>=? fun ctxt ->\n  Selected_distribution_for_cycle.remove_existing ctxt cycle >>=? fun ctxt ->\n  Delegate_sampler_state.remove_existing ctxt cycle >>=? fun ctxt ->\n  Storage.Seed.For_cycle.remove_existing ctxt cycle\n\nlet init_first_cycles ctxt pubkey =\n  let preserved = Constants_storage.preserved_cycles ctxt in\n  List.fold_left_es\n    (fun ctxt c ->\n      let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in\n      snapshot ctxt >>=? fun ctxt ->\n      select_distribution_for_cycle ctxt cycle pubkey)\n    ctxt\n    (0 --> preserved)\n  >>=? fun ctxt ->\n  (* Precompute a snapshot for cycle (preserved_cycles + 1) *)\n  snapshot ctxt\n\nlet fold ctxt ~f ~order init =\n  Storage.Stake.Active_delegate_with_one_roll.fold\n    ctxt\n    ~order\n    ~init:(Ok init)\n    ~f:(fun delegate () acc ->\n      acc >>?= fun acc ->\n      get_staking_balance ctxt delegate >>=? fun stake ->\n      f (delegate, stake) acc)\n\nlet select_new_distribution_at_cycle_end ctxt ~new_cycle =\n  let preserved = Constants_storage.preserved_cycles ctxt in\n  let for_cycle = Cycle_repr.add new_cycle preserved in\n  select_distribution_for_cycle ctxt for_cycle\n\nlet clear_at_cycle_end ctxt ~new_cycle =\n  let max_slashing_period = Constants_storage.max_slashing_period ctxt in\n  match Cycle_repr.sub new_cycle max_slashing_period with\n  | None -> return ctxt\n  | Some cycle_to_clear -> clear_cycle ctxt cycle_to_clear\n\nlet get ctxt delegate =\n  Storage.Stake.Active_delegate_with_one_roll.mem ctxt delegate >>= function\n  | true -> get_staking_balance ctxt delegate\n  | false -> return Tez_repr.zero\n\nlet fold_on_active_delegates_with_rolls =\n  Storage.Stake.Active_delegate_with_one_roll.fold\n\nlet get_selected_distribution = Selected_distribution_for_cycle.get\n\nlet find_selected_distribution =\n  Storage.Stake.Selected_distribution_for_cycle.find\n\nlet prepare_stake_distribution ctxt =\n  let level = Level_storage.current ctxt in\n  Selected_distribution_for_cycle.get ctxt level.cycle >>=? fun stakes ->\n  let stake_distribution =\n    List.fold_left\n      (fun map (pkh, stake) -> Signature.Public_key_hash.Map.add pkh stake map)\n      Signature.Public_key_hash.Map.empty\n      stakes\n  in\n  return\n    (Raw_context.init_stake_distribution_for_current_cycle\n       ctxt\n       stake_distribution)\n\nlet get_total_active_stake = Storage.Total_active_stake.get\n" ;
                } ;
                { name = "Contract_delegate_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** [find ctxt contract] returns the delegate associated to [contract], or [None]\n    if [contract] has no delegate]. *)\nval find :\n  Raw_context.t ->\n  Contract_repr.t ->\n  Signature.Public_key_hash.t option tzresult Lwt.t\n\n(** [registered ctxt delegate] returns true iff delegate is an implicit contract\n    that delegates to itself. *)\nval registered :\n  Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t\n\n(** [init ctxt contract delegate] sets the [delegate] associated to [contract].\n\n    This function is undefined if [contract] is not allocated, or if [contract]\n    has already a delegate. *)\nval init :\n  Raw_context.t ->\n  Contract_repr.t ->\n  Signature.Public_key_hash.t ->\n  Raw_context.t tzresult Lwt.t\n\n(** [remove ctxt contract] removes contract from the list of contracts that\n    delegated to [find ctxt contract], i.e. the output of [delegated_contracts].\n    This function does not affect the value of the expression\n    [find ctxt contract].\n\n    This function is undefined if [contract] is not allocated. *)\nval remove : Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t\n\n(** [delete ctxt contract] behaves as [remove ctxt contract], but in addition\n    removes the association of the [contract] to its current delegate, leaving\n    the former with no delegate.\n\n    This function is undefined if [contract] is not allocated. *)\nval delete : Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t\n\n(** [set ctxt contract delegate] updates the [delegate] associated to [contract].\n\n    This function is undefined if [contract] is not allocated, or if [contract]\n    does not have a delegate. *)\nval set :\n  Raw_context.t ->\n  Contract_repr.t ->\n  Signature.Public_key_hash.t ->\n  Raw_context.t tzresult Lwt.t\n\n(** [delegated_contracts ctxt delegate] returns the list of contracts (implicit\n    or originated) that delegated to [delegate]. *)\nval delegated_contracts :\n  Raw_context.t -> Signature.Public_key_hash.t -> Contract_repr.t list Lwt.t\n\n(** [add_contract_stake ctxt contract amount] calls\n    [Stake_storage.add_stake ctxt delegate amount] if [contract] has a\n    [delegate]. Otherwise this function does nothing. *)\nval add_contract_stake :\n  Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t\n\n(** [remove_contract_stake ctxt contract amount] calls\n    [Stake_storage.remove_stake ctxt delegate amount] if [contract] has a\n    [delegate]. Otherwise this function does nothing. *)\nval remove_contract_stake :\n  Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nlet find = Storage.Contract.Delegate.find\n\nlet remove_contract_stake ctxt contract amount =\n  find ctxt contract >>=? function\n  | None -> return ctxt\n  | Some delegate -> Stake_storage.remove_stake ctxt delegate amount\n\nlet add_contract_stake ctxt contract amount =\n  find ctxt contract >>=? function\n  | None -> return ctxt\n  | Some delegate -> Stake_storage.add_stake ctxt delegate amount\n\n(* A delegate is registered if its \"implicit account\" delegates to itself. *)\nlet registered c delegate =\n  Storage.Contract.Delegate.find c (Contract_repr.implicit_contract delegate)\n  >|=? function\n  | Some current_delegate ->\n      Signature.Public_key_hash.equal delegate current_delegate\n  | None -> false\n\nlet link c contract delegate =\n  Storage.Contract.Balance.get c contract >>=? fun balance ->\n  Stake_storage.add_stake c delegate balance >>=? fun c ->\n  Storage.Contract.Delegated.add\n    (c, Contract_repr.implicit_contract delegate)\n    contract\n  >|= ok\n\nlet unlink c contract =\n  Storage.Contract.Delegate.find c contract >>=? function\n  | None -> return c\n  | Some delegate ->\n      Storage.Contract.Balance.get c contract >>=? fun balance ->\n      (* Removes the balance of the contract from the delegate *)\n      Stake_storage.remove_stake c delegate balance >>=? fun c ->\n      Storage.Contract.Delegated.remove\n        (c, Contract_repr.implicit_contract delegate)\n        contract\n      >|= ok\n\nlet init ctxt contract delegate =\n  Storage.Contract.Delegate.init ctxt contract delegate >>=? fun ctxt ->\n  link ctxt contract delegate\n\nlet delete ctxt contract =\n  unlink ctxt contract >>=? fun ctxt ->\n  Storage.Contract.Delegate.remove ctxt contract >|= ok\n\nlet remove ctxt contract = unlink ctxt contract\n\nlet set ctxt contract delegate =\n  unlink ctxt contract >>=? fun ctxt ->\n  Storage.Contract.Delegate.add ctxt contract delegate >>= fun ctxt ->\n  link ctxt contract delegate\n\nlet delegated_contracts ctxt delegate =\n  let contract = Contract_repr.implicit_contract delegate in\n  Storage.Contract.Delegated.elements (ctxt, contract)\n" ;
                } ;
                { name = "Sapling_storage" ;
                  interface = None ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2019-2020 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nmodule type COMMITMENTS = sig\n  val init : Raw_context.t -> Storage.Sapling.id -> Raw_context.t Lwt.t\n\n  val default_root : Sapling.Hash.t\n\n  val get_root :\n    Raw_context.t ->\n    Storage.Sapling.id ->\n    (Raw_context.t * Sapling.Hash.t) tzresult Lwt.t\n\n  val add :\n    Raw_context.t ->\n    Storage.Sapling.id ->\n    Sapling.Commitment.t list ->\n    int64 ->\n    (Raw_context.t * int) tzresult Lwt.t\n\n  val get_from :\n    Raw_context.t ->\n    Storage.Sapling.id ->\n    int64 ->\n    Sapling.Commitment.t list tzresult Lwt.t\nend\n\nmodule Commitments : COMMITMENTS = struct\n  module H = Sapling.Hash\n\n  (** Incremental Merkle Tree\n   *\n   * A tree of height h contains 2^h leaves and h+1 levels of nodes with\n   * leaves at level 0 and root at level h.\n   *\n   * The leaves are commitments and the tree it is treated as always filled\n   * with a default value H.uncommitted. This allows to have proofs of\n   * membership, or witnesses, of fixed size.\n   *\n   * All the nodes at the same level of an empty tree have the same hash,\n   * which can be computed from the default value of the leaves. This is\n   * stored in the [uncommitted] list.\n   *\n   * Any subtree filled with default values is represented by the Empty\n   * constructor and given its height it's possible to compute its hash\n   * using the [uncommitted] list.\n   *\n   * The leaves are indexed by their position [pos], ranging from 0 to\n   * (2^h)-1. The encoding of [pos] limits the possible size of the tree.\n   * In any case the only valid height for the Sapling library is 32, so even\n   * if the library encodes positions as uint64, they never exceed uint32.\n   *\n   * The tree is incremental in the sense that leaves cannot be modified but\n   * only added and exclusively in successive positions.\n   *\n   * Given that elements are added and retrieved by position, it is possible\n   * to use this information to efficiently navigate the tree.\n   * Given a tree of height [h] and a position [pos], if pos < pow2 (h-1) only\n   * the left subtree needs to be inspected recursively. Otherwise only the\n   * right needs to be visited, decreasing [pos] by [pow2 (h-1)].\n   *\n   * In order to avoid storing the height for each subtree (or worse\n   * recomputing it), each function with suffix `_height` expects the height\n   * of the tree as parameter. These functions are only for internal use and\n   * are later aliased by functions using the default height of a Sapling\n   * incremental Merkle tree.\n   *\n   * Each node of the tree is indexed starting from the root at index 1,\n   * followed by its left child at index 2, right child at index 3 and so on\n   * until the last leaf at index 2^(depth+1)-1, or in terms of height\n   * 2^(32 - height +1) -1.\n   * The functions left and right return the index of the left and right child\n   * of a node.\n   *)\n\n  let pow2 h = Int64.(shift_left 1L h)\n\n  let max_height = 32\n\n  let max_size = pow2 max_height\n\n  let assert_node node height =\n    assert (\n      let first_of_height = pow2 (max_height - height) in\n      let first_of_next_height = Int64.shift_left first_of_height 1 in\n      Compare.Int64.(node >= first_of_height && node < first_of_next_height))\n\n  let assert_height height =\n    assert (Compare.Int.(height >= 0 && height <= max_height))\n\n  let assert_pos pos height =\n    assert (Compare.Int64.(pos >= 0L && pos <= pow2 height))\n\n  let default_root = H.uncommitted ~height:max_height\n\n  let init = Storage.Sapling.commitments_init\n\n  let get_root_height ctx id node height =\n    assert_node node height ;\n    assert_height height ;\n    Storage.Sapling.Commitments.find (ctx, id) node >|=? function\n    | (ctx, None) ->\n        let hash = H.uncommitted ~height in\n        (ctx, hash)\n    | (ctx, Some hash) -> (ctx, hash)\n\n  let left node = Int64.mul node 2L\n\n  let right node = Int64.(add (mul node 2L) 1L)\n\n  (* Not tail-recursive *)\n  let rec split_at n l =\n    if Compare.Int64.(n = 0L) then ([], l)\n    else\n      match l with\n      | [] -> ([], l)\n      | x :: xs ->\n          let (l1, l2) = split_at Int64.(pred n) xs in\n          (x :: l1, l2)\n\n  (* [insert tree height pos cms] inserts the list of commitments\n     [cms] in the tree [tree] of height [height] at the next position [pos].\n     Returns the context, the size of the added storage, and the hash of the\n     node. Not tail-recursive.\n     Pre: incremental tree /\\\n          size tree + List.length cms <= pow2 height /\\\n          pos = size tree /\\\n     Post: incremental tree /\\\n           to_list (insert tree height pos cms) = to_list t @ cms *)\n  let[@coq_struct \"height\"] rec insert ctx id node height pos cms =\n    assert_node node height ;\n    assert_height height ;\n    assert_pos pos height ;\n    match (height, cms) with\n    | (_, []) ->\n        get_root_height ctx id node height >|=? fun (ctx, h) -> (ctx, 0, h)\n    | (0, [cm]) ->\n        let h = H.of_commitment cm in\n        Storage.Sapling.Commitments.init (ctx, id) node h\n        >|=? fun (ctx, size) -> (ctx, size, h)\n    | _ ->\n        let height = height - 1 in\n        (if Compare.Int64.(pos < pow2 height) then\n         let at = Int64.(sub (pow2 height) pos) in\n         let (cml, cmr) = split_at at cms in\n         insert ctx id (left node) height pos cml >>=? fun (ctx, size_l, hl) ->\n         insert ctx id (right node) height 0L cmr >|=? fun (ctx, size_r, hr) ->\n         (ctx, size_l + size_r, hl, hr)\n        else\n          get_root_height ctx id (left node) height >>=? fun (ctx, hl) ->\n          let pos = Int64.(sub pos (pow2 height)) in\n          insert ctx id (right node) height pos cms\n          >|=? fun (ctx, size_r, hr) -> (ctx, size_r, hl, hr))\n        >>=? fun (ctx, size_children, hl, hr) ->\n        let h = H.merkle_hash ~height hl hr in\n        Storage.Sapling.Commitments.add (ctx, id) node h\n        >|=? fun (ctx, size, _existing) -> (ctx, size + size_children, h)\n\n  let[@coq_struct \"height\"] rec fold_from_height ctx id node ~pos ~f ~acc height\n      =\n    assert_node node height ;\n    assert_height height ;\n    assert_pos pos height ;\n    Storage.Sapling.Commitments.find (ctx, id) node\n    (* we don't count gas for this function, it is called only by RPC *)\n    >>=?\n    function\n    | (_ctx, None) -> return acc\n    | (_ctx, Some h) ->\n        if Compare.Int.(height = 0) then return (f acc h)\n        else\n          let full = pow2 (height - 1) in\n          if Compare.Int64.(pos < full) then\n            fold_from_height ctx id (left node) ~pos ~f ~acc (height - 1)\n            >>=? fun acc ->\n            (* Setting pos to 0 folds on the whole right subtree *)\n            fold_from_height ctx id (right node) ~pos:0L ~f ~acc (height - 1)\n          else\n            let pos = Int64.(sub pos full) in\n            fold_from_height ctx id (right node) ~pos ~f ~acc (height - 1)\n\n  let root_node = 1L\n\n  let get_root ctx id = get_root_height ctx id root_node max_height\n\n  (* Expects pos to be the next position to insert. Pos is also the number of\n     inserted leaves.\n     A commitment should always be added together with a corresponding\n     ciphertext in the same position.\n     [insert] is not tail-recursive so we put a hard limit on the size of the\n     list of commitments. The use of [split_at] has O(n logn) complexity that is\n     less relevant on a smaller list. *)\n  let add ctx id cms pos =\n    let l = List.length cms in\n    assert (Compare.Int.(l <= 1000)) ;\n    let n' = Int64.(add pos (of_int l)) in\n    assert (Compare.Int64.(n' <= max_size)) ;\n    insert ctx id root_node max_height pos cms >|=? fun (ctx, size, _h) ->\n    (ctx, size)\n\n  let get_from ctx id pos =\n    fold_from_height\n      ctx\n      id\n      root_node\n      ~pos\n      ~f:(fun acc c -> H.to_commitment c :: acc)\n      ~acc:[]\n      max_height\n    >|=? fun l -> List.rev l\nend\n\nmodule Ciphertexts = struct\n  let init ctx id = Storage.Sapling.ciphertexts_init ctx id\n\n  (* a ciphertext should always be added together with a corresponding\n     commitment in the same position *)\n  let add ctx id c pos = Storage.Sapling.Ciphertexts.init (ctx, id) pos c\n\n  let get_from ctx id offset =\n    let rec aux (ctx, acc) pos =\n      Storage.Sapling.Ciphertexts.find (ctx, id) pos >>=? fun (ctx, c) ->\n      match c with\n      | None -> return (ctx, List.rev acc)\n      | Some c -> aux (ctx, c :: acc) (Int64.succ pos)\n    in\n    aux (ctx, []) offset\nend\n\n(* Collection of nullifiers w/o duplicates, append-only. It has a dual\n   implementation with a hash map for constant `mem` and with a ordered set to\n   retrieve by position.  *)\nmodule Nullifiers = struct\n  let init = Storage.Sapling.nullifiers_init\n\n  let size ctx id = Storage.Sapling.Nullifiers_size.get (ctx, id)\n\n  let mem ctx id nf = Storage.Sapling.Nullifiers_hashed.mem (ctx, id) nf\n\n  (* Allows for duplicates as they are already checked by verify_update before\n     updating the state.\n     Not tail-recursive so we put a hard limit on the size of the\n     list of nullifiers. *)\n  let add ctx id nfs =\n    assert (Compare.Int.(List.compare_length_with nfs 1000 <= 0)) ;\n    size ctx id >>=? fun nf_start_pos ->\n    List.fold_right_es\n      (fun nf (ctx, pos, acc_size) ->\n        Storage.Sapling.Nullifiers_hashed.init (ctx, id) nf\n        >>=? fun (ctx, size) ->\n        Storage.Sapling.Nullifiers_ordered.init (ctx, id) pos nf >|=? fun ctx ->\n        (ctx, Int64.succ pos, Z.add acc_size (Z.of_int size)))\n      nfs\n      (ctx, nf_start_pos, Z.zero)\n    >>=? fun (ctx, nf_end_pos, size) ->\n    Storage.Sapling.Nullifiers_size.update (ctx, id) nf_end_pos >|=? fun ctx ->\n    (ctx, size)\n\n  let get_from ctx id offset =\n    let[@coq_struct \"pos\"] rec aux acc pos =\n      Storage.Sapling.Nullifiers_ordered.find (ctx, id) pos >>=? function\n      | None -> return @@ List.rev acc\n      | Some c -> aux (c :: acc) (Int64.succ pos)\n    in\n    aux [] offset\nend\n\n(** Bounded queue of roots. The full size is initialized with the default\n    uncommitted root, that's why roots storage doesn't need to be carbonated.\n    A maximum of one new root is added per protocol level.\n    If multiple transactions for the same shielded pool are processed during the\n    same contract call or several calls in the same block, only the last root\n    will be stored.\n    This property prevents transactions in the same block from depending on each\n    other and guarantees that a transaction will be valid for a least two hours\n    (hence the 120 size) after being forged. *)\nmodule Roots = struct\n  let size = 120l\n\n  (* pos is the index of the last inserted element *)\n\n  let get ctx id =\n    Storage.Sapling.Roots_pos.get (ctx, id) >>=? fun pos ->\n    Storage.Sapling.Roots.get (ctx, id) pos\n\n  let init ctx id =\n    let[@coq_struct \"pos\"] rec aux ctx pos =\n      if Compare.Int32.(pos < 0l) then return ctx\n      else\n        Storage.Sapling.Roots.init (ctx, id) pos Commitments.default_root\n        >>=? fun ctx -> aux ctx (Int32.pred pos)\n    in\n    aux ctx (Int32.pred size) >>=? fun ctx ->\n    Storage.Sapling.Roots_pos.init (ctx, id) 0l >>=? fun ctx ->\n    let level = (Raw_context.current_level ctx).level in\n    Storage.Sapling.Roots_level.init (ctx, id) level\n\n  let mem ctx id root =\n    Storage.Sapling.Roots_pos.get (ctx, id) >>=? fun start_pos ->\n    let rec aux pos =\n      Storage.Sapling.Roots.get (ctx, id) pos >>=? fun hash ->\n      if Compare.Int.(Sapling.Hash.compare hash root = 0) then return true\n      else\n        let pos = Int32.(pred pos) in\n        let pos = if Compare.Int32.(pos < 0l) then Int32.pred size else pos in\n        if Compare.Int32.(pos = start_pos) then return false else aux pos\n    in\n    aux start_pos\n\n  (* allows duplicates *)\n  let add ctx id root =\n    Storage.Sapling.Roots_pos.get (ctx, id) >>=? fun pos ->\n    let level = (Raw_context.current_level ctx).level in\n    Storage.Sapling.Roots_level.get (ctx, id) >>=? fun stored_level ->\n    if Raw_level_repr.(stored_level = level) then\n      (* if there is another add during the same level, it will over-write on\n         the same position *)\n      Storage.Sapling.Roots.add (ctx, id) pos root >|= ok\n    else\n      (* it's the first add for this level *)\n      (* TODO(samoht): why is it using [update] and not [init] then? *)\n      Storage.Sapling.Roots_level.update (ctx, id) level >>=? fun ctx ->\n      let pos = Int32.rem (Int32.succ pos) size in\n      Storage.Sapling.Roots_pos.update (ctx, id) pos >>=? fun ctx ->\n      Storage.Sapling.Roots.add (ctx, id) pos root >|= ok\nend\n\n(** This type links the permanent state stored in the context at the specified\n    id together with the ephemeral diff managed by the Michelson\n    interpreter. After a successful execution the diff can be applied to update\n    the state at id. The first time a state is created its id is None, one will\n    be assigned after the first application. *)\ntype state = {\n  id : Lazy_storage_kind.Sapling_state.Id.t option;\n  diff : Sapling_repr.diff;\n  memo_size : Sapling_repr.Memo_size.t;\n}\n\nlet empty_diff =\n  Sapling_repr.{commitments_and_ciphertexts = []; nullifiers = []}\n\nlet empty_state ?id ~memo_size () = {id; diff = empty_diff; memo_size}\n\n(** Returns a state from an existing id. *)\nlet state_from_id ctxt id =\n  Storage.Sapling.Memo_size.get (ctxt, id) >|=? fun memo_size ->\n  ({id = Some id; diff = empty_diff; memo_size}, ctxt)\n\nlet rpc_arg = Storage.Sapling.rpc_arg\n\nlet get_memo_size ctx id = Storage.Sapling.Memo_size.get (ctx, id)\n\nlet init ctx id ~memo_size =\n  Storage.Sapling.Memo_size.add (ctx, id) memo_size >>= fun ctx ->\n  Storage.Sapling.Commitments_size.add (ctx, id) Int64.zero >>= fun ctx ->\n  Commitments.init ctx id >>= fun ctx ->\n  Nullifiers.init ctx id >>= fun ctx ->\n  Roots.init ctx id >>=? fun ctx -> Ciphertexts.init ctx id >|= ok\n\n(* Gas costs for apply_diff. *)\nlet sapling_apply_diff_cost ~inputs ~outputs =\n  let open Saturation_repr in\n  add\n    (safe_int 1_300_000)\n    (add\n       (scale_fast (mul_safe_of_int_exn 5_000) (safe_int inputs))\n       (scale_fast (mul_safe_of_int_exn 55_000) (safe_int outputs)))\n\n(** Applies a diff to a state id stored in the context. Updates Commitments,\n    Ciphertexts and Nullifiers using the diff and updates the Roots using the\n    new Commitments tree. *)\nlet apply_diff ctx id diff =\n  let open Sapling_repr in\n  let nb_commitments = List.length diff.commitments_and_ciphertexts in\n  let nb_nullifiers = List.length diff.nullifiers in\n  let sapling_cost =\n    sapling_apply_diff_cost ~inputs:nb_nullifiers ~outputs:nb_commitments\n  in\n  Raw_context.consume_gas ctx sapling_cost >>?= fun ctx ->\n  Storage.Sapling.Commitments_size.get (ctx, id) >>=? fun cm_start_pos ->\n  let cms = List.rev_map fst diff.commitments_and_ciphertexts in\n  Commitments.add ctx id cms cm_start_pos >>=? fun (ctx, size) ->\n  Storage.Sapling.Commitments_size.update\n    (ctx, id)\n    (Int64.add cm_start_pos (Int64.of_int nb_commitments))\n  >>=? fun ctx ->\n  List.fold_right_es\n    (fun (_cm, cp) (ctx, pos, acc_size) ->\n      Ciphertexts.add ctx id cp pos >|=? fun (ctx, size) ->\n      (ctx, Int64.succ pos, Z.add acc_size (Z.of_int size)))\n    diff.commitments_and_ciphertexts\n    (ctx, cm_start_pos, Z.of_int size)\n  >>=? fun (ctx, _ct_end_pos, size) ->\n  Nullifiers.add ctx id diff.nullifiers >>=? fun (ctx, size_nf) ->\n  let size = Z.add size size_nf in\n  match diff.commitments_and_ciphertexts with\n  | [] ->\n      (* avoids adding duplicates to Roots *)\n      return (ctx, size)\n  | _ :: _ ->\n      Commitments.get_root ctx id >>=? fun (ctx, root) ->\n      Roots.add ctx id root >|=? fun ctx -> (ctx, size)\n\nlet add {id; diff; memo_size} cm_cipher_list =\n  assert (\n    List.for_all\n      (fun (_cm, cipher) ->\n        Compare.Int.(Sapling.Ciphertext.get_memo_size cipher = memo_size))\n      cm_cipher_list) ;\n  {\n    id;\n    diff =\n      {\n        diff with\n        commitments_and_ciphertexts =\n          List.rev cm_cipher_list @ diff.commitments_and_ciphertexts;\n      };\n    memo_size;\n  }\n\nlet root_mem ctx {id; _} tested_root =\n  match id with\n  | Some id -> Roots.mem ctx id tested_root\n  | None ->\n      return\n        Compare.Int.(\n          Sapling.Hash.compare tested_root Commitments.default_root = 0)\n\n(* to avoid a double spend we need to check the disk AND the diff *)\nlet nullifiers_mem ctx {id; diff; _} nf =\n  let exists_in_diff =\n    List.exists\n      (fun v -> Compare.Int.(Sapling.Nullifier.compare nf v = 0))\n      diff.nullifiers\n  in\n  if exists_in_diff then return (ctx, true)\n  else\n    match id with\n    | None -> return (ctx, false)\n    | Some id -> Nullifiers.mem ctx id nf\n\n(* Allows for duplicates as they are already checked by verify_update before\n   updating the state. *)\nlet nullifiers_add {id; diff; memo_size} nf =\n  {id; diff = {diff with nullifiers = nf :: diff.nullifiers}; memo_size}\n\ntype root = Sapling.Hash.t\n\nlet root_encoding = Sapling.Hash.encoding\n\nlet get_diff ctx id ?(offset_commitment = 0L) ?(offset_nullifier = 0L) () =\n  if\n    not\n      Sapling.Commitment.(\n        valid_position offset_commitment && valid_position offset_nullifier)\n  then failwith \"Invalid argument.\"\n  else\n    Commitments.get_from ctx id offset_commitment >>=? fun commitments ->\n    Roots.get ctx id >>=? fun root ->\n    Nullifiers.get_from ctx id offset_nullifier >>=? fun nullifiers ->\n    Ciphertexts.get_from ctx id offset_commitment\n    (* we don't count gas for RPCs *)\n    >|=? fun (_ctx, ciphertexts) ->\n    match List.combine ~when_different_lengths:() commitments ciphertexts with\n    | Error () -> failwith \"Invalid argument.\"\n    | Ok commitments_and_ciphertexts ->\n        (root, Sapling_repr.{commitments_and_ciphertexts; nullifiers})\n" ;
                } ;
                { name = "Lazy_storage_diff" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2020 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining 'a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(**\n  See [Lazy_storage_kind] for an introduction on lazy storage.\n\n  This module defines operations on lazy storage types and diffs.\n*)\n\ntype ('id, 'alloc) init = Existing | Copy of {src : 'id} | Alloc of 'alloc\n\ntype ('id, 'alloc, 'updates) diff =\n  | Remove\n  | Update of {init : ('id, 'alloc) init; updates : 'updates}\n\n(* Exposing this type is needed only for legacy big map diff. *)\ntype diffs_item = private\n  | Item :\n      ('i, 'a, 'u) Lazy_storage_kind.t * 'i * ('i, 'a, 'u) diff\n      -> diffs_item\n\nval make :\n  ('i, 'a, 'u) Lazy_storage_kind.t -> 'i -> ('i, 'a, 'u) diff -> diffs_item\n\ntype diffs = diffs_item list\n\nval diffs_in_memory_size : diffs -> Cache_memory_helpers.nodes_and_size\n\nval encoding : diffs Data_encoding.t\n\n(**\n  The returned [Z.t] is the size added by the application of the diffs.\n*)\nval apply : Raw_context.t -> diffs -> (Raw_context.t * Z.t) tzresult Lwt.t\n\nval fresh :\n  ('id, _, _) Lazy_storage_kind.t ->\n  temporary:bool ->\n  Raw_context.t ->\n  (Raw_context.t * 'id) tzresult Lwt.t\n\n(**\n  Initializes the storage for all lazy storage kind.\n  This is useful for genesis only.\n  Protocol updates need to initialize new lazy storage kinds.\n*)\nval init : Raw_context.t -> Raw_context.t tzresult Lwt.t\n\nval cleanup_temporaries : Raw_context.t -> Raw_context.t Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2020 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nmodule type Next = sig\n  type id\n\n  val init : Raw_context.t -> Raw_context.t tzresult Lwt.t\n\n  val incr : Raw_context.t -> (Raw_context.t * id) tzresult Lwt.t\nend\n\nmodule type Total_bytes = sig\n  type id\n\n  val init : Raw_context.t -> id -> Z.t -> Raw_context.t tzresult Lwt.t\n\n  val get : Raw_context.t -> id -> Z.t tzresult Lwt.t\n\n  val update : Raw_context.t -> id -> Z.t -> Raw_context.t tzresult Lwt.t\nend\n\n(** Operations to be defined on a lazy storage type. *)\nmodule type OPS = sig\n  module Id : Lazy_storage_kind.ID\n\n  type alloc\n\n  type updates\n\n  val title : string\n\n  val alloc_encoding : alloc Data_encoding.t\n\n  val updates_encoding : updates Data_encoding.t\n\n  val alloc_in_memory_size : alloc -> Cache_memory_helpers.nodes_and_size\n\n  val updates_in_memory_size : updates -> Cache_memory_helpers.nodes_and_size\n\n  val bytes_size_for_empty : Z.t\n\n  val alloc : Raw_context.t -> id:Id.t -> alloc -> Raw_context.t tzresult Lwt.t\n\n  val apply_updates :\n    Raw_context.t -> id:Id.t -> updates -> (Raw_context.t * Z.t) tzresult Lwt.t\n\n  module Next : Next with type id := Id.t\n\n  module Total_bytes : Total_bytes with type id := Id.t\n\n  (** Deep copy. *)\n  val copy :\n    Raw_context.t -> from:Id.t -> to_:Id.t -> Raw_context.t tzresult Lwt.t\n\n  (** Deep deletion. *)\n  val remove : Raw_context.t -> Id.t -> Raw_context.t Lwt.t\nend\n\nmodule Big_map = struct\n  include Lazy_storage_kind.Big_map\n\n  let alloc_in_memory_size {key_type; value_type} =\n    let open Cache_memory_helpers in\n    ret_adding\n      (expr_size key_type ++ expr_size value_type)\n      (header_size +! (word_size *? 2))\n\n  let updates_in_memory_size updates =\n    let open Cache_memory_helpers in\n    let update_size {key; key_hash = _; value} =\n      ret_adding\n        (expr_size key ++ option_size_vec expr_size value)\n        (header_size +! (word_size *? 3) +? Script_expr_hash.size)\n    in\n    list_fold_size update_size updates\n\n  let bytes_size_for_big_map_key = 65\n\n  let bytes_size_for_empty =\n    let bytes_size_for_big_map = 33 in\n    Z.of_int bytes_size_for_big_map\n\n  let alloc ctxt ~id {key_type; value_type} =\n    (* Annotations are erased to allow sharing on [Copy]. The types from the\n       contract code are used, these ones are only used to make sure they are\n       compatible during transmissions between contracts, and only need to be\n       compatible, annotations notwithstanding. *)\n    let key_type =\n      Micheline.strip_locations\n        (Script_repr.strip_annotations (Micheline.root key_type))\n    in\n    let value_type =\n      Micheline.strip_locations\n        (Script_repr.strip_annotations (Micheline.root value_type))\n    in\n    Storage.Big_map.Key_type.init ctxt id key_type >>=? fun ctxt ->\n    Storage.Big_map.Value_type.init ctxt id value_type\n\n  let apply_update ctxt ~id\n      {\n        key = _key_is_shown_only_on_the_receipt_in_print_big_map_diff;\n        key_hash;\n        value;\n      } =\n    match value with\n    | None ->\n        Storage.Big_map.Contents.remove (ctxt, id) key_hash\n        >|=? fun (ctxt, freed, existed) ->\n        let freed =\n          if existed then freed + bytes_size_for_big_map_key else freed\n        in\n        (ctxt, Z.of_int ~-freed)\n    | Some v ->\n        Storage.Big_map.Contents.add (ctxt, id) key_hash v\n        >|=? fun (ctxt, size_diff, existed) ->\n        let size_diff =\n          if existed then size_diff else size_diff + bytes_size_for_big_map_key\n        in\n        (ctxt, Z.of_int size_diff)\n\n  let apply_updates ctxt ~id updates =\n    List.fold_left_es\n      (fun (ctxt, size) update ->\n        apply_update ctxt ~id update >|=? fun (ctxt, added_size) ->\n        (ctxt, Z.add size added_size))\n      (ctxt, Z.zero)\n      updates\n\n  include Storage.Big_map\nend\n\ntype ('id, 'alloc, 'updates) ops =\n  (module OPS\n     with type Id.t = 'id\n      and type alloc = 'alloc\n      and type updates = 'updates)\n\nmodule Sapling_state = struct\n  include Lazy_storage_kind.Sapling_state\n\n  let alloc_in_memory_size {memo_size = (_ : int)} =\n    let open Cache_memory_helpers in\n    (Nodes.zero, header_size +! word_size)\n\n  let updates_in_memory_size update =\n    (Cache_memory_helpers.Nodes.zero, Sapling_repr.diff_in_memory_size update)\n\n  let bytes_size_for_empty = Z.of_int 33\n\n  let alloc ctxt ~id {memo_size} = Sapling_storage.init ctxt id ~memo_size\n\n  let apply_updates ctxt ~id updates =\n    Sapling_storage.apply_diff ctxt id updates\n\n  include Storage.Sapling\nend\n\n(*\n  To add a new lazy storage kind here, you only need to create a module similar\n  to [Big_map] above and add a case to [get_ops] below.\n*)\n\nlet get_ops : type i a u. (i, a, u) Lazy_storage_kind.t -> (i, a, u) ops =\n  function\n  | Big_map -> (module Big_map)\n  | Sapling_state -> (module Sapling_state)\n  [@@coq_axiom_with_reason \"gadt\"]\n\ntype ('id, 'alloc) init = Existing | Copy of {src : 'id} | Alloc of 'alloc\n\ntype ('id, 'alloc, 'updates) diff =\n  | Remove\n  | Update of {init : ('id, 'alloc) init; updates : 'updates}\n\nlet diff_encoding : type i a u. (i, a, u) ops -> (i, a, u) diff Data_encoding.t\n    =\n fun (module OPS) ->\n  let open Data_encoding in\n  union\n    [\n      case\n        (Tag 0)\n        ~title:\"update\"\n        (obj2\n           (req \"action\" (constant \"update\"))\n           (req \"updates\" OPS.updates_encoding))\n        (function\n          | Update {init = Existing; updates} -> Some ((), updates) | _ -> None)\n        (fun ((), updates) -> Update {init = Existing; updates});\n      case\n        (Tag 1)\n        ~title:\"remove\"\n        (obj1 (req \"action\" (constant \"remove\")))\n        (function Remove -> Some () | _ -> None)\n        (fun () -> Remove);\n      case\n        (Tag 2)\n        ~title:\"copy\"\n        (obj3\n           (req \"action\" (constant \"copy\"))\n           (req \"source\" OPS.Id.encoding)\n           (req \"updates\" OPS.updates_encoding))\n        (function\n          | Update {init = Copy {src}; updates} -> Some ((), src, updates)\n          | _ -> None)\n        (fun ((), src, updates) -> Update {init = Copy {src}; updates});\n      case\n        (Tag 3)\n        ~title:\"alloc\"\n        (merge_objs\n           (obj2\n              (req \"action\" (constant \"alloc\"))\n              (req \"updates\" OPS.updates_encoding))\n           OPS.alloc_encoding)\n        (function\n          | Update {init = Alloc alloc; updates} -> Some (((), updates), alloc)\n          | _ -> None)\n        (fun (((), updates), alloc) -> Update {init = Alloc alloc; updates});\n    ]\n\nlet init_size :\n    type i a u.\n    (i, a, u) ops -> (i, a) init -> Cache_memory_helpers.nodes_and_size =\n fun (module OPS) init ->\n  let open Cache_memory_helpers in\n  match init with\n  | Existing -> zero\n  | Copy {src = _id_is_a_Z_fitting_in_an_int_for_a_long_time} ->\n      (Nodes.zero, header_size +! word_size)\n  | Alloc alloc ->\n      ret_adding (OPS.alloc_in_memory_size alloc) (header_size +! word_size)\n\nlet updates_size :\n    type i a u. (i, a, u) ops -> u -> Cache_memory_helpers.nodes_and_size =\n fun (module OPS) updates -> OPS.updates_in_memory_size updates\n\nlet diff_in_memory_size kind diff =\n  let open Cache_memory_helpers in\n  match diff with\n  | Remove -> zero\n  | Update {init; updates} ->\n      let ops = get_ops kind in\n      ret_adding (init_size ops init ++ updates_size ops updates) h2w\n\n(**\n  [apply_updates ctxt ops ~id init] applies the updates [updates] on lazy\n  storage [id] on storage context [ctxt] using operations [ops] and returns the\n  updated storage context and the added size in bytes (may be negative).\n*)\nlet apply_updates :\n    type i a u.\n    Raw_context.t ->\n    (i, a, u) ops ->\n    id:i ->\n    u ->\n    (Raw_context.t * Z.t) tzresult Lwt.t =\n fun ctxt (module OPS) ~id updates ->\n  OPS.apply_updates ctxt ~id updates >>=? fun (ctxt, updates_size) ->\n  if Z.(equal updates_size zero) then return (ctxt, updates_size)\n  else\n    OPS.Total_bytes.get ctxt id >>=? fun size ->\n    OPS.Total_bytes.update ctxt id (Z.add size updates_size) >|=? fun ctxt ->\n    (ctxt, updates_size)\n\n(**\n  [apply_init ctxt ops ~id init] applies the initialization [init] on lazy\n  storage [id] on storage context [ctxt] using operations [ops] and returns the\n  updated storage context and the added size in bytes (may be negative).\n\n  If [id] represents a temporary lazy storage, the added size may be wrong.\n*)\nlet apply_init :\n    type i a u.\n    Raw_context.t ->\n    (i, a, u) ops ->\n    id:i ->\n    (i, a) init ->\n    (Raw_context.t * Z.t) tzresult Lwt.t =\n fun ctxt (module OPS) ~id init ->\n  match init with\n  | Existing -> return (ctxt, Z.zero)\n  | Copy {src} ->\n      OPS.copy ctxt ~from:src ~to_:id >>=? fun ctxt ->\n      if OPS.Id.is_temp id then return (ctxt, Z.zero)\n      else\n        OPS.Total_bytes.get ctxt src >>=? fun copy_size ->\n        return (ctxt, Z.add copy_size OPS.bytes_size_for_empty)\n  | Alloc alloc ->\n      OPS.Total_bytes.init ctxt id Z.zero >>=? fun ctxt ->\n      OPS.alloc ctxt ~id alloc >>=? fun ctxt ->\n      return (ctxt, OPS.bytes_size_for_empty)\n\n(**\n  [apply_diff ctxt ops ~id diff] applies the diff [diff] on lazy storage [id]\n  on storage context [ctxt] using operations [ops] and returns the updated\n  storage context and the added size in bytes (may be negative).\n\n  If [id] represents a temporary lazy storage, the added size may be wrong.\n*)\nlet apply_diff :\n    type i a u.\n    Raw_context.t ->\n    (i, a, u) ops ->\n    id:i ->\n    (i, a, u) diff ->\n    (Raw_context.t * Z.t) tzresult Lwt.t =\n fun ctxt ((module OPS) as ops) ~id diff ->\n  match diff with\n  | Remove ->\n      if OPS.Id.is_temp id then\n        OPS.remove ctxt id >|= fun ctxt -> ok (ctxt, Z.zero)\n      else\n        OPS.Total_bytes.get ctxt id >>=? fun size ->\n        OPS.remove ctxt id >>= fun ctxt ->\n        return (ctxt, Z.neg (Z.add size OPS.bytes_size_for_empty))\n  | Update {init; updates} ->\n      apply_init ctxt ops ~id init >>=? fun (ctxt, init_size) ->\n      apply_updates ctxt ops ~id updates >>=? fun (ctxt, updates_size) ->\n      return (ctxt, Z.add init_size updates_size)\n\ntype diffs_item =\n  | Item :\n      ('i, 'a, 'u) Lazy_storage_kind.t * 'i * ('i, 'a, 'u) diff\n      -> diffs_item\n\nlet make :\n    type i a u.\n    (i, a, u) Lazy_storage_kind.t -> i -> (i, a, u) diff -> diffs_item =\n fun k id diff -> Item (k, id, diff)\n\nlet item_encoding =\n  let open Data_encoding in\n  union\n  @@ List.map\n       (fun (tag, Lazy_storage_kind.Ex_Kind k) ->\n         let ops = get_ops k in\n         let (module OPS) = ops in\n         let title = OPS.title in\n         case\n           (Tag tag)\n           ~title\n           (obj3\n              (req \"kind\" (constant title))\n              (req \"id\" OPS.Id.encoding)\n              (req \"diff\" (diff_encoding ops)))\n           (fun (Item (kind, id, diff)) ->\n             match Lazy_storage_kind.equal k kind with\n             | Eq -> Some ((), id, diff)\n             | Neq -> None)\n           (fun ((), id, diff) -> Item (k, id, diff)))\n       Lazy_storage_kind.all\n  [@@coq_axiom_with_reason \"gadt\"]\n\nlet item_in_memory_size\n    (Item\n      ( kind\n      (* kinds are constant tags *),\n        _id_is_a_Z_fitting_in_an_int_for_a_long_time,\n        diff )) =\n  let open Cache_memory_helpers in\n  ret_adding (diff_in_memory_size kind diff) h3w\n\ntype diffs = diffs_item list\n\nlet diffs_in_memory_size diffs =\n  Cache_memory_helpers.list_fold_size item_in_memory_size diffs\n\nlet encoding =\n  let open Data_encoding in\n  def \"lazy_storage_diff\" @@ list item_encoding\n\nlet apply ctxt diffs =\n  List.fold_left_es\n    (fun (ctxt, total_size) (Item (k, id, diff)) ->\n      let ops = get_ops k in\n      apply_diff ctxt ops ~id diff >|=? fun (ctxt, added_size) ->\n      let (module OPS) = ops in\n      ( ctxt,\n        if OPS.Id.is_temp id then total_size else Z.add total_size added_size ))\n    (ctxt, Z.zero)\n    diffs\n\nlet fresh :\n    type i a u.\n    (i, a, u) Lazy_storage_kind.t ->\n    temporary:bool ->\n    Raw_context.t ->\n    (Raw_context.t * i) tzresult Lwt.t =\n fun kind ~temporary ctxt ->\n  if temporary then\n    return\n      (Raw_context.fold_map_temporary_lazy_storage_ids ctxt (fun temp_ids ->\n           Lazy_storage_kind.Temp_ids.fresh kind temp_ids))\n  else\n    let (module OPS) = get_ops kind in\n    OPS.Next.incr ctxt\n [@@coq_axiom_with_reason \"gadt\"]\n\nlet init ctxt =\n  List.fold_left_es\n    (fun ctxt (_tag, Lazy_storage_kind.Ex_Kind k) ->\n      let (module OPS) = get_ops k in\n      OPS.Next.init ctxt)\n    ctxt\n    Lazy_storage_kind.all\n  [@@coq_axiom_with_reason \"gadt\"]\n\nlet cleanup_temporaries ctxt =\n  Raw_context.map_temporary_lazy_storage_ids_s ctxt (fun temp_ids ->\n      List.fold_left_s\n        (fun ctxt (_tag, Lazy_storage_kind.Ex_Kind k) ->\n          let (module OPS) = get_ops k in\n          Lazy_storage_kind.Temp_ids.fold_s k OPS.remove temp_ids ctxt)\n        ctxt\n        Lazy_storage_kind.all\n      >|= fun ctxt -> (ctxt, Lazy_storage_kind.Temp_ids.init))\n  [@@coq_axiom_with_reason \"gadt\"]\n" ;
                } ;
                { name = "Contract_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype error +=\n  | (* `Temporary *)\n      Balance_too_low of\n      Contract_repr.contract * Tez_repr.t * Tez_repr.t\n  | (* `Temporary *)\n      Counter_in_the_past of Contract_repr.contract * Z.t * Z.t\n  | (* `Branch *)\n      Counter_in_the_future of Contract_repr.contract * Z.t * Z.t\n  | (* `Temporary *)\n      Non_existing_contract of Contract_repr.contract\n  | (* `Branch *)\n      Empty_implicit_contract of Signature.Public_key_hash.t\n  | (* `Branch *)\n      Empty_implicit_delegated_contract of\n      Signature.Public_key_hash.t\n  | (* `Permanent *)\n      Inconsistent_public_key of\n      Signature.Public_key.t * Signature.Public_key.t\n  | (* `Permanent *) Failure of string\n\n(** [allocated ctxt contract] returns [true] if and only if the\n   contract is stored in [Storage.Contract.Balance]. *)\nval allocated : Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t\n\n(** [exists ctxt contract] returns [true] if and only if either the\n   contract is originated or it is (implicit and) \"allocated\". *)\nval exists : Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t\n\n(** [must_exist ctxt contract] fails with the [Non_existing_contract] error if\n    [exists ctxt contract] returns [false]. Even though this function is\n    gas-free, it is always called in a context where some gas consumption is\n    guaranteed whenever necessary. The first context is that of a transfer\n    operation, and in that case the base cost of a manager operation\n    ([Micheclson_v1_gas.Cost_of.manager_operation]) is consumed. The second\n    context is that of an activation operation, and in that case no gas needs to\n    be consumed since that operation is not a manager operation. *)\nval must_exist : Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t\n\n(** [must_be_allocated ctxt contract] fails when the contract is not\n   allocated. It fails with [Non_existing_contract] if the contract is\n   originated, and it fails with [Empty_implicit_contract] if the\n   contract is implicit. *)\nval must_be_allocated : Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t\n\nval list : Raw_context.t -> Contract_repr.t list Lwt.t\n\nval check_counter_increment :\n  Raw_context.t -> Signature.Public_key_hash.t -> Z.t -> unit tzresult Lwt.t\n\nval increment_counter :\n  Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t\n\nval get_balance : Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t\n\nval get_balance_carbonated :\n  Raw_context.t ->\n  Contract_repr.t ->\n  (Raw_context.t * Tez_repr.t) tzresult Lwt.t\n\nval get_counter :\n  Raw_context.t -> Signature.Public_key_hash.t -> Z.t tzresult Lwt.t\n\nval get_script_code :\n  Raw_context.t ->\n  Contract_repr.t ->\n  (Raw_context.t * Script_repr.lazy_expr option) tzresult Lwt.t\n\nval get_script :\n  Raw_context.t ->\n  Contract_repr.t ->\n  (Raw_context.t * Script_repr.t option) tzresult Lwt.t\n\nval get_storage :\n  Raw_context.t ->\n  Contract_repr.t ->\n  (Raw_context.t * Script_repr.expr option) tzresult Lwt.t\n\nmodule Legacy_big_map_diff : sig\n  type item = private\n    | Update of {\n        big_map : Z.t;\n        diff_key : Script_repr.expr;\n        diff_key_hash : Script_expr_hash.t;\n        diff_value : Script_repr.expr option;\n      }\n    | Clear of Z.t\n    | Copy of {src : Z.t; dst : Z.t}\n    | Alloc of {\n        big_map : Z.t;\n        key_type : Script_repr.expr;\n        value_type : Script_repr.expr;\n      }\n\n  type t = item list\n\n  val encoding : t Data_encoding.t\n\n  val to_lazy_storage_diff : t -> Lazy_storage_diff.diffs\n\n  val of_lazy_storage_diff : Lazy_storage_diff.diffs -> t\nend\n\nval update_script_storage :\n  Raw_context.t ->\n  Contract_repr.t ->\n  Script_repr.expr ->\n  Lazy_storage_diff.diffs option ->\n  Raw_context.t tzresult Lwt.t\n\nval credit_only_call_from_token :\n  Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t\n\nval spend_only_call_from_token :\n  Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t\n\n(** [raw_originate ctxt ~prepaid_bootstrap_storage contract ~script]\n    originates the [contract] parameter. The [storage] space allocated by this\n    origination is considered to be free of charge or to have been already paid\n    for by the user, if and only if [prepaid_bootstrap_storage] is [true]. In \n    particular, the amount of space allocated by this origination will be part\n    of the consumed space to pay for returned by the next call to\n    [Fees_storage.record_paid_storage_space ctxt contract], if and only if\n    [prepaid_bootstrap_storage] is [false]. *)\nval raw_originate :\n  Raw_context.t ->\n  prepaid_bootstrap_storage:bool ->\n  Contract_repr.t ->\n  script:Script_repr.t * Lazy_storage_diff.diffs option ->\n  Raw_context.t tzresult Lwt.t\n\nval fresh_contract_from_current_nonce :\n  Raw_context.t -> (Raw_context.t * Contract_repr.t) tzresult\n\nval originated_from_current_nonce :\n  since:Raw_context.t ->\n  until:Raw_context.t ->\n  Contract_repr.t list tzresult Lwt.t\n\nval init : Raw_context.t -> Raw_context.t tzresult Lwt.t\n\nval used_storage_space : Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t\n\nval paid_storage_space : Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t\n\nval set_paid_storage_space_and_return_fees_to_pay :\n  Raw_context.t ->\n  Contract_repr.t ->\n  Z.t ->\n  (Z.t * Raw_context.t) tzresult Lwt.t\n\n(** Increases the balance of a contract. Calling this function directly may\n    break important invariants. Consider calling [credit] instead. *)\nval increase_balance_only_call_from_token :\n  Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t\n\n(** Decreases the balance of a contract. Calling this function directly may\n    break important invariants. Consider calling [spend] instead. *)\nval decrease_balance_only_call_from_token :\n  Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2019-2020 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype error +=\n  | (* `Temporary *)\n      Balance_too_low of\n      Contract_repr.contract * Tez_repr.t * Tez_repr.t\n  | (* `Temporary *)\n      Counter_in_the_past of Contract_repr.contract * Z.t * Z.t\n  | (* `Branch *)\n      Counter_in_the_future of Contract_repr.contract * Z.t * Z.t\n  | (* `Temporary *)\n      Non_existing_contract of Contract_repr.contract\n  | (* `Branch *)\n      Empty_implicit_contract of Signature.Public_key_hash.t\n  | (* `Branch *)\n      Empty_implicit_delegated_contract of\n      Signature.Public_key_hash.t\n  | (* `Permanent *)\n      Inconsistent_public_key of\n      Signature.Public_key.t * Signature.Public_key.t\n  | (* `Permanent *) Failure of string\n\nlet () =\n  register_error_kind\n    `Temporary\n    ~id:\"contract.balance_too_low\"\n    ~title:\"Balance too low\"\n    ~description:\"An operation tried to spend more tokens than the contract has\"\n    ~pp:(fun ppf (c, b, a) ->\n      Format.fprintf\n        ppf\n        \"Balance of contract %a too low (%a) to spend %a\"\n        Contract_repr.pp\n        c\n        Tez_repr.pp\n        b\n        Tez_repr.pp\n        a)\n    Data_encoding.(\n      obj3\n        (req \"contract\" Contract_repr.encoding)\n        (req \"balance\" Tez_repr.encoding)\n        (req \"amount\" Tez_repr.encoding))\n    (function Balance_too_low (c, b, a) -> Some (c, b, a) | _ -> None)\n    (fun (c, b, a) -> Balance_too_low (c, b, a)) ;\n  register_error_kind\n    `Temporary\n    ~id:\"contract.counter_in_the_future\"\n    ~title:\"Invalid counter (not yet reached) in a manager operation\"\n    ~description:\"An operation assumed a contract counter in the future\"\n    ~pp:(fun ppf (contract, exp, found) ->\n      Format.fprintf\n        ppf\n        \"Counter %a not yet reached for contract %a (expected %a)\"\n        Z.pp_print\n        found\n        Contract_repr.pp\n        contract\n        Z.pp_print\n        exp)\n    Data_encoding.(\n      obj3\n        (req \"contract\" Contract_repr.encoding)\n        (req \"expected\" z)\n        (req \"found\" z))\n    (function Counter_in_the_future (c, x, y) -> Some (c, x, y) | _ -> None)\n    (fun (c, x, y) -> Counter_in_the_future (c, x, y)) ;\n  register_error_kind\n    `Branch\n    ~id:\"contract.counter_in_the_past\"\n    ~title:\"Invalid counter (already used) in a manager operation\"\n    ~description:\"An operation assumed a contract counter in the past\"\n    ~pp:(fun ppf (contract, exp, found) ->\n      Format.fprintf\n        ppf\n        \"Counter %a already used for contract %a (expected %a)\"\n        Z.pp_print\n        found\n        Contract_repr.pp\n        contract\n        Z.pp_print\n        exp)\n    Data_encoding.(\n      obj3\n        (req \"contract\" Contract_repr.encoding)\n        (req \"expected\" z)\n        (req \"found\" z))\n    (function Counter_in_the_past (c, x, y) -> Some (c, x, y) | _ -> None)\n    (fun (c, x, y) -> Counter_in_the_past (c, x, y)) ;\n  register_error_kind\n    `Temporary\n    ~id:\"contract.non_existing_contract\"\n    ~title:\"Non existing contract\"\n    ~description:\n      \"A contract handle is not present in the context (either it never was or \\\n       it has been destroyed)\"\n    ~pp:(fun ppf contract ->\n      Format.fprintf ppf \"Contract %a does not exist\" Contract_repr.pp contract)\n    Data_encoding.(obj1 (req \"contract\" Contract_repr.encoding))\n    (function Non_existing_contract c -> Some c | _ -> None)\n    (fun c -> Non_existing_contract c) ;\n  register_error_kind\n    `Permanent\n    ~id:\"contract.manager.inconsistent_public_key\"\n    ~title:\"Inconsistent public key\"\n    ~description:\n      \"A provided manager public key is different with the public key stored \\\n       in the contract\"\n    ~pp:(fun ppf (eh, ph) ->\n      Format.fprintf\n        ppf\n        \"Expected manager public key %s but %s was provided\"\n        (Signature.Public_key.to_b58check ph)\n        (Signature.Public_key.to_b58check eh))\n    Data_encoding.(\n      obj2\n        (req \"public_key\" Signature.Public_key.encoding)\n        (req \"expected_public_key\" Signature.Public_key.encoding))\n    (function Inconsistent_public_key (eh, ph) -> Some (eh, ph) | _ -> None)\n    (fun (eh, ph) -> Inconsistent_public_key (eh, ph)) ;\n  register_error_kind\n    `Permanent\n    ~id:\"contract.failure\"\n    ~title:\"Contract storage failure\"\n    ~description:\"Unexpected contract storage error\"\n    ~pp:(fun ppf s -> Format.fprintf ppf \"Contract_storage.Failure %S\" s)\n    Data_encoding.(obj1 (req \"message\" string))\n    (function Failure s -> Some s | _ -> None)\n    (fun s -> Failure s) ;\n  register_error_kind\n    `Branch\n    ~id:\"implicit.empty_implicit_contract\"\n    ~title:\"Empty implicit contract\"\n    ~description:\n      \"No manager operations are allowed on an empty implicit contract.\"\n    ~pp:(fun ppf implicit ->\n      Format.fprintf\n        ppf\n        \"Empty implicit contract (%a)\"\n        Signature.Public_key_hash.pp\n        implicit)\n    Data_encoding.(obj1 (req \"implicit\" Signature.Public_key_hash.encoding))\n    (function Empty_implicit_contract c -> Some c | _ -> None)\n    (fun c -> Empty_implicit_contract c) ;\n  register_error_kind\n    `Branch\n    ~id:\"implicit.empty_implicit_delegated_contract\"\n    ~title:\"Empty implicit delegated contract\"\n    ~description:\"Emptying an implicit delegated account is not allowed.\"\n    ~pp:(fun ppf implicit ->\n      Format.fprintf\n        ppf\n        \"Emptying implicit delegated contract (%a)\"\n        Signature.Public_key_hash.pp\n        implicit)\n    Data_encoding.(obj1 (req \"implicit\" Signature.Public_key_hash.encoding))\n    (function Empty_implicit_delegated_contract c -> Some c | _ -> None)\n    (fun c -> Empty_implicit_delegated_contract c)\n\nlet failwith msg = fail (Failure msg)\n\nmodule Legacy_big_map_diff = struct\n  (*\n    Big_map_diff receipt as it was represented in 006 and earlier.\n    It is kept here for now for backward compatibility of tools. *)\n\n  type item =\n    | Update of {\n        big_map : Z.t;\n        diff_key : Script_repr.expr;\n        diff_key_hash : Script_expr_hash.t;\n        diff_value : Script_repr.expr option;\n      }\n    | Clear of Z.t\n    | Copy of {src : Z.t; dst : Z.t}\n    | Alloc of {\n        big_map : Z.t;\n        key_type : Script_repr.expr;\n        value_type : Script_repr.expr;\n      }\n\n  type t = item list\n\n  let item_encoding =\n    let open Data_encoding in\n    union\n      [\n        case\n          (Tag 0)\n          ~title:\"update\"\n          (obj5\n             (req \"action\" (constant \"update\"))\n             (req \"big_map\" z)\n             (req \"key_hash\" Script_expr_hash.encoding)\n             (req \"key\" Script_repr.expr_encoding)\n             (opt \"value\" Script_repr.expr_encoding))\n          (function\n            | Update {big_map; diff_key_hash; diff_key; diff_value} ->\n                Some ((), big_map, diff_key_hash, diff_key, diff_value)\n            | _ -> None)\n          (fun ((), big_map, diff_key_hash, diff_key, diff_value) ->\n            Update {big_map; diff_key_hash; diff_key; diff_value});\n        case\n          (Tag 1)\n          ~title:\"remove\"\n          (obj2 (req \"action\" (constant \"remove\")) (req \"big_map\" z))\n          (function Clear big_map -> Some ((), big_map) | _ -> None)\n          (fun ((), big_map) -> Clear big_map);\n        case\n          (Tag 2)\n          ~title:\"copy\"\n          (obj3\n             (req \"action\" (constant \"copy\"))\n             (req \"source_big_map\" z)\n             (req \"destination_big_map\" z))\n          (function Copy {src; dst} -> Some ((), src, dst) | _ -> None)\n          (fun ((), src, dst) -> Copy {src; dst});\n        case\n          (Tag 3)\n          ~title:\"alloc\"\n          (obj4\n             (req \"action\" (constant \"alloc\"))\n             (req \"big_map\" z)\n             (req \"key_type\" Script_repr.expr_encoding)\n             (req \"value_type\" Script_repr.expr_encoding))\n          (function\n            | Alloc {big_map; key_type; value_type} ->\n                Some ((), big_map, key_type, value_type)\n            | _ -> None)\n          (fun ((), big_map, key_type, value_type) ->\n            Alloc {big_map; key_type; value_type});\n      ]\n\n  let encoding = Data_encoding.list item_encoding\n\n  let to_lazy_storage_diff legacy_diffs =\n    let rev_head (diffs : (_ * (_, _, _) Lazy_storage_diff.diff) list) =\n      match diffs with\n      | [] -> []\n      | (_, Remove) :: _ -> diffs\n      | (id, Update {init; updates}) :: rest ->\n          (id, Update {init; updates = List.rev updates}) :: rest\n    in\n    (* Invariant:\n       Updates are collected one by one, in reverse order, on the head diff\n       item. So only and exactly the head diff item has its updates reversed.\n    *)\n    List.fold_left\n      (fun (new_diff : (_ * (_, _, _) Lazy_storage_diff.diff) list) item ->\n        match item with\n        | Clear id -> (id, Lazy_storage_diff.Remove) :: rev_head new_diff\n        | Copy {src; dst} ->\n            let src =\n              Lazy_storage_kind.Big_map.Id\n              .of_legacy_USE_ONLY_IN_Legacy_big_map_diff\n                src\n            in\n            (dst, Lazy_storage_diff.Update {init = Copy {src}; updates = []})\n            :: rev_head new_diff\n        | Alloc {big_map; key_type; value_type} ->\n            ( big_map,\n              Lazy_storage_diff.(\n                Update\n                  {\n                    init = Alloc Lazy_storage_kind.Big_map.{key_type; value_type};\n                    updates = [];\n                  }) )\n            :: rev_head new_diff\n        | Update\n            {\n              big_map;\n              diff_key = key;\n              diff_key_hash = key_hash;\n              diff_value = value;\n            } -> (\n            match new_diff with\n            | (id, diff) :: rest when Compare.Z.(id = big_map) ->\n                let diff =\n                  match diff with\n                  | Remove -> assert false\n                  | Update {init; updates} ->\n                      let updates =\n                        Lazy_storage_kind.Big_map.{key; key_hash; value}\n                        :: updates\n                      in\n                      Lazy_storage_diff.Update {init; updates}\n                in\n                (id, diff) :: rest\n            | new_diff ->\n                let updates =\n                  [Lazy_storage_kind.Big_map.{key; key_hash; value}]\n                in\n                (big_map, Update {init = Existing; updates})\n                :: rev_head new_diff))\n      []\n      legacy_diffs\n    |> rev_head\n    |> List.rev_map (fun (id, diff) ->\n           let id =\n             Lazy_storage_kind.Big_map.Id\n             .of_legacy_USE_ONLY_IN_Legacy_big_map_diff\n               id\n           in\n           Lazy_storage_diff.make Lazy_storage_kind.Big_map id diff)\n\n  let of_lazy_storage_diff diffs =\n    List.fold_left\n      (fun legacy_diffs (Lazy_storage_diff.Item (kind, id, diff)) ->\n        let diffs =\n          match kind with\n          | Lazy_storage_kind.Big_map -> (\n              let id =\n                Lazy_storage_kind.Big_map.Id\n                .to_legacy_USE_ONLY_IN_Legacy_big_map_diff\n                  id\n              in\n              match diff with\n              | Remove -> [Clear id]\n              | Update {init; updates} -> (\n                  let updates =\n                    List.rev_map\n                      (fun {Lazy_storage_kind.Big_map.key; key_hash; value} ->\n                        Update\n                          {\n                            big_map = id;\n                            diff_key = key;\n                            diff_key_hash = key_hash;\n                            diff_value = value;\n                          })\n                      updates\n                  in\n                  match init with\n                  | Existing -> updates\n                  | Copy {src} ->\n                      let src =\n                        Lazy_storage_kind.Big_map.Id\n                        .to_legacy_USE_ONLY_IN_Legacy_big_map_diff\n                          src\n                      in\n                      Copy {src; dst = id} :: updates\n                  | Alloc {key_type; value_type} ->\n                      Alloc {big_map = id; key_type; value_type} :: updates))\n          | _ -> (* Not a Big_map *) []\n        in\n        diffs :: legacy_diffs)\n      []\n      diffs\n    |> List.rev |> List.flatten\n    [@@coq_axiom_with_reason \"gadt\"]\nend\n\nlet update_script_lazy_storage c = function\n  | None -> return (c, Z.zero)\n  | Some diffs -> Lazy_storage_diff.apply c diffs\n\nlet create_base c ~prepaid_bootstrap_storage\n    (* Free space for bootstrap contracts *)\n      contract ~balance ~manager ?script () =\n  (match Contract_repr.is_implicit contract with\n  | None -> return c\n  | Some _ ->\n      Storage.Contract.Global_counter.get c >>=? fun counter ->\n      Storage.Contract.Counter.init c contract counter)\n  >>=? fun c ->\n  Storage.Contract.Balance.init c contract balance >>=? fun c ->\n  (match manager with\n  | Some manager ->\n      Contract_manager_storage.init c contract (Manager_repr.Hash manager)\n  | None -> return c)\n  >>=? fun c ->\n  match script with\n  | Some ({Script_repr.code; storage}, lazy_storage_diff) ->\n      Storage.Contract.Code.init c contract code >>=? fun (c, code_size) ->\n      Storage.Contract.Storage.init c contract storage\n      >>=? fun (c, storage_size) ->\n      update_script_lazy_storage c lazy_storage_diff\n      >>=? fun (c, lazy_storage_size) ->\n      let total_size =\n        Z.add\n          (Z.add (Z.of_int code_size) (Z.of_int storage_size))\n          lazy_storage_size\n      in\n      assert (Compare.Z.(total_size >= Z.zero)) ;\n      let prepaid_bootstrap_storage =\n        if prepaid_bootstrap_storage then total_size else Z.zero\n      in\n      Storage.Contract.Paid_storage_space.init\n        c\n        contract\n        prepaid_bootstrap_storage\n      >>=? fun c ->\n      Storage.Contract.Used_storage_space.init c contract total_size\n  | None -> return c\n\nlet raw_originate c ~prepaid_bootstrap_storage contract ~script =\n  create_base\n    c\n    ~prepaid_bootstrap_storage\n    contract\n    ~balance:Tez_repr.zero\n    ~manager:None\n    ~script\n    ()\n\nlet create_implicit c manager ~balance =\n  create_base\n    c\n    ~prepaid_bootstrap_storage:false\n    (Contract_repr.implicit_contract manager)\n    ~balance\n    ~manager:(Some manager)\n    ?script:None\n    ()\n\nlet delete c contract =\n  match Contract_repr.is_implicit contract with\n  | None ->\n      (* For non implicit contract Big_map should be cleared *)\n      failwith \"Non implicit contracts cannot be removed\"\n  | Some _ ->\n      Contract_delegate_storage.remove c contract >>=? fun c ->\n      Storage.Contract.Balance.remove_existing c contract >>=? fun c ->\n      Contract_manager_storage.remove_existing c contract >>=? fun c ->\n      Storage.Contract.Counter.remove_existing c contract >>=? fun c ->\n      Storage.Contract.Code.remove c contract >>=? fun (c, _, _) ->\n      Storage.Contract.Storage.remove c contract >>=? fun (c, _, _) ->\n      Storage.Contract.Paid_storage_space.remove c contract >>= fun c ->\n      Storage.Contract.Used_storage_space.remove c contract >|= ok\n\nlet allocated c contract =\n  Storage.Contract.Balance.find c contract >>=? function\n  | None -> return_false\n  | Some _ -> return_true\n\nlet exists c contract =\n  match Contract_repr.is_implicit contract with\n  | Some _ -> return_true\n  | None -> allocated c contract\n\nlet must_exist c contract =\n  exists c contract >>=? function\n  | true -> return_unit\n  | false -> fail (Non_existing_contract contract)\n\nlet must_be_allocated c contract =\n  allocated c contract >>=? function\n  | true -> return_unit\n  | false -> (\n      match Contract_repr.is_implicit contract with\n      | Some pkh -> fail (Empty_implicit_contract pkh)\n      | None -> fail (Non_existing_contract contract))\n\nlet list c = Storage.Contract.list c\n\nlet fresh_contract_from_current_nonce c =\n  Raw_context.increment_origination_nonce c >|? fun (c, nonce) ->\n  (c, Contract_repr.originated_contract nonce)\n\nlet originated_from_current_nonce ~since:ctxt_since ~until:ctxt_until =\n  Raw_context.get_origination_nonce ctxt_since >>?= fun since ->\n  Raw_context.get_origination_nonce ctxt_until >>?= fun until ->\n  List.filter_es\n    (fun contract -> exists ctxt_until contract)\n    (Contract_repr.originated_contracts ~since ~until)\n\nlet check_counter_increment c manager counter =\n  let contract = Contract_repr.implicit_contract manager in\n  Storage.Contract.Counter.get c contract >>=? fun contract_counter ->\n  let expected = Z.succ contract_counter in\n  if Compare.Z.(expected = counter) then return_unit\n  else if Compare.Z.(expected > counter) then\n    fail (Counter_in_the_past (contract, expected, counter))\n  else fail (Counter_in_the_future (contract, expected, counter))\n\nlet increment_counter c manager =\n  let contract = Contract_repr.implicit_contract manager in\n  Storage.Contract.Global_counter.get c >>=? fun global_counter ->\n  Storage.Contract.Global_counter.update c (Z.succ global_counter) >>=? fun c ->\n  Storage.Contract.Counter.get c contract >>=? fun contract_counter ->\n  Storage.Contract.Counter.update c contract (Z.succ contract_counter)\n\nlet get_script_code c contract = Storage.Contract.Code.find c contract\n\nlet get_script c contract =\n  Storage.Contract.Code.find c contract >>=? fun (c, code) ->\n  Storage.Contract.Storage.find c contract >>=? fun (c, storage) ->\n  match (code, storage) with\n  | (None, None) -> return (c, None)\n  | (Some code, Some storage) -> return (c, Some {Script_repr.code; storage})\n  | (None, Some _) | (Some _, None) -> failwith \"get_script\"\n\nlet get_storage ctxt contract =\n  Storage.Contract.Storage.find ctxt contract >>=? function\n  | (ctxt, None) -> return (ctxt, None)\n  | (ctxt, Some storage) ->\n      Raw_context.consume_gas ctxt (Script_repr.force_decode_cost storage)\n      >>?= fun ctxt ->\n      Script_repr.force_decode storage >>?= fun storage ->\n      return (ctxt, Some storage)\n\nlet get_counter c manager =\n  let contract = Contract_repr.implicit_contract manager in\n  Storage.Contract.Counter.find c contract >>=? function\n  | None -> (\n      match Contract_repr.is_implicit contract with\n      | Some _ -> Storage.Contract.Global_counter.get c\n      | None -> failwith \"get_counter\")\n  | Some v -> return v\n\nlet get_balance c contract =\n  Storage.Contract.Balance.find c contract >>=? function\n  | None -> (\n      match Contract_repr.is_implicit contract with\n      | Some _ -> return Tez_repr.zero\n      | None -> failwith \"get_balance\")\n  | Some v -> return v\n\nlet get_balance_carbonated c contract =\n  (* Reading an int64 from /contracts/index/<hash>/balance *)\n  Raw_context.consume_gas\n    c\n    (Storage_costs.read_access ~path_length:4 ~read_bytes:8)\n  >>?= fun c ->\n  get_balance c contract >>=? fun balance -> return (c, balance)\n\nlet update_script_storage c contract storage lazy_storage_diff =\n  let storage = Script_repr.lazy_expr storage in\n  update_script_lazy_storage c lazy_storage_diff\n  >>=? fun (c, lazy_storage_size_diff) ->\n  Storage.Contract.Storage.update c contract storage >>=? fun (c, size_diff) ->\n  Storage.Contract.Used_storage_space.get c contract >>=? fun previous_size ->\n  let new_size =\n    Z.add previous_size (Z.add lazy_storage_size_diff (Z.of_int size_diff))\n  in\n  Storage.Contract.Used_storage_space.update c contract new_size\n\nlet spend_only_call_from_token c contract amount =\n  Storage.Contract.Balance.find c contract >>=? fun balance ->\n  let balance = Option.value balance ~default:Tez_repr.zero in\n  match Tez_repr.(balance -? amount) with\n  | Error _ -> fail (Balance_too_low (contract, balance, amount))\n  | Ok new_balance -> (\n      Storage.Contract.Balance.update c contract new_balance >>=? fun c ->\n      Contract_delegate_storage.remove_contract_stake c contract amount\n      >>=? fun c ->\n      if Tez_repr.(new_balance > Tez_repr.zero) then return c\n      else\n        match Contract_repr.is_implicit contract with\n        | None -> return c (* Never delete originated contracts *)\n        | Some pkh -> (\n            Contract_delegate_storage.find c contract >>=? function\n            | Some pkh' ->\n                if Signature.Public_key_hash.equal pkh pkh' then return c\n                else\n                  (* Delegated implicit accounts cannot be emptied *)\n                  fail (Empty_implicit_delegated_contract pkh)\n            | None ->\n                (* Delete empty implicit contract *)\n                delete c contract))\n\n(* [Tez_repr.(amount <> zero)] is a precondition of this function. It ensures that\n   no entry associating a null balance to an implicit contract exists in the map\n   [Storage.Contract.Balance]. *)\nlet credit_only_call_from_token c contract amount =\n  Storage.Contract.Balance.find c contract >>=? function\n  | None -> (\n      match Contract_repr.is_implicit contract with\n      | None -> fail (Non_existing_contract contract)\n      | Some manager -> create_implicit c manager ~balance:amount)\n  | Some balance ->\n      Tez_repr.(amount +? balance) >>?= fun balance ->\n      Storage.Contract.Balance.update c contract balance >>=? fun c ->\n      Contract_delegate_storage.add_contract_stake c contract amount\n\nlet init c =\n  Storage.Contract.Global_counter.init c Z.zero >>=? fun c ->\n  Lazy_storage_diff.init c\n\nlet used_storage_space c contract =\n  Storage.Contract.Used_storage_space.find c contract\n  >|=? Option.value ~default:Z.zero\n\nlet paid_storage_space c contract =\n  Storage.Contract.Paid_storage_space.find c contract\n  >|=? Option.value ~default:Z.zero\n\nlet set_paid_storage_space_and_return_fees_to_pay c contract new_storage_space =\n  Storage.Contract.Paid_storage_space.get c contract\n  >>=? fun already_paid_space ->\n  if Compare.Z.(already_paid_space >= new_storage_space) then return (Z.zero, c)\n  else\n    let to_pay = Z.sub new_storage_space already_paid_space in\n    Storage.Contract.Paid_storage_space.update c contract new_storage_space\n    >|=? fun c -> (to_pay, c)\n\nlet update_balance ctxt contract f amount =\n  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->\n  f balance amount >>?= fun new_balance ->\n  Storage.Contract.Balance.update ctxt contract new_balance\n\nlet increase_balance_only_call_from_token ctxt contract amount =\n  update_balance ctxt contract Tez_repr.( +? ) amount\n\nlet decrease_balance_only_call_from_token ctxt contract amount =\n  update_balance ctxt contract Tez_repr.( -? ) amount\n" ;
                } ;
                { name = "Commitment_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** [exists ctxt bpkh] returns true iff [bpkh] is associated to a non null\n    commitment. *)\nval exists : Raw_context.t -> Blinded_public_key_hash.t -> bool Lwt.t\n\n(** [committed_amount ctxt bpkh] return the commitment associated to [bpkh], or\n    [Tez_repr.zero] if [bpkh] has no associated commitment. *)\nval committed_amount :\n  Raw_context.t -> Blinded_public_key_hash.t -> Tez_repr.t tzresult Lwt.t\n\nval increase_commitment_only_call_from_token :\n  Raw_context.t ->\n  Blinded_public_key_hash.t ->\n  Tez_repr.t ->\n  Raw_context.t tzresult Lwt.t\n\nval decrease_commitment_only_call_from_token :\n  Raw_context.t ->\n  Blinded_public_key_hash.t ->\n  Tez_repr.t ->\n  Raw_context.t tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nlet exists = Storage.Commitments.mem\n\nlet committed_amount ctxt bpkh =\n  Storage.Commitments.find ctxt bpkh >>=? fun balance ->\n  return (Option.value ~default:Tez_repr.zero balance)\n\nlet increase_commitment_only_call_from_token ctxt bpkh amount =\n  if Tez_repr.(amount = zero) then return ctxt\n  else\n    committed_amount ctxt bpkh >>=? fun balance ->\n    Tez_repr.(amount +? balance) >>?= fun new_balance ->\n    Storage.Commitments.add ctxt bpkh new_balance >|= ok\n\nlet decrease_commitment_only_call_from_token ctxt bpkh amount =\n  committed_amount ctxt bpkh >>=? fun balance ->\n  Tez_repr.(balance -? amount) >>?= fun new_balance ->\n  if Tez_repr.(new_balance = Tez_repr.zero) then\n    Storage.Commitments.remove ctxt bpkh >|= ok\n  else Storage.Commitments.add ctxt bpkh new_balance >|= ok\n" ;
                } ;
                { name = "Token" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2020-2021 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** The aim of this module is to manage operations involving tokens such as\n    minting, transferring, and burning. Every constructor of the types [source],\n    [container], or [sink] represents a kind of account that holds a given (or\n    possibly infinite) amount of tokens.\n\n    Tokens can be transferred from a [source] to a [sink]. To uniformly handle\n    all cases, special constructors of sources and sinks may be used. For\n    example, the source [`Minted] is used to express a transfer of minted tokens\n    to a destination, and the sink [`Burned] is used to express the action of\n    burning a given amount of tokens taken from a source. Thanks to uniformity,\n    it is easier to track transfers of tokens throughout the protocol by running\n    [grep -R \"Token.transfer\" src/proto_alpha]. *)\n\n(** [container] is the type of token holders with finite capacity, and whose assets\n    are contained in the context. Let [d] be a delegate. Be aware that transferring\n    to/from [`Delegate_balance d] will not update [d]'s stake, while transferring\n    to/from [`Contract (Contract_repr.implicit_contract d)] will update [d]'s\n    stake. *)\ntype container =\n  [ `Contract of Contract_repr.t\n  | `Collected_commitments of Blinded_public_key_hash.t\n  | `Delegate_balance of Signature.Public_key_hash.t\n  | `Frozen_deposits of Signature.Public_key_hash.t\n  | `Block_fees\n  | `Legacy_deposits of Signature.Public_key_hash.t * Cycle_repr.t\n  | `Legacy_fees of Signature.Public_key_hash.t * Cycle_repr.t\n  | `Legacy_rewards of Signature.Public_key_hash.t * Cycle_repr.t ]\n\n(** [source] is the type of token providers. Token providers that are not\n    containers are considered to have infinite capacity. *)\ntype source =\n  [ `Invoice\n  | `Bootstrap\n  | `Initial_commitments\n  | `Revelation_rewards\n  | `Double_signing_evidence_rewards\n  | `Endorsing_rewards\n  | `Baking_rewards\n  | `Baking_bonuses\n  | `Minted\n  | `Liquidity_baking_subsidies\n  | container ]\n\n(** [sink] is the type of token receivers. Token receivers that are not\n    containers are considered to have infinite capacity. *)\ntype sink =\n  [ `Storage_fees\n  | `Double_signing_punishments\n  | `Lost_endorsing_rewards of Signature.Public_key_hash.t * bool * bool\n  | `Burned\n  | container ]\n\n(** [allocated ctxt container] returns true if [balance ctxt container] is\n    guaranteed not to fail, and returns false when [balance ctxt container] may\n    fail. *)\nval allocated : Raw_context.t -> container -> bool tzresult Lwt.t\n\n(** [balance ctxt container] returns the balance associated to the token holder,\n    may fail if [allocated ctxt container] returns [false].\n    Returns an error with the message \"get_balance\" if [container] refers to an\n    originated contract that is not allocated.\n    Returns a {!Storage_Error Missing_key} error if [container] is of the form\n    [`Delegate_balance pkh], where [pkh] refers to an implicit contract that is\n    not allocated. *)\nval balance : Raw_context.t -> container -> Tez_repr.t tzresult Lwt.t\n\n(** [transfer_n ?origin ctxt sources dest] transfers [amount] Tez from [src] to\n    [dest] for each [(src, amount)] pair in [sources], and returns a new\n    context, and the list of corresponding balance updates. The function behaves\n    as though [transfer src dest amount] was invoked for each pair\n    [(src, amount)] in [sources], however a single balance update is generated\n    for the total amount transferred to [dest].\n    When [sources] is an empty list, the function does nothing to the context,\n    and returns an empty list of balance updates. *)\nval transfer_n :\n  ?origin:Receipt_repr.update_origin ->\n  Raw_context.t ->\n  ([< source] * Tez_repr.t) list ->\n  [< sink] ->\n  (Raw_context.t * Receipt_repr.balance_updates) tzresult Lwt.t\n\n(** [transfer ?origin ctxt src dest amount] transfers [amount] Tez from source\n    [src] to destination [dest], and returns a new context, and the list of\n    corresponding balance updates tagged with [origin]. By default, [~origin] is\n    set to [Receipt_repr.Block_application].\n    Returns {!Storage_Error Missing_key} if [src] refers to a contract that is\n    not allocated.\n    Returns a [Balance_too_low] error if [src] refers to a contract whose\n    balance is less than [amount].\n    Returns a [Subtraction_underflow] error if [src] refers to a source that is\n    not a contract and whose balance is less than [amount].\n    Returns a [Empty_implicit_delegated_contract] error if [src] is an\n    implicit contract that delegates to a different contract, and whose balance\n    is equal to [amount].\n    Returns a [Non_existing_contract] error if\n    [dest] refers to an originated contract that is not allocated.\n    Returns a [Non_existing_contract] error if [amount <> Tez_repr.zero], and\n    [dest] refers to an originated contract that is not allocated.\n    Returns a [Addition_overflow] error if [dest] refers to a sink whose balance\n    is greater than [Int64.max - amount].\n    Returns a [Wrong_level] error if [src] or [dest] refer to a level that is\n    not the current level. *)\nval transfer :\n  ?origin:Receipt_repr.update_origin ->\n  Raw_context.t ->\n  [< source] ->\n  [< sink] ->\n  Tez_repr.t ->\n  (Raw_context.t * Receipt_repr.balance_updates) tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2020-2021 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype container =\n  [ `Contract of Contract_repr.t\n  | `Collected_commitments of Blinded_public_key_hash.t\n  | `Delegate_balance of Signature.Public_key_hash.t\n  | `Frozen_deposits of Signature.Public_key_hash.t\n  | `Block_fees\n  | `Legacy_deposits of Signature.Public_key_hash.t * Cycle_repr.t\n  | `Legacy_fees of Signature.Public_key_hash.t * Cycle_repr.t\n  | `Legacy_rewards of Signature.Public_key_hash.t * Cycle_repr.t ]\n\ntype source =\n  [ `Invoice\n  | `Bootstrap\n  | `Initial_commitments\n  | `Revelation_rewards\n  | `Double_signing_evidence_rewards\n  | `Endorsing_rewards\n  | `Baking_rewards\n  | `Baking_bonuses\n  | `Minted\n  | `Liquidity_baking_subsidies\n  | container ]\n\ntype sink =\n  [ `Storage_fees\n  | `Double_signing_punishments\n  | `Lost_endorsing_rewards of Signature.Public_key_hash.t * bool * bool\n  | `Burned\n  | container ]\n\nlet allocated ctxt stored =\n  match stored with\n  | `Contract contract -> Contract_storage.allocated ctxt contract\n  | `Collected_commitments bpkh -> Commitment_storage.exists ctxt bpkh >|= ok\n  | `Delegate_balance delegate ->\n      let contract = Contract_repr.implicit_contract delegate in\n      Contract_storage.allocated ctxt contract\n  | `Frozen_deposits delegate ->\n      let contract = Contract_repr.implicit_contract delegate in\n      Frozen_deposits_storage.allocated ctxt contract >|= ok\n  | `Block_fees -> return_true\n  (* TODO: remove in J *)\n  | `Legacy_deposits (delegate, cycle) ->\n      let contract = Contract_repr.implicit_contract delegate in\n      Storage.Contract.Legacy_frozen_deposits.mem (ctxt, contract) cycle >|= ok\n  | `Legacy_fees (delegate, cycle) ->\n      let contract = Contract_repr.implicit_contract delegate in\n      Storage.Contract.Legacy_frozen_fees.mem (ctxt, contract) cycle >|= ok\n  | `Legacy_rewards (delegate, cycle) ->\n      let contract = Contract_repr.implicit_contract delegate in\n      Storage.Contract.Legacy_frozen_rewards.mem (ctxt, contract) cycle >|= ok\n\nlet balance ctxt stored =\n  match stored with\n  | `Contract contract -> Contract_storage.get_balance ctxt contract\n  | `Collected_commitments bpkh -> Commitment_storage.committed_amount ctxt bpkh\n  | `Delegate_balance delegate ->\n      let contract = Contract_repr.implicit_contract delegate in\n      Storage.Contract.Balance.get ctxt contract\n  | `Frozen_deposits delegate -> (\n      let contract = Contract_repr.implicit_contract delegate in\n      Frozen_deposits_storage.find ctxt contract >|=? fun frozen_deposits ->\n      match frozen_deposits with\n      | None -> Tez_repr.zero\n      | Some frozen_deposits -> frozen_deposits.current_amount)\n  | `Block_fees -> return (Raw_context.get_collected_fees ctxt)\n  (* TODO: remove in J *)\n  | `Legacy_deposits (delegate, cycle) ->\n      let contract = Contract_repr.implicit_contract delegate in\n      Storage.Contract.Legacy_frozen_deposits.find (ctxt, contract) cycle\n      >|=? Option.value ~default:Tez_repr.zero\n  | `Legacy_fees (delegate, cycle) ->\n      let contract = Contract_repr.implicit_contract delegate in\n      Storage.Contract.Legacy_frozen_fees.find (ctxt, contract) cycle\n      >|=? Option.value ~default:Tez_repr.zero\n  | `Legacy_rewards (delegate, cycle) ->\n      let contract = Contract_repr.implicit_contract delegate in\n      Storage.Contract.Legacy_frozen_rewards.find (ctxt, contract) cycle\n      >|=? Option.value ~default:Tez_repr.zero\n\nlet credit ctxt dest amount origin =\n  let open Receipt_repr in\n  (match dest with\n  | `Storage_fees -> return (ctxt, Storage_fees)\n  | `Double_signing_punishments -> return (ctxt, Double_signing_punishments)\n  | `Lost_endorsing_rewards (d, p, r) ->\n      return (ctxt, Lost_endorsing_rewards (d, p, r))\n  | `Burned -> return (ctxt, Burned)\n  | `Contract dest ->\n      Contract_storage.credit_only_call_from_token ctxt dest amount\n      >|=? fun ctxt -> (ctxt, Contract dest)\n  | `Collected_commitments bpkh ->\n      Commitment_storage.increase_commitment_only_call_from_token\n        ctxt\n        bpkh\n        amount\n      >|=? fun ctxt -> (ctxt, Commitments bpkh)\n  | `Delegate_balance delegate ->\n      let contract = Contract_repr.implicit_contract delegate in\n      Contract_storage.increase_balance_only_call_from_token\n        ctxt\n        contract\n        amount\n      >|=? fun ctxt -> (ctxt, Contract contract)\n  | `Frozen_deposits delegate as dest ->\n      allocated ctxt dest >>=? fun allocated ->\n      (if not allocated then Frozen_deposits_storage.init ctxt delegate\n      else return ctxt)\n      >>=? fun ctxt ->\n      Frozen_deposits_storage.credit_only_call_from_token ctxt delegate amount\n      >|=? fun ctxt -> (ctxt, Deposits delegate)\n  | `Block_fees ->\n      Raw_context.credit_collected_fees_only_call_from_token ctxt amount\n      >>?= fun ctxt -> return (ctxt, Block_fees)\n  (* TODO: remove in J *)\n  | `Legacy_deposits (delegate, cycle) as dest ->\n      let contract = Contract_repr.implicit_contract delegate in\n      balance ctxt dest >>=? fun old_amount ->\n      Tez_repr.(old_amount +? amount) >>?= fun new_amount ->\n      Storage.Contract.Legacy_frozen_deposits.add\n        (ctxt, contract)\n        cycle\n        new_amount\n      >>= fun ctxt -> return (ctxt, Legacy_deposits (delegate, cycle))\n  | `Legacy_fees (delegate, cycle) as dest ->\n      let contract = Contract_repr.implicit_contract delegate in\n      balance ctxt dest >>=? fun old_amount ->\n      Tez_repr.(old_amount +? amount) >>?= fun new_amount ->\n      Storage.Contract.Legacy_frozen_fees.add (ctxt, contract) cycle new_amount\n      >>= fun ctxt -> return (ctxt, Legacy_fees (delegate, cycle))\n  | `Legacy_rewards (delegate, cycle) as dest ->\n      let contract = Contract_repr.implicit_contract delegate in\n      balance ctxt dest >>=? fun old_amount ->\n      Tez_repr.(old_amount +? amount) >>?= fun new_amount ->\n      Storage.Contract.Legacy_frozen_rewards.add\n        (ctxt, contract)\n        cycle\n        new_amount\n      >>= fun ctxt -> return (ctxt, Legacy_rewards (delegate, cycle)))\n  >|=? fun (ctxt, balance) -> (ctxt, (balance, Credited amount, origin))\n\nlet spend ctxt src amount origin =\n  let open Receipt_repr in\n  (match src with\n  | `Bootstrap -> return (ctxt, Bootstrap)\n  | `Invoice -> return (ctxt, Invoice)\n  | `Initial_commitments -> return (ctxt, Initial_commitments)\n  | `Minted -> return (ctxt, Minted)\n  | `Liquidity_baking_subsidies -> return (ctxt, Liquidity_baking_subsidies)\n  | `Revelation_rewards -> return (ctxt, Nonce_revelation_rewards)\n  | `Double_signing_evidence_rewards ->\n      return (ctxt, Double_signing_evidence_rewards)\n  | `Endorsing_rewards -> return (ctxt, Endorsing_rewards)\n  | `Baking_rewards -> return (ctxt, Baking_rewards)\n  | `Baking_bonuses -> return (ctxt, Baking_bonuses)\n  | `Contract src ->\n      Contract_storage.spend_only_call_from_token ctxt src amount\n      >|=? fun ctxt -> (ctxt, Contract src)\n  | `Collected_commitments bpkh ->\n      Commitment_storage.decrease_commitment_only_call_from_token\n        ctxt\n        bpkh\n        amount\n      >>=? fun ctxt -> return (ctxt, Commitments bpkh)\n  | `Delegate_balance delegate ->\n      let contract = Contract_repr.implicit_contract delegate in\n      Contract_storage.decrease_balance_only_call_from_token\n        ctxt\n        contract\n        amount\n      >|=? fun ctxt -> (ctxt, Contract contract)\n  | `Frozen_deposits delegate ->\n      (if Tez_repr.(amount = zero) then return ctxt\n      else\n        Frozen_deposits_storage.spend_only_call_from_token ctxt delegate amount)\n      >>=? fun ctxt -> return (ctxt, Deposits delegate)\n  | `Block_fees ->\n      Raw_context.spend_collected_fees_only_call_from_token ctxt amount\n      >>?= fun ctxt -> return (ctxt, Block_fees)\n  (* TODO: remove in J *)\n  | `Legacy_deposits (delegate, cycle) as src ->\n      balance ctxt src >>=? fun old_amount ->\n      Tez_repr.(old_amount -? amount) >>?= fun new_amount ->\n      let contract = Contract_repr.implicit_contract delegate in\n      (if Tez_repr.(new_amount = zero) then\n       Storage.Contract.Legacy_frozen_deposits.remove (ctxt, contract) cycle\n      else\n        Storage.Contract.Legacy_frozen_deposits.add\n          (ctxt, contract)\n          cycle\n          new_amount)\n      >>= fun ctxt -> return (ctxt, Legacy_deposits (delegate, cycle))\n  | `Legacy_fees (delegate, cycle) as src ->\n      balance ctxt src >>=? fun old_amount ->\n      Tez_repr.(old_amount -? amount) >>?= fun new_amount ->\n      let contract = Contract_repr.implicit_contract delegate in\n      (if Tez_repr.(new_amount = zero) then\n       Storage.Contract.Legacy_frozen_fees.remove (ctxt, contract) cycle\n      else\n        Storage.Contract.Legacy_frozen_fees.add\n          (ctxt, contract)\n          cycle\n          new_amount)\n      >>= fun ctxt -> return (ctxt, Legacy_fees (delegate, cycle))\n  | `Legacy_rewards (delegate, cycle) as src ->\n      balance ctxt src >>=? fun old_amount ->\n      Tez_repr.(old_amount -? amount) >>?= fun new_amount ->\n      let contract = Contract_repr.implicit_contract delegate in\n      (if Tez_repr.(new_amount = zero) then\n       Storage.Contract.Legacy_frozen_rewards.remove (ctxt, contract) cycle\n      else\n        Storage.Contract.Legacy_frozen_rewards.add\n          (ctxt, contract)\n          cycle\n          new_amount)\n      >>= fun ctxt -> return (ctxt, Legacy_rewards (delegate, cycle)))\n  >|=? fun (ctxt, balance) -> (ctxt, (balance, Debited amount, origin))\n\nlet transfer_n ?(origin = Receipt_repr.Block_application) ctxt src dest =\n  let sources = List.filter (fun (_, am) -> Tez_repr.(am <> zero)) src in\n  match sources with\n  | [] ->\n      (* Avoid accessing context data when there is nothing to transfer. *)\n      return (ctxt, [])\n  | _ :: _ ->\n      List.fold_left_es\n        (fun (ctxt, total, debit_logs) (source, amount) ->\n          spend ctxt source amount origin >>=? fun (ctxt, debit_log) ->\n          Tez_repr.(amount +? total) >>?= fun total ->\n          return (ctxt, total, debit_log :: debit_logs))\n        (ctxt, Tez_repr.zero, [])\n        sources\n      >>=? fun (ctxt, amount, debit_logs) ->\n      credit ctxt dest amount origin >|=? fun (ctxt, credit_log) ->\n      (* Make sure the order of balance updates is : debit logs in the order of\n         of the parameter [src], and then the credit log. *)\n      let balance_updates = List.rev (credit_log :: debit_logs) in\n      (ctxt, balance_updates)\n\nlet transfer ?(origin = Receipt_repr.Block_application) ctxt src dest amount =\n  transfer_n ~origin ctxt [(src, amount)] dest\n" ;
                } ;
                { name = "Delegate_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Allow to register a delegate when creating an account. *)\nval init :\n  Raw_context.t ->\n  Contract_repr.t ->\n  Signature.Public_key_hash.t ->\n  Raw_context.t tzresult Lwt.t\n\nval pubkey :\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Signature.Public_key.t tzresult Lwt.t\n\n(** Updating the delegate of a contract.\n\n    When calling this function on an \"implicit contract\" and setting\n    the delegate to the contract manager registers it as a delegate. One\n    cannot unregister a delegate for now. The associate contract is now\n    'undeletable'. *)\nval set :\n  Raw_context.t ->\n  Contract_repr.t ->\n  Signature.Public_key_hash.t option ->\n  Raw_context.t tzresult Lwt.t\n\nval frozen_deposits_limit :\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Tez_repr.t option tzresult Lwt.t\n\nval set_frozen_deposits_limit :\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Tez_repr.t option ->\n  Raw_context.t Lwt.t\n\ntype error +=\n  | (* `Permanent *) No_deletion of Signature.Public_key_hash.t\n  | (* `Temporary *) Active_delegate\n  | (* `Temporary *) Current_delegate\n  | (* `Permanent *) Empty_delegate_account of Signature.Public_key_hash.t\n  | (* `Permanent *) Unregistered_delegate of Signature.Public_key_hash.t\n  | (* `Permanent *) Unassigned_validation_slot_for_level of Level_repr.t * int\n  | (* `Permanent *)\n      Cannot_find_active_stake of {\n      cycle : Cycle_repr.t;\n      delegate : Signature.Public_key_hash.t;\n    }\n  | (* `Temporary *) Not_registered of Signature.Public_key_hash.t\n\n(** Check that a given implicit account is a registered delegate. *)\nval check_delegate :\n  Raw_context.t -> Signature.Public_key_hash.t -> unit tzresult Lwt.t\n\n(** Participation information. We denote by:\n    - \"static\" information that does not change during the cycle\n    - \"dynamic\" information that may change during the cycle *)\ntype participation_info = {\n  expected_cycle_activity : int;\n      (** The total expected slots to be endorsed in the cycle. (static) *)\n  minimal_cycle_activity : int;\n      (** The minimal endorsing slots in the cycle to get endorsing\n      rewards. (static) *)\n  missed_slots : int;\n      (** The number of missed endorsing slots in the cycle. (dynamic) *)\n  missed_levels : int;\n      (** The number of missed endorsing levels in the cycle. (dynamic) *)\n  remaining_allowed_missed_slots : int;\n      (** Remaining amount of endorsing slots that can be missed in the\n      cycle before forfeiting the rewards. (dynamic) *)\n  expected_endorsing_rewards : Tez_repr.t;\n      (** Endorsing rewards that will be distributed at the end of the\n     cycle if activity at that point will be greater than the minimal\n     required. If the activity is already known to be below the\n     required minimum, then the rewards are zero. (dynamic) *)\n}\n\nval delegate_participation_info :\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  participation_info tzresult Lwt.t\n\n(** Iterate on all registered delegates. *)\nval fold :\n  Raw_context.t ->\n  order:[`Sorted | `Undefined] ->\n  init:'a ->\n  f:(Signature.Public_key_hash.t -> 'a -> 'a Lwt.t) ->\n  'a Lwt.t\n\n(** List all registered delegates. *)\nval list : Raw_context.t -> Signature.Public_key_hash.t list Lwt.t\n\nval balance :\n  Raw_context.t -> Signature.public_key_hash -> Tez_repr.tez tzresult Lwt.t\n\ntype level_participation = Participated | Didn't_participate\n\n(** Record the participation of a delegate as a validator. *)\nval record_endorsing_participation :\n  Raw_context.t ->\n  delegate:Signature.Public_key_hash.t ->\n  participation:level_participation ->\n  endorsing_power:int ->\n  Raw_context.t tzresult Lwt.t\n\n(** Sets the payload and block producer as active. Pays the baking\n   reward and the fees to the payload producer and the reward bonus to\n   the payload producer (if the reward_bonus is not None).*)\nval record_baking_activity_and_pay_rewards_and_fees :\n  Raw_context.t ->\n  payload_producer:Signature.Public_key_hash.t ->\n  block_producer:Signature.Public_key_hash.t ->\n  baking_reward:Tez_repr.t ->\n  reward_bonus:Tez_repr.t option ->\n  (Raw_context.t * Receipt_repr.balance_updates) tzresult Lwt.t\n\n(** Trigger the context maintenance at the end of cycle 'n', i.e.:\n   unfreeze the endorsing rewards, potentially deactivate delegates.\n   Return the corresponding balances updates and the list of\n   deactivated delegates. *)\nval cycle_end :\n  Raw_context.t ->\n  Cycle_repr.t ->\n  Storage.Seed.unrevealed_nonce list ->\n  (Raw_context.t\n  * Receipt_repr.balance_updates\n  * Signature.Public_key_hash.t list)\n  tzresult\n  Lwt.t\n\n(** Returns true if the given delegate has already been slashed\n   for double baking for the given level. *)\nval already_slashed_for_double_baking :\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Level_repr.t ->\n  bool tzresult Lwt.t\n\n(** Returns true if the given delegate has already been slashed\n   for double preendorsing or double endorsing for the given level. *)\nval already_slashed_for_double_endorsing :\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Level_repr.t ->\n  bool tzresult Lwt.t\n\n(** Burn some frozen deposit for a delegate at a given level. Returns\n    the burned amount. *)\nval punish_double_endorsing :\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Level_repr.t ->\n  (Raw_context.t * Tez_repr.t * Receipt_repr.balance_updates) tzresult Lwt.t\n\nval punish_double_baking :\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Level_repr.t ->\n  (Raw_context.t * Tez_repr.t * Receipt_repr.balance_updates) tzresult Lwt.t\n\n(** Returns a delegate's frozen deposits, both the current amount and\n   the initial freezed amount.\n\n    A delegate's frozen balance is only composed of frozen deposits;\n   rewards and fees are not frozen, but simply credited at the right\n   moment.  *)\nval frozen_deposits :\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Storage.deposits tzresult Lwt.t\n\n(** Returns the full 'balance' of the implicit contract associated to\n    a given key, i.e. the sum of the spendable balance and of the\n    frozen balance.\n\n    Only use this function for RPCs: this is expensive. *)\nval full_balance :\n  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t\n\nval staking_balance :\n  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t\n\n(** Only use this function for RPCs: this is expensive. *)\nval delegated_balance :\n  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t\n\nval deactivated :\n  Raw_context.t -> Signature.Public_key_hash.t -> bool tzresult Lwt.t\n\n(** Participation slots potentially associated to accounts. The\n   accounts that didn't place a deposit will be excluded from this\n   list. This function should only be used to compute the deposits to\n   freeze or initialize the protocol while stitching. RPCs can use this\n   function to predict an approximation of long term future slot\n   allocations. It shouldn't be used in the baker. *)\nval slot_owner :\n  Raw_context.t ->\n  Level_repr.t ->\n  Slot_repr.t ->\n  (Raw_context.t * (Signature.Public_key.t * Signature.Public_key_hash.t))\n  tzresult\n  Lwt.t\n\nval baking_rights_owner :\n  Raw_context.t ->\n  Level_repr.t ->\n  round:Round_repr.round ->\n  (Raw_context.t * int * (Signature.public_key * Signature.public_key_hash))\n  tzresult\n  Lwt.t\n\nval freeze_deposits_do_not_call_except_for_migration :\n  Raw_context.t ->\n  new_cycle:Cycle_repr.t ->\n  balance_updates:Receipt_repr.balance_updates ->\n  (Raw_context.t * Receipt_repr.balance_updates) tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype error +=\n  | (* `Permanent *) No_deletion of Signature.Public_key_hash.t\n  | (* `Temporary *) Active_delegate\n  | (* `Temporary *) Current_delegate\n  | (* `Permanent *) Empty_delegate_account of Signature.Public_key_hash.t\n  | (* `Permanent *) Unregistered_delegate of Signature.Public_key_hash.t\n  | (* `Permanent *) Unassigned_validation_slot_for_level of Level_repr.t * int\n  | (* `Permanent *)\n      Cannot_find_active_stake of {\n      cycle : Cycle_repr.t;\n      delegate : Signature.Public_key_hash.t;\n    }\n  | (* `Temporary *) Not_registered of Signature.Public_key_hash.t\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"delegate.no_deletion\"\n    ~title:\"Forbidden delegate deletion\"\n    ~description:\"Tried to unregister a delegate\"\n    ~pp:(fun ppf delegate ->\n      Format.fprintf\n        ppf\n        \"Delegate deletion is forbidden (%a)\"\n        Signature.Public_key_hash.pp\n        delegate)\n    Data_encoding.(obj1 (req \"delegate\" Signature.Public_key_hash.encoding))\n    (function No_deletion c -> Some c | _ -> None)\n    (fun c -> No_deletion c) ;\n  register_error_kind\n    `Temporary\n    ~id:\"delegate.already_active\"\n    ~title:\"Delegate already active\"\n    ~description:\"Useless delegate reactivation\"\n    ~pp:(fun ppf () ->\n      Format.fprintf ppf \"The delegate is still active, no need to refresh it\")\n    Data_encoding.empty\n    (function Active_delegate -> Some () | _ -> None)\n    (fun () -> Active_delegate) ;\n  register_error_kind\n    `Temporary\n    ~id:\"delegate.unchanged\"\n    ~title:\"Unchanged delegated\"\n    ~description:\"Contract already delegated to the given delegate\"\n    ~pp:(fun ppf () ->\n      Format.fprintf\n        ppf\n        \"The contract is already delegated to the same delegate\")\n    Data_encoding.empty\n    (function Current_delegate -> Some () | _ -> None)\n    (fun () -> Current_delegate) ;\n  register_error_kind\n    `Permanent\n    ~id:\"delegate.empty_delegate_account\"\n    ~title:\"Empty delegate account\"\n    ~description:\"Cannot register a delegate when its implicit account is empty\"\n    ~pp:(fun ppf delegate ->\n      Format.fprintf\n        ppf\n        \"Delegate registration is forbidden when the delegate\\n\\\n        \\           implicit account is empty (%a)\"\n        Signature.Public_key_hash.pp\n        delegate)\n    Data_encoding.(obj1 (req \"delegate\" Signature.Public_key_hash.encoding))\n    (function Empty_delegate_account c -> Some c | _ -> None)\n    (fun c -> Empty_delegate_account c) ;\n  (* Unregistered delegate *)\n  register_error_kind\n    `Permanent\n    ~id:\"contract.manager.unregistered_delegate\"\n    ~title:\"Unregistered delegate\"\n    ~description:\"A contract cannot be delegated to an unregistered delegate\"\n    ~pp:(fun ppf k ->\n      Format.fprintf\n        ppf\n        \"The provided public key (with hash %a) is not registered as valid \\\n         delegate key.\"\n        Signature.Public_key_hash.pp\n        k)\n    Data_encoding.(obj1 (req \"hash\" Signature.Public_key_hash.encoding))\n    (function Unregistered_delegate k -> Some k | _ -> None)\n    (fun k -> Unregistered_delegate k) ;\n  (* Unassigned_validation_slot_for_level *)\n  register_error_kind\n    `Permanent\n    ~id:\"delegate.unassigned_validation_slot_for_level\"\n    ~title:\"Unassigned validation slot for level\"\n    ~description:\n      \"The validation slot for the given level is not assigned. Nobody payed \\\n       for that slot, or the level is either in the past or too far in the \\\n       future (further than the validatiors_selection_offset constant)\"\n    ~pp:(fun ppf (l, slot) ->\n      Format.fprintf\n        ppf\n        \"The validation slot %i for the level %a is not assigned. Nobody payed \\\n         for that slot, or the level is either in the past or too far in the \\\n         future (further than the validatiors_selection_offset constant)\"\n        slot\n        Level_repr.pp\n        l)\n    Data_encoding.(obj2 (req \"level\" Level_repr.encoding) (req \"slot\" int31))\n    (function\n      | Unassigned_validation_slot_for_level (l, s) -> Some (l, s) | _ -> None)\n    (fun (l, s) -> Unassigned_validation_slot_for_level (l, s)) ;\n  register_error_kind\n    `Permanent\n    ~id:\"delegate.cannot_find_active_stake\"\n    ~title:\"Cannot find active stake\"\n    ~description:\n      \"The active stake of a delegate cannot be found for the given cycle.\"\n    ~pp:(fun ppf (cycle, delegate) ->\n      Format.fprintf\n        ppf\n        \"The active stake of the delegate %a cannot be found for the cycle %a.\"\n        Cycle_repr.pp\n        cycle\n        Signature.Public_key_hash.pp\n        delegate)\n    Data_encoding.(\n      obj2\n        (req \"cycle\" Cycle_repr.encoding)\n        (req \"delegate\" Signature.Public_key_hash.encoding))\n    (function\n      | Cannot_find_active_stake {cycle; delegate} -> Some (cycle, delegate)\n      | _ -> None)\n    (fun (cycle, delegate) -> Cannot_find_active_stake {cycle; delegate}) ;\n  register_error_kind\n    `Temporary\n    ~id:\"delegate.not_registered\"\n    ~title:\"Not a registered delegate\"\n    ~description:\n      \"The provided public key hash is not the address of a registered \\\n       delegate.\"\n    ~pp:(fun ppf pkh ->\n      Format.fprintf\n        ppf\n        \"The provided public key hash (%a) is not the address of a registered \\\n         delegate. If you own this account and want to register it as a \\\n         delegate, use a delegation operation to delegate the account to \\\n         itself.\"\n        Signature.Public_key_hash.pp\n        pkh)\n    Data_encoding.(obj1 (req \"pkh\" Signature.Public_key_hash.encoding))\n    (function Not_registered pkh -> Some pkh | _ -> None)\n    (fun pkh -> Not_registered pkh)\n\nlet set_inactive ctxt delegate =\n  let delegate_contract = Contract_repr.implicit_contract delegate in\n  Delegate_activation_storage.set_inactive ctxt delegate_contract\n  >>= fun ctxt ->\n  Stake_storage.deactivate_only_call_from_delegate_storage ctxt delegate >|= ok\n\nlet set_active ctxt delegate =\n  Delegate_activation_storage.set_active ctxt delegate\n  >>=? fun (ctxt, inactive) ->\n  if not inactive then return ctxt\n  else Stake_storage.activate_only_call_from_delegate_storage ctxt delegate\n\nlet staking_balance ctxt delegate =\n  Contract_delegate_storage.registered ctxt delegate >>=? fun is_registered ->\n  if is_registered then Stake_storage.get_staking_balance ctxt delegate\n  else return Tez_repr.zero\n\nlet pubkey ctxt delegate =\n  Contract_manager_storage.get_manager_key\n    ctxt\n    delegate\n    ~error:(Unregistered_delegate delegate)\n\nlet init ctxt contract delegate =\n  Contract_manager_storage.is_manager_key_revealed ctxt delegate\n  >>=? fun known_delegate ->\n  error_unless known_delegate (Unregistered_delegate delegate) >>?= fun () ->\n  Contract_delegate_storage.registered ctxt delegate >>=? fun is_registered ->\n  error_unless is_registered (Unregistered_delegate delegate) >>?= fun () ->\n  Contract_delegate_storage.init ctxt contract delegate\n\nlet set c contract delegate =\n  match delegate with\n  | None -> (\n      match Contract_repr.is_implicit contract with\n      | Some pkh ->\n          (* check if contract is a registered delegate *)\n          Contract_delegate_storage.registered c pkh >>=? fun is_registered ->\n          if is_registered then fail (No_deletion pkh)\n          else Contract_delegate_storage.delete c contract\n      | None -> Contract_delegate_storage.delete c contract)\n  | Some delegate ->\n      Contract_manager_storage.is_manager_key_revealed c delegate\n      >>=? fun known_delegate ->\n      Contract_delegate_storage.registered c delegate\n      >>=? fun registered_delegate ->\n      let self_delegation =\n        match Contract_repr.is_implicit contract with\n        | Some pkh -> Signature.Public_key_hash.equal pkh delegate\n        | None -> false\n      in\n      if (not known_delegate) || not (registered_delegate || self_delegation)\n      then fail (Unregistered_delegate delegate)\n      else\n        (Contract_delegate_storage.find c contract >>=? function\n         | Some current_delegate\n           when Signature.Public_key_hash.equal delegate current_delegate ->\n             if self_delegation then\n               Delegate_activation_storage.is_inactive c delegate >>=? function\n               | true -> return_unit\n               | false -> fail Active_delegate\n             else fail Current_delegate\n         | None | Some _ -> return_unit)\n        >>=? fun () ->\n        (* check if contract is a registered delegate *)\n        (match Contract_repr.is_implicit contract with\n        | Some pkh ->\n            Contract_delegate_storage.registered c pkh >>=? fun is_registered ->\n            (* allow self-delegation to re-activate *)\n            if (not self_delegation) && is_registered then\n              fail (No_deletion pkh)\n            else return_unit\n        | None -> return_unit)\n        >>=? fun () ->\n        Storage.Contract.Balance.mem c contract >>= fun exists ->\n        error_when\n          (self_delegation && not exists)\n          (Empty_delegate_account delegate)\n        >>?= fun () ->\n        Contract_delegate_storage.set c contract delegate >>=? fun c ->\n        if self_delegation then\n          Storage.Delegates.add c delegate >>= fun c -> set_active c delegate\n        else return c\n\nlet frozen_deposits_limit ctxt delegate =\n  Storage.Contract.Frozen_deposits_limit.find\n    ctxt\n    (Contract_repr.implicit_contract delegate)\n\nlet set_frozen_deposits_limit ctxt delegate limit =\n  Storage.Contract.Frozen_deposits_limit.add_or_remove\n    ctxt\n    (Contract_repr.implicit_contract delegate)\n    limit\n\nlet update_activity ctxt last_cycle =\n  let preserved = Constants_storage.preserved_cycles ctxt in\n  match Cycle_repr.sub last_cycle preserved with\n  | None -> return (ctxt, [])\n  | Some _unfrozen_cycle ->\n      Stake_storage.fold_on_active_delegates_with_rolls\n        ctxt\n        ~order:`Sorted\n        ~init:(Ok (ctxt, []))\n        ~f:(fun delegate () acc ->\n          acc >>?= fun (ctxt, deactivated) ->\n          Delegate_activation_storage.grace_period ctxt delegate\n          >>=? fun cycle ->\n          if Cycle_repr.(cycle <= last_cycle) then\n            set_inactive ctxt delegate >|=? fun ctxt ->\n            (ctxt, delegate :: deactivated)\n          else return (ctxt, deactivated))\n      >|=? fun (ctxt, deactivated) -> (ctxt, deactivated)\n\nlet expected_slots_for_given_active_stake ctxt ~total_active_stake ~active_stake\n    =\n  let blocks_per_cycle =\n    Int32.to_int (Constants_storage.blocks_per_cycle ctxt)\n  in\n  let consensus_committee_size =\n    Constants_storage.consensus_committee_size ctxt\n  in\n  let number_of_endorsements_per_cycle =\n    blocks_per_cycle * consensus_committee_size\n  in\n  return\n    (Z.to_int\n       (Z.div\n          (Z.mul\n             (Z.of_int64 (Tez_repr.to_mutez active_stake))\n             (Z.of_int number_of_endorsements_per_cycle))\n          (Z.of_int64 (Tez_repr.to_mutez total_active_stake))))\n\nlet delegate_participated_enough ctxt delegate =\n  Storage.Contract.Missed_endorsements.find ctxt delegate >>=? function\n  | None -> return_true\n  | Some missed_endorsements ->\n      return Compare.Int.(missed_endorsements.remaining_slots >= 0)\n\nlet delegate_has_revealed_nonces delegate unrevelead_nonces_set =\n  not (Signature.Public_key_hash.Set.mem delegate unrevelead_nonces_set)\n\nlet distribute_endorsing_rewards ctxt last_cycle unrevealed_nonces =\n  let endorsing_reward_per_slot =\n    Constants_storage.endorsing_reward_per_slot ctxt\n  in\n  let unrevealed_nonces_set =\n    List.fold_left\n      (fun set {Storage.Seed.nonce_hash = _; delegate} ->\n        Signature.Public_key_hash.Set.add delegate set)\n      Signature.Public_key_hash.Set.empty\n      unrevealed_nonces\n  in\n  Stake_storage.get_total_active_stake ctxt last_cycle\n  >>=? fun total_active_stake ->\n  Stake_storage.get_selected_distribution ctxt last_cycle >>=? fun delegates ->\n  List.fold_left_es\n    (fun (ctxt, balance_updates) (delegate, active_stake) ->\n      let delegate_contract = Contract_repr.implicit_contract delegate in\n      delegate_participated_enough ctxt delegate_contract\n      >>=? fun sufficient_participation ->\n      let has_revealed_nonces =\n        delegate_has_revealed_nonces delegate unrevealed_nonces_set\n      in\n      expected_slots_for_given_active_stake\n        ctxt\n        ~total_active_stake\n        ~active_stake\n      >>=? fun expected_slots ->\n      let rewards = Tez_repr.mul_exn endorsing_reward_per_slot expected_slots in\n      (if sufficient_participation && has_revealed_nonces then\n       (* Sufficient participation: we pay the rewards *)\n       Token.transfer\n         ctxt\n         `Endorsing_rewards\n         (`Contract delegate_contract)\n         rewards\n       >|=? fun (ctxt, payed_rewards_receipts) ->\n       (ctxt, payed_rewards_receipts @ balance_updates)\n      else\n        (* Insufficient participation or unrevealed nonce: no rewards *)\n        Token.transfer\n          ctxt\n          `Endorsing_rewards\n          (`Lost_endorsing_rewards\n            (delegate, not sufficient_participation, not has_revealed_nonces))\n          rewards\n        >|=? fun (ctxt, payed_rewards_receipts) ->\n        (ctxt, payed_rewards_receipts @ balance_updates))\n      >>=? fun (ctxt, balance_updates) ->\n      Storage.Contract.Missed_endorsements.remove ctxt delegate_contract\n      >>= fun ctxt -> return (ctxt, balance_updates))\n    (ctxt, [])\n    delegates\n\nlet clear_outdated_slashed_deposits ctxt ~new_cycle =\n  let max_slashable_period = Constants_storage.max_slashing_period ctxt in\n  match Cycle_repr.(sub new_cycle max_slashable_period) with\n  | None -> Lwt.return ctxt\n  | Some outdated_cycle -> Storage.Slashed_deposits.clear (ctxt, outdated_cycle)\n\n(* Return a map from delegates (with active stake at some cycle\n   in the cycle window [from_cycle, to_cycle]) to the maximum\n   of the stake to be deposited for each such cycle (which is just the\n   [frozen_deposits_percentage] of the active stake at that cycle). Also\n   return the delegates that have fallen out of the sliding window. *)\nlet max_frozen_deposits_and_delegates_to_remove ctxt ~from_cycle ~to_cycle =\n  let frozen_deposits_percentage =\n    Constants_storage.frozen_deposits_percentage ctxt\n  in\n  let cycles = Cycle_repr.(from_cycle ---> to_cycle) in\n  (match Cycle_repr.pred from_cycle with\n  | None -> return Signature.Public_key_hash.Set.empty\n  | Some cleared_cycle -> (\n      Stake_storage.find_selected_distribution ctxt cleared_cycle\n      >|=? fun cleared_cycle_delegates ->\n      match cleared_cycle_delegates with\n      | None -> Signature.Public_key_hash.Set.empty\n      | Some delegates ->\n          List.fold_left\n            (fun set (d, _) -> Signature.Public_key_hash.Set.add d set)\n            Signature.Public_key_hash.Set.empty\n            delegates))\n  >>=? fun cleared_cycle_delegates ->\n  List.fold_left_es\n    (fun (maxima, delegates_to_remove) (cycle : Cycle_repr.t) ->\n      Stake_storage.get_selected_distribution ctxt cycle\n      >|=? fun active_stakes ->\n      List.fold_left\n        (fun (maxima, delegates_to_remove) (delegate, stake) ->\n          let stake_to_be_deposited =\n            Tez_repr.(div_exn (mul_exn stake frozen_deposits_percentage) 100)\n          in\n          let maxima =\n            Signature.Public_key_hash.Map.update\n              delegate\n              (function\n                | None -> Some stake_to_be_deposited\n                | Some maximum ->\n                    Some (Tez_repr.max maximum stake_to_be_deposited))\n              maxima\n          in\n          let delegates_to_remove =\n            Signature.Public_key_hash.Set.remove delegate delegates_to_remove\n          in\n          (maxima, delegates_to_remove))\n        (maxima, delegates_to_remove)\n        active_stakes)\n    (Signature.Public_key_hash.Map.empty, cleared_cycle_delegates)\n    cycles\n\nlet freeze_deposits ?(origin = Receipt_repr.Block_application) ctxt ~new_cycle\n    ~balance_updates =\n  let max_slashable_period = Constants_storage.max_slashing_period ctxt in\n  (* We want to be able to slash for at most [max_slashable_period] *)\n  (match Cycle_repr.(sub new_cycle (max_slashable_period - 1)) with\n  | None ->\n      Storage.Tenderbake.First_level.get ctxt\n      >>=? fun first_level_of_tenderbake ->\n      let cycle_eras = Raw_context.cycle_eras ctxt in\n      let level = Level_repr.from_raw ~cycle_eras first_level_of_tenderbake in\n      return level.cycle\n  | Some cycle -> return cycle)\n  >>=? fun from_cycle ->\n  let preserved_cycles = Constants_storage.preserved_cycles ctxt in\n  let to_cycle = Cycle_repr.(add new_cycle preserved_cycles) in\n  max_frozen_deposits_and_delegates_to_remove ctxt ~from_cycle ~to_cycle\n  >>=? fun (maxima, delegates_to_remove) ->\n  Signature.Public_key_hash.Map.fold_es\n    (fun delegate maximum_stake_to_be_deposited (ctxt, balance_updates) ->\n      (* Here we make sure to preserve the following invariant :\n         maximum_stake_to_be_deposited <= frozen_deposits + balance\n         See select_distribution_for_cycle *)\n      let delegate_contract = Contract_repr.implicit_contract delegate in\n      Frozen_deposits_storage.update_deposits_cap\n        ctxt\n        delegate_contract\n        maximum_stake_to_be_deposited\n      >>=? fun (ctxt, current_amount) ->\n      if Tez_repr.(current_amount > maximum_stake_to_be_deposited) then\n        Tez_repr.(current_amount -? maximum_stake_to_be_deposited)\n        >>?= fun to_reimburse ->\n        Token.transfer\n          ~origin\n          ctxt\n          (`Frozen_deposits delegate)\n          (`Delegate_balance delegate)\n          to_reimburse\n        >|=? fun (ctxt, bupds) -> (ctxt, bupds @ balance_updates)\n      else if Tez_repr.(current_amount < maximum_stake_to_be_deposited) then\n        Tez_repr.(maximum_stake_to_be_deposited -? current_amount)\n        >>?= fun desired_to_freeze ->\n        Storage.Contract.Balance.get ctxt delegate_contract >>=? fun balance ->\n        (* In case the delegate hasn't been slashed in this cycle,\n           the following invariant holds:\n           maximum_stake_to_be_deposited <= frozen_deposits + balance\n           See select_distribution_for_cycle\n\n           If the delegate has been slashed during the cycle, the invariant\n           above doesn't necessarily hold. In this case, we freeze the max\n           we can for the delegate. *)\n        let to_freeze = Tez_repr.(min balance desired_to_freeze) in\n        Token.transfer\n          ~origin\n          ctxt\n          (`Delegate_balance delegate)\n          (`Frozen_deposits delegate)\n          to_freeze\n        >|=? fun (ctxt, bupds) -> (ctxt, bupds @ balance_updates)\n      else return (ctxt, balance_updates))\n    maxima\n    (ctxt, balance_updates)\n  >>=? fun (ctxt, balance_updates) ->\n  (* Unfreeze deposits (that is, set them to zero) for delegates that\n     were previously in the relevant window (and therefore had some\n     frozen deposits) but are not in the new window; because that means\n     that such a delegate had no active stake in the relevant cycles,\n     and therefore it should have no frozen deposits. *)\n  Signature.Public_key_hash.Set.fold_es\n    (fun delegate (ctxt, balance_updates) ->\n      let delegate_contract = Contract_repr.implicit_contract delegate in\n      Frozen_deposits_storage.get ctxt delegate_contract\n      >>=? fun frozen_deposits ->\n      if Tez_repr.(frozen_deposits.current_amount > zero) then\n        Frozen_deposits_storage.update_deposits_cap\n          ctxt\n          delegate_contract\n          Tez_repr.zero\n        >>=? fun (ctxt, (_current_amount : Tez_repr.t)) ->\n        Token.transfer\n          ~origin\n          ctxt\n          (`Frozen_deposits delegate)\n          (`Delegate_balance delegate)\n          frozen_deposits.current_amount\n        >|=? fun (ctxt, bupds) -> (ctxt, bupds @ balance_updates)\n      else return (ctxt, balance_updates))\n    delegates_to_remove\n    (ctxt, balance_updates)\n\nlet freeze_deposits_do_not_call_except_for_migration =\n  freeze_deposits ~origin:Protocol_migration\n\nlet cycle_end ctxt last_cycle unrevealed_nonces =\n  let new_cycle = Cycle_repr.add last_cycle 1 in\n  Stake_storage.select_new_distribution_at_cycle_end ctxt ~new_cycle pubkey\n  >>=? fun ctxt ->\n  clear_outdated_slashed_deposits ctxt ~new_cycle >>= fun ctxt ->\n  distribute_endorsing_rewards ctxt last_cycle unrevealed_nonces\n  >>=? fun (ctxt, balance_updates) ->\n  freeze_deposits ctxt ~new_cycle ~balance_updates\n  >>=? fun (ctxt, balance_updates) ->\n  Stake_storage.clear_at_cycle_end ctxt ~new_cycle >>=? fun ctxt ->\n  update_activity ctxt last_cycle >>=? fun (ctxt, deactivated_delagates) ->\n  return (ctxt, balance_updates, deactivated_delagates)\n\nlet balance ctxt delegate =\n  let contract = Contract_repr.implicit_contract delegate in\n  Storage.Contract.Balance.get ctxt contract\n\nlet frozen_deposits ctxt delegate =\n  Frozen_deposits_storage.get ctxt (Contract_repr.implicit_contract delegate)\n\nlet full_balance ctxt delegate =\n  frozen_deposits ctxt delegate >>=? fun frozen_deposits ->\n  balance ctxt delegate >>=? fun balance ->\n  Lwt.return Tez_repr.(frozen_deposits.current_amount +? balance)\n\nlet deactivated = Delegate_activation_storage.is_inactive\n\nlet delegated_balance ctxt delegate =\n  staking_balance ctxt delegate >>=? fun staking_balance ->\n  balance ctxt delegate >>=? fun balance ->\n  frozen_deposits ctxt delegate >>=? fun frozen_deposits ->\n  Tez_repr.(balance +? frozen_deposits.current_amount)\n  >>?= fun self_staking_balance ->\n  Lwt.return Tez_repr.(staking_balance -? self_staking_balance)\n\nlet fold = Storage.Delegates.fold\n\nlet list = Storage.Delegates.elements\n\n(* The fact that this succeeds iff [registered ctxt pkh] returns true is an\n   invariant of the [set] function. *)\nlet check_delegate ctxt pkh =\n  Storage.Delegates.mem ctxt pkh >>= function\n  | true -> return_unit\n  | false -> fail (Not_registered pkh)\n\nmodule Random = struct\n  (* [init_random_state] initialize a random sequence drawing state\n     that's unique for a given (seed, level, index) triple. Elements\n     from this sequence are drawn using [take_int64], updating the\n     state for the next draw. The initial state is the Blake2b hash of\n     the three randomness sources, and an offset set to zero\n     (indicating that zero bits of randomness have been\n     consumed). When drawing random elements, bits are extracted from\n     the state until exhaustion (256 bits), at which point the state\n     is rehashed and the offset reset to 0. *)\n\n  let init_random_state seed level index =\n    ( Raw_hashes.blake2b\n        (Data_encoding.Binary.to_bytes_exn\n           Data_encoding.(tup3 Seed_repr.seed_encoding int32 int32)\n           (seed, level.Level_repr.cycle_position, Int32.of_int index)),\n      0 )\n\n  let take_int64 bound state =\n    let drop_if_over =\n      (* This function draws random values in [0-(bound-1)] by drawing\n         in [0-(2^63-1)] (64-bit) and computing the value modulo\n         [bound]. For the application of [mod bound] to preserve\n         uniformity, the input space must be of the form\n         [0-(n*bound-1)]. We enforce this by rejecting 64-bit samples\n         above this limit (in which case, we draw a new 64-sample from\n         the sequence and try again). *)\n      Int64.sub Int64.max_int (Int64.rem Int64.max_int bound)\n    in\n    let rec loop (bytes, n) =\n      let consumed_bytes = 8 in\n      let state_size = Bytes.length bytes in\n      if Compare.Int.(n > state_size - consumed_bytes) then\n        loop (Raw_hashes.blake2b bytes, 0)\n      else\n        let r = Int64.abs (TzEndian.get_int64 bytes n) in\n        if Compare.Int64.(r >= drop_if_over) then\n          loop (bytes, n + consumed_bytes)\n        else\n          let v = Int64.rem r bound in\n          (v, (bytes, n + consumed_bytes))\n    in\n    loop state\n\n  let owner c (level : Level_repr.t) offset =\n    (* TODO: https://gitlab.com/tezos/tezos/-/issues/2084\n       compute sampler at stake distribution snapshot instead of lazily. *)\n    let cycle = level.Level_repr.cycle in\n    (match Raw_context.sampler_for_cycle c cycle with\n    | Error `Sampler_not_set ->\n        Seed_storage.for_cycle c cycle >>=? fun seed ->\n        Stake_storage.Delegate_sampler_state.get c cycle >>=? fun state ->\n        let (c, seed, state) =\n          match Raw_context.set_sampler_for_cycle c cycle (seed, state) with\n          | Error `Sampler_already_set -> assert false\n          | Ok c -> (c, seed, state)\n        in\n        return (c, seed, state)\n    | Ok (seed, state) -> return (c, seed, state))\n    >>=? fun (c, seed, state) ->\n    let sample ~int_bound ~mass_bound =\n      let state = init_random_state seed level offset in\n      let (i, state) = take_int64 (Int64.of_int int_bound) state in\n      let (elt, _) = take_int64 mass_bound state in\n      (Int64.to_int i, elt)\n    in\n    let (pk, pkh) = Sampler.sample state sample in\n    return (c, (pk, pkh))\nend\n\n(* Round robin delegate selection. This is only used for testing purposes. *)\nmodule Round_robin = struct\n  let over level slot delegates =\n    let nth_mod n l =\n      match List.nth_opt l (n mod List.length l) with\n      | None -> assert false\n      | Some x -> x\n    in\n    let level_int = Int32.to_int level.Level_repr.level_position in\n    if Compare.Int.(level_int = 0) then\n      (* dummy case for level 0 *)\n      nth_mod 0 delegates |> nth_mod 0 |> return\n    else\n      let adjusted_level = level_int - 1 in\n      let n_defined_levels = List.length delegates in\n      if Compare.Int.(adjusted_level < n_defined_levels) then\n        nth_mod adjusted_level delegates |> nth_mod slot |> return\n      else\n        let delegates =\n          match List.rev delegates with [] -> assert false | last :: _ -> last\n        in\n        nth_mod (level_int - n_defined_levels + slot) delegates |> return\nend\n\nlet slot_owner c level slot =\n  match (Constants_storage.parametric c).delegate_selection with\n  | Random -> Random.owner c level (Slot_repr.to_int slot)\n  | Round_robin_over delegates ->\n      Round_robin.over level (Slot_repr.to_int slot) delegates >|=? fun pk ->\n      (c, (pk, Signature.Public_key.hash pk))\n\nlet baking_rights_owner c (level : Level_repr.t) ~round =\n  Round_repr.to_int round >>?= fun round ->\n  let consensus_committee_size = Constants_storage.consensus_committee_size c in\n  let pos = round mod consensus_committee_size in\n  slot_owner c level pos >>=? fun (ctxt, pk) ->\n  return (ctxt, Slot_repr.of_int_do_not_use_except_for_parameters pos, pk)\n\nlet already_slashed_for_double_endorsing ctxt delegate (level : Level_repr.t) =\n  Storage.Slashed_deposits.find (ctxt, level.cycle) (level.level, delegate)\n  >>=? function\n  | None -> return_false\n  | Some slashed -> return slashed.for_double_endorsing\n\nlet already_slashed_for_double_baking ctxt delegate (level : Level_repr.t) =\n  Storage.Slashed_deposits.find (ctxt, level.cycle) (level.level, delegate)\n  >>=? function\n  | None -> return_false\n  | Some slashed -> return slashed.for_double_baking\n\nlet punish_double_endorsing ctxt delegate (level : Level_repr.t) =\n  let delegate_contract = Contract_repr.implicit_contract delegate in\n  Frozen_deposits_storage.get ctxt delegate_contract >>=? fun frozen_deposits ->\n  let slashing_ratio : Constants_repr.ratio =\n    Constants_storage.ratio_of_frozen_deposits_slashed_per_double_endorsement\n      ctxt\n  in\n  let punish_value =\n    Tez_repr.(\n      div_exn\n        (mul_exn frozen_deposits.initial_amount slashing_ratio.numerator)\n        slashing_ratio.denominator)\n  in\n  let amount_to_burn =\n    Tez_repr.(min frozen_deposits.current_amount punish_value)\n  in\n  Token.transfer\n    ctxt\n    (`Frozen_deposits delegate)\n    `Double_signing_punishments\n    amount_to_burn\n  >>=? fun (ctxt, balance_updates) ->\n  Stake_storage.remove_stake ctxt delegate amount_to_burn >>=? fun ctxt ->\n  Storage.Slashed_deposits.find (ctxt, level.cycle) (level.level, delegate)\n  >>=? fun slashed ->\n  let slashed : Storage.slashed_level =\n    match slashed with\n    | None -> {for_double_endorsing = true; for_double_baking = false}\n    | Some slashed ->\n        assert (Compare.Bool.(slashed.for_double_endorsing = false)) ;\n        {slashed with for_double_endorsing = true}\n  in\n  Storage.Slashed_deposits.add\n    (ctxt, level.cycle)\n    (level.level, delegate)\n    slashed\n  >>= fun ctxt -> return (ctxt, amount_to_burn, balance_updates)\n\nlet punish_double_baking ctxt delegate (level : Level_repr.t) =\n  let delegate_contract = Contract_repr.implicit_contract delegate in\n  Frozen_deposits_storage.get ctxt delegate_contract >>=? fun frozen_deposits ->\n  let slashing_for_one_block =\n    Constants_storage.double_baking_punishment ctxt\n  in\n  let amount_to_burn =\n    Tez_repr.(min frozen_deposits.current_amount slashing_for_one_block)\n  in\n  Token.transfer\n    ctxt\n    (`Frozen_deposits delegate)\n    `Double_signing_punishments\n    amount_to_burn\n  >>=? fun (ctxt, balance_updates) ->\n  Stake_storage.remove_stake ctxt delegate amount_to_burn >>=? fun ctxt ->\n  Storage.Slashed_deposits.find (ctxt, level.cycle) (level.level, delegate)\n  >>=? fun slashed ->\n  let slashed : Storage.slashed_level =\n    match slashed with\n    | None -> {for_double_endorsing = false; for_double_baking = true}\n    | Some slashed ->\n        assert (Compare.Bool.(slashed.for_double_baking = false)) ;\n        {slashed with for_double_baking = true}\n  in\n  Storage.Slashed_deposits.add\n    (ctxt, level.cycle)\n    (level.level, delegate)\n    slashed\n  >>= fun ctxt -> return (ctxt, amount_to_burn, balance_updates)\n\ntype level_participation = Participated | Didn't_participate\n\n(* Note that the participation for the last block of a cycle is\n   recorded in the next cycle. *)\nlet record_endorsing_participation ctxt ~delegate ~participation\n    ~endorsing_power =\n  match participation with\n  | Participated -> set_active ctxt delegate\n  | Didn't_participate -> (\n      let contract = Contract_repr.implicit_contract delegate in\n      Storage.Contract.Missed_endorsements.find ctxt contract >>=? function\n      | Some {remaining_slots; missed_levels} ->\n          let remaining_slots = remaining_slots - endorsing_power in\n          Storage.Contract.Missed_endorsements.update\n            ctxt\n            contract\n            {remaining_slots; missed_levels = missed_levels + 1}\n      | None -> (\n          let level = Level_storage.current ctxt in\n          Raw_context.stake_distribution_for_current_cycle ctxt\n          >>?= fun stake_distribution ->\n          match\n            Signature.Public_key_hash.Map.find delegate stake_distribution\n          with\n          | None ->\n              (* This happens when the block is the first one in a\n                 cycle, and therefore the endorsements are for the last\n                 block of the previous cycle, and when the delegate does\n                 not have an active stake at the current cycle; in this\n                 case its participation is simply ignored. *)\n              assert (Compare.Int32.(level.cycle_position = 0l)) ;\n              return ctxt\n          | Some active_stake ->\n              Stake_storage.get_total_active_stake ctxt level.cycle\n              >>=? fun total_active_stake ->\n              expected_slots_for_given_active_stake\n                ctxt\n                ~total_active_stake\n                ~active_stake\n              >>=? fun expected_slots ->\n              let Constants_repr.{numerator; denominator} =\n                Constants_storage.minimal_participation_ratio ctxt\n              in\n              let minimal_activity = expected_slots * numerator / denominator in\n              let maximal_inactivity = expected_slots - minimal_activity in\n              let remaining_slots = maximal_inactivity - endorsing_power in\n              Storage.Contract.Missed_endorsements.init\n                ctxt\n                contract\n                {remaining_slots; missed_levels = 1}))\n\nlet record_baking_activity_and_pay_rewards_and_fees ctxt ~payload_producer\n    ~block_producer ~baking_reward ~reward_bonus =\n  set_active ctxt payload_producer >>=? fun ctxt ->\n  (if not (Signature.Public_key_hash.equal payload_producer block_producer) then\n   set_active ctxt block_producer\n  else return ctxt)\n  >>=? fun ctxt ->\n  let pay_payload_producer ctxt delegate =\n    let contract = Contract_repr.implicit_contract delegate in\n    Token.balance ctxt `Block_fees >>=? fun block_fees ->\n    Token.transfer_n\n      ctxt\n      [(`Block_fees, block_fees); (`Baking_rewards, baking_reward)]\n      (`Contract contract)\n  in\n  let pay_block_producer ctxt delegate bonus =\n    let contract = Contract_repr.implicit_contract delegate in\n    Token.transfer ctxt `Baking_bonuses (`Contract contract) bonus\n  in\n  pay_payload_producer ctxt payload_producer\n  >>=? fun (ctxt, balance_updates_payload_producer) ->\n  (match reward_bonus with\n  | Some bonus -> pay_block_producer ctxt block_producer bonus\n  | None -> return (ctxt, []))\n  >>=? fun (ctxt, balance_updates_block_producer) ->\n  return\n    (ctxt, balance_updates_payload_producer @ balance_updates_block_producer)\n\ntype participation_info = {\n  expected_cycle_activity : int;\n  minimal_cycle_activity : int;\n  missed_slots : int;\n  missed_levels : int;\n  remaining_allowed_missed_slots : int;\n  expected_endorsing_rewards : Tez_repr.t;\n}\n\n(* Inefficient, only for RPC *)\nlet delegate_participation_info ctxt delegate =\n  let level = Level_storage.current ctxt in\n  Stake_storage.get_selected_distribution ctxt level.cycle\n  >>=? fun stake_distribution ->\n  match\n    List.assoc_opt\n      ~equal:Signature.Public_key_hash.equal\n      delegate\n      stake_distribution\n  with\n  | None ->\n      (* delegate does not have an active stake at the current cycle *)\n      return\n        {\n          expected_cycle_activity = 0;\n          minimal_cycle_activity = 0;\n          missed_slots = 0;\n          missed_levels = 0;\n          remaining_allowed_missed_slots = 0;\n          expected_endorsing_rewards = Tez_repr.zero;\n        }\n  | Some active_stake ->\n      Stake_storage.get_total_active_stake ctxt level.cycle\n      >>=? fun total_active_stake ->\n      expected_slots_for_given_active_stake\n        ctxt\n        ~total_active_stake\n        ~active_stake\n      >>=? fun expected_cycle_activity ->\n      let Constants_repr.{numerator; denominator} =\n        Constants_storage.minimal_participation_ratio ctxt\n      in\n      let endorsing_reward_per_slot =\n        Constants_storage.endorsing_reward_per_slot ctxt\n      in\n      let minimal_cycle_activity =\n        expected_cycle_activity * numerator / denominator\n      in\n      let maximal_cycle_inactivity =\n        expected_cycle_activity - minimal_cycle_activity\n      in\n      let expected_endorsing_rewards =\n        Tez_repr.mul_exn endorsing_reward_per_slot expected_cycle_activity\n      in\n      let contract = Contract_repr.implicit_contract delegate in\n      Storage.Contract.Missed_endorsements.find ctxt contract\n      >>=? fun missed_endorsements ->\n      let (missed_slots, missed_levels, remaining_allowed_missed_slots) =\n        match missed_endorsements with\n        | None -> (0, 0, maximal_cycle_inactivity)\n        | Some {remaining_slots; missed_levels} ->\n            ( maximal_cycle_inactivity - remaining_slots,\n              missed_levels,\n              Compare.Int.max 0 remaining_slots )\n      in\n      let expected_endorsing_rewards =\n        match missed_endorsements with\n        | Some r when Compare.Int.(r.remaining_slots < 0) -> Tez_repr.zero\n        | _ -> expected_endorsing_rewards\n      in\n      return\n        {\n          expected_cycle_activity;\n          minimal_cycle_activity;\n          missed_slots;\n          missed_levels;\n          remaining_allowed_missed_slots;\n          expected_endorsing_rewards;\n        }\n" ;
                } ;
                { name = "Bootstrap_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nval init :\n  Raw_context.t ->\n  typecheck:\n    (Raw_context.t ->\n    Script_repr.t ->\n    ((Script_repr.t * Lazy_storage_diff.diffs option) * Raw_context.t) tzresult\n    Lwt.t) ->\n  ?no_reward_cycles:int ->\n  Parameters_repr.bootstrap_account list ->\n  Parameters_repr.bootstrap_contract list ->\n  (Raw_context.t * Receipt_repr.balance_updates) tzresult Lwt.t\n\nval cycle_end : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nlet init_account (ctxt, balance_updates)\n    ({public_key_hash; public_key; amount} : Parameters_repr.bootstrap_account)\n    =\n  let contract = Contract_repr.implicit_contract public_key_hash in\n  Token.transfer\n    ~origin:Protocol_migration\n    ctxt\n    `Bootstrap\n    (`Contract contract)\n    amount\n  >>=? fun (ctxt, new_balance_updates) ->\n  (match public_key with\n  | Some public_key ->\n      Contract_manager_storage.reveal_manager_key\n        ctxt\n        public_key_hash\n        public_key\n      >>=? fun ctxt -> Delegate_storage.set ctxt contract (Some public_key_hash)\n  | None -> return ctxt)\n  >|=? fun ctxt -> (ctxt, new_balance_updates @ balance_updates)\n\nlet init_contract ~typecheck (ctxt, balance_updates)\n    ({delegate; amount; script} : Parameters_repr.bootstrap_contract) =\n  Contract_storage.fresh_contract_from_current_nonce ctxt\n  >>?= fun (ctxt, contract) ->\n  typecheck ctxt script >>=? fun (script, ctxt) ->\n  Contract_storage.raw_originate\n    ctxt\n    ~prepaid_bootstrap_storage:true\n    contract\n    ~script\n  >>=? fun ctxt ->\n  (match delegate with\n  | None -> return ctxt\n  | Some delegate -> Delegate_storage.init ctxt contract delegate)\n  >>=? fun ctxt ->\n  let origin = Receipt_repr.Protocol_migration in\n  Token.transfer ~origin ctxt `Bootstrap (`Contract contract) amount\n  >|=? fun (ctxt, new_balance_updates) ->\n  (ctxt, new_balance_updates @ balance_updates)\n\nlet init ctxt ~typecheck ?no_reward_cycles accounts contracts =\n  let nonce = Operation_hash.hash_string [\"Un festival de GADT.\"] in\n  let ctxt = Raw_context.init_origination_nonce ctxt nonce in\n  List.fold_left_es init_account (ctxt, []) accounts\n  >>=? fun (ctxt, balance_updates) ->\n  List.fold_left_es (init_contract ~typecheck) (ctxt, balance_updates) contracts\n  >>=? fun (ctxt, balance_updates) ->\n  (match no_reward_cycles with\n  | None -> return ctxt\n  | Some cycles ->\n      (* Store pending ramp ups. *)\n      let constants = Raw_context.constants ctxt in\n      (* Start without rewards *)\n      Raw_context.patch_constants ctxt (fun c ->\n          {\n            c with\n            baking_reward_fixed_portion = Tez_repr.zero;\n            baking_reward_bonus_per_slot = Tez_repr.zero;\n            endorsing_reward_per_slot = Tez_repr.zero;\n          })\n      >>= fun ctxt ->\n      (* Store the final reward. *)\n      Storage.Ramp_up.(\n        Rewards.init\n          ctxt\n          (Cycle_repr.of_int32_exn (Int32.of_int cycles))\n          {\n            baking_reward_fixed_portion = constants.baking_reward_fixed_portion;\n            baking_reward_bonus_per_slot =\n              constants.baking_reward_bonus_per_slot;\n            endorsing_reward_per_slot = constants.endorsing_reward_per_slot;\n          }))\n  >|=? fun ctxt -> (ctxt, balance_updates)\n\nlet cycle_end ctxt last_cycle =\n  let next_cycle = Cycle_repr.succ last_cycle in\n  Storage.Ramp_up.Rewards.find ctxt next_cycle >>=? function\n  | None -> return ctxt\n  | Some\n      Storage.Ramp_up.\n        {\n          baking_reward_fixed_portion;\n          baking_reward_bonus_per_slot;\n          endorsing_reward_per_slot;\n        } ->\n      Storage.Ramp_up.Rewards.remove_existing ctxt next_cycle >>=? fun ctxt ->\n      Raw_context.patch_constants ctxt (fun c ->\n          {\n            c with\n            baking_reward_fixed_portion;\n            baking_reward_bonus_per_slot;\n            endorsing_reward_per_slot;\n          })\n      >|= ok\n" ;
                } ;
                { name = "Voting_period_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nval init : Raw_context.t -> Voting_period_repr.t -> Raw_context.t tzresult Lwt.t\n\n(** Sets the initial period to [{voting_period = root; kind = Proposal;\n    start_position}]. *)\nval init_first_period :\n  Raw_context.t -> start_position:Int32.t -> Raw_context.t tzresult Lwt.t\n\n(** Increment the index by one and set the kind to Proposal. *)\nval reset : Raw_context.t -> Raw_context.t tzresult Lwt.t\n\n(** Increment the index by one and set the kind to its successor. *)\nval succ : Raw_context.t -> Raw_context.t tzresult Lwt.t\n\nval get_current : Raw_context.t -> Voting_period_repr.t tzresult Lwt.t\n\nval get_current_kind : Raw_context.t -> Voting_period_repr.kind tzresult Lwt.t\n\n(** Returns true if the context level is the last of current voting period.  *)\nval is_last_block : Raw_context.t -> bool tzresult Lwt.t\n\n(** Returns the voting period information for the current level. *)\nval get_rpc_current_info :\n  Raw_context.t -> Voting_period_repr.info tzresult Lwt.t\n\n(** Returns the voting period information for the next level. *)\nval get_rpc_succ_info : Raw_context.t -> Voting_period_repr.info tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(*\n  The shell uses the convention that a context at level n is the resulting\n  context of the application of block n.\n  Therefore when using an RPC on the last level of a voting period, the context\n  that is inspected is the resulting one.\n\n  However [Amendment.may_start_new_voting_period] is run at the end of voting\n  period and it has to prepare the context for validating operations of the next\n  period. This causes the counter-intuitive result that the info returned by RPCs\n  at last level of a voting period mention data of the next voting period.\n\n  For example, when validating the last block of a proposal period at level n\n  we have:\n  - Input context:\n\n       voting_period = { kind = Proposal;\n                         index = i;\n                         start_position = n - blocks_per_voting_period}\n\n       - position  = n - start_position = blocks_per_voting_period\n       - remaining = blocks_per_voting_period - (position + 1) = 0\n\n  - Output context:\n\n       voting_period = { kind = Exploration;\n                         index = i + 1;\n                         start_position = n + 1}\n\n      Now if we calculate position and remaining in the voting period we get\n      strange results:\n       - position  = n - (n + 1) = -1\n       - remaining = blocks_per_voting_period\n\n  To work around this issue, two RPCs were added\n  `Voting_period_storage.get_rpc_current_info`, which returns the correct\n  info also for the last context of a period, and\n  `Voting_period_storage.get_rpc_succ_info`, which can be used at the last\n  context of a period to craft operations that will be valid for the first\n  block of the new period.\n\n  This odd behaviour could be fixed if [Amendment.may_start_new_voting_period]\n  was called when we start validating the first block of a voting period instead\n  that at the end of the validation of the last block of a voting period.\n  This should be carefully done because the voting period listing depends on\n  the rolls and it might break some invariant.\n\n  When this is implemented one should:\n  - edit the function [reset_current] and [inc_current] to use the\n    current level and not the next one.\n  - remove the storage for pred_kind\n  - make Voting_period_repr.t abstract\n\n  You can also look at the MR description here:\n  https://gitlab.com/metastatedev/tezos/-/merge_requests/333\n *)\n\n(* Voting periods start at the first block of a cycle. More formally,\n   the invariant of start_position with respect to cycle_position is:\n     cycle_position mod blocks_per_cycle ==\n     position_in_period mod blocks_per_cycle *)\n\nlet set_current = Storage.Vote.Current_period.update\n\nlet get_current = Storage.Vote.Current_period.get\n\nlet init = Storage.Vote.Current_period.init\n\nlet init_first_period ctxt ~start_position =\n  init ctxt @@ Voting_period_repr.root ~start_position >>=? fun ctxt ->\n  Storage.Vote.Pred_period_kind.init ctxt Voting_period_repr.Proposal\n\nlet common ctxt =\n  get_current ctxt >>=? fun current_period ->\n  Storage.Vote.Pred_period_kind.update ctxt current_period.kind >|=? fun ctxt ->\n  let start_position =\n    (* because we are preparing the voting period for the next block we need to\n       use the next level. *)\n    Int32.succ (Level_storage.current ctxt).level_position\n  in\n  (ctxt, current_period, start_position)\n\nlet reset ctxt =\n  common ctxt >>=? fun (ctxt, current_period, start_position) ->\n  Voting_period_repr.raw_reset current_period ~start_position\n  |> set_current ctxt\n\nlet succ ctxt =\n  common ctxt >>=? fun (ctxt, current_period, start_position) ->\n  Voting_period_repr.raw_succ current_period ~start_position |> set_current ctxt\n\nlet get_current_kind ctxt = get_current ctxt >|=? fun {kind; _} -> kind\n\nlet get_current_info ctxt =\n  get_current ctxt >|=? fun voting_period ->\n  let blocks_per_voting_period =\n    Constants_storage.blocks_per_voting_period ctxt\n  in\n  let level = Level_storage.current ctxt in\n  let position = Voting_period_repr.position_since level voting_period in\n  let remaining =\n    Voting_period_repr.remaining_blocks\n      level\n      voting_period\n      ~blocks_per_voting_period\n  in\n  Voting_period_repr.{voting_period; position; remaining}\n\nlet get_current_remaining ctxt =\n  get_current ctxt >|=? fun voting_period ->\n  let blocks_per_voting_period =\n    Constants_storage.blocks_per_voting_period ctxt\n  in\n  Voting_period_repr.remaining_blocks\n    (Level_storage.current ctxt)\n    voting_period\n    ~blocks_per_voting_period\n\nlet is_last_block ctxt =\n  get_current_remaining ctxt >|=? fun remaining ->\n  Compare.Int32.(remaining = 0l)\n\nlet get_rpc_current_info ctxt =\n  get_current_info ctxt\n  >>=? fun ({voting_period; position; _} as voting_period_info) ->\n  if Compare.Int32.(position = Int32.minus_one) then\n    let level = Level_storage.current ctxt in\n    let blocks_per_voting_period =\n      Constants_storage.blocks_per_voting_period ctxt\n    in\n    Storage.Vote.Pred_period_kind.get ctxt >|=? fun pred_kind ->\n    let voting_period : Voting_period_repr.t =\n      {\n        index = Int32.pred voting_period.index;\n        kind = pred_kind;\n        start_position =\n          Int32.(sub voting_period.start_position blocks_per_voting_period);\n      }\n    in\n    let position = Voting_period_repr.position_since level voting_period in\n    let remaining =\n      Voting_period_repr.remaining_blocks\n        level\n        voting_period\n        ~blocks_per_voting_period\n    in\n    ({voting_period; remaining; position} : Voting_period_repr.info)\n  else return voting_period_info\n\nlet get_rpc_succ_info ctxt =\n  Level_storage.from_raw_with_offset\n    ctxt\n    ~offset:1l\n    (Level_storage.current ctxt).level\n  >>?= fun level ->\n  get_current ctxt >|=? fun voting_period ->\n  let blocks_per_voting_period =\n    Constants_storage.blocks_per_voting_period ctxt\n  in\n  let position = Voting_period_repr.position_since level voting_period in\n  let remaining =\n    Voting_period_repr.remaining_blocks\n      level\n      voting_period\n      ~blocks_per_voting_period\n  in\n  Voting_period_repr.{voting_period; position; remaining}\n" ;
                } ;
                { name = "Vote_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Manages all the voting related storage in Storage.Vote.  *)\n\n(** Records a protocol proposal with the delegate that proposed it. *)\nval record_proposal :\n  Raw_context.t ->\n  Protocol_hash.t ->\n  Signature.Public_key_hash.t ->\n  Raw_context.t tzresult Lwt.t\n\nval recorded_proposal_count_for_delegate :\n  Raw_context.t -> Signature.Public_key_hash.t -> int tzresult Lwt.t\n\n(** Computes for each proposal how many delegates proposed it. *)\nval get_proposals : Raw_context.t -> int32 Protocol_hash.Map.t tzresult Lwt.t\n\nval clear_proposals : Raw_context.t -> Raw_context.t Lwt.t\n\n(** Counts of the votes *)\ntype ballots = {yay : int32; nay : int32; pass : int32}\n\nval ballots_encoding : ballots Data_encoding.t\n\nval has_recorded_ballot :\n  Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t\n\n(** Records a vote for a delegate, returns a {!Storage_error Existing_key} if\n    the vote was already registered *)\nval record_ballot :\n  Raw_context.t ->\n  Signature.Public_key_hash.t ->\n  Vote_repr.ballot ->\n  Raw_context.t tzresult Lwt.t\n\n(** Computes the sum of the current ballots weighted by stake. *)\nval get_ballots : Raw_context.t -> ballots tzresult Lwt.t\n\nval get_ballot_list :\n  Raw_context.t -> (Signature.Public_key_hash.t * Vote_repr.ballot) list Lwt.t\n\nval clear_ballots : Raw_context.t -> Raw_context.t Lwt.t\n\nval listings_encoding :\n  (Signature.Public_key_hash.t * int32) list Data_encoding.t\n\n(** Populates [!Storage.Vote.Listings] using the currently existing rolls and\n    sets Listings_size. Delegates without rolls are not included in the listing. *)\nval update_listings : Raw_context.t -> Raw_context.t tzresult Lwt.t\n\n(** Returns the sum of all rolls of all delegates. *)\nval listing_size : Raw_context.t -> int32 tzresult Lwt.t\n\n(** Verifies the presence of a delegate in the listing. *)\nval in_listings : Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t\n\nval get_listings :\n  Raw_context.t -> (Signature.Public_key_hash.t * int32) list Lwt.t\n\nval get_voting_power_free :\n  Raw_context.t -> Signature.public_key_hash -> int32 tzresult Lwt.t\n\nval get_voting_power :\n  Raw_context.t ->\n  Signature.public_key_hash ->\n  (Raw_context.t * int32) tzresult Lwt.t\n\nval get_total_voting_power_free : Raw_context.t -> int32 tzresult Lwt.t\n\nval get_total_voting_power :\n  Raw_context.t -> (Raw_context.t * int32) tzresult Lwt.t\n\nval get_current_quorum : Raw_context.t -> int32 tzresult Lwt.t\n\nval get_participation_ema : Raw_context.t -> int32 tzresult Lwt.t\n\nval set_participation_ema :\n  Raw_context.t -> int32 -> Raw_context.t tzresult Lwt.t\n\nval get_current_proposal : Raw_context.t -> Protocol_hash.t tzresult Lwt.t\n\nval find_current_proposal :\n  Raw_context.t -> Protocol_hash.t option tzresult Lwt.t\n\nval init_current_proposal :\n  Raw_context.t -> Protocol_hash.t -> Raw_context.t tzresult Lwt.t\n\nval clear_current_proposal : Raw_context.t -> Raw_context.t tzresult Lwt.t\n\n(** Sets the initial quorum to 80% and period kind to proposal. *)\nval init :\n  Raw_context.t -> start_position:Int32.t -> Raw_context.t tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nlet recorded_proposal_count_for_delegate ctxt proposer =\n  Storage.Vote.Proposals_count.find ctxt proposer >|=? Option.value ~default:0\n\nlet record_proposal ctxt proposal proposer =\n  recorded_proposal_count_for_delegate ctxt proposer >>=? fun count ->\n  Storage.Vote.Proposals_count.add ctxt proposer (count + 1) >>= fun ctxt ->\n  Storage.Vote.Proposals.add ctxt (proposal, proposer) >|= ok\n\nlet get_proposals ctxt =\n  Storage.Vote.Proposals.fold\n    ctxt\n    ~order:`Sorted\n    ~init:(ok Protocol_hash.Map.empty)\n    ~f:(fun (proposal, delegate) acc ->\n      (* Assuming the same listings is used at votings *)\n      Storage.Vote.Listings.get ctxt delegate >>=? fun weight ->\n      Lwt.return\n        ( acc >|? fun acc ->\n          let previous =\n            match Protocol_hash.Map.find proposal acc with\n            | None -> 0l\n            | Some x -> x\n          in\n          Protocol_hash.Map.add proposal (Int32.add weight previous) acc ))\n\nlet clear_proposals ctxt =\n  Storage.Vote.Proposals_count.clear ctxt >>= fun ctxt ->\n  Storage.Vote.Proposals.clear ctxt\n\ntype ballots = {yay : int32; nay : int32; pass : int32}\n\nlet ballots_encoding =\n  let open Data_encoding in\n  conv\n    (fun {yay; nay; pass} -> (yay, nay, pass))\n    (fun (yay, nay, pass) -> {yay; nay; pass})\n  @@ obj3 (req \"yay\" int32) (req \"nay\" int32) (req \"pass\" int32)\n\nlet has_recorded_ballot = Storage.Vote.Ballots.mem\n\nlet record_ballot = Storage.Vote.Ballots.init\n\nlet get_ballots ctxt =\n  Storage.Vote.Ballots.fold\n    ctxt\n    ~order:`Sorted\n    ~f:(fun delegate ballot (ballots : ballots tzresult) ->\n      (* Assuming the same listings is used at votings *)\n      Storage.Vote.Listings.get ctxt delegate >>=? fun weight ->\n      let count = Int32.add weight in\n      Lwt.return\n        ( ballots >|? fun ballots ->\n          match ballot with\n          | Yay -> {ballots with yay = count ballots.yay}\n          | Nay -> {ballots with nay = count ballots.nay}\n          | Pass -> {ballots with pass = count ballots.pass} ))\n    ~init:(ok {yay = 0l; nay = 0l; pass = 0l})\n\nlet get_ballot_list = Storage.Vote.Ballots.bindings\n\nlet clear_ballots = Storage.Vote.Ballots.clear\n\nlet listings_encoding =\n  Data_encoding.(\n    list\n      (obj2 (req \"pkh\" Signature.Public_key_hash.encoding) (req \"rolls\" int32)))\n\nlet update_listings ctxt =\n  Storage.Vote.Listings.clear ctxt >>= fun ctxt ->\n  let tokens_per_roll =\n    Tez_repr.to_mutez (Constants_storage.tokens_per_roll ctxt)\n  in\n  Stake_storage.fold\n    ctxt\n    (ctxt, 0l)\n    ~order:`Sorted\n    ~f:(fun (delegate, stake) (ctxt, total) ->\n      let nb_rolls =\n        Int64.to_int32 @@ Int64.div (Tez_repr.to_mutez stake) tokens_per_roll\n      in\n      Storage.Vote.Listings.init ctxt delegate nb_rolls >|=? fun ctxt ->\n      (ctxt, Int32.add total nb_rolls))\n  >>=? fun (ctxt, total) ->\n  Storage.Vote.Listings_size.add ctxt total >>= fun ctxt -> return ctxt\n\nlet listing_size = Storage.Vote.Listings_size.get\n\nlet in_listings = Storage.Vote.Listings.mem\n\nlet get_listings = Storage.Vote.Listings.bindings\n\nlet get_voting_power_free ctxt owner =\n  Storage.Vote.Listings.find ctxt owner >|=? Option.value ~default:0l\n\n(* This function bypasses the carbonated functors to account for gas consumption.\n   This is a temporary situation intended to be fixed by adding the right\n   carbonated functors in a future amendment *)\nlet get_voting_power ctxt owner =\n  let open Raw_context in\n  (* Always consume read access to memory *)\n  (* Accessing an int32 at /votes/listings/<KeyKind>/<hash> *)\n  consume_gas ctxt (Storage_costs.read_access ~path_length:4 ~read_bytes:4)\n  >>?= fun ctxt ->\n  Storage.Vote.Listings.find ctxt owner >|=? function\n  | None -> (ctxt, 0l)\n  | Some power -> (ctxt, power)\n\nlet get_total_voting_power_free = listing_size\n\n(* This function bypasses the carbonated functors to account for gas consumption.\n   This is a temporary situation intended to be fixed by adding the right\n   carbonated functors in a future amendment *)\nlet get_total_voting_power ctxt =\n  let open Raw_context in\n  (* Accessing an int32 at /votes/listings_size *)\n  consume_gas ctxt (Storage_costs.read_access ~path_length:2 ~read_bytes:4)\n  >>?= fun ctxt ->\n  get_total_voting_power_free ctxt >|=? fun total_voting_power ->\n  (ctxt, total_voting_power)\n\nlet get_current_quorum ctxt =\n  Storage.Vote.Participation_ema.get ctxt >|=? fun participation_ema ->\n  let quorum_min = Constants_storage.quorum_min ctxt in\n  let quorum_max = Constants_storage.quorum_max ctxt in\n  let quorum_diff = Int32.sub quorum_max quorum_min in\n  Int32.(add quorum_min (div (mul participation_ema quorum_diff) 100_00l))\n\nlet get_participation_ema = Storage.Vote.Participation_ema.get\n\nlet set_participation_ema = Storage.Vote.Participation_ema.update\n\nlet get_current_proposal = Storage.Vote.Current_proposal.get\n\nlet find_current_proposal = Storage.Vote.Current_proposal.find\n\nlet init_current_proposal = Storage.Vote.Current_proposal.init\n\nlet clear_current_proposal = Storage.Vote.Current_proposal.remove_existing\n\nlet init ctxt ~start_position =\n  (* participation EMA is in centile of a percentage *)\n  let participation_ema = Constants_storage.quorum_max ctxt in\n  Storage.Vote.Participation_ema.init ctxt participation_ema >>=? fun ctxt ->\n  Voting_period_storage.init_first_period ctxt ~start_position\n" ;
                } ;
                { name = "Fees_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype error += Cannot_pay_storage_fee (* `Temporary *)\n\ntype error += Operation_quota_exceeded (* `Temporary *)\n\ntype error += Storage_limit_too_high (* `Permanent *)\n\n(** [record_global_constant_storage_space ctxt size] records\n    paid storage space for registering a new global constant.\n    Cost is <size> in bytes + 65 additional bytes for the key\n    hash of the expression. Returns new context and the cost.\n*)\nval record_global_constant_storage_space :\n  Raw_context.t -> Z.t -> Raw_context.t * Z.t\n\n(** [record_paid_storage_space ctxt contract] updates the amount of storage\n    consumed by the [contract] and considered as accounted for as far as\n    future payment is concerned. Returns a new context, the total space\n    consumed by the [contract], and the additional (and unpaid) space consumed\n    since the last call of this function on this [contract]. *)\nval record_paid_storage_space :\n  Raw_context.t -> Contract_repr.t -> (Raw_context.t * Z.t * Z.t) tzresult Lwt.t\n\n(** [check_storage_limit ctxt ~storage_limit] raises the [Storage_limit_too_high]\n     error iff [storage_limit] is negative or greater the constant\n     [hard_storage_limit_per_operation]. *)\nval check_storage_limit : Raw_context.t -> storage_limit:Z.t -> unit tzresult\n\n(** [burn_storage_fees ctxt ~storage_limit ~payer consumed] takes funds from the\n    [payer] to pay the cost of the [consumed] storage. This function has an\n    optional parameter [~origin] that allows to set the origin of returned\n    balance updates (by default the parameter is set to [Block_application]).\n    Returns an updated context, an updated storage limit equal to\n    [storage_limit - consumed], and the relevant balance updates.\n    Raises the [Operation_quota_exceeded] error if [storage_limit < consumed].\n    Raises the [Cannot_pay_storage_fee] error if the funds from the [payer] are\n    not sufficient to pay the storage fees. *)\nval burn_storage_fees :\n  ?origin:Receipt_repr.update_origin ->\n  Raw_context.t ->\n  storage_limit:Z.t ->\n  payer:Token.source ->\n  Z.t ->\n  (Raw_context.t * Z.t * Receipt_repr.balance_updates) tzresult Lwt.t\n\n(** Calls [burn_storage_fees] with the parameter [consumed] mapped to the\n    constant [origination_size]. *)\nval burn_origination_fees :\n  ?origin:Receipt_repr.update_origin ->\n  Raw_context.t ->\n  storage_limit:Z.t ->\n  payer:Token.source ->\n  (Raw_context.t * Z.t * Receipt_repr.balance_updates) tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype error += Cannot_pay_storage_fee (* `Temporary *)\n\ntype error += Operation_quota_exceeded (* `Temporary *)\n\ntype error += Storage_limit_too_high (* `Permanent *)\n\nlet () =\n  let open Data_encoding in\n  register_error_kind\n    `Temporary\n    ~id:\"contract.cannot_pay_storage_fee\"\n    ~title:\"Cannot pay storage fee\"\n    ~description:\"The storage fee is higher than the contract balance\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"Cannot pay storage storage fee\")\n    Data_encoding.empty\n    (function Cannot_pay_storage_fee -> Some () | _ -> None)\n    (fun () -> Cannot_pay_storage_fee) ;\n  register_error_kind\n    `Temporary\n    ~id:\"storage_exhausted.operation\"\n    ~title:\"Storage quota exceeded for the operation\"\n    ~description:\n      \"A script or one of its callee wrote more bytes than the operation said \\\n       it would\"\n    Data_encoding.empty\n    (function Operation_quota_exceeded -> Some () | _ -> None)\n    (fun () -> Operation_quota_exceeded) ;\n  register_error_kind\n    `Permanent\n    ~id:\"storage_limit_too_high\"\n    ~title:\"Storage limit out of protocol hard bounds\"\n    ~description:\"A transaction tried to exceed the hard limit on storage\"\n    empty\n    (function Storage_limit_too_high -> Some () | _ -> None)\n    (fun () -> Storage_limit_too_high)\n\nlet record_global_constant_storage_space context size =\n  (* Following the precedent of big_map, a key in the\n     global table of constants costs 65 bytes (see\n     [Lazy_storage_diff.Big_map.bytes_size_for_big_map_key])*)\n  let cost_of_key = Z.of_int 65 in\n  let to_be_paid = Z.add size cost_of_key in\n  (context, to_be_paid)\n\nlet record_paid_storage_space c contract =\n  Contract_storage.used_storage_space c contract >>=? fun size ->\n  Contract_storage.set_paid_storage_space_and_return_fees_to_pay c contract size\n  >>=? fun (to_be_paid, c) -> return (c, size, to_be_paid)\n\nlet source_must_exist c src =\n  match src with\n  | `Contract src -> Contract_storage.must_exist c src\n  | _ -> return_unit\n\nlet burn_storage_fees ?(origin = Receipt_repr.Block_application) c\n    ~storage_limit ~payer consumed =\n  let remaining = Z.sub storage_limit consumed in\n  if Compare.Z.(remaining < Z.zero) then fail Operation_quota_exceeded\n  else\n    let cost_per_byte = Constants_storage.cost_per_byte c in\n    Tez_repr.(cost_per_byte *? Z.to_int64 consumed) >>?= fun to_burn ->\n    (* Burning the fees... *)\n    if Tez_repr.(to_burn = Tez_repr.zero) then\n      (* If the payer was deleted by transferring all its balance, and no space\n         was used, burning zero would fail *)\n      return (c, remaining, [])\n    else\n      trace\n        Cannot_pay_storage_fee\n        ( source_must_exist c payer >>=? fun () ->\n          Token.transfer ~origin c payer `Storage_fees to_burn\n          >>=? fun (ctxt, balance_updates) ->\n          return (ctxt, remaining, balance_updates) )\n\nlet burn_origination_fees ?(origin = Receipt_repr.Block_application) c\n    ~storage_limit ~payer =\n  let origination_size = Constants_storage.origination_size c in\n  burn_storage_fees ~origin c ~storage_limit ~payer (Z.of_int origination_size)\n\nlet check_storage_limit c ~storage_limit =\n  if\n    Compare.Z.(\n      storage_limit > (Raw_context.constants c).hard_storage_limit_per_operation)\n    || Compare.Z.(storage_limit < Z.zero)\n  then error Storage_limit_too_high\n  else Result.return_unit\n" ;
                } ;
                { name = "Ticket_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Trili Tech, <contact@trili.tech>                       *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** A value of type [key_hash] is a hashed combination of:\n  - Ticketer\n  - Content type\n  - Content\n  - Owner\n*)\ntype key_hash\n\n(** [script_expr_hash_of_key_hash key_hash] returns a [Script_expr_hash.t] value\n    representation of the given [key_hash]. This is useful for comparing and\n    pretty-printing key-hash values. *)\nval script_expr_hash_of_key_hash : key_hash -> Script_expr_hash.t\n\n(** [make_key_hash ctxt ~ticketer ~typ ~contents ~owner] creates a hashed\n    representation of the given [ticketer], [typ], [contents] and [owner].\n*)\nval make_key_hash :\n  Raw_context.t ->\n  ticketer:Script_repr.node ->\n  typ:Script_repr.node ->\n  contents:Script_repr.node ->\n  owner:Script_repr.node ->\n  (key_hash * Raw_context.t) tzresult\n\n(** [get_balance ctxt key] receives the ticket balance for the given\n    [key] in the context [ctxt]. The [key] represents a ticket content and a\n    ticket creator pair. In case there exists no value for the given [key],\n    [None] is returned.\n    *)\nval get_balance :\n  Raw_context.t -> key_hash -> (Z.t option * Raw_context.t) tzresult Lwt.t\n\n(** [adjust_balance ctxt key ~delta] adjusts the balance of the\n    given key (representing a ticket content, creator and owner pair)\n    and [delta]. The value of [delta] can be positive as well as negative.\n    If there is no pre-exising balance for the given ticket type and owner,\n    it is assumed to be 0 and the new balance is [delta]. The function also\n    returns the difference between the old and the new size of the storage.\n    Note that the difference may be negative. For example, because when\n    setting the balance to zero, an entry is removed.\n\n    The function fails with a [Negative_ticket_balance] error\n    in case the resulting balance is negative.\n *)\nval adjust_balance :\n  Raw_context.t -> key_hash -> delta:Z.t -> (Z.t * Raw_context.t) tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Trili Tech, <contact@trili.tech>                       *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype key_hash = Script_expr_hash.t\n\ntype error +=\n  | Negative_ticket_balance of {key : Script_expr_hash.t; balance : Z.t}\n  | Failed_to_hash_node\n\nlet script_expr_hash_of_key_hash key_hash = key_hash\n\nlet hash_bytes_cost bytes =\n  let module S = Saturation_repr in\n  let ( + ) = S.add in\n  let v0 = S.safe_int @@ Bytes.length bytes in\n  let ( lsr ) = S.shift_right in\n  S.safe_int 200 + (v0 + (v0 lsr 2)) |> Gas_limit_repr.atomic_step_cost\n\nlet hash_of_node ctxt node =\n  Raw_context.consume_gas ctxt (Script_repr.strip_locations_cost node)\n  >>? fun ctxt ->\n  let node = Micheline.strip_locations node in\n  match Data_encoding.Binary.to_bytes_opt Script_repr.expr_encoding node with\n  | Some bytes ->\n      Raw_context.consume_gas ctxt (hash_bytes_cost bytes) >|? fun ctxt ->\n      (Script_expr_hash.hash_bytes [bytes], ctxt)\n  | None -> error Failed_to_hash_node\n\nlet make_key_hash ctxt ~ticketer ~typ ~contents ~owner =\n  hash_of_node ctxt\n  @@ Micheline.Seq (Micheline.dummy_location, [ticketer; typ; contents; owner])\n\nlet () =\n  let open Data_encoding in\n  register_error_kind\n    `Permanent\n    ~id:\"Negative_ticket_balance\"\n    ~title:\"Negative ticket balance\"\n    ~description:\"Attempted to set a negative ticket balance value\"\n    ~pp:(fun ppf (key, balance) ->\n      Format.fprintf\n        ppf\n        \"Attempted to set negative ticket balance value '%a' for key %a.\"\n        Z.pp_print\n        balance\n        Script_expr_hash.pp\n        key)\n    (obj2 (req \"key\" Script_expr_hash.encoding) (req \"balance\" Data_encoding.z))\n    (function\n      | Negative_ticket_balance {key; balance} -> Some (key, balance)\n      | _ -> None)\n    (fun (key, balance) -> Negative_ticket_balance {key; balance}) ;\n  register_error_kind\n    `Branch\n    ~id:\"Failed_to_hash_node\"\n    ~title:\"Failed to hash node\"\n    ~description:\"Failed to hash node for a key in the ticket-balance table\"\n    ~pp:(fun ppf () ->\n      Format.fprintf\n        ppf\n        \"Failed to hash node for a key in the ticket-balance table\")\n    Data_encoding.empty\n    (function Failed_to_hash_node -> Some () | _ -> None)\n    (fun () -> Failed_to_hash_node)\n\nlet get_balance ctxt key =\n  Storage.Ticket_balance.Table.find ctxt key >|=? fun (ctxt, res) -> (res, ctxt)\n\nlet set_balance ctxt key balance =\n  let cost_of_key = Z.of_int 65 in\n  fail_when\n    Compare.Z.(balance < Z.zero)\n    (Negative_ticket_balance {key; balance})\n  >>=? fun () ->\n  if Compare.Z.(balance = Z.zero) then\n    Storage.Ticket_balance.Table.remove ctxt key\n    >|=? fun (ctxt, freed, existed) ->\n    (* If we remove an existing entry, then we return the freed size for\n       both the key and the value. *)\n    let freed =\n      if existed then Z.neg @@ Z.add cost_of_key (Z.of_int freed) else Z.zero\n    in\n    (freed, ctxt)\n  else\n    Storage.Ticket_balance.Table.add ctxt key balance\n    >|=? fun (ctxt, size_diff, existed) ->\n    let size_diff =\n      let z_diff = Z.of_int size_diff in\n      (* For a new entry we also charge the space for storing the key *)\n      if existed then z_diff else Z.add cost_of_key z_diff\n    in\n    (size_diff, ctxt)\n\nlet adjust_balance ctxt key ~delta =\n  get_balance ctxt key >>=? fun (res, ctxt) ->\n  let old_balance = Option.value ~default:Z.zero res in\n  set_balance ctxt key (Z.add old_balance delta)\n" ;
                } ;
                { name = "Liquidity_baking_repr" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Tocqueville Group, Inc. <contact@tezos.com>            *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nval get_cpmm_address : Raw_context.t -> Contract_repr.t tzresult Lwt.t\n\ntype escape_ema = Int32.t\n\n(** Checks if below EMA threshold (after updating), sunset level, and if CPMM\n    contract exists. *)\nval on_subsidy_allowed :\n  Raw_context.t ->\n  escape_vote:bool ->\n  (Raw_context.t -> Contract_repr.t -> (Raw_context.t * 'a list) tzresult Lwt.t) ->\n  (Raw_context.t * 'a list * escape_ema) tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Tocqueville Group, Inc. <contact@tezos.com>            *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nlet get_cpmm_address = Storage.Liquidity_baking.Cpmm_address.get\n\nlet get_escape_ema = Storage.Liquidity_baking.Escape_ema.get\n\ntype escape_ema = Int32.t\n\nlet on_cpmm_exists ctxt f =\n  get_cpmm_address ctxt >>=? fun cpmm_contract ->\n  Contract_storage.exists ctxt cpmm_contract >>=? function\n  | false ->\n      (* do nothing if the cpmm is not found *)\n      return (ctxt, [])\n  | true -> f ctxt cpmm_contract\n\nlet on_below_sunset ctxt f =\n  let sunset_level = Constants_storage.liquidity_baking_sunset_level ctxt in\n  let level = Raw_level_repr.to_int32 (Level_storage.current ctxt).level in\n  if Compare.Int32.(level >= sunset_level) then return (ctxt, [])\n  else on_cpmm_exists ctxt f\n\n(* ema starts at zero\n   ema[n+1] = (1999 * ema[n] // 2000) + (1000 if escape_vote[n] else 0)\n   where escape_vote is protocol_data.contents.liquidity_baking_escape_vote *)\nlet update_escape_ema ctxt ~escape_vote =\n  get_escape_ema ctxt >>=? fun old_ema ->\n  (* if ema is over threshold, we don't update it because liquidity baking is permanently off *)\n  if\n    Compare.Int32.(\n      old_ema < Constants_storage.liquidity_baking_escape_ema_threshold ctxt)\n  then\n    let new_ema =\n      Int32.(\n        add (div (mul 1999l old_ema) 2000l) (if escape_vote then 1000l else 0l))\n    in\n    Storage.Liquidity_baking.Escape_ema.update ctxt new_ema >|=? fun ctxt ->\n    (ctxt, new_ema, false)\n  else return (ctxt, old_ema, true)\n\nlet on_subsidy_allowed ctxt ~escape_vote f =\n  update_escape_ema ctxt ~escape_vote\n  >>=? fun (ctxt, escape_ema, threshold_reached) ->\n  (* liquidity baking permanently shuts off if threshold is reached once *)\n  if threshold_reached then return (ctxt, [], escape_ema)\n  else\n    on_below_sunset ctxt f >|=? fun (ctxt, operation_results) ->\n    (ctxt, operation_results, escape_ema)\n" ;
                } ;
                { name = "Liquidity_baking_cpmm" ;
                  interface = None ;
                  implementation = "let script_hex : Hex.t =\n  `Hex\n    \"02000011c405000764076407640865046e00000006256f776e6572076504620000000d256d696e4c71744d696e7465640765046200000013256d6178546f6b656e734465706f7369746564046b0000000925646561646c696e650000000d256164644c6971756964697479046c000000082564656661756c7407640865046e0000000325746f076504620000000a256c71744275726e65640765046a00000010256d696e58747a57697468647261776e0765046200000013256d696e546f6b656e7357697468647261776e046b0000000925646561646c696e65000000102572656d6f76654c69717569646974790865046e00000015256f7574707574446578746572436f6e74726163740765046200000010256d696e546f6b656e73426f756768740765046e0000000325746f076504620000000b25746f6b656e73536f6c64046b0000000925646561646c696e650000000d25746f6b656e546f546f6b656e07640865046e0000000325746f076504620000000b25746f6b656e73536f6c640765046a0000000d256d696e58747a426f75676874046b0000000925646561646c696e650000000b25746f6b656e546f58747a0865046e0000000325746f0765046200000010256d696e546f6b656e73426f75676874046b0000000925646561646c696e650000000b2578747a546f546f6b656e0501076504620000000a25746f6b656e506f6f6c0765046a000000082578747a506f6f6c0765046200000009256c7174546f74616c0765046e0000000d25746f6b656e41646472657373046e0000000b256c71744164647265737305020200000f7203210317034c0316072e02000009d1072e020000035a072e020000032603210317034c0316034c03210317034c0316034c03210317034c0316034c034003190328072c020000000c05200004074303620003032702000002ea0743036a000105700004032105710005031703160322072f0200000013074303680100000008444956206279203003270200000000031603130743036a0001034c0322072f02000000130743036801000000084449562062792030032702000000000316034c0321057100020570000603210571000703170317031605700002032105710003033a0322072f020000001307430368010000000844495620627920300327020000000003160570000205700006032105710007031605700003033a0322072f020000001307430368010000000844495620627920300327020000002a03210317034c03160743036200000570000203190325072c02000000000200000008074303620001031205700002034c0321057100020319032a072c020000000c05200005074303620004032702000001b60571000203210571000303190337072c020000000c0520000407430362000503270200000190057000030321057100040317031703170570000203210571000305700005032105710006031703170316031203420570000403210571000503170316034205700004032105710005031603420317034c032105710002057000050321057100060316031203420321031703170313057000060317031603120342034c03160342034c03490354034203480342034c032105710002034c03210317034c0316034c03210317034c031605700003031703170317031606550765036e0765036e036200000009257472616e73666572072f0200000008074303620000032702000000000743036a000005700003057000030342057000030342034d05700002033005700003034205700002032105710003034c03210317034c031605700002031703170317031706550765045b00000009257175616e74697479046e00000007257461726765740000000b256d696e744f724275726e072f020000000807430362000c032702000000000743036a000005700002057000030342034d05700002053d036d05700002031b05700002031b0342020000002803200321031703170313057000020321057100030317031603120342034c03160342053d036d0342020000066b072e020000038d03210317034c0316034c03210317034c0316034c03210317034c0316034c03210317034c0316034c034003190328072c020000000c05200005074303620003032702000003470743036a000003130319032a072c020000000c0520000507430362000a03270200000323057000040321057100050317031703160743036a000105700006032105710007031703160322072f0200000013074303680100000008444956206279203003270200000000031605700004032105710005033a0322072f020000001307430368010000000844495620627920300327020000000003160743036a0001034c033a0570000503210571000603170317031605700006032105710007031605700005032105710006033a0322072f02000000130743036801000000084449562062792030032702000000000316057000030570000203210571000303190337072c020000000c0520000607430362000b0327020000022e05700002034c03210571000203190337072c020000000c0520000507430362000d032702000002060570000203210571000305700005032105710006031703170316034b0356072f020000000807430362000e03270200000000034c032105710002057000060321057100070316034b0356072f020000000807430362000f03270200000000057000040743035b0000034b0348034205700006032105710007034c03210317034c031605700002031703170317031706550765045b00000009257175616e74697479046e00000007257461726765740000000b256d696e744f724275726e072f020000000807430362000c032702000000000743036a000005700002057000030342034d0570000305700005032105710006034203490354034205700006032105710007034c03210317034c0316034c03210317034c031605700003031703170317031606550765036e0765036e036200000009257472616e73666572072f0200000008074303620000032702000000000743036a000005700003057000030342057000030342034d05700004032105710005057000060555036c072f020000000807430362000903270200000000034c0743036c030b034d0570000603210571000703170317057000060570000703210571000803170316034b034205700006031603420321031703170317057000060342034c032105710002031703160342034c031603420317057000040342053d036d05700002031b05700002031b05700002031b034202000002d203210317034c0316034c03210317034c0316034c03210317034c0316034c03210317034c03160570000406550765046e0000000325746f0765046200000010256d696e546f6b656e73426f75676874046b0000000925646561646c696e650000000b2578747a546f546f6b656e072f020000000807430362001f032702000000000743036a000003130319032a072c020000000c0520000607430362000a0327020000022d05700002032105710003034003190328072c020000000c05200006074303620003032702000002050743036200a70f05700002032105710003033a0743036200a80f057000070321057100080316033a031205700006032105710007031703160743036200a70f05700004032105710005033a033a0322072f020000001307430368010000000844495620627920300327020000000003160743036200a80f0743036200a70f05700002032105710003033a0322072f02000000130743036801000000084449562062792030032702000000000316057000070321057100080317057000040321057100050570000903210571000a031603120342032103170317057000030321057100040570000a03170316034b0342034c031603420570000403490354034203480342034c032105710002034c03210317034c0316034c03210317034c031605700003031703170317031606550765036e0765036e036200000009257472616e73666572072f0200000008074303620000032702000000000743036a000005700003057000030342057000030342034d057000040570000303210571000405700006057000080342057000070342034d0570000305700004034b0743036e0100000024747a314b65326837734464616b484a5168385758345a3337326475314b4368736b7379550555036c072f020000000807430362000903270200000000034c0743036c030b034d05700003053d036d05700002031b05700002031b05700002031b0342020000058d072e02000002cc03210317034c0316034c03210317034c0316034c03210317034c0316034c034003190328072c020000000c05200004074303620003032702000002900743036a000003130319032a072c020000000c0520000407430362000a0327020000026c0743036200a70f05700002032105710003033a0743036200a80f057000050321057100060316033a03120743036a000105700005032105710006031703160322072f020000001307430368010000000844495620627920300327020000000003160743036200a70f05700004032105710005033a033a0322072f020000001307430368010000000844495620627920300327020000000003160743036a0001034c033a0743036200a80f0743036200a70f05700002032105710003033a0322072f0200000013074303680100000008444956206279203003270200000000031605700002034c03210571000203190337072c020000000a032007430362000803270200000000057000020321057100030349035403420348034205700005032105710006034c03210317034c0316034c03210317034c031605700003031703170317031606550765036e0765036e036200000009257472616e73666572072f0200000008074303620000032702000000000743036a000005700003057000030342057000030342034d034c032105710002057000050555036c072f020000000807430362000903270200000000034c0743036c030b034d0570000503210571000603170570000505700006032105710007031603120342032103170317057000050321057100060570000703170316034b0342034c031603420570000305700004034b0743036e0100000024747a314b65326837734464616b484a5168385758345a3337326475314b4368736b7379550555036c072f020000000807430362000903270200000000034c0743036c030b034d034c053d036d05700002031b05700002031b05700002031b034202000002b503210317034c0316034c03210317034c0316034c034003190328072c020000000c05200003074303620003032702000002830743036a000105700003032105710004031703160322072f0200000013074303680100000008444956206279203003270200000000031603130743036a0001034c0322072f020000001307430368010000000844495620627920300327020000000003160743036200a80f0743036200a70f05700002032105710003033a0322072f02000000130743036801000000084449562062792030032702000000000316032105700002034b03110743036200a70f05700002032105710003033a0743036200a80f05700004033a03120570000503210571000603160743036200a70f05700004032105710005033a033a0322072f0200000013074303680100000008444956206279203003270200000000031605700003034c03210571000203190337072c020000000a0320074303620012032702000000000321057000050321057100060316034b0356072f02000000080743036200130327020000000005700005032105710006031703170743036a000105700005033a05700006032105710007031703160312034205700005031603420317034c0342034c057000030342034903540342034c032105710002034c03210317034c0316034c03210317034c031605700003031703170317031606550765036e0765036e036200000009257472616e73666572072f0200000008074303620000032702000000000743036a000005700003057000030342057000030342034d0743036a000105700003033a0743036e0100000024747a314b65326837734464616b484a5168385758345a3337326475314b4368736b7379550555036c072f020000000807430362000903270200000000034c0743036c030b034d05700002053d036d05700002031b05700002031b0342\"\n\nlet script_bytes : Bytes.t option = Hex.to_bytes script_hex\n\nlet script_opt : Script_repr.expr option =\n  Option.bind\n    script_bytes\n    (Data_encoding.Binary.of_bytes_opt Script_repr.expr_encoding)\n\nlet script : Script_repr.expr =\n  Option.value_f ~default:(fun () -> assert false) script_opt\n" ;
                } ;
                { name = "Liquidity_baking_lqt" ;
                  interface = None ;
                  implementation = "let script_hex : Hex.t =\n  `Hex\n    \"020000070005000764076407640865046e00000008257370656e6465720462000000062576616c75650000000825617070726f766508650865046e00000006256f776e6572046e00000008257370656e646572000000082572657175657374065a0362000000092563616c6c6261636b0000000d25676574416c6c6f77616e636507640865046e00000006256f776e6572065a0362000000092563616c6c6261636b0000000b2567657442616c616e63650865046c000000082572657175657374065a0362000000092563616c6c6261636b0000000f25676574546f74616c537570706c7907640865045b00000009257175616e74697479046e00000007257461726765740000000b256d696e744f724275726e0865046e000000052566726f6d0765046e0000000325746f0462000000062576616c756500000009257472616e73666572050107650861036e03620000000725746f6b656e73076508610765046e00000006256f776e6572046e00000008257370656e64657203620000000b25616c6c6f77616e6365730765046e000000062561646d696e04620000000d25746f74616c5f737570706c7905020200000552032103170743036a000003130319033c072c020000001607430368010000000b446f6e7453656e6454657a03270200000000034c0316072e02000001b2072e0200000132072e02000000e2034c03210571000203170316034c0321057100020316034803420743036200000570000303210571000403170319032a07430362000005700003032105710004057000030321057100040329072f020000000607430362000002000000000319032a0314072c0200000020074303680100000015556e73616665416c6c6f77616e63654368616e676503270200000000057000030321057100040317031705700002057000030317074303620000034c03210571000203190325072c02000000060320053e0362020000000203460570000303500342034c03160342053d036d03420200000044034c032105700002053d036d034c03210571000203170743036a000005700004031703160570000403160329072f02000000060743036200000200000000034d031b03420200000074072e0200000042034c032105700002053d036d034c03210571000203170743036a00000570000403160570000403160329072f02000000060743036200000200000000034d031b03420200000026034c032105700002053d036d034c03170743036a000005700003031703170317034d031b0342020000035e072e020000013c034c03210571000203170317031603480319033c072c02000000140743036801000000094f6e6c7941646d696e03270200000000032103160570000203210571000303160570000203210571000303170329072f0200000006074303620000020000000003120356072f020000003607430368010000002b43616e6e6f74206275726e206d6f7265207468616e207468652074617267657427732062616c616e63652e03270200000000034c032105710002031605700003032105710004031703170317031203110570000303210571000403170570000403160743036200000570000403210571000503190325072c020000000a057000030320053e03620200000006057000030346057000040317035003420321057100020317031703160342034c032105710002031703160342034c03160342053d036d03420200000216034c03210571000203170316057000020321057100030316057000020321057100030316034803190325072c0200000002034c02000000a903480570000303210571000403160342057000030321057100040317031705700003032105710004057000020321057100030329072f02000000060743036200000200000000034b0356072f020000001d0743036801000000124e6f74456e6f756768416c6c6f77616e636503270200000000057000030743036200000570000203210571000303190325072c0200000008034c0320053e03620200000004034c03460570000203500570000203210571000303170317057000020321057100030570000403210571000503160329072f02000000060743036200000200000000034b0356072f020000001b0743036801000000104e6f74456e6f75676842616c616e636503270200000000057000020743036200000570000203210571000303190325072c0200000008034c0320053e03620200000004034c034605700003032105710004031603500570000203210571000303170317034c03210571000205700004032105710005031703160329072f020000000607430362000002000000000312034c0743036200000570000203210571000303190325072c0200000008034c0320053e03620200000004034c034605700003031703160350057000020317034c0342032103170317057000020342034c03160342053d036d0342\"\n\nlet script_bytes : Bytes.t option = Hex.to_bytes script_hex\n\nlet script_opt : Script_repr.expr option =\n  Option.bind\n    script_bytes\n    (Data_encoding.Binary.of_bytes_opt Script_repr.expr_encoding)\n\nlet script : Script_repr.expr =\n  Option.value_f ~default:(fun () -> assert false) script_opt\n" ;
                } ;
                { name = "Liquidity_baking_migration" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Tocqueville Group, Inc. <contact@tezos.com>            *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nval init :\n  Raw_context.t ->\n  typecheck:\n    (Raw_context.t ->\n    Script_repr.t ->\n    ((Script_repr.t * Lazy_storage_diff.diffs option) * Raw_context.t) tzresult\n    Lwt.t) ->\n  (Raw_context.t * Migration_repr.origination_result list) tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Tocqueville Group, Inc. <contact@tezos.com>            *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** This module is used to originate contracts for liquidity baking during\n    protocol stitching: a CPMM (constant product market making) contract and a\n    liquidity token FA1.2 contract, with the storage of each containing the\n    other's address.\n\n    The CPMM's storage contains a token address, which corresponds to tzBTC when\n    originated on mainnet and a reference FA1.2 contract when originated for\n    testing.\n\n    The test FA1.2 contract uses the same script as the liquidity token. Its\n    manager is initialized to the first bootstrap account. Before originating it,\n    we make sure we are not on mainnet by both checking for the existence of the\n    tzBTC contract and that the level is sufficiently low.\n\n    The Michelson and Ligo code, as well as Coq proofs, for the CPMM and\n    liquidity token contracts are available here:\n    https://gitlab.com/dexter2tz/dexter2tz/-/tree/liquidity_baking\n\n    All contracts were generated from Ligo at revision\n    4d10d07ca05abe0f8a5fb97d15267bf5d339d9f4 and converted to OCaml using\n    `tezos-client convert`.\n*)\n\nopen Michelson_v1_primitives\nopen Micheline\n\nlet null_address =\n  Bytes.of_string\n    \"\\000\\000\\000\\000\\000\\000\\000\\000\\000\\000\\000\\000\\000\\000\\000\\000\\000\\000\\000\\000\\000\\000\"\n\nlet mainnet_tzBTC_address = \"KT1PWx2mnDueood7fEmfbBDKx1D9BAnnXitn\"\n\n(** If token_pool, xtz_pool, or lqt_total are ever zero the CPMM will be\n    permanently broken. Therefore, we initialize it with the null address\n    registered as a liquidity provider with 1 satoshi tzBTC and 100 mutez\n    (roughly the current exchange rate).  *)\nlet cpmm_init_storage ~token_address ~lqt_address =\n  Script_repr.lazy_expr\n    (Micheline.strip_locations\n       (Prim\n          ( 0,\n            D_Pair,\n            [\n              Int (1, Z.one);\n              Int (2, Z.of_int 100);\n              Int (3, Z.of_int 100);\n              String (4, token_address);\n              String (5, lqt_address);\n            ],\n            [] )))\n\nlet lqt_init_storage cpmm_address =\n  Script_repr.lazy_expr\n    (Micheline.strip_locations\n       (Prim\n          ( 0,\n            D_Pair,\n            [\n              Seq\n                ( 1,\n                  [\n                    Prim\n                      ( 2,\n                        D_Elt,\n                        [Bytes (3, null_address); Int (4, Z.of_int 100)],\n                        [] );\n                  ] );\n              Seq (5, []);\n              String (6, cpmm_address);\n              Int (7, Z.of_int 100);\n            ],\n            [] )))\n\nlet test_fa12_init_storage manager =\n  Script_repr.lazy_expr\n    (Micheline.strip_locations\n       (Prim\n          ( 0,\n            D_Pair,\n            [\n              Seq (1, []);\n              Seq (2, []);\n              String (3, manager);\n              Int (4, Z.of_int 10_000);\n            ],\n            [] )))\n\nlet originate ctxt address ~balance script =\n  Contract_storage.raw_originate\n    ctxt\n    ~prepaid_bootstrap_storage:true\n    address\n    ~script\n  >>=? fun ctxt ->\n  Contract_storage.used_storage_space ctxt address >>=? fun size ->\n  Fees_storage.burn_origination_fees\n    ~origin:Protocol_migration\n    ctxt\n    ~storage_limit:(Z.of_int64 Int64.max_int)\n    ~payer:`Liquidity_baking_subsidies\n  >>=? fun (ctxt, _, origination_updates) ->\n  Fees_storage.burn_storage_fees\n    ~origin:Protocol_migration\n    ctxt\n    ~storage_limit:(Z.of_int64 Int64.max_int)\n    ~payer:`Liquidity_baking_subsidies\n    size\n  >>=? fun (ctxt, _, storage_updates) ->\n  Token.transfer\n    ~origin:Protocol_migration\n    ctxt\n    `Liquidity_baking_subsidies\n    (`Contract address)\n    balance\n  >>=? fun (ctxt, transfer_updates) ->\n  let balance_updates =\n    origination_updates @ storage_updates @ transfer_updates\n  in\n  let result : Migration_repr.origination_result =\n    {\n      balance_updates;\n      originated_contracts = [address];\n      storage_size = size;\n      paid_storage_size_diff = size;\n    }\n  in\n  return (ctxt, result)\n\nlet originate_test_fa12 ~typecheck ctxt admin =\n  Contract_storage.fresh_contract_from_current_nonce ctxt\n  >>?= fun (ctxt, fa12_address) ->\n  let script =\n    Script_repr.\n      {\n        code = Script_repr.lazy_expr Liquidity_baking_lqt.script;\n        storage =\n          test_fa12_init_storage (Signature.Public_key_hash.to_b58check admin);\n      }\n  in\n  typecheck ctxt script >>=? fun (script, ctxt) ->\n  originate ctxt fa12_address ~balance:(Tez_repr.of_mutez_exn 1_000_000L) script\n  >|=? fun (ctxt, origination_result) ->\n  (ctxt, fa12_address, [origination_result])\n\n(* hardcoded from lib_parameters *)\nlet first_bootstrap_account =\n  Signature.Public_key.hash\n    (Signature.Public_key.of_b58check_exn\n       \"edpkuBknW28nW72KG6RoHtYW7p12T6GKc7nAbwYX5m8Wd9sDVC9yav\")\n\nlet check_tzBTC ~typecheck current_level ctxt f =\n  Contract_repr.of_b58check mainnet_tzBTC_address >>?= fun tzBTC ->\n  Contract_storage.exists ctxt tzBTC >>=? function\n  | true ->\n      (* If tzBTC exists, we're on mainnet and we use it as the token address in the CPMM. *)\n      f ctxt tzBTC []\n  | false ->\n      (* If the tzBTC contract does not exist, we originate a test FA1.2 contract using the same script as the LQT. This is so that we can test the contracts after performing the same protocol migration that will be done on mainnet.\n\n         First, we check current level is below mainnet level roughly around 010 injection so we do not accidentally originate the test token contract on mainnet. *)\n      if Compare.Int32.(current_level < 1_437_862l) then\n        originate_test_fa12 ~typecheck ctxt first_bootstrap_account\n        (* Token contract admin *)\n        >>=? fun (ctxt, token_address, token_result) ->\n        f ctxt token_address token_result\n      else\n        (* If we accidentally entered the tzBTC address incorrectly, but current level indicates this could be mainnet, we do not originate any contracts *)\n        return (ctxt, [])\n\nlet init ctxt ~typecheck =\n  (* We use a custom origination nonce because it is unset when stitching from 009 *)\n  let nonce = Operation_hash.hash_string [\"Drip, drip, drip.\"] in\n  let ctxt = Raw_context.init_origination_nonce ctxt nonce in\n  Storage.Liquidity_baking.Escape_ema.init ctxt 0l >>=? fun ctxt ->\n  let current_level =\n    Raw_level_repr.to_int32 (Level_storage.current ctxt).level\n  in\n  Contract_storage.fresh_contract_from_current_nonce ctxt\n  >>?= fun (ctxt, cpmm_address) ->\n  Contract_storage.fresh_contract_from_current_nonce ctxt\n  >>?= fun (ctxt, lqt_address) ->\n  Storage.Liquidity_baking.Cpmm_address.init ctxt cpmm_address >>=? fun ctxt ->\n  check_tzBTC\n    ~typecheck\n    current_level\n    ctxt\n    (fun ctxt token_address token_result ->\n      let cpmm_script =\n        Script_repr.\n          {\n            code = Script_repr.lazy_expr Liquidity_baking_cpmm.script;\n            storage =\n              cpmm_init_storage\n                ~token_address:(Contract_repr.to_b58check token_address)\n                ~lqt_address:(Contract_repr.to_b58check lqt_address);\n          }\n      in\n      typecheck ctxt cpmm_script >>=? fun (cpmm_script, ctxt) ->\n      let lqt_script =\n        Script_repr.\n          {\n            code = Script_repr.lazy_expr Liquidity_baking_lqt.script;\n            storage = lqt_init_storage (Contract_repr.to_b58check cpmm_address);\n          }\n      in\n      typecheck ctxt lqt_script >>=? fun (lqt_script, ctxt) ->\n      originate\n        ctxt\n        cpmm_address\n        ~balance:(Tez_repr.of_mutez_exn 100L)\n        cpmm_script\n      >>=? fun (ctxt, cpmm_result) ->\n      originate ctxt lqt_address ~balance:Tez_repr.zero lqt_script\n      >|=? fun (ctxt, lqt_result) ->\n      (* Unsets the origination nonce, which is okay because this is called after other originations in stitching. *)\n      let ctxt = Raw_context.unset_origination_nonce ctxt in\n      (ctxt, [cpmm_result; lqt_result] @ token_result))\n" ;
                } ;
                { name = "Init_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020-2021 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Functions to setup storage. Used by [Alpha_context.prepare].\n\n    If you have defined a new type of storage, you should add relevant\n    setups here.\n  *)\n\n(* This is the genesis protocol: initialise the state *)\nval prepare_first_block :\n  Context.t ->\n  typecheck:\n    (Raw_context.t ->\n    Script_repr.t ->\n    ((Script_repr.t * Lazy_storage_diff.diffs option) * Raw_context.t)\n    Error_monad.tzresult\n    Lwt.t) ->\n  level:int32 ->\n  timestamp:Time.t ->\n  (Raw_context.t, Error_monad.error Error_monad.trace) Pervasives.result Lwt.t\n\nval prepare :\n  Context.t ->\n  level:Int32.t ->\n  predecessor_timestamp:Time.t ->\n  timestamp:Time.t ->\n  (Raw_context.t\n  * Receipt_repr.balance_updates\n  * Migration_repr.origination_result list)\n  Error_monad.tzresult\n  Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2019-2020 Nomadic Labs <contact@nomadic-labs.com>           *)\n(* Copyright (c) 2021 DaiLambda, Inc. <contact@dailambda.jp>                 *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(*\n  To add invoices, you can use a helper function like this one:\n\n  (** Invoice a contract at a given address with a given amount. Returns the\n      updated context and a  balance update receipt (singleton list). The address\n      must be a valid base58 hash, otherwise this is no-op and returns an empty\n      receipts list.\n\n      Do not fail if something goes wrong.\n  *)\n  let invoice_contract ctxt ~address ~amount_mutez =\n    match Tez_repr.of_mutez amount_mutez with\n    | None -> Lwt.return (ctxt, [])\n    | Some amount -> (\n        ( Contract_repr.of_b58check address >>?= fun recipient ->\n          Token.transfer\n            ~origin:Protocol_migration\n            ctxt\n            `Invoice\n            (`Contract recipient)\n            amount )\n        >|= function\n        | Ok res -> res\n        | Error _ -> (ctxt, []))\n*)\n\nlet unfreeze_deposits_rewards_and_fees ctxt delegate cycle =\n  Token.balance ctxt (`Legacy_deposits (delegate, cycle)) >>=? fun deposits ->\n  Token.balance ctxt (`Legacy_fees (delegate, cycle)) >>=? fun fees ->\n  Token.balance ctxt (`Legacy_rewards (delegate, cycle)) >>=? fun rewards ->\n  let contract = Contract_repr.implicit_contract delegate in\n  Token.transfer_n\n    ~origin:Protocol_migration\n    ctxt\n    [\n      (`Legacy_deposits (delegate, cycle), deposits);\n      (`Legacy_fees (delegate, cycle), fees);\n      (`Legacy_rewards (delegate, cycle), rewards);\n    ]\n    (`Delegate_balance delegate)\n  >>=? fun (ctxt, balance_updates) ->\n  Contract_delegate_storage.add_contract_stake ctxt contract rewards\n  >|=? fun ctxt -> (ctxt, balance_updates)\n\n(* Note that Legacy_frozen_* tables do not need to be cleared because\n   they become empty, given that when the amount in such a table\n   becomes 0 the contract is automatically removed from the table (see\n   the [Transfer] module). *)\nlet unfreeze_all_remaining_deposits_rewards_and_fees ctxt migration_cycle =\n  let preserved = Constants_storage.preserved_cycles ctxt in\n  List.fold_left_es\n    (fun (ctxt, balance_updates) cycle_offset ->\n      match Cycle_repr.sub migration_cycle cycle_offset with\n      | None -> return (ctxt, balance_updates)\n      | Some unfrozen_cycle ->\n          Storage.Legacy_delegates_with_frozen_balance.fold\n            (ctxt, unfrozen_cycle)\n            ~order:`Sorted\n            ~init:(Ok (ctxt, balance_updates))\n            ~f:(fun delegate acc ->\n              acc >>?= fun (ctxt, bus) ->\n              unfreeze_deposits_rewards_and_fees ctxt delegate unfrozen_cycle\n              >|=? fun (ctxt, balance_updates) -> (ctxt, balance_updates @ bus))\n          >>=? fun (ctxt, balance_updates) ->\n          Storage.Legacy_delegates_with_frozen_balance.clear\n            (ctxt, unfrozen_cycle)\n          >>= fun ctxt -> return (ctxt, balance_updates))\n    (ctxt, [])\n    Misc.(0 --> preserved)\n\nlet migrate_nonces ctxt migration_cycle =\n  let migrate_cycle ctxt cycle =\n    let levels = Level_storage.levels_with_commitments_in_cycle ctxt cycle in\n    let migrate ctxt level =\n      Storage.Seed.Nonce_legacy.mem ctxt level >>= function\n      | false -> return ctxt\n      | true ->\n          Storage.Seed.Nonce_legacy.get ctxt level >>=? fun nonce ->\n          Storage.Seed.Nonce.add ctxt level nonce >>= return\n    in\n    List.fold_left_es migrate ctxt levels\n  in\n  List.fold_left_es\n    migrate_cycle\n    ctxt\n    (match Cycle_repr.pred migration_cycle with\n    | None -> [migration_cycle]\n    | Some previous_cycle -> [previous_cycle; migration_cycle])\n\nlet prepare_first_block ctxt ~typecheck ~level ~timestamp =\n  Raw_context.prepare_first_block ~level ~timestamp ctxt\n  >>=? fun (previous_protocol, ctxt) ->\n  let cycle = (Raw_context.current_level ctxt).cycle in\n  (match previous_protocol with\n  | Genesis param ->\n      (* This is the genesis protocol: initialise the state *)\n      let init_commitment (ctxt, balance_updates)\n          Commitment_repr.{blinded_public_key_hash; amount} =\n        Token.transfer\n          ctxt\n          `Initial_commitments\n          (`Collected_commitments blinded_public_key_hash)\n          amount\n        >>=? fun (ctxt, new_balance_updates) ->\n        return (ctxt, new_balance_updates @ balance_updates)\n      in\n      List.fold_left_es init_commitment (ctxt, []) param.commitments\n      >>=? fun (ctxt, commitments_balance_updates) ->\n      Storage.Stake.Last_snapshot.init ctxt 0 >>=? fun ctxt ->\n      Seed_storage.init ctxt >>=? fun ctxt ->\n      Contract_storage.init ctxt >>=? fun ctxt ->\n      Bootstrap_storage.init\n        ctxt\n        ~typecheck\n        ?no_reward_cycles:param.no_reward_cycles\n        param.bootstrap_accounts\n        param.bootstrap_contracts\n      >>=? fun (ctxt, bootstrap_balance_updates) ->\n      Stake_storage.init_first_cycles ctxt Delegate_storage.pubkey\n      >>=? fun ctxt ->\n      Vote_storage.init\n        ctxt\n        ~start_position:(Level_storage.current ctxt).level_position\n      >>=? fun ctxt ->\n      Storage.Block_round.init ctxt Round_repr.zero >>=? fun ctxt ->\n      Vote_storage.update_listings ctxt >>=? fun ctxt ->\n      (* Must be called after other originations since it unsets the origination nonce.*)\n      Liquidity_baking_migration.init ctxt ~typecheck\n      >>=? fun (ctxt, operation_results) ->\n      Storage.Pending_migration.Operation_results.init ctxt operation_results\n      >>=? fun ctxt ->\n      Raw_level_repr.of_int32 level >>?= fun first_level ->\n      Storage.Tenderbake.First_level.init ctxt first_level >>=? fun ctxt ->\n      return (ctxt, commitments_balance_updates @ bootstrap_balance_updates)\n  | Hangzhou_011 ->\n      Raw_level_repr.of_int32 level >>?= fun first_level ->\n      Storage.Tenderbake.First_level.init ctxt first_level >>=? fun ctxt ->\n      Storage.Block_round.init ctxt Round_repr.zero >>=? fun ctxt ->\n      Raw_context.remove_existing_tree ctxt [\"block_priority\"] >>=? fun ctxt ->\n      Storage.Legacy_active_delegates_with_rolls.fold\n        ctxt\n        ~order:`Sorted\n        ~init:(Ok ctxt)\n        ~f:(fun pkh ctxt ->\n          ctxt >>?= fun ctxt ->\n          Storage.Roll_legacy.Delegate_roll_list.remove_existing ctxt pkh)\n      >>=? fun ctxt ->\n      Storage.Legacy_active_delegates_with_rolls.clear ctxt >>= fun ctxt ->\n      let old_tokens_per_roll = Constants_storage.tokens_per_roll ctxt in\n      let new_tokens_per_roll = Tez_repr.(mul_exn one 6_000) in\n      assert (Tez_repr.(new_tokens_per_roll < old_tokens_per_roll)) ;\n      Roll_storage_legacy.fold\n        ctxt\n        ~f:(fun _roll pk (stakes, pk_map) ->\n          let (pkh, pk_map) =\n            match Misc.Public_key_map.find pk pk_map with\n            | None ->\n                let pkh = Signature.Public_key.hash pk in\n                (pkh, Misc.Public_key_map.add pk pkh pk_map)\n            | Some pkh -> (pkh, pk_map)\n          in\n          let stake =\n            Signature.Public_key_hash.Map.update\n              pkh\n              (function None -> Some 1l | Some n -> Some (Int32.succ n))\n              stakes\n          in\n          return (stake, pk_map))\n        (Signature.Public_key_hash.Map.empty, Misc.Public_key_map.empty)\n      >>=? fun (stakes, _pk_map) ->\n      Storage.Delegates.fold\n        ctxt\n        ~order:`Sorted\n        ~init:(Ok ctxt)\n        ~f:(fun pkh ctxt ->\n          ctxt >>?= fun ctxt ->\n          Roll_storage_legacy.get_change ctxt pkh >>=? fun change ->\n          Storage.Roll_legacy.Delegate_change.remove ctxt pkh >>= fun ctxt ->\n          Frozen_deposits_storage.init ctxt pkh >>=? fun ctxt ->\n          Delegate_activation_storage.is_inactive ctxt pkh >>=? fun inactive ->\n          match Signature.Public_key_hash.Map.find pkh stakes with\n          | None ->\n              Storage.Stake.Staking_balance.init ctxt pkh change\n              >>=? fun ctxt ->\n              if (not inactive) && Tez_repr.(change >= new_tokens_per_roll) then\n                Storage.Stake.Active_delegate_with_one_roll.add ctxt pkh ()\n                >>= fun ctxt -> return ctxt\n              else return ctxt\n          | Some n ->\n              Lwt.return\n                ( Tez_repr.(old_tokens_per_roll *? Int64.of_int32 n)\n                >>? fun rolls -> Tez_repr.(rolls +? change) )\n              >>=? fun staking_balance ->\n              Storage.Stake.Staking_balance.init ctxt pkh staking_balance\n              >>=? fun ctxt ->\n              (if not inactive then\n               Storage.Stake.Active_delegate_with_one_roll.add ctxt pkh ()\n              else Lwt.return ctxt)\n              >>= fun ctxt -> return ctxt)\n      >>=? fun ctxt ->\n      Raw_context.patch_constants ctxt (fun constants ->\n          {\n            constants with\n            Constants_repr.tokens_per_roll = Tez_repr.(mul_exn one 6_000);\n          })\n      >>= fun ctxt ->\n      (* NOTE: the code below fails when the migration happens during\n         the first cycle after Genesis, probably because of a bug in\n         the initialization of the previous protocol from Genesis. *)\n      let preserved = Constants_storage.preserved_cycles ctxt in\n      let max_slashing_period = Constants_storage.max_slashing_period ctxt in\n      List.fold_left_s\n        (fun ctxt cycle ->\n          Storage.Roll_legacy.Last_for_snapshot.clear (ctxt, cycle)\n          >>= fun ctxt ->\n          Storage.Roll_legacy.Snapshot_for_cycle.remove ctxt cycle)\n        ctxt\n        Cycle_repr.(\n          (match Cycle_repr.sub cycle preserved with\n          | None -> cycle\n          | Some cycle -> cycle)\n          ---> Cycle_repr.add cycle (preserved + 3))\n      >>= fun ctxt ->\n      Raw_context.remove_existing_tree ctxt [\"rolls\"] >>=? fun ctxt ->\n      migrate_nonces ctxt cycle >>=? fun ctxt ->\n      unfreeze_all_remaining_deposits_rewards_and_fees ctxt cycle\n      >>=? fun (ctxt, balance_updates) ->\n      Storage.Stake.Last_snapshot.init ctxt 0 >>=? fun ctxt ->\n      List.fold_left_es\n        (fun ctxt cycle ->\n          Storage.Seed.For_cycle.mem ctxt cycle >>= function\n          | false -> return ctxt\n          | true ->\n              Stake_storage.snapshot ctxt >>=? fun ctxt ->\n              Stake_storage\n              .select_distribution_for_cycle_do_not_call_except_for_migration\n                ctxt\n                cycle\n                Delegate_storage.pubkey)\n        ctxt\n        Cycle_repr.(\n          (match Cycle_repr.sub cycle (max_slashing_period - 1) with\n          | None -> cycle\n          | Some cycle -> cycle)\n          ---> Cycle_repr.add cycle (preserved + 1))\n      >>=? fun ctxt ->\n      (* Remove seeds that will not be useful any longer: those from\n         [cycle - preserved_cycles - 1] to [cycle -  max_slashable_period].\n         NB: The seed at [cycle - preserved] is already removed by\n         H.cycle_end.  The seed at [cycle - max_slashable_period + 1]\n         is removed a bit later below by [Stake_storage.clear_at_cycle_end]. *)\n      (match\n         ( Cycle_repr.sub cycle (preserved - 1),\n           Cycle_repr.sub cycle max_slashing_period )\n       with\n      | (Some from_cycle, Some to_cycle) ->\n          List.fold_left_es\n            (fun ctxt cycle ->\n              Storage.Seed.For_cycle.mem ctxt cycle >>= function\n              | false -> return ctxt\n              | true -> Storage.Seed.For_cycle.remove_existing ctxt cycle)\n            ctxt\n            Cycle_repr.(from_cycle ---> to_cycle)\n      | _ -> return ctxt)\n      >>=? fun ctxt -> return (ctxt, balance_updates))\n  >>=? fun (ctxt, balance_updates) ->\n  Stake_storage.snapshot ctxt >>=? fun ctxt ->\n  Delegate_storage.freeze_deposits_do_not_call_except_for_migration\n    ~new_cycle:cycle\n    ~balance_updates\n    ctxt\n  >>=? fun (ctxt, balance_updates) ->\n  (match Level_storage.dawn_of_a_new_cycle ctxt with\n  | None -> return ctxt\n  | Some last_cycle ->\n      assert (Cycle_repr.(last_cycle = cycle)) ;\n      Stake_storage.clear_at_cycle_end ctxt ~new_cycle:(Cycle_repr.succ cycle))\n  >>=? fun ctxt ->\n  Receipt_repr.group_balance_updates balance_updates >>?= fun balance_updates ->\n  Storage.Pending_migration.Balance_updates.add ctxt balance_updates\n  >>= fun ctxt -> return ctxt\n\nlet prepare ctxt ~level ~predecessor_timestamp ~timestamp =\n  Raw_context.prepare ~level ~predecessor_timestamp ~timestamp ctxt\n  >>=? fun ctxt -> Storage.Pending_migration.remove ctxt\n" ;
                } ;
                { name = "Sapling_validator" ;
                  interface = None ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2019-2020 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(* Check that each nullifier is not already present in the state and add it.\n   Important to avoid spending the same input twice in a transaction. *)\nlet rec check_and_update_nullifiers ctxt state inputs =\n  match inputs with\n  | [] -> return (ctxt, Some state)\n  | input :: inputs -> (\n      Sapling_storage.nullifiers_mem ctxt state Sapling.UTXO.(input.nf)\n      >>=? function\n      | (ctxt, true) -> return (ctxt, None)\n      | (ctxt, false) ->\n          let state =\n            Sapling_storage.nullifiers_add state Sapling.UTXO.(input.nf)\n          in\n          check_and_update_nullifiers ctxt state inputs)\n\nlet verify_update :\n    Raw_context.t ->\n    Sapling_storage.state ->\n    Sapling_repr.transaction ->\n    string ->\n    (Raw_context.t * (Int64.t * Sapling_storage.state) option) tzresult Lwt.t =\n fun ctxt state transaction key ->\n  (* Check the transaction *)\n  (* To avoid overflowing the balance, the number of inputs and outputs must be\n     bounded.\n     Ciphertexts' memo_size must match the state's memo_size.\n     These constraints are already enforced at the encoding level. *)\n  assert (Compare.Int.(List.compare_length_with transaction.inputs 5208 <= 0)) ;\n  assert (Compare.Int.(List.compare_length_with transaction.outputs 2019 <= 0)) ;\n  let pass =\n    List.for_all\n      (fun output ->\n        Compare.Int.(\n          Sapling.Ciphertext.get_memo_size Sapling.UTXO.(output.ciphertext)\n          = state.memo_size))\n      transaction.outputs\n  in\n  if not pass then return (ctxt, None)\n  else\n    (* Check the root is a recent state *)\n    Sapling_storage.root_mem ctxt state transaction.root >>=? fun pass ->\n    if not pass then return (ctxt, None)\n    else\n      check_and_update_nullifiers ctxt state transaction.inputs >|=? function\n      | (ctxt, None) -> (ctxt, None)\n      | (ctxt, Some state) ->\n          Sapling.Verification.with_verification_ctx (fun vctx ->\n              let pass =\n                (* Check all the output ZK proofs *)\n                List.for_all\n                  (fun output -> Sapling.Verification.check_output vctx output)\n                  transaction.outputs\n              in\n              if not pass then (ctxt, None)\n              else\n                let pass =\n                  (* Check all the input Zk proofs and signatures *)\n                  List.for_all\n                    (fun input ->\n                      Sapling.Verification.check_spend\n                        vctx\n                        input\n                        transaction.root\n                        key)\n                    transaction.inputs\n                in\n                if not pass then (ctxt, None)\n                else\n                  let pass =\n                    (* Check the signature and balance of the whole transaction *)\n                    Sapling.Verification.final_check vctx transaction key\n                  in\n                  if not pass then (ctxt, None)\n                  else\n                    (* update tree *)\n                    let list_to_add =\n                      List.map\n                        (fun output ->\n                          Sapling.UTXO.(output.cm, output.ciphertext))\n                        transaction.outputs\n                    in\n                    let state = Sapling_storage.add state list_to_add in\n                    (ctxt, Some (transaction.balance, state)))\n" ;
                } ;
                { name = "Global_constants_costs" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Costs function for the global table of constants. *)\n\n(** Cost of calling [Global_constats_storage.expr_to_address_in_context]. *)\nval expr_to_address_in_context_cost : bytes -> Gas_limit_repr.cost\n\n(** Step costs for [Global_constats_storage.expand_node]. *)\nval expand_constants_branch_cost : Gas_limit_repr.cost\n\nval expand_no_constants_branch_cost : Script_repr.node -> Gas_limit_repr.cost\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nmodule S = Saturation_repr\n\nlet log2 x = S.safe_int (1 + S.numbits x)\n\nlet ( + ) = S.add\n\nlet ( lsr ) = S.shift_right\n\n(* Approximating 200 + 1.266960 * number of bytes *)\nlet expr_to_address_in_context_cost bytes =\n  let v0 = Bytes.length bytes |> S.safe_int in\n  S.safe_int 200 + (v0 + (v0 lsr 2)) |> Gas_limit_repr.atomic_step_cost\n\nlet expand_constants_branch_cost =\n  Gas_limit_repr.atomic_step_cost @@ S.safe_int 4095\n\n(* Approximating 100 + 4.639474 * n*log(n) *)\nlet expand_no_constants_branch_cost node =\n  let v0 = Script_repr.micheline_nodes node |> S.safe_int in\n  let v0 = S.mul v0 (log2 v0) in\n  S.safe_int 100 + S.mul (S.safe_int 4) v0 + (v0 lsr 1) + (v0 lsr 3)\n  |> Gas_limit_repr.atomic_step_cost\n" ;
                } ;
                { name = "Global_constants_storage" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Marigold <team@marigold.dev>                           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** This module represents access to a global table of constant\n    Micheline values. Users may register a Micheline value in the\n    table, paying the cost of storage. Once stored, contracts source code may\n    reference this value by its hash. \n    \n    Note: the table does not typecheck the values stored in it.\n    Instead, any place that uses constants must first call [expand]\n    before typechecking the code. This decision was made to make it as\n    easy as possible for users to register values to the table, and also\n    to allow maximum flexibility in the use of constants for different\n    parts of a Michelson script (code, types, data, etc.). *)\n\ntype error += Expression_too_deep\n\ntype error += Expression_already_registered\n\n(** A constant is the prim of the literal characters \"constant\".\n    A constant must have a single argument, being a string with a\n    well formed hash of a Micheline expression (i.e generated by\n    [Script_expr_hash.to_b58check]). *)\ntype error += Badly_formed_constant_expression\n\ntype error += Nonexistent_global\n\n(** [get context hash] retrieves the Micheline value with the given hash.\n     \n    Fails with [Nonexistent_global] if no value is found at the given hash.\n\n    Fails with [Storage_error Corrupted_data] if the deserialisation fails.\n      \n    Consumes [Gas_repr.read_bytes_cost <size of the value>]. *)\nval get :\n  Raw_context.t ->\n  Script_expr_hash.t ->\n  (Raw_context.t * Script_repr.expr) tzresult Lwt.t\n\n(** [register context value] registers a constant in the global table of constants,\n    returning the hash and storage bytes consumed.\n\n    Does not type-check the Micheline code being registered, allow potentially\n    ill-typed Michelson values to be stored in the table (see note at top of module).\n\n    The constant is stored unexpanded, but it is temporarily expanded at registration\n    time only to check the expanded version respects the following limits.\n    This also ensures there are no cyclic dependencies between constants.\n\n    Fails with [Expression_too_deep] if, after fully expanding all constants,\n    the expression would have a depth greater than [Constant_repr.max_allowed_global_constant_depth].\n\n    Fails with [Badly_formed_constant_expression] if constants are not\n    well-formed (see declaration of [Badly_formed_constant_expression]) or with\n    [Nonexistent_global] if a referenced constant does not exist in the table.\n\n    Consumes serialization cost.\n    Consumes [Gas_repr.write_bytes_cost <size>] where size is the number\n    of bytes in the binary serialization provided by [Script_repr.expr_encoding]. *)\nval register :\n  Raw_context.t ->\n  Script_repr.expr ->\n  (Raw_context.t * Script_expr_hash.t * Z.t) tzresult Lwt.t\n\n(** [expand context expr] replaces every constant in the\n    given Michelson expression with its value stored in the global table.\n\n    The expansion is applied recursively so that the returned expression\n    contains no constant.\n\n    Fails with [Badly_formed_constant_expression] if constants are not\n    well-formed (see declaration of [Badly_formed_constant_expression]) or\n    with [Nonexistent_global] if a referenced constant does not exist in\n    the table. *)\nval expand :\n  Raw_context.t ->\n  Script_repr.expr ->\n  (Raw_context.t * Script_repr.expr) tzresult Lwt.t\n\nmodule Internal_for_tests : sig\n  (** [node_too_large node] returns true if:\n      - The number of sub-nodes in the [node] \n        exceeds [Global_constants_storage.node_size_limit].\n      - The sum of the bytes in String, Int,\n        and Bytes sub-nodes of [node] exceeds\n        [Global_constants_storage.bytes_size_limit].\n      \n      Otherwise returns false.  *)\n  val node_too_large : Script_repr.node -> bool\n\n  (** [bottom_up_fold_cps initial_accumulator node initial_k f]\n   folds [node] and all its sub-nodes if any, starting from\n   [initial_accumulator], using an initial continuation [initial_k].\n   At each node, [f] is called to transform the continuation [k] into\n   the next one. This explicit manipulation of the continuation\n   is typically useful to short-circuit.\n\n   Notice that a common source of bug is to forget to properly call the\n   continuation in `f`.\n   \n   See [Global_constants_storage.expand] for an example.\n\n   TODO: https://gitlab.com/tezos/tezos/-/issues/1609\n   Move function to lib_micheline.\n\n   On our next opportunity to update the environment, we\n   should move this function to lib_micheline.\n   *)\n  val bottom_up_fold_cps :\n    'accumulator ->\n    'loc Script_repr.michelson_node ->\n    ('accumulator -> 'loc Script_repr.michelson_node -> 'return) ->\n    ('accumulator ->\n    'loc Script_repr.michelson_node ->\n    ('accumulator -> 'loc Script_repr.michelson_node -> 'return) ->\n    'return) ->\n    'return\n\n  (* [expr_to_address_in_context context expr] converts [expr]\n     into a unique hash represented by a [Script_expr_hash.t].\n\n     Consumes gas corresponding to the cost of converting [expr]\n     to bytes and hashing the bytes. *)\n  val expr_to_address_in_context :\n    Raw_context.t ->\n    Script_repr.expr ->\n    (Raw_context.t * Script_expr_hash.t) tzresult\nend\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Marigold <team@marigold.dev>                           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\nopen Micheline\nopen Michelson_v1_primitives\n\n(*\n\n   See [expand] for an example.\n\n   TODO: https://gitlab.com/tezos/tezos/-/issues/1609\n   Move function to lib_micheline.\n\n   On our next opportunity to update the environment, we\n   should move this function to lib_micheline.\n\n*)\nlet bottom_up_fold_cps initial_accumulator node initial_k f =\n  let rec traverse_node accu node k =\n    f accu node @@ fun accu node ->\n    match node with\n    | String _ | Int _ | Bytes _ -> k accu node\n    | Prim (loc, prim, args, annot) ->\n        (traverse_nodes [@ocaml.tailcall]) accu args @@ fun accu args ->\n        f accu (Prim (loc, prim, args, annot)) k\n    | Seq (loc, elts) ->\n        (traverse_nodes [@ocaml.tailcall]) accu elts @@ fun accu elts ->\n        f accu (Seq (loc, elts)) k\n  and traverse_nodes accu nodes k =\n    match nodes with\n    | [] -> k accu []\n    | node :: nodes ->\n        (traverse_node [@ocaml.tailcall]) accu node @@ fun accu node ->\n        (traverse_nodes [@ocaml.tailcall]) accu nodes @@ fun accu nodes ->\n        k accu (node :: nodes)\n  in\n  traverse_node initial_accumulator node initial_k\n  [@@coq_axiom_with_reason \"local mutually recursive definition not handled\"]\n\nmodule Gas_costs = Global_constants_costs\nmodule Expr_hash_map = Map.Make (Script_expr_hash)\n\ntype error += Expression_too_deep\n\ntype error += Expression_already_registered\n\ntype error += Badly_formed_constant_expression\n\ntype error += Nonexistent_global\n\ntype error += Expression_too_large\n\nlet () =\n  let description =\n    \"Attempted to register an expression that, after fully expanding all \\\n     referenced global constants, would result in too many levels of nesting.\"\n  in\n  register_error_kind\n    `Branch\n    ~id:\"Expression_too_deep\"\n    ~title:\"Expression too deep\"\n    ~description\n    ~pp:(fun ppf () -> Format.fprintf ppf \"%s\" description)\n    Data_encoding.empty\n    (function Expression_too_deep -> Some () | _ -> None)\n    (fun () -> Expression_too_deep) ;\n  let description =\n    \"Attempted to register an expression as global constant that has already \\\n     been registered.\"\n  in\n  register_error_kind\n    `Branch\n    ~id:\"Expression_already_registered\"\n    ~title:\"Expression already registered\"\n    ~description\n    ~pp:(fun ppf () -> Format.fprintf ppf \"%s\" description)\n    Data_encoding.empty\n    (function Expression_already_registered -> Some () | _ -> None)\n    (fun () -> Expression_already_registered) ;\n  let description =\n    \"Found a badly formed constant expression. The 'constant' primitive must \\\n     always be followed by a string of the hash of the expression it points \\\n     to.\"\n  in\n  register_error_kind\n    `Branch\n    ~id:\"Badly_formed_constant_expression\"\n    ~title:\"Badly formed constant expression\"\n    ~description\n    ~pp:(fun ppf () -> Format.fprintf ppf \"%s\" description)\n    Data_encoding.empty\n    (function Badly_formed_constant_expression -> Some () | _ -> None)\n    (fun () -> Badly_formed_constant_expression) ;\n  let description =\n    \"No registered global was found at the given hash in storage.\"\n  in\n  register_error_kind\n    `Branch\n    ~id:\"Nonexistent_global\"\n    ~title:\"Tried to look up nonexistent global\"\n    ~description\n    ~pp:(fun ppf () -> Format.fprintf ppf \"%s\" description)\n    Data_encoding.empty\n    (function Nonexistent_global -> Some () | _ -> None)\n    (fun () -> Nonexistent_global) ;\n  let description =\n    \"Encountered an expression that, after expanding all constants, is larger \\\n     than the expression size limit.\"\n  in\n  register_error_kind\n    `Branch\n    ~id:\"Expression_too_large\"\n    ~title:\"Expression too large\"\n    ~description\n    ~pp:(fun ppf () -> Format.fprintf ppf \"%s\" description)\n    Data_encoding.empty\n    (function Expression_too_large -> Some () | _ -> None)\n    (fun () -> Expression_too_large)\n\nlet get context hash =\n  Storage.Global_constants.Map.find context hash >>=? fun (context, value) ->\n  match value with\n  | None -> fail Nonexistent_global\n  | Some value -> return (context, value)\n\nlet expr_to_address_in_context context expr =\n  let lexpr = Script_repr.lazy_expr expr in\n  Raw_context.consume_gas context @@ Script_repr.force_bytes_cost lexpr\n  >>? fun context ->\n  Script_repr.force_bytes lexpr >>? fun b ->\n  Raw_context.consume_gas context @@ Gas_costs.expr_to_address_in_context_cost b\n  >|? fun context -> (context, Script_expr_hash.hash_bytes [b])\n\nlet node_too_large node =\n  let node_size = Script_repr.Micheline_size.of_node node in\n  let nodes = Saturation_repr.to_int node_size.nodes in\n  let string_bytes = Saturation_repr.to_int node_size.string_bytes in\n  let z_bytes = Saturation_repr.to_int node_size.z_bytes in\n  Compare.Int.(\n    nodes > Constants_repr.max_micheline_node_count\n    || string_bytes + z_bytes > Constants_repr.max_micheline_bytes_limit)\n\nlet expand_node context node =\n  (* We charge for traversing the top-level node at the beginning.\n     Inside the loop, we charge for traversing each new constant\n     that gets expanded. *)\n  Raw_context.consume_gas\n    context\n    (Gas_costs.expand_no_constants_branch_cost node)\n  >>?= fun context ->\n  bottom_up_fold_cps\n    (* We carry a Boolean representing whether we\n       had to do any expansions or not. *)\n    (context, Expr_hash_map.empty, false)\n    node\n    (fun (context, _, did_expansion) node ->\n      return (context, node, did_expansion))\n    (fun (context, map, did_expansion) node k ->\n      match node with\n      | Prim (_, H_constant, args, annot) -> (\n          (* Charge for validating the b58check hash. *)\n          Raw_context.consume_gas context Gas_costs.expand_constants_branch_cost\n          >>?= fun context ->\n          match (args, annot) with\n          (* A constant Prim should always have a single String argument,\n              being a properly formatted hash. *)\n          | ([String (_, address)], []) -> (\n              match Script_expr_hash.of_b58check_opt address with\n              | None -> fail Badly_formed_constant_expression\n              | Some hash -> (\n                  match Expr_hash_map.find hash map with\n                  | Some node ->\n                      (* Charge traversing the newly retrieved node *)\n                      Raw_context.consume_gas\n                        context\n                        (Gas_costs.expand_no_constants_branch_cost node)\n                      >>?= fun context -> k (context, map, true) node\n                  | None ->\n                      get context hash >>=? fun (context, expr) ->\n                      (* Charge traversing the newly retrieved node *)\n                      let node = root expr in\n                      Raw_context.consume_gas\n                        context\n                        (Gas_costs.expand_no_constants_branch_cost node)\n                      >>?= fun context ->\n                      k (context, Expr_hash_map.add hash node map, true) node))\n          | _ -> fail Badly_formed_constant_expression)\n      | Int _ | String _ | Bytes _ | Prim _ | Seq _ ->\n          k (context, map, did_expansion) node)\n  >>=? fun (context, node, did_expansion) ->\n  if did_expansion then\n    (* Gas charged during expansion is at least proportional to the size of the\n       resulting node so the execution time of [node_too_large] is already\n       covered. *)\n    if node_too_large node then fail Expression_too_large\n    else return (context, node)\n  else return (context, node)\n\nlet expand context expr =\n  expand_node context (root expr) >|=? fun (context, node) ->\n  (context, strip_locations node)\n\n(** Computes the maximum depth of a Micheline node. Fails\n    with [Expression_too_deep] if greater than\n    [max_allowed_global_constant_depth].*)\nlet check_depth node =\n  let rec advance node depth k =\n    if Compare.Int.(depth > Constants_repr.max_allowed_global_constant_depth)\n    then error Expression_too_deep\n    else\n      match node with\n      | Int _ | String _ | Bytes _ | Prim (_, _, [], _) | Seq (_, []) ->\n          (k [@tailcall]) (depth + 1)\n      | Prim (loc, _, hd :: tl, _) | Seq (loc, hd :: tl) ->\n          (advance [@tailcall]) hd (depth + 1) (fun dhd ->\n              (advance [@tailcall])\n                (* Because [depth] doesn't care about the content\n                   of the expression, we can safely throw away information\n                   about primitives and replace them with the [Seq] constructor.*)\n                (Seq (loc, tl))\n                depth\n                (fun dtl -> (k [@tailcall]) (Compare.Int.max dhd dtl)))\n  in\n  advance node 0 (fun x -> Ok x)\n\nlet register context value =\n  (* To calculate the total depth, we first expand all constants\n     in the expression. This may fail with [Expression_too_large].\n\n     Though the stored expression is the unexpanded version.\n  *)\n  expand_node context (root value) >>=? fun (context, node) ->\n  (* We do not need to carbonate [check_depth]. [expand_node] and\n     [Storage.Global_constants.Map.init] are already carbonated\n     with gas at least proportional to the size of the expanded node\n     and the computation cost of [check_depth] is of the same order. *)\n  check_depth node >>?= fun (_depth : int) ->\n  expr_to_address_in_context context value >>?= fun (context, key) ->\n  trace Expression_already_registered\n  @@ Storage.Global_constants.Map.init context key value\n  >|=? fun (context, size) -> (context, key, Z.of_int size)\n\nmodule Internal_for_tests = struct\n  let node_too_large = node_too_large\n\n  let bottom_up_fold_cps = bottom_up_fold_cps\n\n  let expr_to_address_in_context = expr_to_address_in_context\nend\n" ;
                } ;
                { name = "Alpha_context" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2019-2021 Nomadic Labs <contact@nomadic-labs.com>           *)\n(* Copyright (c) 2021 Trili Tech, <contact@trili.tech>                       *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** An [Alpha_context.t] is an immutable snapshot of the ledger state at some block\n    height, preserving\n    {{:https://tezos.gitlab.io/developer/entering_alpha.html#the-big-abstraction-barrier-alpha-context}\n    type-safety and invariants} of the ledger state.\n\n    {2 Implementation}\n\n    [Alpha_context.t] is a wrapper over [Raw_context.t], which in turn is a\n    wrapper around [Context.t] from the Protocol Environment.\n\n    {2 Lifetime of an Alpha_context}\n\n    - Creation, using [prepare] or [prepare_first_block]\n\n    - Modification, using the operations defined in this signature\n\n    - Finalization, using [finalize]\n *)\n\nmodule type BASIC_DATA = sig\n  type t\n\n  include Compare.S with type t := t\n\n  val encoding : t Data_encoding.t\n\n  val pp : Format.formatter -> t -> unit\nend\n\ntype t\n\ntype context = t\n\ntype public_key = Signature.Public_key.t\n\ntype public_key_hash = Signature.Public_key_hash.t\n\ntype signature = Signature.t\n\nmodule Slot : sig\n  type t\n\n  include Compare.S with type t := t\n\n  val pp : Format.formatter -> t -> unit\n\n  val zero : t\n\n  val succ : t -> t\n\n  val of_int_do_not_use_except_for_parameters : int -> t\n\n  val encoding : t Data_encoding.encoding\n\n  val slot_range : min:int -> count:int -> t list tzresult\n\n  module Map : Map.S with type key = t\n\n  module Set : Set.S with type elt = t\nend\n\nmodule Tez : sig\n  include BASIC_DATA\n\n  type tez = t\n\n  val zero : tez\n\n  val one_mutez : tez\n\n  val one_cent : tez\n\n  val fifty_cents : tez\n\n  val one : tez\n\n  val ( -? ) : tez -> tez -> tez tzresult\n\n  val sub_opt : tez -> tez -> tez option\n\n  val ( +? ) : tez -> tez -> tez tzresult\n\n  val ( *? ) : tez -> int64 -> tez tzresult\n\n  val ( /? ) : tez -> int64 -> tez tzresult\n\n  val of_string : string -> tez option\n\n  val to_string : tez -> string\n\n  val of_mutez : int64 -> tez option\n\n  val to_mutez : tez -> int64\n\n  val of_mutez_exn : int64 -> t\n\n  val mul_exn : t -> int -> t\n\n  val div_exn : t -> int -> t\nend\n\nmodule Period : sig\n  include BASIC_DATA\n\n  type period = t\n\n  val rpc_arg : period RPC_arg.arg\n\n  val of_seconds : int64 -> period tzresult\n\n  val of_seconds_exn : int64 -> period\n\n  val to_seconds : period -> int64\n\n  val add : period -> period -> period tzresult\n\n  val mult : int32 -> period -> period tzresult\n\n  val zero : period\n\n  val one_second : period\n\n  val one_minute : period\n\n  val one_hour : period\n\n  val compare : period -> period -> int\nend\n\nmodule Timestamp : sig\n  include BASIC_DATA with type t = Time.t\n\n  type time = t\n\n  val ( +? ) : time -> Period.t -> time tzresult\n\n  val ( -? ) : time -> time -> Period.t tzresult\n\n  val ( - ) : time -> Period.t -> time\n\n  val of_notation : string -> time option\n\n  val to_notation : time -> string\n\n  val of_seconds : int64 -> time\n\n  val to_seconds : time -> int64\n\n  val of_seconds_string : string -> time option\n\n  val to_seconds_string : time -> string\n\n  val current : context -> time\n\n  val predecessor : context -> time\nend\n\nmodule Raw_level : sig\n  include BASIC_DATA\n\n  type raw_level = t\n\n  val rpc_arg : raw_level RPC_arg.arg\n\n  val diff : raw_level -> raw_level -> int32\n\n  val root : raw_level\n\n  val succ : raw_level -> raw_level\n\n  val pred : raw_level -> raw_level option\n\n  val to_int32 : raw_level -> int32\n\n  val of_int32 : int32 -> raw_level tzresult\nend\n\nmodule Cycle : sig\n  include BASIC_DATA\n\n  type cycle = t\n\n  val rpc_arg : cycle RPC_arg.arg\n\n  val root : cycle\n\n  val succ : cycle -> cycle\n\n  val pred : cycle -> cycle option\n\n  val add : cycle -> int -> cycle\n\n  val sub : cycle -> int -> cycle option\n\n  val to_int32 : cycle -> int32\n\n  module Map : Map.S with type key = cycle\nend\n\nmodule Round : sig\n  (* A round represents an iteration of the single-shot consensus algorithm.\n     This mostly simply re-exports [Round_repr]. See [Round_repr] for\n     additional documentation of this module *)\n\n  type t\n\n  val zero : t\n\n  val succ : t -> t\n\n  val pred : t -> t tzresult\n\n  val to_int32 : t -> int32\n\n  val of_int32 : int32 -> t tzresult\n\n  val of_int : int -> t tzresult\n\n  val to_int : t -> int tzresult\n\n  val to_slot : t -> committee_size:int -> Slot.t tzresult\n\n  val pp : Format.formatter -> t -> unit\n\n  val encoding : t Data_encoding.t\n\n  include Compare.S with type t := t\n\n  module Map : Map.S with type key = t\n\n  type round_durations\n\n  val pp_round_durations : Format.formatter -> round_durations -> unit\n\n  val round_durations_encoding : round_durations Data_encoding.t\n\n  val round_duration : round_durations -> t -> Period.t\n\n  module Durations : sig\n    val create :\n      first_round_duration:Period.t ->\n      delay_increment_per_round:Period.t ->\n      round_durations tzresult\n\n    val create_opt :\n      first_round_duration:Period.t ->\n      delay_increment_per_round:Period.t ->\n      round_durations option\n  end\n\n  val level_offset_of_round : round_durations -> round:t -> Period.t tzresult\n\n  val timestamp_of_round :\n    round_durations ->\n    predecessor_timestamp:Time.t ->\n    predecessor_round:t ->\n    round:t ->\n    Time.t tzresult\n\n  val timestamp_of_another_round_same_level :\n    round_durations ->\n    current_timestamp:Time.t ->\n    current_round:t ->\n    considered_round:t ->\n    Time.t tzresult\n\n  val round_of_timestamp :\n    round_durations ->\n    predecessor_timestamp:Time.t ->\n    predecessor_round:t ->\n    timestamp:Time.t ->\n    t tzresult\n\n  (* retrieve a round from the context *)\n  val get : context -> t tzresult Lwt.t\n\n  (* store a round in context *)\n  val update : context -> t -> context tzresult Lwt.t\nend\n\nmodule Gas : sig\n  (** This module implements the gas subsystem of the context.\n\n     Gas reflects the computational cost of each operation to limit\n     the cost of operations and, by extension, the cost of blocks.\n\n     There are two gas quotas: one for operation and one for\n     block. For this reason, we maintain two gas levels -- one for\n     operations and another one for blocks -- that correspond to the\n     remaining amounts of gas, initialized with the quota\n     limits and decreased each time gas is consumed.\n\n  *)\n\n  module Arith :\n    Fixed_point_repr.Safe\n      with type 'a t = Saturation_repr.may_saturate Saturation_repr.t\n  [@@coq_plain_module]\n\n  (** For maintenance operations or for testing, gas can be\n     [Unaccounted]. Otherwise, the computation is [Limited] by the\n     [remaining] gas in the context. *)\n  type t = private Unaccounted | Limited of {remaining : Arith.fp}\n\n  val encoding : t Data_encoding.encoding\n\n  val pp : Format.formatter -> t -> unit\n\n  (** [check_limit_is_valid ctxt limit] checks that the given gas\n     [limit] is well-formed, i.e., it does not exceed the hard gas\n     limit per operation as defined in [ctxt] and it is positive. *)\n  val check_limit_is_valid : context -> 'a Arith.t -> unit tzresult\n\n  (** [set_limit ctxt limit] returns a context with a given\n     [limit] level of gas allocated for an operation. *)\n  val set_limit : context -> 'a Arith.t -> context\n\n  (** [set_unlimited] allows unlimited gas consumption. *)\n  val set_unlimited : context -> context\n\n  (** [remaining_operation_gas ctxt] returns the current gas level in\n     the context [ctxt] for the current operation. If gas is\n     [Unaccounted], an arbitrary value will be returned. *)\n  val remaining_operation_gas : context -> Arith.fp\n\n  (** [reset_block_gas ctxt] returns a context where the remaining gas\n     in the block is reset to the constant [hard_gas_limit_per_block],\n     i.e., as if no operations have been included in the block.\n\n     /!\\ Do not call this function unless you want to validate\n     operations on their own (like in the mempool). *)\n  val reset_block_gas : context -> context\n\n  (** [level ctxt] is the current gas level in [ctxt] for the current\n     operation. *)\n  val level : context -> t\n\n  (** [update_remaining_operation_gas ctxt remaining] sets the current\n     gas level for operations to [remaining]. *)\n  val update_remaining_operation_gas : context -> Arith.fp -> context\n\n  (** [consumed since until] is the operation gas level difference\n     between context [since] and context [until]. This function\n     returns [Arith.zero] if any of the two contexts allows for an\n     unlimited gas consumption. This function also returns\n     [Arith.zero] if [since] has less gas than [until]. *)\n  val consumed : since:context -> until:context -> Arith.fp\n\n  (** [block_level ctxt] returns the block gas level in context [ctxt]. *)\n  val block_level : context -> Arith.fp\n\n  (** Costs are computed using a saturating arithmetic. See\n     {!Saturation_repr}. *)\n  type cost = Saturation_repr.may_saturate Saturation_repr.t\n\n  val cost_encoding : cost Data_encoding.encoding\n\n  val pp_cost : Format.formatter -> cost -> unit\n\n  (** [consume ctxt cost] subtracts [cost] to the current operation\n     gas level in [ctxt]. This operation may fail with\n     [Operation_quota_exceeded] if the operation gas level would\n     go below zero. *)\n  val consume : context -> cost -> context tzresult\n\n  type error += Operation_quota_exceeded (* `Temporary *)\n\n  (** [consume_limit_in_block ctxt limit] consumes [limit] in\n     the current block gas level of the context. This operation may\n     fail with error [Block_quota_exceeded] if not enough gas remains\n     in the block. This operation may also fail with\n     [Gas_limit_too_high] if [limit] is greater than the allowed\n     limit for operation gas level. *)\n  val consume_limit_in_block : context -> 'a Arith.t -> context tzresult\n\n  type error += Block_quota_exceeded (* `Temporary *)\n\n  type error += Gas_limit_too_high (* `Permanent *)\n\n  (** The cost of free operation is [0]. *)\n  val free : cost\n\n  (** [atomic_step_cost x] corresponds to [x] milliunit of gas. *)\n  val atomic_step_cost : _ Saturation_repr.t -> cost\n\n  (** [step_cost x] corresponds to [x] units of gas. *)\n  val step_cost : _ Saturation_repr.t -> cost\n\n  (** Cost of allocating qwords of storage.\n    [alloc_cost n] estimates the cost of allocating [n] qwords of storage. *)\n  val alloc_cost : _ Saturation_repr.t -> cost\n\n  (** Cost of allocating bytes in the storage.\n    [alloc_bytes_cost b] estimates the cost of allocating [b] bytes of\n    storage. *)\n  val alloc_bytes_cost : int -> cost\n\n  (** Cost of allocating bytes in the storage.\n\n      [alloc_mbytes_cost b] estimates the cost of allocating [b] bytes of\n      storage and the cost of an header to describe these bytes. *)\n  val alloc_mbytes_cost : int -> cost\n\n  (** Cost of reading the storage.\n    [read_bytes_cost n] estimates the cost of reading [n] bytes of storage. *)\n  val read_bytes_cost : int -> cost\n\n  (** Cost of writing to storage.\n    [write_bytes_const n] estimates the cost of writing [n] bytes to the\n    storage. *)\n  val write_bytes_cost : int -> cost\n\n  (** Multiply a cost by a factor. Both arguments are saturated arithmetic values,\n    so no negative numbers are involved. *)\n  val ( *@ ) : _ Saturation_repr.t -> cost -> cost\n\n  (** Add two costs together. *)\n  val ( +@ ) : cost -> cost -> cost\n\n  (** [cost_of_repr] is an internal operation needed to inject costs\n     for Storage_costs into Gas.cost. *)\n  val cost_of_repr : Gas_limit_repr.cost -> cost\nend\n\nmodule Script_string : module type of Script_string_repr\n\nmodule Script_int : module type of Script_int_repr\n\nmodule Script_timestamp : sig\n  open Script_int\n\n  type t\n\n  val compare : t -> t -> int\n\n  val to_string : t -> string\n\n  val to_notation : t -> string option\n\n  val to_num_str : t -> string\n\n  val of_string : string -> t option\n\n  val diff : t -> t -> z num\n\n  val add_delta : t -> z num -> t\n\n  val sub_delta : t -> z num -> t\n\n  val now : context -> t\n\n  val to_zint : t -> Z.t\n\n  val of_zint : Z.t -> t\n\n  val encoding : t Data_encoding.encoding\nend\n\nmodule Script : sig\n  type prim = Michelson_v1_primitives.prim =\n    | K_parameter\n    | K_storage\n    | K_code\n    | K_view\n    | D_False\n    | D_Elt\n    | D_Left\n    | D_None\n    | D_Pair\n    | D_Right\n    | D_Some\n    | D_True\n    | D_Unit\n    | I_PACK\n    | I_UNPACK\n    | I_BLAKE2B\n    | I_SHA256\n    | I_SHA512\n    | I_ABS\n    | I_ADD\n    | I_AMOUNT\n    | I_AND\n    | I_BALANCE\n    | I_CAR\n    | I_CDR\n    | I_CHAIN_ID\n    | I_CHECK_SIGNATURE\n    | I_COMPARE\n    | I_CONCAT\n    | I_CONS\n    | I_CREATE_ACCOUNT\n    | I_CREATE_CONTRACT\n    | I_IMPLICIT_ACCOUNT\n    | I_DIP\n    | I_DROP\n    | I_DUP\n    | I_VIEW\n    | I_EDIV\n    | I_EMPTY_BIG_MAP\n    | I_EMPTY_MAP\n    | I_EMPTY_SET\n    | I_EQ\n    | I_EXEC\n    | I_APPLY\n    | I_FAILWITH\n    | I_GE\n    | I_GET\n    | I_GET_AND_UPDATE\n    | I_GT\n    | I_HASH_KEY\n    | I_IF\n    | I_IF_CONS\n    | I_IF_LEFT\n    | I_IF_NONE\n    | I_INT\n    | I_LAMBDA\n    | I_LE\n    | I_LEFT\n    | I_LEVEL\n    | I_LOOP\n    | I_LSL\n    | I_LSR\n    | I_LT\n    | I_MAP\n    | I_MEM\n    | I_MUL\n    | I_NEG\n    | I_NEQ\n    | I_NIL\n    | I_NONE\n    | I_NOT\n    | I_NOW\n    | I_OR\n    | I_PAIR\n    | I_UNPAIR\n    | I_PUSH\n    | I_RIGHT\n    | I_SIZE\n    | I_SOME\n    | I_SOURCE\n    | I_SENDER\n    | I_SELF\n    | I_SELF_ADDRESS\n    | I_SLICE\n    | I_STEPS_TO_QUOTA\n    | I_SUB\n    | I_SUB_MUTEZ\n    | I_SWAP\n    | I_TRANSFER_TOKENS\n    | I_SET_DELEGATE\n    | I_UNIT\n    | I_UPDATE\n    | I_XOR\n    | I_ITER\n    | I_LOOP_LEFT\n    | I_ADDRESS\n    | I_CONTRACT\n    | I_ISNAT\n    | I_CAST\n    | I_RENAME\n    | I_SAPLING_EMPTY_STATE\n    | I_SAPLING_VERIFY_UPDATE\n    | I_DIG\n    | I_DUG\n    | I_NEVER\n    | I_VOTING_POWER\n    | I_TOTAL_VOTING_POWER\n    | I_KECCAK\n    | I_SHA3\n    | I_PAIRING_CHECK\n    | I_TICKET\n    | I_READ_TICKET\n    | I_SPLIT_TICKET\n    | I_JOIN_TICKETS\n    | I_OPEN_CHEST\n    | T_bool\n    | T_contract\n    | T_int\n    | T_key\n    | T_key_hash\n    | T_lambda\n    | T_list\n    | T_map\n    | T_big_map\n    | T_nat\n    | T_option\n    | T_or\n    | T_pair\n    | T_set\n    | T_signature\n    | T_string\n    | T_bytes\n    | T_mutez\n    | T_timestamp\n    | T_unit\n    | T_operation\n    | T_address\n    | T_sapling_transaction\n    | T_sapling_state\n    | T_chain_id\n    | T_never\n    | T_bls12_381_g1\n    | T_bls12_381_g2\n    | T_bls12_381_fr\n    | T_ticket\n    | T_chest_key\n    | T_chest\n    | H_constant\n\n  type location = Micheline.canonical_location\n\n  type annot = Micheline.annot\n\n  type expr = prim Micheline.canonical\n\n  type lazy_expr = expr Data_encoding.lazy_t\n\n  val lazy_expr : expr -> lazy_expr\n\n  type 'location michelson_node = ('location, prim) Micheline.node\n\n  type unlocated_michelson_node = unit michelson_node\n\n  type node = location michelson_node\n\n  type t = {code : lazy_expr; storage : lazy_expr}\n\n  val location_encoding : location Data_encoding.t\n\n  val expr_encoding : expr Data_encoding.t\n\n  val prim_encoding : prim Data_encoding.t\n\n  val encoding : t Data_encoding.t\n\n  val lazy_expr_encoding : lazy_expr Data_encoding.t\n\n  val deserialization_cost_estimated_from_bytes : int -> Gas.cost\n\n  val deserialized_cost : expr -> Gas.cost\n\n  val serialized_cost : bytes -> Gas.cost\n\n  val bytes_node_cost : bytes -> Gas.cost\n\n  (** Mode of deserialization gas consumption in {!force_decode}:\n\n      - {!Always}: the gas is taken independently of the internal state of the\n        [lazy_expr]\n      - {!When_needed}: the gas is consumed only if the [lazy_expr] has never\n        been deserialized before. *)\n  type consume_deserialization_gas = Always | When_needed\n\n  (** Decode an expression in the context after consuming the deserialization\n      gas cost (see {!consume_deserialization_gas}). *)\n  val force_decode_in_context :\n    consume_deserialization_gas:consume_deserialization_gas ->\n    context ->\n    lazy_expr ->\n    (expr * context) tzresult\n\n  val force_bytes_in_context :\n    context -> lazy_expr -> (bytes * context) tzresult\n\n  val unit_parameter : lazy_expr\n\n  val strip_locations_cost : _ michelson_node -> Gas.cost\n\n  val strip_annotations_cost : node -> Gas.cost\n\n  val strip_annotations : node -> node\nend\n\nmodule Constants : sig\n  (** Fixed constants *)\n  type fixed\n\n  type delegate_selection =\n    | Random\n    | Round_robin_over of Signature.Public_key.t list list\n\n  val fixed_encoding : fixed Data_encoding.t\n\n  val proof_of_work_nonce_size : int\n\n  val nonce_length : int\n\n  val max_anon_ops_per_block : int\n\n  val max_operation_data_length : int\n\n  val max_proposals_per_delegate : int\n\n  val michelson_maximum_type_size : int\n\n  type ratio = {numerator : int; denominator : int}\n\n  val ratio_encoding : ratio Data_encoding.t\n\n  val pp_ratio : Format.formatter -> ratio -> unit\n\n  (** Constants parameterized by context *)\n  type parametric = {\n    preserved_cycles : int;\n    blocks_per_cycle : int32;\n    blocks_per_commitment : int32;\n    blocks_per_stake_snapshot : int32;\n    blocks_per_voting_period : int32;\n    hard_gas_limit_per_operation : Gas.Arith.integral;\n    hard_gas_limit_per_block : Gas.Arith.integral;\n    proof_of_work_threshold : int64;\n    tokens_per_roll : Tez.t;\n    seed_nonce_revelation_tip : Tez.t;\n    origination_size : int;\n    baking_reward_fixed_portion : Tez.t;\n    baking_reward_bonus_per_slot : Tez.t;\n    endorsing_reward_per_slot : Tez.t;\n    cost_per_byte : Tez.t;\n    hard_storage_limit_per_operation : Z.t;\n    quorum_min : int32;\n    quorum_max : int32;\n    min_proposal_quorum : int32;\n    liquidity_baking_subsidy : Tez.t;\n    liquidity_baking_sunset_level : int32;\n    liquidity_baking_escape_ema_threshold : int32;\n    max_operations_time_to_live : int;\n    minimal_block_delay : Period.t;\n    delay_increment_per_round : Period.t;\n    minimal_participation_ratio : ratio;\n    consensus_committee_size : int;\n    consensus_threshold : int;\n    max_slashing_period : int;\n    frozen_deposits_percentage : int;\n    double_baking_punishment : Tez.t;\n    ratio_of_frozen_deposits_slashed_per_double_endorsement : ratio;\n    delegate_selection : delegate_selection;\n  }\n\n  module Generated : sig\n    type t = {\n      consensus_threshold : int;\n      baking_reward_fixed_portion : Tez.t;\n      baking_reward_bonus_per_slot : Tez.t;\n      endorsing_reward_per_slot : Tez.t;\n    }\n\n    val generate : consensus_committee_size:int -> blocks_per_minute:ratio -> t\n  end\n\n  val parametric_encoding : parametric Data_encoding.t\n\n  val parametric : context -> parametric\n\n  val preserved_cycles : context -> int\n\n  val blocks_per_cycle : context -> int32\n\n  val blocks_per_commitment : context -> int32\n\n  val blocks_per_stake_snapshot : context -> int32\n\n  val blocks_per_voting_period : context -> int32\n\n  val hard_gas_limit_per_operation : context -> Gas.Arith.integral\n\n  val hard_gas_limit_per_block : context -> Gas.Arith.integral\n\n  val cost_per_byte : context -> Tez.t\n\n  val hard_storage_limit_per_operation : context -> Z.t\n\n  val proof_of_work_threshold : context -> int64\n\n  val tokens_per_roll : context -> Tez.t\n\n  val seed_nonce_revelation_tip : context -> Tez.t\n\n  val origination_size : context -> int\n\n  val baking_reward_fixed_portion : context -> Tez.t\n\n  val baking_reward_bonus_per_slot : context -> Tez.t\n\n  val endorsing_reward_per_slot : context -> Tez.t\n\n  val quorum_min : context -> int32\n\n  val quorum_max : context -> int32\n\n  val min_proposal_quorum : context -> int32\n\n  val liquidity_baking_subsidy : context -> Tez.t\n\n  val liquidity_baking_sunset_level : context -> int32\n\n  val liquidity_baking_escape_ema_threshold : context -> int32\n\n  val minimal_block_delay : context -> Period.t\n\n  val delay_increment_per_round : context -> Period.t\n\n  val round_durations : context -> Round.round_durations\n\n  val consensus_committee_size : context -> int\n\n  val consensus_threshold : context -> int\n\n  val minimal_participation_ratio : context -> ratio\n\n  val max_slashing_period : context -> int\n\n  val frozen_deposits_percentage : context -> int\n\n  val double_baking_punishment : context -> Tez.t\n\n  val ratio_of_frozen_deposits_slashed_per_double_endorsement : context -> ratio\n\n  val delegate_selection_encoding : delegate_selection Data_encoding.t\n\n  (** All constants: fixed and parametric *)\n  type t = private {fixed : fixed; parametric : parametric}\n\n  val all : context -> t\n\n  val encoding : t Data_encoding.t\nend\n\nmodule Global_constants_storage : sig\n  type error += Expression_too_deep\n\n  type error += Expression_already_registered\n\n  (** A constant is the prim of the literal characters \"constant\".\n    A constant must have a single argument, being a string with a\n    well formed hash of a Micheline expression (i.e generated by\n    [Script_expr_hash.to_b58check]). *)\n  type error += Badly_formed_constant_expression\n\n  type error += Nonexistent_global\n\n  (** [get context hash] retrieves the Micheline value with the given hash.\n\n    Fails with [Nonexistent_global] if no value is found at the given hash.\n\n    Fails with [Storage_error Corrupted_data] if the deserialisation fails.\n\n    Consumes [Gas_repr.read_bytes_cost <size of the value>]. *)\n  val get : t -> Script_expr_hash.t -> (t * Script.expr) tzresult Lwt.t\n\n  (** [register context value] Register a constant in the global table of constants,\n    returning the hash and storage bytes consumed.\n\n    Does not type-check the Micheline code being registered, allow potentially\n    ill-typed Michelson values (see note at top of module in global_constants_storage.mli).\n\n    The constant is stored unexpanded, but it is temporarily expanded at registration\n    time only to check the expanded version respects the following limits.\n\n    Fails with [Expression_too_deep] if, after fully, expanding all constants,\n    the expression would contain too many nested levels, that is more than\n    [Constants_repr.max_allowed_global_constant_depth].\n\n    Fails with [Badly_formed_constant_expression] if constants are not\n    well-formed (see declaration of [Badly_formed_constant_expression]) or with\n    [Nonexistent_global] if a referenced constant does not exist in the table.\n\n    Consumes serialization cost.\n    Consumes [Gas_repr.write_bytes_cost <size>] where size is the number\n    of bytes in the binary serialization provided by [Script.expr_encoding].*)\n  val register :\n    t -> Script.expr -> (t * Script_expr_hash.t * Z.t) tzresult Lwt.t\n\n  (** [expand context expr] Replaces every constant in the\n    given Michelson expression with its value stored in the global table.\n\n    The expansion is applied recursively so that the returned expression\n    contains no constant.\n\n    Fails with [Badly_formed_constant_expression] if constants are not\n    well-formed (see declaration of [Badly_formed_constant_expression]) or\n    with [Nonexistent_global] if a referenced constant does not exist in\n    the table. *)\n  val expand : t -> Script.expr -> (t * Script.expr) tzresult Lwt.t\n\n  module Internal_for_tests : sig\n    (** [node_too_large node] returns true if:\n      - The number of sub-nodes in the [node]\n        exceeds [Global_constants_storage.node_size_limit].\n      - The sum of the bytes in String, Int,\n        and Bytes sub-nodes of [node] exceeds\n        [Global_constants_storage.bytes_size_limit].\n\n      Otherwise returns false.  *)\n    val node_too_large : Script.node -> bool\n\n    (** [bottom_up_fold_cps initial_accumulator node initial_k f]\n        folds [node] and all its sub-nodes if any, starting from\n        [initial_accumulator], using an initial continuation [initial_k].\n        At each node, [f] is called to transform the continuation [k] into\n        the next one. This explicit manipulation of the continuation\n        is typically useful to short-circuit.\n\n        Notice that a common source of bug is to forget to properly call the\n        continuation in `f`. *)\n    val bottom_up_fold_cps :\n      'accumulator ->\n      'loc Script.michelson_node ->\n      ('accumulator -> 'loc Script.michelson_node -> 'return) ->\n      ('accumulator ->\n      'loc Script.michelson_node ->\n      ('accumulator -> 'loc Script.michelson_node -> 'return) ->\n      'return) ->\n      'return\n\n    (** [expr_to_address_in_context context expr] converts [expr]\n       into a unique hash represented by a [Script_expr_hash.t].\n\n       Consumes gas corresponding to the cost of converting [expr]\n       to bytes and hashing the bytes. *)\n    val expr_to_address_in_context :\n      t -> Script.expr -> (t * Script_expr_hash.t) tzresult\n  end\nend\n\nmodule Cache : sig\n  type size = int\n\n  type index = int\n\n  module Admin : sig\n    type key\n\n    type value\n\n    val pp : Format.formatter -> context -> unit\n\n    val set_cache_layout : context -> size list -> context Lwt.t\n\n    val sync : context -> cache_nonce:Bytes.t -> context Lwt.t\n\n    val clear : context -> context\n\n    val future_cache_expectation : context -> time_in_blocks:int -> context\n\n    val cache_size : context -> cache_index:int -> size option\n\n    val cache_size_limit : context -> cache_index:int -> size option\n\n    val value_of_key :\n      context -> Context.Cache.key -> Context.Cache.value tzresult Lwt.t\n  end\n\n  type namespace = private string\n\n  val create_namespace : string -> namespace\n\n  type identifier = string\n\n  module type CLIENT = sig\n    type cached_value\n\n    val cache_index : index\n\n    val namespace : namespace\n\n    val value_of_identifier :\n      context -> identifier -> cached_value tzresult Lwt.t\n  end\n\n  module type INTERFACE = sig\n    type cached_value\n\n    val update :\n      context -> identifier -> (cached_value * size) option -> context tzresult\n\n    val find : context -> identifier -> cached_value option tzresult Lwt.t\n\n    val list_identifiers : context -> (string * int) list\n\n    val identifier_rank : context -> string -> int option\n\n    val size : context -> int\n\n    val size_limit : context -> int\n  end\n\n  val register_exn :\n    (module CLIENT with type cached_value = 'a) ->\n    (module INTERFACE with type cached_value = 'a)\nend\n\nmodule Level : sig\n  type t = private {\n    level : Raw_level.t;\n    level_position : int32;\n    cycle : Cycle.t;\n    cycle_position : int32;\n    expected_commitment : bool;\n  }\n\n  include BASIC_DATA with type t := t\n\n  val pp_full : Format.formatter -> t -> unit\n\n  type level = t\n\n  val root : context -> level\n\n  val succ : context -> level -> level\n\n  val pred : context -> level -> level option\n\n  val from_raw : context -> Raw_level.t -> level\n\n  (** Fails with [Negative_level_and_offset_sum] if the sum of the raw_level and the offset is negative. *)\n  val from_raw_with_offset :\n    context -> offset:int32 -> Raw_level.t -> level tzresult\n\n  (** [add c level i] i must be positive *)\n  val add : context -> level -> int -> level\n\n  (** [sub c level i] i must be positive *)\n  val sub : context -> level -> int -> level option\n\n  val diff : level -> level -> int32\n\n  val current : context -> level\n\n  val last_level_in_cycle : context -> Cycle.t -> level\n\n  val levels_in_cycle : context -> Cycle.t -> level list\n\n  val levels_in_current_cycle : context -> ?offset:int32 -> unit -> level list\n\n  val last_allowed_fork_level : context -> Raw_level.t\n\n  val dawn_of_a_new_cycle : context -> Cycle.t option\n\n  val may_snapshot_rolls : context -> bool\nend\n\nmodule Fitness : sig\n  type error += Invalid_fitness | Wrong_fitness | Outdated_fitness\n\n  type raw = Fitness.t\n\n  type t\n\n  val encoding : t Data_encoding.t\n\n  val pp : Format.formatter -> t -> unit\n\n  val create :\n    level:Raw_level.t ->\n    locked_round:Round.t option ->\n    predecessor_round:Round.t ->\n    round:Round.t ->\n    t tzresult\n\n  val create_without_locked_round :\n    level:Raw_level.t -> predecessor_round:Round.t -> round:Round.t -> t\n\n  val to_raw : t -> raw\n\n  val from_raw : raw -> t tzresult\n\n  val round_from_raw : raw -> Round.t tzresult\n\n  val predecessor_round_from_raw : raw -> Round.t tzresult\n\n  val level : t -> Raw_level.t\n\n  val round : t -> Round.t\n\n  val locked_round : t -> Round.t option\n\n  val predecessor_round : t -> Round.t\nend\n\nmodule Nonce : sig\n  type t\n\n  type nonce = t\n\n  val encoding : nonce Data_encoding.t\n\n  type unrevealed = {nonce_hash : Nonce_hash.t; delegate : public_key_hash}\n\n  val record_hash : context -> unrevealed -> context tzresult Lwt.t\n\n  val reveal : context -> Level.t -> nonce -> context tzresult Lwt.t\n\n  type status = Unrevealed of unrevealed | Revealed of nonce\n\n  val get : context -> Level.t -> status tzresult Lwt.t\n\n  val of_bytes : bytes -> nonce tzresult\n\n  val hash : nonce -> Nonce_hash.t\n\n  val check_hash : nonce -> Nonce_hash.t -> bool\nend\n\nmodule Seed : sig\n  type seed\n\n  type error += Unknown of {oldest : Cycle.t; cycle : Cycle.t; latest : Cycle.t}\n\n  val for_cycle : context -> Cycle.t -> seed tzresult Lwt.t\n\n  val cycle_end :\n    context -> Cycle.t -> (context * Nonce.unrevealed list) tzresult Lwt.t\n\n  val seed_encoding : seed Data_encoding.t\nend\n\nmodule Big_map : sig\n  module Id : sig\n    type t\n\n    val encoding : t Data_encoding.t\n\n    val rpc_arg : t RPC_arg.arg\n\n    (** In the protocol, to be used in parse_data only *)\n    val parse_z : Z.t -> t\n\n    (** In the protocol, to be used in unparse_data only *)\n    val unparse_to_z : t -> Z.t\n  end\n\n  val fresh : temporary:bool -> context -> (context * Id.t) tzresult Lwt.t\n\n  val mem :\n    context -> Id.t -> Script_expr_hash.t -> (context * bool) tzresult Lwt.t\n\n  val get_opt :\n    context ->\n    Id.t ->\n    Script_expr_hash.t ->\n    (context * Script.expr option) tzresult Lwt.t\n\n  val exists :\n    context ->\n    Id.t ->\n    (context * (Script.expr * Script.expr) option) tzresult Lwt.t\n\n  (** [list_values ?offset ?length ctxt id] lists all values stored in big map [id].\n\n      The first [offset] values are ignored (if passed). Negative offsets are treated as [0].\n\n      There will be no more than [length] values in the result list (if passed).\n      Negative values are treated as [0].\n\n      The returned {!context} takes into account gas consumption of loading values.\n  *)\n  val list_values :\n    ?offset:int ->\n    ?length:int ->\n    context ->\n    Id.t ->\n    (context * Script.expr list) tzresult Lwt.t\n\n  type update = {\n    key : Script_repr.expr;\n    key_hash : Script_expr_hash.t;\n    value : Script_repr.expr option;\n  }\n\n  type updates = update list\n\n  type alloc = {key_type : Script_repr.expr; value_type : Script_repr.expr}\nend\n\nmodule Sapling : sig\n  module Id : sig\n    type t\n\n    val encoding : t Data_encoding.t\n\n    val rpc_arg : t RPC_arg.arg\n\n    val parse_z : Z.t -> t (* To be used in parse_data only *)\n\n    val unparse_to_z : t -> Z.t (* To be used in unparse_data only *)\n  end\n\n  val fresh : temporary:bool -> context -> (context * Id.t) tzresult Lwt.t\n\n  type diff = private {\n    commitments_and_ciphertexts :\n      (Sapling.Commitment.t * Sapling.Ciphertext.t) list;\n    nullifiers : Sapling.Nullifier.t list;\n  }\n\n  val diff_encoding : diff Data_encoding.t\n\n  module Memo_size : sig\n    type t\n\n    val encoding : t Data_encoding.t\n\n    val equal : t -> t -> bool\n\n    val parse_z : Z.t -> (t, string) result\n\n    val unparse_to_z : t -> Z.t\n  end\n\n  type state = private {id : Id.t option; diff : diff; memo_size : Memo_size.t}\n\n  (**\n    Returns a [state] with fields filled accordingly.\n    [id] should only be used by [extract_lazy_storage_updates].\n   *)\n  val empty_state : ?id:Id.t -> memo_size:Memo_size.t -> unit -> state\n\n  type transaction = Sapling.UTXO.transaction\n\n  val transaction_encoding : transaction Data_encoding.t\n\n  val transaction_get_memo_size : transaction -> Memo_size.t option\n\n  (**\n    Tries to fetch a state from the storage.\n   *)\n  val state_from_id : context -> Id.t -> (state * context) tzresult Lwt.t\n\n  val rpc_arg : Id.t RPC_arg.t\n\n  type root = Sapling.Hash.t\n\n  val root_encoding : root Data_encoding.t\n\n  (* Function exposed as RPC. Returns the root and a diff of a state starting\n     from an optional offset which is zero by default. *)\n  val get_diff :\n    context ->\n    Id.t ->\n    ?offset_commitment:Int64.t ->\n    ?offset_nullifier:Int64.t ->\n    unit ->\n    (root * diff) tzresult Lwt.t\n\n  val verify_update :\n    context ->\n    state ->\n    transaction ->\n    string ->\n    (context * (Int64.t * state) option) tzresult Lwt.t\n\n  type alloc = {memo_size : Memo_size.t}\n\n  type updates = diff\n\n  val transaction_in_memory_size : transaction -> Cache_memory_helpers.sint\n\n  val diff_in_memory_size : diff -> Cache_memory_helpers.sint\nend\n\nmodule Lazy_storage : sig\n  module Kind : sig\n    type ('id, 'alloc, 'updates) t =\n      | Big_map : (Big_map.Id.t, Big_map.alloc, Big_map.updates) t\n      | Sapling_state : (Sapling.Id.t, Sapling.alloc, Sapling.updates) t\n  end\n\n  module IdSet : sig\n    type t\n\n    type 'acc fold_f = {f : 'i 'a 'u. ('i, 'a, 'u) Kind.t -> 'i -> 'acc -> 'acc}\n\n    val empty : t\n\n    val mem : ('i, 'a, 'u) Kind.t -> 'i -> t -> bool\n\n    val add : ('i, 'a, 'u) Kind.t -> 'i -> t -> t\n\n    val diff : t -> t -> t\n\n    val fold : ('i, 'a, 'u) Kind.t -> ('i -> 'acc -> 'acc) -> t -> 'acc -> 'acc\n\n    val fold_all : 'acc fold_f -> t -> 'acc -> 'acc\n  end\n\n  type ('id, 'alloc) init = Existing | Copy of {src : 'id} | Alloc of 'alloc\n\n  type ('id, 'alloc, 'updates) diff =\n    | Remove\n    | Update of {init : ('id, 'alloc) init; updates : 'updates}\n\n  type diffs_item\n\n  val make : ('i, 'a, 'u) Kind.t -> 'i -> ('i, 'a, 'u) diff -> diffs_item\n\n  type diffs = diffs_item list\n\n  val encoding : diffs Data_encoding.t\n\n  val diffs_in_memory_size : diffs -> Cache_memory_helpers.nodes_and_size\n\n  val legacy_big_map_diff_encoding : diffs Data_encoding.t\n\n  val cleanup_temporaries : context -> context Lwt.t\n\n  val apply : t -> diffs -> (t * Z.t) tzresult Lwt.t\nend\n\nmodule Contract : sig\n  include BASIC_DATA\n\n  type contract = t\n\n  val in_memory_size : t -> Cache_memory_helpers.sint\n\n  val rpc_arg : contract RPC_arg.arg\n\n  val to_b58check : contract -> string\n\n  val of_b58check : string -> contract tzresult\n\n  val implicit_contract : public_key_hash -> contract\n\n  val is_implicit : contract -> public_key_hash option\n\n  val exists : context -> contract -> bool tzresult Lwt.t\n\n  val must_exist : context -> contract -> unit tzresult Lwt.t\n\n  val allocated : context -> contract -> bool tzresult Lwt.t\n\n  val must_be_allocated : context -> contract -> unit tzresult Lwt.t\n\n  val list : context -> contract list Lwt.t\n\n  val get_manager_key :\n    ?error:error -> context -> public_key_hash -> public_key tzresult Lwt.t\n\n  val is_manager_key_revealed :\n    context -> public_key_hash -> bool tzresult Lwt.t\n\n  val reveal_manager_key :\n    context -> public_key_hash -> public_key -> context tzresult Lwt.t\n\n  val get_script_code :\n    context -> contract -> (context * Script.lazy_expr option) tzresult Lwt.t\n\n  val get_script :\n    context -> contract -> (context * Script.t option) tzresult Lwt.t\n\n  val get_storage :\n    context -> contract -> (context * Script.expr option) tzresult Lwt.t\n\n  val get_counter : context -> public_key_hash -> Z.t tzresult Lwt.t\n\n  val get_balance : context -> contract -> Tez.t tzresult Lwt.t\n\n  val get_balance_carbonated :\n    context -> contract -> (context * Tez.t) tzresult Lwt.t\n\n  val init_origination_nonce : context -> Operation_hash.t -> context\n\n  val unset_origination_nonce : context -> context\n\n  val fresh_contract_from_current_nonce : context -> (context * t) tzresult\n\n  val originated_from_current_nonce :\n    since:context -> until:context -> contract list tzresult Lwt.t\n\n  module Legacy_big_map_diff : sig\n    type item = private\n      | Update of {\n          big_map : Z.t;\n          diff_key : Script.expr;\n          diff_key_hash : Script_expr_hash.t;\n          diff_value : Script.expr option;\n        }\n      | Clear of Z.t\n      | Copy of {src : Z.t; dst : Z.t}\n      | Alloc of {\n          big_map : Z.t;\n          key_type : Script.expr;\n          value_type : Script.expr;\n        }\n\n    type t = private item list\n\n    val of_lazy_storage_diff : Lazy_storage.diffs -> t\n  end\n\n  type error += Balance_too_low of contract * Tez.t * Tez.t\n\n  val update_script_storage :\n    context ->\n    contract ->\n    Script.expr ->\n    Lazy_storage.diffs option ->\n    context tzresult Lwt.t\n\n  val used_storage_space : context -> t -> Z.t tzresult Lwt.t\n\n  val increment_counter : context -> public_key_hash -> context tzresult Lwt.t\n\n  val check_counter_increment :\n    context -> public_key_hash -> Z.t -> unit tzresult Lwt.t\n\n  (**/**)\n\n  (* Only for testing *)\n  type origination_nonce\n\n  val initial_origination_nonce : Operation_hash.t -> origination_nonce\n\n  val originated_contract : origination_nonce -> contract\n\n  val raw_originate :\n    context ->\n    prepaid_bootstrap_storage:bool ->\n    t ->\n    script:Script.t * Lazy_storage.diffs option ->\n    context tzresult Lwt.t\nend\n\nmodule Receipt : sig\n  type balance =\n    | Contract of Contract.t\n    | Legacy_rewards of Signature.Public_key_hash.t * Cycle.t\n    | Block_fees\n    | Legacy_deposits of Signature.Public_key_hash.t * Cycle.t\n    | Deposits of public_key_hash\n    | Nonce_revelation_rewards\n    | Double_signing_evidence_rewards\n    | Endorsing_rewards\n    | Baking_rewards\n    | Baking_bonuses\n    | Legacy_fees of Signature.Public_key_hash.t * Cycle.t\n    | Storage_fees\n    | Double_signing_punishments\n    | Lost_endorsing_rewards of Signature.Public_key_hash.t * bool * bool\n    | Liquidity_baking_subsidies\n    | Burned\n    | Commitments of Blinded_public_key_hash.t\n    | Bootstrap\n    | Invoice\n    | Initial_commitments\n    | Minted\n\n  val compare_balance : balance -> balance -> int\n\n  type balance_update = Debited of Tez.t | Credited of Tez.t\n\n  type update_origin =\n    | Block_application\n    | Protocol_migration\n    | Subsidy\n    | Simulation\n\n  val compare_update_origin : update_origin -> update_origin -> int\n\n  type balance_updates = (balance * balance_update * update_origin) list\n\n  val balance_updates_encoding : balance_updates Data_encoding.t\n\n  val group_balance_updates : balance_updates -> balance_updates tzresult\nend\n\nmodule Delegate : sig\n  val init :\n    context ->\n    Contract.t ->\n    Signature.Public_key_hash.t ->\n    context tzresult Lwt.t\n\n  val find : context -> Contract.t -> public_key_hash option tzresult Lwt.t\n\n  val set :\n    context -> Contract.t -> public_key_hash option -> context tzresult Lwt.t\n\n  val frozen_deposits_limit :\n    context -> Signature.Public_key_hash.t -> Tez.t option tzresult Lwt.t\n\n  val set_frozen_deposits_limit :\n    context -> Signature.Public_key_hash.t -> Tez.t option -> context Lwt.t\n\n  val fold :\n    context ->\n    order:[`Sorted | `Undefined] ->\n    init:'a ->\n    f:(public_key_hash -> 'a -> 'a Lwt.t) ->\n    'a Lwt.t\n\n  val list : context -> public_key_hash list Lwt.t\n\n  val check_delegate : context -> public_key_hash -> unit tzresult Lwt.t\n\n  type participation_info = {\n    expected_cycle_activity : int;\n    minimal_cycle_activity : int;\n    missed_slots : int;\n    missed_levels : int;\n    remaining_allowed_missed_slots : int;\n    expected_endorsing_rewards : Tez.t;\n  }\n\n  val delegate_participation_info :\n    context -> public_key_hash -> participation_info tzresult Lwt.t\n\n  val cycle_end :\n    context ->\n    Cycle.t ->\n    Nonce.unrevealed list ->\n    (context * Receipt.balance_updates * Signature.Public_key_hash.t list)\n    tzresult\n    Lwt.t\n\n  val already_slashed_for_double_endorsing :\n    context -> public_key_hash -> Level.t -> bool tzresult Lwt.t\n\n  val already_slashed_for_double_baking :\n    context -> public_key_hash -> Level.t -> bool tzresult Lwt.t\n\n  val punish_double_endorsing :\n    context ->\n    public_key_hash ->\n    Level.t ->\n    (context * Tez.t * Receipt.balance_updates) tzresult Lwt.t\n\n  val punish_double_baking :\n    context ->\n    public_key_hash ->\n    Level.t ->\n    (context * Tez.t * Receipt.balance_updates) tzresult Lwt.t\n\n  val full_balance : context -> public_key_hash -> Tez.t tzresult Lwt.t\n\n  type level_participation = Participated | Didn't_participate\n\n  val record_baking_activity_and_pay_rewards_and_fees :\n    context ->\n    payload_producer:Signature.Public_key_hash.t ->\n    block_producer:Signature.Public_key_hash.t ->\n    baking_reward:Tez.t ->\n    reward_bonus:Tez.t option ->\n    (context * Receipt.balance_updates) tzresult Lwt.t\n\n  val record_endorsing_participation :\n    context ->\n    delegate:Signature.Public_key_hash.t ->\n    participation:level_participation ->\n    endorsing_power:int ->\n    context tzresult Lwt.t\n\n  type deposits = {initial_amount : Tez.t; current_amount : Tez.t}\n\n  val frozen_deposits : context -> public_key_hash -> deposits tzresult Lwt.t\n\n  val staking_balance :\n    context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t\n\n  val delegated_contracts :\n    context -> Signature.Public_key_hash.t -> Contract.t list Lwt.t\n\n  val delegated_balance :\n    context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t\n\n  val registered : context -> Signature.Public_key_hash.t -> bool tzresult Lwt.t\n\n  val deactivated :\n    context -> Signature.Public_key_hash.t -> bool tzresult Lwt.t\n\n  val grace_period :\n    context -> Signature.Public_key_hash.t -> Cycle.t tzresult Lwt.t\n\n  val pubkey : context -> public_key_hash -> public_key tzresult Lwt.t\n\n  val prepare_stake_distribution : context -> context tzresult Lwt.t\nend\n\nmodule Voting_period : sig\n  type kind = Proposal | Exploration | Cooldown | Promotion | Adoption\n\n  val kind_encoding : kind Data_encoding.encoding\n\n  val pp_kind : Format.formatter -> kind -> unit\n\n  (* This type should be abstract *)\n  type voting_period = private {\n    index : int32;\n    kind : kind;\n    start_position : int32;\n  }\n\n  type t = voting_period\n\n  include BASIC_DATA with type t := t\n\n  val encoding : voting_period Data_encoding.t\n\n  val pp : Format.formatter -> voting_period -> unit\n\n  val reset : context -> context tzresult Lwt.t\n\n  val succ : context -> context tzresult Lwt.t\n\n  val get_current : context -> voting_period tzresult Lwt.t\n\n  val get_current_kind : context -> kind tzresult Lwt.t\n\n  val is_last_block : context -> bool tzresult Lwt.t\n\n  type info = {voting_period : t; position : int32; remaining : int32}\n\n  val info_encoding : info Data_encoding.t\n\n  val pp_info : Format.formatter -> info -> unit\n\n  val get_rpc_current_info : context -> info tzresult Lwt.t\n\n  val get_rpc_succ_info : context -> info tzresult Lwt.t\nend\n\nmodule Vote : sig\n  type proposal = Protocol_hash.t\n\n  val record_proposal :\n    context -> Protocol_hash.t -> public_key_hash -> context tzresult Lwt.t\n\n  val get_proposals : context -> int32 Protocol_hash.Map.t tzresult Lwt.t\n\n  val clear_proposals : context -> context Lwt.t\n\n  val recorded_proposal_count_for_delegate :\n    context -> public_key_hash -> int tzresult Lwt.t\n\n  val listings_encoding :\n    (Signature.Public_key_hash.t * int32) list Data_encoding.t\n\n  val update_listings : context -> context tzresult Lwt.t\n\n  val listing_size : context -> int32 tzresult Lwt.t\n\n  val in_listings : context -> public_key_hash -> bool Lwt.t\n\n  val get_listings : context -> (public_key_hash * int32) list Lwt.t\n\n  type ballot = Yay | Nay | Pass\n\n  val get_voting_power_free :\n    context -> Signature.Public_key_hash.t -> int32 tzresult Lwt.t\n\n  val get_voting_power :\n    context -> Signature.Public_key_hash.t -> (context * int32) tzresult Lwt.t\n\n  val get_total_voting_power_free : context -> int32 tzresult Lwt.t\n\n  val get_total_voting_power : context -> (context * int32) tzresult Lwt.t\n\n  val ballot_encoding : ballot Data_encoding.t\n\n  type ballots = {yay : int32; nay : int32; pass : int32}\n\n  val ballots_encoding : ballots Data_encoding.t\n\n  val has_recorded_ballot : context -> public_key_hash -> bool Lwt.t\n\n  val record_ballot :\n    context -> public_key_hash -> ballot -> context tzresult Lwt.t\n\n  val get_ballots : context -> ballots tzresult Lwt.t\n\n  val get_ballot_list :\n    context -> (Signature.Public_key_hash.t * ballot) list Lwt.t\n\n  val clear_ballots : context -> context Lwt.t\n\n  val get_current_quorum : context -> int32 tzresult Lwt.t\n\n  val get_participation_ema : context -> int32 tzresult Lwt.t\n\n  val set_participation_ema : context -> int32 -> context tzresult Lwt.t\n\n  val get_current_proposal : context -> proposal tzresult Lwt.t\n\n  val find_current_proposal : context -> proposal option tzresult Lwt.t\n\n  val init_current_proposal : context -> proposal -> context tzresult Lwt.t\n\n  val clear_current_proposal : context -> context tzresult Lwt.t\nend\n\nmodule Block_payload : sig\n  val hash :\n    predecessor:Block_hash.t ->\n    Round.t ->\n    Operation_list_hash.t ->\n    Block_payload_hash.t\nend\n\nmodule Block_header : sig\n  type contents = {\n    payload_hash : Block_payload_hash.t;\n    payload_round : Round.t;\n    seed_nonce_hash : Nonce_hash.t option;\n    proof_of_work_nonce : bytes;\n    liquidity_baking_escape_vote : bool;\n  }\n\n  type protocol_data = {contents : contents; signature : Signature.t}\n\n  type t = {shell : Block_header.shell_header; protocol_data : protocol_data}\n\n  type block_header = t\n\n  type raw = Block_header.t\n\n  type shell_header = Block_header.shell_header\n\n  type block_watermark = Block_header of Chain_id.t\n\n  val to_watermark : block_watermark -> Signature.watermark\n\n  val of_watermark : Signature.watermark -> block_watermark option\n\n  module Proof_of_work : sig\n    val check_hash : Block_hash.t -> int64 -> bool\n\n    val check_header_proof_of_work_stamp :\n      shell_header -> contents -> int64 -> bool\n\n    val check_proof_of_work_stamp :\n      proof_of_work_threshold:int64 -> block_header -> unit tzresult\n  end\n\n  val raw : block_header -> raw\n\n  val hash : block_header -> Block_hash.t\n\n  val hash_raw : raw -> Block_hash.t\n\n  val encoding : block_header Data_encoding.encoding\n\n  val raw_encoding : raw Data_encoding.t\n\n  val contents_encoding : contents Data_encoding.t\n\n  val unsigned_encoding : (shell_header * contents) Data_encoding.t\n\n  val protocol_data_encoding : protocol_data Data_encoding.encoding\n\n  val shell_header_encoding : shell_header Data_encoding.encoding\n\n  (** The maximum size of block headers in bytes *)\n  val max_header_length : int\n\n  type error +=\n    | Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t\n    | Invalid_stamp\n    | Invalid_payload_hash of {\n        expected : Block_payload_hash.t;\n        provided : Block_payload_hash.t;\n      }\n    | Locked_round_after_block_round of {\n        locked_round : Round_repr.t;\n        round : Round_repr.t;\n      }\n    | Invalid_payload_round of {\n        payload_round : Round_repr.t;\n        round : Round_repr.t;\n      }\n    | Insufficient_locked_round_evidence of {\n        voting_power : int;\n        consensus_threshold : int;\n      }\n    | Invalid_commitment of {expected : bool}\n\n  val check_timestamp :\n    Round.round_durations ->\n    timestamp:Time.t ->\n    round:Round.t ->\n    predecessor_timestamp:Time.t ->\n    predecessor_round:Round.t ->\n    unit tzresult\n\n  val check_signature :\n    t -> Chain_id.t -> Signature.Public_key.t -> unit tzresult\n\n  val begin_validate_block_header :\n    block_header:t ->\n    chain_id:Chain_id.t ->\n    predecessor_timestamp:Time.t ->\n    predecessor_round:Round.t ->\n    fitness:Fitness.t ->\n    timestamp:Time.t ->\n    delegate_pk:Signature.public_key ->\n    round_durations:Round.round_durations ->\n    proof_of_work_threshold:int64 ->\n    expected_commitment:bool ->\n    unit tzresult\n\n  type locked_round_evidence = {\n    preendorsement_round : Round.t;\n    preendorsement_count : int;\n  }\n\n  type checkable_payload_hash =\n    | No_check\n    | Expected_payload_hash of Block_payload_hash.t\n\n  val finalize_validate_block_header :\n    block_header_contents:contents ->\n    round:Round.t ->\n    fitness:Fitness.t ->\n    checkable_payload_hash:checkable_payload_hash ->\n    locked_round_evidence:locked_round_evidence option ->\n    consensus_threshold:int ->\n    unit tzresult\nend\n\nmodule Kind : sig\n  type preendorsement_consensus_kind = Preendorsement_consensus_kind\n\n  type endorsement_consensus_kind = Endorsement_consensus_kind\n\n  type 'a consensus =\n    | Preendorsement_kind : preendorsement_consensus_kind consensus\n    | Endorsement_kind : endorsement_consensus_kind consensus\n\n  type preendorsement = preendorsement_consensus_kind consensus\n\n  type endorsement = endorsement_consensus_kind consensus\n\n  type seed_nonce_revelation = Seed_nonce_revelation_kind\n\n  type 'a double_consensus_operation_evidence =\n    | Double_consensus_operation_evidence\n\n  type double_endorsement_evidence =\n    endorsement_consensus_kind double_consensus_operation_evidence\n\n  type double_preendorsement_evidence =\n    preendorsement_consensus_kind double_consensus_operation_evidence\n\n  type double_baking_evidence = Double_baking_evidence_kind\n\n  type activate_account = Activate_account_kind\n\n  type proposals = Proposals_kind\n\n  type ballot = Ballot_kind\n\n  type reveal = Reveal_kind\n\n  type transaction = Transaction_kind\n\n  type origination = Origination_kind\n\n  type delegation = Delegation_kind\n\n  type set_deposits_limit = Set_deposits_limit_kind\n\n  type failing_noop = Failing_noop_kind\n\n  type register_global_constant = Register_global_constant_kind\n\n  type 'a manager =\n    | Reveal_manager_kind : reveal manager\n    | Transaction_manager_kind : transaction manager\n    | Origination_manager_kind : origination manager\n    | Delegation_manager_kind : delegation manager\n    | Register_global_constant_manager_kind : register_global_constant manager\n    | Set_deposits_limit_manager_kind : set_deposits_limit manager\nend\n\ntype 'a consensus_operation_type =\n  | Endorsement : Kind.endorsement consensus_operation_type\n  | Preendorsement : Kind.preendorsement consensus_operation_type\n\nval pp_operation_kind :\n  Format.formatter -> 'kind consensus_operation_type -> unit\n\ntype consensus_content = {\n  slot : Slot.t;\n  level : Raw_level.t;\n  (* The level is not required to validate an endorsement when it corresponds\n     to the current payload, but if we want to filter endorsements, we need\n     the level. *)\n  round : Round.t;\n  block_payload_hash : Block_payload_hash.t;\n}\n\nval consensus_content_encoding : consensus_content Data_encoding.t\n\nval pp_consensus_content : Format.formatter -> consensus_content -> unit\n\ntype 'kind operation = {\n  shell : Operation.shell_header;\n  protocol_data : 'kind protocol_data;\n}\n\nand 'kind protocol_data = {\n  contents : 'kind contents_list;\n  signature : Signature.t option;\n}\n\nand _ contents_list =\n  | Single : 'kind contents -> 'kind contents_list\n  | Cons :\n      'kind Kind.manager contents * 'rest Kind.manager contents_list\n      -> ('kind * 'rest) Kind.manager contents_list\n\nand _ contents =\n  | Preendorsement : consensus_content -> Kind.preendorsement contents\n  | Endorsement : consensus_content -> Kind.endorsement contents\n  | Seed_nonce_revelation : {\n      level : Raw_level.t;\n      nonce : Nonce.t;\n    }\n      -> Kind.seed_nonce_revelation contents\n  | Double_preendorsement_evidence : {\n      op1 : Kind.preendorsement operation;\n      op2 : Kind.preendorsement operation;\n    }\n      -> Kind.double_preendorsement_evidence contents\n  | Double_endorsement_evidence : {\n      op1 : Kind.endorsement operation;\n      op2 : Kind.endorsement operation;\n    }\n      -> Kind.double_endorsement_evidence contents\n  | Double_baking_evidence : {\n      bh1 : Block_header.t;\n      bh2 : Block_header.t;\n    }\n      -> Kind.double_baking_evidence contents\n  | Activate_account : {\n      id : Ed25519.Public_key_hash.t;\n      activation_code : Blinded_public_key_hash.activation_code;\n    }\n      -> Kind.activate_account contents\n  | Proposals : {\n      source : Signature.Public_key_hash.t;\n      period : int32;\n      proposals : Protocol_hash.t list;\n    }\n      -> Kind.proposals contents\n  | Ballot : {\n      source : Signature.Public_key_hash.t;\n      period : int32;\n      proposal : Protocol_hash.t;\n      ballot : Vote.ballot;\n    }\n      -> Kind.ballot contents\n  | Failing_noop : string -> Kind.failing_noop contents\n  | Manager_operation : {\n      source : Signature.Public_key_hash.t;\n      fee : Tez.tez;\n      counter : counter;\n      operation : 'kind manager_operation;\n      gas_limit : Gas.Arith.integral;\n      storage_limit : Z.t;\n    }\n      -> 'kind Kind.manager contents\n\nand _ manager_operation =\n  | Reveal : Signature.Public_key.t -> Kind.reveal manager_operation\n  | Transaction : {\n      amount : Tez.tez;\n      parameters : Script.lazy_expr;\n      entrypoint : string;\n      destination : Contract.contract;\n    }\n      -> Kind.transaction manager_operation\n  | Origination : {\n      delegate : Signature.Public_key_hash.t option;\n      script : Script.t;\n      credit : Tez.tez;\n      preorigination : Contract.t option;\n    }\n      -> Kind.origination manager_operation\n  | Delegation :\n      Signature.Public_key_hash.t option\n      -> Kind.delegation manager_operation\n  | Register_global_constant : {\n      value : Script.lazy_expr;\n    }\n      -> Kind.register_global_constant manager_operation\n  | Set_deposits_limit :\n      Tez.t option\n      -> Kind.set_deposits_limit manager_operation\n\nand counter = Z.t\n\ntype 'kind internal_operation = {\n  source : Contract.contract;\n  operation : 'kind manager_operation;\n  nonce : int;\n}\n\ntype packed_manager_operation =\n  | Manager : 'kind manager_operation -> packed_manager_operation\n\ntype packed_contents = Contents : 'kind contents -> packed_contents\n\ntype packed_contents_list =\n  | Contents_list : 'kind contents_list -> packed_contents_list\n\ntype packed_protocol_data =\n  | Operation_data : 'kind protocol_data -> packed_protocol_data\n\ntype packed_operation = {\n  shell : Operation.shell_header;\n  protocol_data : packed_protocol_data;\n}\n\ntype packed_internal_operation =\n  | Internal_operation : 'kind internal_operation -> packed_internal_operation\n\nval manager_kind : 'kind manager_operation -> 'kind Kind.manager\n\nmodule Operation : sig\n  type nonrec 'kind contents = 'kind contents\n\n  type nonrec packed_contents = packed_contents\n\n  val contents_encoding : packed_contents Data_encoding.t\n\n  type nonrec 'kind protocol_data = 'kind protocol_data\n\n  type nonrec packed_protocol_data = packed_protocol_data\n\n  type consensus_watermark =\n    | Endorsement of Chain_id.t\n    | Preendorsement of Chain_id.t\n\n  val to_watermark : consensus_watermark -> Signature.watermark\n\n  val of_watermark : Signature.watermark -> consensus_watermark option\n\n  val protocol_data_encoding : packed_protocol_data Data_encoding.t\n\n  val unsigned_encoding :\n    (Operation.shell_header * packed_contents_list) Data_encoding.t\n\n  type raw = Operation.t = {shell : Operation.shell_header; proto : bytes}\n\n  val raw_encoding : raw Data_encoding.t\n\n  val contents_list_encoding : packed_contents_list Data_encoding.t\n\n  type 'kind t = 'kind operation = {\n    shell : Operation.shell_header;\n    protocol_data : 'kind protocol_data;\n  }\n\n  type nonrec packed = packed_operation\n\n  val encoding : packed Data_encoding.t\n\n  val raw : _ operation -> raw\n\n  val hash : _ operation -> Operation_hash.t\n\n  val hash_raw : raw -> Operation_hash.t\n\n  val hash_packed : packed_operation -> Operation_hash.t\n\n  val acceptable_passes : packed_operation -> int list\n\n  type error += Missing_signature (* `Permanent *)\n\n  type error += Invalid_signature (* `Permanent *)\n\n  val check_signature : public_key -> Chain_id.t -> _ operation -> unit tzresult\n\n  val internal_operation_encoding : packed_internal_operation Data_encoding.t\n\n  val packed_internal_operation_in_memory_size :\n    packed_internal_operation -> Cache_memory_helpers.nodes_and_size\n\n  val pack : 'kind operation -> packed_operation\n\n  type ('a, 'b) eq = Eq : ('a, 'a) eq\n\n  val equal : 'a operation -> 'b operation -> ('a, 'b) eq option\n\n  module Encoding : sig\n    type 'b case =\n      | Case : {\n          tag : int;\n          name : string;\n          encoding : 'a Data_encoding.t;\n          select : packed_contents -> 'b contents option;\n          proj : 'b contents -> 'a;\n          inj : 'a -> 'b contents;\n        }\n          -> 'b case\n\n    val preendorsement_case : Kind.preendorsement case\n\n    val endorsement_case : Kind.endorsement case\n\n    val seed_nonce_revelation_case : Kind.seed_nonce_revelation case\n\n    val double_preendorsement_evidence_case :\n      Kind.double_preendorsement_evidence case\n\n    val double_endorsement_evidence_case : Kind.double_endorsement_evidence case\n\n    val double_baking_evidence_case : Kind.double_baking_evidence case\n\n    val activate_account_case : Kind.activate_account case\n\n    val proposals_case : Kind.proposals case\n\n    val ballot_case : Kind.ballot case\n\n    val failing_noop_case : Kind.failing_noop case\n\n    val reveal_case : Kind.reveal Kind.manager case\n\n    val transaction_case : Kind.transaction Kind.manager case\n\n    val origination_case : Kind.origination Kind.manager case\n\n    val delegation_case : Kind.delegation Kind.manager case\n\n    val register_global_constant_case :\n      Kind.register_global_constant Kind.manager case\n\n    val set_deposits_limit_case : Kind.set_deposits_limit Kind.manager case\n\n    module Manager_operations : sig\n      type 'b case =\n        | MCase : {\n            tag : int;\n            name : string;\n            encoding : 'a Data_encoding.t;\n            select : packed_manager_operation -> 'kind manager_operation option;\n            proj : 'kind manager_operation -> 'a;\n            inj : 'a -> 'kind manager_operation;\n          }\n            -> 'kind case\n\n      val reveal_case : Kind.reveal case\n\n      val transaction_case : Kind.transaction case\n\n      val origination_case : Kind.origination case\n\n      val delegation_case : Kind.delegation case\n\n      val register_global_constant_case : Kind.register_global_constant case\n\n      val set_deposits_limit_case : Kind.set_deposits_limit case\n    end\n  end\n\n  val of_list : packed_contents list -> packed_contents_list tzresult\n\n  val to_list : packed_contents_list -> packed_contents list\nend\n\nmodule Stake_distribution : sig\n  val snapshot : context -> context tzresult Lwt.t\n\n  val baking_rights_owner :\n    context ->\n    Level.t ->\n    round:Round.t ->\n    (context * Slot.t * (public_key * public_key_hash)) tzresult Lwt.t\n\n  val slot_owner :\n    context ->\n    Level.t ->\n    Slot.t ->\n    (context * (public_key * public_key_hash)) tzresult Lwt.t\n\n  val delegate_pubkey : context -> public_key_hash -> public_key tzresult Lwt.t\n\n  val get_staking_balance :\n    context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t\nend\n\nmodule Commitment : sig\n  type t = {\n    blinded_public_key_hash : Blinded_public_key_hash.t;\n    amount : Tez.tez;\n  }\n\n  val encoding : t Data_encoding.t\nend\n\nmodule Bootstrap : sig\n  val cycle_end : context -> Cycle.t -> context tzresult Lwt.t\nend\n\nmodule Migration : sig\n  type origination_result = {\n    balance_updates : Receipt.balance_updates;\n    originated_contracts : Contract.t list;\n    storage_size : Z.t;\n    paid_storage_size_diff : Z.t;\n  }\nend\n\n(** Create an [Alpha_context.t] from an untyped context (first block in the chain only). *)\nval prepare_first_block :\n  Context.t ->\n  typecheck:\n    (context ->\n    Script.t ->\n    ((Script.t * Lazy_storage.diffs option) * context) tzresult Lwt.t) ->\n  level:Int32.t ->\n  timestamp:Time.t ->\n  context tzresult Lwt.t\n\n(** Create an [Alpha_context.t] from an untyped context. *)\nval prepare :\n  Context.t ->\n  level:Int32.t ->\n  predecessor_timestamp:Time.t ->\n  timestamp:Time.t ->\n  (context * Receipt.balance_updates * Migration.origination_result list)\n  tzresult\n  Lwt.t\n\nval activate : context -> Protocol_hash.t -> context Lwt.t\n\nval reset_internal_nonce : context -> context\n\nval fresh_internal_nonce : context -> (context * int) tzresult\n\nval record_internal_nonce : context -> int -> context\n\nval internal_nonce_already_recorded : context -> int -> bool\n\nval description : context Storage_description.t\n\n(** Finalize an {{!t} [Alpha_context.t]}, producing a [validation_result].\n *)\nval finalize :\n  ?commit_message:string -> context -> Fitness.raw -> Updater.validation_result\n\n(** Should only be used by [Main.current_context] to return a context usable for RPCs *)\nval current_context : context -> Context.t\n\nval record_non_consensus_operation_hash : context -> Operation_hash.t -> context\n\nval non_consensus_operations : context -> Operation_hash.t list\n\nmodule Parameters : sig\n  type bootstrap_account = {\n    public_key_hash : public_key_hash;\n    public_key : public_key option;\n    amount : Tez.t;\n  }\n\n  type bootstrap_contract = {\n    delegate : public_key_hash option;\n    amount : Tez.t;\n    script : Script.t;\n  }\n\n  type t = {\n    bootstrap_accounts : bootstrap_account list;\n    bootstrap_contracts : bootstrap_contract list;\n    commitments : Commitment.t list;\n    constants : Constants.parametric;\n    security_deposit_ramp_up_cycles : int option;\n    no_reward_cycles : int option;\n  }\n\n  val encoding : t Data_encoding.t\nend\n\nmodule Liquidity_baking : sig\n  val get_cpmm_address : context -> Contract.t tzresult Lwt.t\n\n  type escape_ema = Int32.t\n\n  val on_subsidy_allowed :\n    context ->\n    escape_vote:bool ->\n    (context -> Contract.t -> (context * 'a list) tzresult Lwt.t) ->\n    (context * 'a list * escape_ema) tzresult Lwt.t\nend\n\n(** This module re-exports functions from [Ticket_storage]. See\n    documentation of the functions there.\n *)\nmodule Ticket_balance : sig\n  type key_hash\n\n  val script_expr_hash_of_key_hash : key_hash -> Script_expr_hash.t\n\n  val make_key_hash :\n    context ->\n    ticketer:Script.node ->\n    typ:Script.node ->\n    contents:Script.node ->\n    owner:Script.node ->\n    (key_hash * context) tzresult\n\n  val adjust_balance :\n    context -> key_hash -> delta:Z.t -> (Z.t * context) tzresult Lwt.t\n\n  val get_balance : context -> key_hash -> (Z.t option * context) tzresult Lwt.t\nend\n\nmodule First_level_of_tenderbake : sig\n  val get : context -> Raw_level.t tzresult Lwt.t\nend\n\nmodule Consensus : sig\n  include\n    Raw_context.CONSENSUS\n      with type t := t\n       and type slot := Slot.t\n       and type 'a slot_map := 'a Slot.Map.t\n       and type slot_set := Slot.Set.t\n       and type round := Round.t\n\n  val store_endorsement_branch :\n    context -> Block_hash.t * Block_payload_hash.t -> context Lwt.t\n\n  val store_grand_parent_branch :\n    context -> Block_hash.t * Block_payload_hash.t -> context Lwt.t\nend\n\n(** See 'token.mli' for more explanation. *)\nmodule Token : sig\n  type container =\n    [ `Contract of Contract.t\n    | `Collected_commitments of Blinded_public_key_hash.t\n    | `Delegate_balance of Signature.Public_key_hash.t\n    | `Frozen_deposits of Signature.Public_key_hash.t\n    | `Block_fees\n    | `Legacy_deposits of Signature.Public_key_hash.t * Cycle.t\n    | `Legacy_fees of Signature.Public_key_hash.t * Cycle.t\n    | `Legacy_rewards of Signature.Public_key_hash.t * Cycle.t ]\n\n  type source =\n    [ `Invoice\n    | `Bootstrap\n    | `Initial_commitments\n    | `Revelation_rewards\n    | `Double_signing_evidence_rewards\n    | `Endorsing_rewards\n    | `Baking_rewards\n    | `Baking_bonuses\n    | `Minted\n    | `Liquidity_baking_subsidies\n    | container ]\n\n  type sink =\n    [ `Storage_fees\n    | `Double_signing_punishments\n    | `Lost_endorsing_rewards of Signature.Public_key_hash.t * bool * bool\n    | `Burned\n    | container ]\n\n  val allocated : context -> container -> bool tzresult Lwt.t\n\n  val balance : context -> container -> Tez.t tzresult Lwt.t\n\n  val transfer_n :\n    ?origin:Receipt.update_origin ->\n    context ->\n    ([< source] * Tez.t) list ->\n    [< sink] ->\n    (context * Receipt.balance_updates) tzresult Lwt.t\n\n  val transfer :\n    ?origin:Receipt.update_origin ->\n    context ->\n    [< source] ->\n    [< sink] ->\n    Tez.t ->\n    (context * Receipt.balance_updates) tzresult Lwt.t\nend\n\nmodule Fees : sig\n  val record_paid_storage_space :\n    context -> Contract.t -> (context * Z.t * Z.t) tzresult Lwt.t\n\n  val record_global_constant_storage_space : context -> Z.t -> context * Z.t\n\n  val burn_storage_fees :\n    ?origin:Receipt.update_origin ->\n    context ->\n    storage_limit:Z.t ->\n    payer:Token.source ->\n    Z.t ->\n    (context * Z.t * Receipt.balance_updates) tzresult Lwt.t\n\n  val burn_origination_fees :\n    ?origin:Receipt.update_origin ->\n    context ->\n    storage_limit:Z.t ->\n    payer:Token.source ->\n    (context * Z.t * Receipt.balance_updates) tzresult Lwt.t\n\n  type error += Cannot_pay_storage_fee (* `Temporary *)\n\n  type error += Operation_quota_exceeded (* `Temporary *)\n\n  type error += Storage_limit_too_high (* `Permanent *)\n\n  val check_storage_limit : context -> storage_limit:Z.t -> unit tzresult\nend\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2019-2020 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\ntype t = Raw_context.t\n\ntype context = t\n\nmodule type BASIC_DATA = sig\n  type t\n\n  include Compare.S with type t := t\n\n  val encoding : t Data_encoding.t\n\n  val pp : Format.formatter -> t -> unit\nend\n\nmodule Tez = Tez_repr\nmodule Period = Period_repr\n\nmodule Timestamp = struct\n  include Time_repr\n\n  let current = Raw_context.current_timestamp\n\n  let predecessor = Raw_context.predecessor_timestamp\nend\n\nmodule Slot = struct\n  include Slot_repr\n\n  let slot_range = List.slot_range\nend\n\ninclude Operation_repr\n\nmodule Operation = struct\n  type 'kind t = 'kind operation = {\n    shell : Operation.shell_header;\n    protocol_data : 'kind protocol_data;\n  }\n\n  type packed = packed_operation\n\n  let unsigned_encoding = unsigned_operation_encoding\n\n  include Operation_repr\nend\n\nmodule Block_header = Block_header_repr\n\nmodule Vote = struct\n  include Vote_repr\n  include Vote_storage\nend\n\nmodule Block_payload = struct\n  include Block_payload_repr\nend\n\nmodule First_level_of_tenderbake = struct\n  let get = Storage.Tenderbake.First_level.get\nend\n\nmodule Raw_level = Raw_level_repr\nmodule Cycle = Cycle_repr\nmodule Script_string = Script_string_repr\nmodule Script_int = Script_int_repr\n\nmodule Script_timestamp = struct\n  include Script_timestamp_repr\n\n  let now ctxt =\n    let {Constants_repr.minimal_block_delay; _} = Raw_context.constants ctxt in\n    let first_delay = Period_repr.to_seconds minimal_block_delay in\n    let current_timestamp = Raw_context.predecessor_timestamp ctxt in\n    Time.add current_timestamp first_delay |> Timestamp.to_seconds |> of_int64\nend\n\nmodule Script = struct\n  include Michelson_v1_primitives\n  include Script_repr\n\n  type consume_deserialization_gas = Always | When_needed\n\n  let force_decode_in_context ~consume_deserialization_gas ctxt lexpr =\n    let gas_cost =\n      match consume_deserialization_gas with\n      | Always -> Script_repr.stable_force_decode_cost lexpr\n      | When_needed -> Script_repr.force_decode_cost lexpr\n    in\n    Raw_context.consume_gas ctxt gas_cost >>? fun ctxt ->\n    Script_repr.force_decode lexpr >|? fun v -> (v, ctxt)\n\n  let force_bytes_in_context ctxt lexpr =\n    Raw_context.consume_gas ctxt (Script_repr.force_bytes_cost lexpr)\n    >>? fun ctxt ->\n    Script_repr.force_bytes lexpr >|? fun v -> (v, ctxt)\nend\n\nmodule Fees = Fees_storage\n\ntype public_key = Signature.Public_key.t\n\ntype public_key_hash = Signature.Public_key_hash.t\n\ntype signature = Signature.t\n\nmodule Constants = struct\n  include Constants_repr\n  include Constants_storage\n\n  let round_durations ctxt = Raw_context.round_durations ctxt\n\n  let all ctxt = all (parametric ctxt)\nend\n\nmodule Voting_period = struct\n  include Voting_period_repr\n  include Voting_period_storage\nend\n\nmodule Round = struct\n  include Round_repr\n  module Durations = Durations\n\n  type round_durations = Durations.t\n\n  let pp_round_durations = Durations.pp\n\n  let round_durations_encoding = Durations.encoding\n\n  let round_duration = Round_repr.Durations.round_duration\n\n  let update ctxt round = Storage.Block_round.update ctxt round\n\n  let get ctxt = Storage.Block_round.get ctxt\nend\n\nmodule Gas = struct\n  include Gas_limit_repr\n\n  type error += Gas_limit_too_high = Raw_context.Gas_limit_too_high\n\n  type error += Block_quota_exceeded = Raw_context.Block_quota_exceeded\n\n  type error += Operation_quota_exceeded = Raw_context.Operation_quota_exceeded\n\n  let check_limit_is_valid = Raw_context.check_gas_limit_is_valid\n\n  let set_limit = Raw_context.set_gas_limit\n\n  let consume_limit_in_block = Raw_context.consume_gas_limit_in_block\n\n  let set_unlimited = Raw_context.set_gas_unlimited\n\n  let consume = Raw_context.consume_gas\n\n  let remaining_operation_gas = Raw_context.remaining_operation_gas\n\n  let update_remaining_operation_gas =\n    Raw_context.update_remaining_operation_gas\n\n  let reset_block_gas ctxt =\n    let gas = Constants.hard_gas_limit_per_block ctxt in\n    Raw_context.update_remaining_block_gas ctxt gas\n\n  let level = Raw_context.gas_level\n\n  let consumed = Raw_context.gas_consumed\n\n  let block_level = Raw_context.block_gas_level\n\n  (* Necessary to inject costs for Storage_costs into Gas.cost *)\n  let cost_of_repr cost = cost\nend\n\nmodule Level = struct\n  include Level_repr\n  include Level_storage\nend\n\nmodule Lazy_storage = struct\n  module Kind = Lazy_storage_kind\n  module IdSet = Kind.IdSet\n  include Lazy_storage_diff\n\n  let legacy_big_map_diff_encoding =\n    Data_encoding.conv\n      Contract_storage.Legacy_big_map_diff.of_lazy_storage_diff\n      Contract_storage.Legacy_big_map_diff.to_lazy_storage_diff\n      Contract_storage.Legacy_big_map_diff.encoding\nend\n\nmodule Contract = struct\n  include Contract_repr\n  include Contract_storage\n\n  let init_origination_nonce = Raw_context.init_origination_nonce\n\n  let unset_origination_nonce = Raw_context.unset_origination_nonce\n\n  let is_manager_key_revealed = Contract_manager_storage.is_manager_key_revealed\n\n  let reveal_manager_key = Contract_manager_storage.reveal_manager_key\n\n  let get_manager_key = Contract_manager_storage.get_manager_key\nend\n\nmodule Global_constants_storage = Global_constants_storage\n\nmodule Big_map = struct\n  module Big_map = Lazy_storage_kind.Big_map\n\n  module Id = struct\n    type t = Big_map.Id.t\n\n    let encoding = Big_map.Id.encoding\n\n    let rpc_arg = Big_map.Id.rpc_arg\n\n    let parse_z = Big_map.Id.parse_z\n\n    let unparse_to_z = Big_map.Id.unparse_to_z\n  end\n\n  let fresh ~temporary c = Lazy_storage.fresh Big_map ~temporary c\n\n  let mem c m k = Storage.Big_map.Contents.mem (c, m) k\n\n  let get_opt c m k = Storage.Big_map.Contents.find (c, m) k\n\n  let list_values ?offset ?length c m =\n    Storage.Big_map.Contents.list_values ?offset ?length (c, m)\n\n  let exists c id =\n    Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost 0) >>?= fun c ->\n    Storage.Big_map.Key_type.find c id >>=? fun kt ->\n    match kt with\n    | None -> return (c, None)\n    | Some kt ->\n        Storage.Big_map.Value_type.get c id >|=? fun kv -> (c, Some (kt, kv))\n\n  type update = Big_map.update = {\n    key : Script_repr.expr;\n    key_hash : Script_expr_hash.t;\n    value : Script_repr.expr option;\n  }\n\n  type updates = Big_map.updates\n\n  type alloc = Big_map.alloc = {\n    key_type : Script_repr.expr;\n    value_type : Script_repr.expr;\n  }\nend\n\nmodule Sapling = struct\n  module Sapling_state = Lazy_storage_kind.Sapling_state\n\n  module Id = struct\n    type t = Sapling_state.Id.t\n\n    let encoding = Sapling_state.Id.encoding\n\n    let rpc_arg = Sapling_state.Id.rpc_arg\n\n    let parse_z = Sapling_state.Id.parse_z\n\n    let unparse_to_z = Sapling_state.Id.unparse_to_z\n  end\n\n  include Sapling_repr\n  include Sapling_storage\n  include Sapling_validator\n\n  let fresh ~temporary c = Lazy_storage.fresh Sapling_state ~temporary c\n\n  type updates = Sapling_state.updates\n\n  type alloc = Sapling_state.alloc = {memo_size : Sapling_repr.Memo_size.t}\nend\n\nmodule Receipt = Receipt_repr\n\nmodule Delegate = struct\n  include Delegate_storage\n\n  type deposits = Storage.deposits = {\n    initial_amount : Tez.t;\n    current_amount : Tez.t;\n  }\n\n  let grace_period = Delegate_activation_storage.grace_period\n\n  let prepare_stake_distribution = Stake_storage.prepare_stake_distribution\n\n  let registered = Contract_delegate_storage.registered\n\n  let find = Contract_delegate_storage.find\n\n  let delegated_contracts = Contract_delegate_storage.delegated_contracts\nend\n\nmodule Stake_distribution = struct\n  let snapshot = Stake_storage.snapshot\n\n  let baking_rights_owner = Delegate.baking_rights_owner\n\n  let slot_owner = Delegate.slot_owner\n\n  let delegate_pubkey = Delegate.pubkey\n\n  let get_staking_balance = Delegate.staking_balance\nend\n\nmodule Nonce = Nonce_storage\n\nmodule Seed = struct\n  include Seed_repr\n  include Seed_storage\nend\n\nmodule Fitness = struct\n  type raw = Fitness.t\n\n  include Fitness_repr\nend\n\nmodule Bootstrap = Bootstrap_storage\n\nmodule Commitment = struct\n  include Commitment_repr\n  include Commitment_storage\nend\n\nmodule Migration = Migration_repr\n\nmodule Consensus = struct\n  include Raw_context.Consensus\n\n  let load_endorsement_branch ctxt =\n    Storage.Tenderbake.Endorsement_branch.find ctxt >>=? function\n    | Some endorsement_branch ->\n        Raw_context.Consensus.set_endorsement_branch ctxt endorsement_branch\n        |> return\n    | None -> return ctxt\n\n  let store_endorsement_branch ctxt branch =\n    let ctxt = set_endorsement_branch ctxt branch in\n    Storage.Tenderbake.Endorsement_branch.add ctxt branch\n\n  let load_grand_parent_branch ctxt =\n    Storage.Tenderbake.Grand_parent_branch.find ctxt >>=? function\n    | Some grand_parent_branch ->\n        Raw_context.Consensus.set_grand_parent_branch ctxt grand_parent_branch\n        |> return\n    | None -> return ctxt\n\n  let store_grand_parent_branch ctxt branch =\n    let ctxt = set_grand_parent_branch ctxt branch in\n    Storage.Tenderbake.Grand_parent_branch.add ctxt branch\nend\n\nlet prepare_first_block = Init_storage.prepare_first_block\n\nlet prepare ctxt ~level ~predecessor_timestamp ~timestamp =\n  Init_storage.prepare ctxt ~level ~predecessor_timestamp ~timestamp\n  >>=? fun (ctxt, balance_updates, origination_results) ->\n  Consensus.load_endorsement_branch ctxt >>=? fun ctxt ->\n  Consensus.load_grand_parent_branch ctxt >>=? fun ctxt ->\n  return (ctxt, balance_updates, origination_results)\n\nlet finalize ?commit_message:message c fitness =\n  let context = Raw_context.recover c in\n  {\n    Updater.context;\n    fitness;\n    message;\n    max_operations_ttl = (Raw_context.constants c).max_operations_time_to_live;\n    last_allowed_fork_level =\n      Raw_level.to_int32 @@ Level.last_allowed_fork_level c;\n  }\n\nlet current_context c = Raw_context.recover c\n\nlet record_non_consensus_operation_hash =\n  Raw_context.record_non_consensus_operation_hash\n\nlet non_consensus_operations = Raw_context.non_consensus_operations\n\nlet activate = Raw_context.activate\n\nlet reset_internal_nonce = Raw_context.reset_internal_nonce\n\nlet fresh_internal_nonce = Raw_context.fresh_internal_nonce\n\nlet record_internal_nonce = Raw_context.record_internal_nonce\n\nlet internal_nonce_already_recorded =\n  Raw_context.internal_nonce_already_recorded\n\nlet description = Raw_context.description\n\nmodule Parameters = Parameters_repr\nmodule Liquidity_baking = Liquidity_baking_repr\n\nmodule Ticket_balance = struct\n  include Ticket_storage\nend\n\nmodule Token = Token\nmodule Cache = Cache_repr\n" ;
                } ;
                { name = "Local_gas_counter" ;
                  interface = None ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\n(*\n\n   Gas update and check for gas exhaustion\n   =======================================\n\n   Costs of various computations are subtracted from an amount of gas made\n   available for the script execution.\n\n   Updating the gas counter is a critical aspect to operation validation\n   because it is done at many places.\n\n   For this reason, the gas counter must be read and updated as quickly as\n   possible. Hence, the gas counter should be stored in a machine register. To\n   motivate the OCaml compiler to make that choice, we represent the gas counter\n   as a local parameter of the execution [step] function.\n\n*)\n\ntype local_gas_counter = int\n\n(*\n\n   The gas counter stored in the context is desynchronized with the\n   [local_gas_counter] used locally. When we have to call a gas-consuming\n   function working on context with no local gas counter, we must update the\n   context so that it carries an up-to-date gas counter. Similarly, when we\n   return from such a function, the [local_gas_counter] must be updated as well.\n\n   To statically track these points where the context's gas counter\n   must be updated, we introduce a type for outdated contexts. The\n   [step] function carries an [outdated_context]. When an external\n   function needs a [context], the typechecker points out the need for\n   a conversion: this forces us to either call [update_context], or\n   better, when this is possible, the function\n   [use_gas_counter_in_ctxt].\n\n*)\ntype outdated_context = OutDatedContext of context [@@unboxed]\n\nlet update_context local_gas_counter = function\n  | OutDatedContext ctxt ->\n      Gas.update_remaining_operation_gas\n        ctxt\n        (Saturation_repr.safe_int local_gas_counter)\n  [@@ocaml.inline always]\n\nlet update_local_gas_counter ctxt =\n  (Gas.remaining_operation_gas ctxt :> int)\n  [@@ocaml.inline always]\n\nlet outdated ctxt = OutDatedContext ctxt [@@ocaml.inline always]\n\nlet context_from_outdated_context (OutDatedContext ctxt) =\n  ctxt\n  [@@ocaml.inline always]\n\nlet use_gas_counter_in_ctxt ctxt local_gas_counter f =\n  let ctxt = update_context local_gas_counter ctxt in\n  f ctxt >>=? fun (y, ctxt) ->\n  return (y, outdated ctxt, update_local_gas_counter ctxt)\n  [@@ocaml.inline always]\n\nlet update_and_check gas_counter (cost : Gas.cost) =\n  let gas_counter = gas_counter - (cost :> int) in\n  if Compare.Int.(gas_counter < 0) then None else Some gas_counter\n  [@@ocaml.inline always]\n\nlet consume local_gas_counter cost =\n  match update_and_check local_gas_counter cost with\n  | None -> error Gas.Operation_quota_exceeded\n  | Some local_gas_counter -> Ok local_gas_counter\n  [@@ocaml.inline always]\n" ;
                } ;
                { name = "Gas_monad" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\n(** This monad combines:\n    - a state monad where the state is the context\n    - two levels of error monad to distinguish gas exhaustion from other errors\n\n    It is useful for backtracking on type checking errors without backtracking\n    the consumed gas.\n*)\ntype ('a, 'trace) t\n\n(** Alias of [('a, 'trace) t] to avoid confusion when the module is open *)\ntype ('a, 'trace) gas_monad = ('a, 'trace) t\n\n(** monadic return operator of the gas monad *)\nval return : 'a -> ('a, 'trace) t\n\n(** Binding operator for the gas monad *)\nval ( >>$ ) : ('a, 'trace) t -> ('a -> ('b, 'trace) t) -> ('b, 'trace) t\n\n(** Mapping operator for the gas monad, [m >|$ f] is equivalent to\n    [m >>$ fun x -> return (f x)] *)\nval ( >|$ ) : ('a, 'trace) t -> ('a -> 'b) -> ('b, 'trace) t\n\n(** Variant of [( >>$ )] to bind uncarbonated functions *)\nval ( >?$ ) : ('a, 'trace) t -> ('a -> ('b, 'trace) result) -> ('b, 'trace) t\n\n(** Another variant of [( >>$ )] that lets recover from inner errors *)\nval ( >??$ ) :\n  ('a, 'trace) t -> (('a, 'trace) result -> ('b, 'trace) t) -> ('b, 'trace) t\n\n(** gas-free embedding of tzresult values. [of_result x] is equivalent to [return () >?$ fun () -> x] *)\nval of_result : ('a, 'trace) result -> ('a, 'trace) t\n\n(** A wrapper around Gas.consume. If that fails, the whole computation\n    within the Gas_monad returns an error. See the Alpha_context.Gas module\n    for details.*)\nval consume_gas : Gas.cost -> (unit, 'trace) t\n\n(** Escaping the gas monad *)\nval run : context -> ('a, 'trace) t -> (('a, 'trace) result * context) tzresult\n\n(** re-export of [Error_monad.record_trace_eval]. This function has no\n    effect in the case of a gas-exhaustion error. *)\nval record_trace_eval :\n  (unit -> 'err) -> ('a, 'err trace) t -> ('a, 'err trace) t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\n(* The outer [tzresult] is for gas exhaustion only. The inner [result] is for all\n   other (non-gas) errors. *)\ntype ('a, 'trace) t = context -> (('a, 'trace) result * context) tzresult\n\ntype ('a, 'trace) gas_monad = ('a, 'trace) t\n\nlet of_result x ctxt = ok (x, ctxt)\n\nlet return x = of_result (ok x)\n\nlet ( >>$ ) m f ctxt =\n  m ctxt >>? fun (x, ctxt) ->\n  match x with Ok y -> f y ctxt | Error _ as err -> of_result err ctxt\n\nlet ( >|$ ) m f ctxt = m ctxt >>? fun (x, ctxt) -> of_result (x >|? f) ctxt\n\nlet ( >?$ ) m f = m >>$ fun x -> of_result (f x)\n\nlet ( >??$ ) m f ctxt = m ctxt >>? fun (x, ctxt) -> f x ctxt\n\nlet consume_gas cost ctxt = Gas.consume ctxt cost >>? return ()\n\nlet run ctxt x = x ctxt\n\nlet record_trace_eval f m ctxt =\n  m ctxt >>? fun (x, ctxt) -> of_result (record_trace_eval f x) ctxt\n" ;
                } ;
                { name = "Script_tc_errors" ;
                  interface = None ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\nopen Script\n\n(* ---- Error definitions ---------------------------------------------------*)\n\ntype kind = Int_kind | String_kind | Bytes_kind | Prim_kind | Seq_kind\n\ntype unparsed_stack_ty = (Script.expr * Script.annot) list\n\ntype type_map = (Script.location * (unparsed_stack_ty * unparsed_stack_ty)) list\n\n(* Structure errors *)\ntype error += Invalid_arity of Script.location * prim * int * int\n\ntype error += Invalid_seq_arity of Script.location * int * int\n\ntype error +=\n  | Invalid_namespace of\n      Script.location\n      * prim\n      * Michelson_v1_primitives.namespace\n      * Michelson_v1_primitives.namespace\n\ntype error += Invalid_primitive of Script.location * prim list * prim\n\ntype error += Invalid_kind of Script.location * kind list * kind\n\ntype error += Invalid_never_expr of Script.location\n\ntype error += Missing_field of prim\n\ntype error += Duplicate_field of Script.location * prim\n\ntype error += Unexpected_lazy_storage of Script.location\n\ntype error += Unexpected_operation of Script.location\n\ntype error += Unexpected_contract of Script.location\n\ntype error += No_such_entrypoint of string\n\ntype error += Duplicate_entrypoint of string\n\ntype error += Unreachable_entrypoint of prim list\n\ntype error += Entrypoint_name_too_long of string\n\n(* Instruction typing errors *)\ntype error += Fail_not_in_tail_position of Script.location\n\ntype error +=\n  | Undefined_binop :\n      Script.location * prim * Script.expr * Script.expr\n      -> error\n\ntype error += Undefined_unop : Script.location * prim * Script.expr -> error\n\ntype error +=\n  | Bad_return : Script.location * unparsed_stack_ty * Script.expr -> error\n\ntype error +=\n  | Bad_stack : Script.location * prim * int * unparsed_stack_ty -> error\n\ntype error +=\n  | Unmatched_branches :\n      Script.location * unparsed_stack_ty * unparsed_stack_ty\n      -> error\n\n(* View errors *)\ntype error += View_name_too_long of string\n\ntype error += Bad_view_name of Script.location\n\ntype error +=\n  | Ill_typed_view of {\n      loc : Script.location;\n      actual : unparsed_stack_ty;\n      expected : unparsed_stack_ty;\n    }\n\ntype error += Duplicated_view_name of Script.location\n\ntype error += Self_in_lambda of Script.location\n\ntype error += Bad_stack_length\n\ntype error += Bad_stack_item of int\n\ntype error += Inconsistent_annotations of string * string\n\ntype error +=\n  | Inconsistent_type_annotations :\n      Script.location * Script.expr * Script.expr\n      -> error\n\ntype error += Inconsistent_field_annotations of string * string\n\ntype error += Unexpected_annotation of Script.location\n\ntype error += Ungrouped_annotations of Script.location\n\ntype error += Invalid_map_body : Script.location * unparsed_stack_ty -> error\n\ntype error += Invalid_map_block_fail of Script.location\n\ntype error +=\n  | Invalid_iter_body :\n      Script.location * unparsed_stack_ty * unparsed_stack_ty\n      -> error\n\ntype error += Type_too_large : Script.location * int -> error\n\ntype error += Pair_bad_argument of Script.location\n\ntype error += Unpair_bad_argument of Script.location\n\ntype error += Dup_n_bad_argument of Script.location\n\ntype error += Dup_n_bad_stack of Script.location\n\n(* Value typing errors *)\ntype error +=\n  | Invalid_constant : Script.location * Script.expr * Script.expr -> error\n\ntype error +=\n  | Invalid_syntactic_constant : Script.location * Script.expr * string -> error\n\ntype error += Invalid_contract of Script.location * Contract.t\n\ntype error += Invalid_big_map of Script.location * Big_map.Id.t\n\ntype error += Comparable_type_expected : Script.location * Script.expr -> error\n\ntype error += Inconsistent_type_sizes : int * int -> error\n\ntype error +=\n  | Inconsistent_types :\n      Script.location option * Script.expr * Script.expr\n      -> error\n\ntype error +=\n  | Inconsistent_memo_sizes : Sapling.Memo_size.t * Sapling.Memo_size.t -> error\n\ntype error += Unordered_map_keys of Script.location * Script.expr\n\ntype error += Unordered_set_values of Script.location * Script.expr\n\ntype error += Duplicate_map_keys of Script.location * Script.expr\n\ntype error += Duplicate_set_values of Script.location * Script.expr\n\n(* Toplevel errors *)\ntype error +=\n  | Ill_typed_data : string option * Script.expr * Script.expr -> error\n\ntype error += Ill_formed_type of string option * Script.expr * Script.location\n\ntype error += Ill_typed_contract : Script.expr * type_map -> error\n\n(* Deprecation errors *)\ntype error += Deprecated_instruction of prim\n\n(* Stackoverflow errors *)\ntype error += Typechecking_too_many_recursive_calls\n\ntype error += Unparsing_too_many_recursive_calls\n\n(* Ticket errors *)\ntype error += Unexpected_ticket of Script.location\n\ntype error += Unexpected_forged_value of Script.location\n\ntype error += Non_dupable_type of Script.location * Script.expr\n\n(* Impossible errors *)\ntype error += Unparsing_invariant_violated\n" ;
                } ;
                { name = "Script_ir_annot" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\ntype var_annot = private Var_annot of Non_empty_string.t [@@ocaml.unboxed]\n\ntype type_annot = private Type_annot of Non_empty_string.t [@@ocaml.unboxed]\n\ntype field_annot = private Field_annot of Non_empty_string.t [@@ocaml.unboxed]\n\nmodule FOR_TESTS : sig\n  val unsafe_var_annot_of_string : string -> var_annot\n\n  val unsafe_type_annot_of_string : string -> type_annot\n\n  val unsafe_field_annot_of_string : string -> field_annot\nend\n\n(** Default annotations *)\n\nval default_now_annot : var_annot option\n\nval default_amount_annot : var_annot option\n\nval default_balance_annot : var_annot option\n\nval default_level_annot : var_annot option\n\nval default_source_annot : var_annot option\n\nval default_sender_annot : var_annot option\n\nval default_self_annot : var_annot option\n\nval default_arg_annot : var_annot option\n\nval lambda_arg_annot : var_annot option\n\nval default_param_annot : var_annot option\n\nval default_storage_annot : var_annot option\n\nval default_sapling_state_annot : var_annot option\n\nval default_sapling_balance_annot : var_annot option\n\nval default_car_annot : field_annot option\n\nval default_cdr_annot : field_annot option\n\nval default_contract_annot : field_annot option\n\nval default_addr_annot : field_annot option\n\nval default_pack_annot : field_annot option\n\nval default_unpack_annot : field_annot option\n\nval default_slice_annot : field_annot option\n\nval default_elt_annot : field_annot option\n\nval default_key_annot : field_annot option\n\nval default_hd_annot : field_annot option\n\nval default_tl_annot : field_annot option\n\nval default_some_annot : field_annot option\n\nval default_left_annot : field_annot option\n\nval default_right_annot : field_annot option\n\n(** Unparse annotations to their string representation *)\n\nval unparse_type_annot : type_annot option -> string list\n\nval unparse_var_annot : var_annot option -> string list\n\nval unparse_field_annot : field_annot option -> string list\n\n(** Conversion functions between different annotation kinds *)\n\nval field_to_var_annot : field_annot option -> var_annot option\n\nval type_to_var_annot : type_annot option -> var_annot option\n\nval var_to_field_annot : var_annot option -> field_annot option\n\n(** Replace an annotation by its default value if it is [None] *)\nval default_annot : default:'a option -> 'a option -> 'a option\n\n(** Generate annotation for field accesses, of the form [var.field1.field2] *)\nval gen_access_annot :\n  var_annot option ->\n  ?default:field_annot option ->\n  field_annot option ->\n  var_annot option\n\n(** Merge type annotations.\n    @return an error {!Inconsistent_type_annotations} if they are both present\n    and different, unless [legacy] *)\nval merge_type_annot :\n  legacy:bool ->\n  type_annot option ->\n  type_annot option ->\n  type_annot option tzresult\n\n(** Merge field annotations.\n    @return an error {!Inconsistent_type_annotations} if they are both present\n    and different, unless [legacy] *)\nval merge_field_annot :\n  legacy:bool ->\n  field_annot option ->\n  field_annot option ->\n  field_annot option tzresult\n\n(** Merge variable annotations, does not fail ([None] if different). *)\nval merge_var_annot : var_annot option -> var_annot option -> var_annot option\n\n(** @return an error {!Unexpected_annotation} in the monad the list is not empty. *)\nval error_unexpected_annot : Script.location -> 'a list -> unit tzresult\n\n(** Parse a type annotation only. *)\nval parse_type_annot :\n  Script.location -> string list -> type_annot option tzresult\n\n(** Parse a field annotation only. *)\nval parse_field_annot :\n  Script.location -> string list -> field_annot option tzresult\n\n(** Parse an annotation for composed types, of the form\n    [:ty_name %field1 %field2] in any order. *)\nval parse_composed_type_annot :\n  Script.location ->\n  string list ->\n  (type_annot option * field_annot option * field_annot option) tzresult\n\n(** Extract and remove a field annotation from a node *)\nval extract_field_annot :\n  Script.node -> (Script.node * field_annot option) tzresult\n\n(** Check that field annotations match, used for field accesses. *)\nval check_correct_field :\n  field_annot option -> field_annot option -> unit tzresult\n\n(** Instruction annotations parsing *)\n\n(** Parse a variable annotation, replaced by a default value if [None]. *)\nval parse_var_annot :\n  Script.location ->\n  ?default:var_annot option ->\n  string list ->\n  var_annot option tzresult\n\nval is_allowed_char : char -> bool\n\nval parse_constr_annot :\n  Script.location ->\n  ?if_special_first:field_annot option ->\n  ?if_special_second:field_annot option ->\n  string list ->\n  (var_annot option\n  * type_annot option\n  * field_annot option\n  * field_annot option)\n  tzresult\n\nval parse_two_var_annot :\n  Script.location ->\n  string list ->\n  (var_annot option * var_annot option) tzresult\n\nval parse_destr_annot :\n  Script.location ->\n  string list ->\n  default_accessor:field_annot option ->\n  field_name:field_annot option ->\n  pair_annot:var_annot option ->\n  value_annot:var_annot option ->\n  (var_annot option * field_annot option) tzresult\n\nval parse_unpair_annot :\n  Script.location ->\n  string list ->\n  field_name_car:field_annot option ->\n  field_name_cdr:field_annot option ->\n  pair_annot:var_annot option ->\n  value_annot_car:var_annot option ->\n  value_annot_cdr:var_annot option ->\n  (var_annot option\n  * var_annot option\n  * field_annot option\n  * field_annot option)\n  tzresult\n\nval parse_entrypoint_annot :\n  Script.location ->\n  ?default:var_annot option ->\n  string list ->\n  (var_annot option * field_annot option) tzresult\n\nval parse_var_type_annot :\n  Script.location ->\n  string list ->\n  (var_annot option * type_annot option) tzresult\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\nopen Micheline\nopen Script_tc_errors\n\ntype var_annot = Var_annot of Non_empty_string.t [@@ocaml.unboxed]\n\ntype type_annot = Type_annot of Non_empty_string.t [@@ocaml.unboxed]\n\ntype field_annot = Field_annot of Non_empty_string.t [@@ocaml.unboxed]\n\nmodule FOR_TESTS = struct\n  let unsafe_var_annot_of_string s =\n    Var_annot (Non_empty_string.of_string_exn s)\n\n  let unsafe_type_annot_of_string s =\n    Type_annot (Non_empty_string.of_string_exn s)\n\n  let unsafe_field_annot_of_string s =\n    Field_annot (Non_empty_string.of_string_exn s)\nend\n\nlet some_var_annot_of_string_exn s =\n  Some (Var_annot (Non_empty_string.of_string_exn s))\n\nlet some_field_annot_of_string_exn s =\n  Some (Field_annot (Non_empty_string.of_string_exn s))\n\nlet default_now_annot = some_var_annot_of_string_exn \"now\"\n\nlet default_amount_annot = some_var_annot_of_string_exn \"amount\"\n\nlet default_balance_annot = some_var_annot_of_string_exn \"balance\"\n\nlet default_level_annot = some_var_annot_of_string_exn \"level\"\n\nlet default_source_annot = some_var_annot_of_string_exn \"source\"\n\nlet default_sender_annot = some_var_annot_of_string_exn \"sender\"\n\nlet default_self_annot = some_var_annot_of_string_exn \"self\"\n\nlet default_arg_annot = some_var_annot_of_string_exn \"arg\"\n\nlet lambda_arg_annot = some_var_annot_of_string_exn \"@arg\"\n\nlet default_param_annot = some_var_annot_of_string_exn \"parameter\"\n\nlet default_storage_annot = some_var_annot_of_string_exn \"storage\"\n\nlet default_car_annot = some_field_annot_of_string_exn \"car\"\n\nlet default_cdr_annot = some_field_annot_of_string_exn \"cdr\"\n\nlet default_contract_annot = some_field_annot_of_string_exn \"contract\"\n\nlet default_addr_annot = some_field_annot_of_string_exn \"address\"\n\nlet default_pack_annot = some_field_annot_of_string_exn \"packed\"\n\nlet default_unpack_annot = some_field_annot_of_string_exn \"unpacked\"\n\nlet default_slice_annot = some_field_annot_of_string_exn \"slice\"\n\nlet default_elt_annot = some_field_annot_of_string_exn \"elt\"\n\nlet default_key_annot = some_field_annot_of_string_exn \"key\"\n\nlet default_hd_annot = some_field_annot_of_string_exn \"hd\"\n\nlet default_tl_annot = some_field_annot_of_string_exn \"tl\"\n\nlet default_some_annot = some_field_annot_of_string_exn \"some\"\n\nlet default_left_annot = some_field_annot_of_string_exn \"left\"\n\nlet default_right_annot = some_field_annot_of_string_exn \"right\"\n\nlet default_sapling_state_annot = some_var_annot_of_string_exn \"sapling\"\n\nlet default_sapling_balance_annot =\n  some_var_annot_of_string_exn \"sapling_balance\"\n\nlet unparse_type_annot : type_annot option -> string list = function\n  | None -> []\n  | Some (Type_annot a) -> [\":\" ^ (a :> string)]\n\nlet unparse_var_annot : var_annot option -> string list = function\n  | None -> []\n  | Some (Var_annot a) -> [\"@\" ^ (a :> string)]\n\nlet unparse_field_annot : field_annot option -> string list = function\n  | None -> []\n  | Some (Field_annot a) -> [\"%\" ^ (a :> string)]\n\nlet field_to_var_annot : field_annot option -> var_annot option = function\n  | None -> None\n  | Some (Field_annot s) -> Some (Var_annot s)\n\nlet type_to_var_annot : type_annot option -> var_annot option = function\n  | None -> None\n  | Some (Type_annot s) -> Some (Var_annot s)\n\nlet var_to_field_annot : var_annot option -> field_annot option = function\n  | None -> None\n  | Some (Var_annot s) -> Some (Field_annot s)\n\nlet default_annot ~default = function None -> default | annot -> annot\n\nlet gen_access_annot :\n    var_annot option ->\n    ?default:field_annot option ->\n    field_annot option ->\n    var_annot option =\n fun value_annot ?(default = None) field_annot ->\n  match (value_annot, field_annot, default) with\n  | (None, None, _) | (Some _, None, None) -> None\n  | (None, Some (Field_annot f), _) -> Some (Var_annot f)\n  | (Some (Var_annot v), None, Some (Field_annot f)) ->\n      Some (Var_annot (Non_empty_string.cat2 v ~sep:\".\" f))\n  | (Some (Var_annot v), Some (Field_annot f), _) ->\n      Some (Var_annot (Non_empty_string.cat2 v ~sep:\".\" f))\n\nlet merge_type_annot :\n    legacy:bool ->\n    type_annot option ->\n    type_annot option ->\n    type_annot option tzresult =\n fun ~legacy annot1 annot2 ->\n  match (annot1, annot2) with\n  | (None, None) | (Some _, None) | (None, Some _) -> Result.return_none\n  | (Some (Type_annot a1), Some (Type_annot a2)) ->\n      if legacy || Non_empty_string.(a1 = a2) then ok annot1\n      else\n        error\n          (Inconsistent_annotations (\":\" ^ (a1 :> string), \":\" ^ (a2 :> string)))\n\nlet merge_field_annot :\n    legacy:bool ->\n    field_annot option ->\n    field_annot option ->\n    field_annot option tzresult =\n fun ~legacy annot1 annot2 ->\n  match (annot1, annot2) with\n  | (None, None) | (Some _, None) | (None, Some _) -> Result.return_none\n  | (Some (Field_annot a1), Some (Field_annot a2)) ->\n      if legacy || Non_empty_string.(a1 = a2) then ok annot1\n      else\n        error\n          (Inconsistent_annotations (\"%\" ^ (a1 :> string), \"%\" ^ (a2 :> string)))\n\nlet merge_var_annot : var_annot option -> var_annot option -> var_annot option =\n fun annot1 annot2 ->\n  match (annot1, annot2) with\n  | (None, None) | (Some _, None) | (None, Some _) -> None\n  | (Some (Var_annot a1), Some (Var_annot a2)) ->\n      if Non_empty_string.(a1 = a2) then annot1 else None\n\nlet error_unexpected_annot loc annot =\n  match annot with\n  | [] -> Result.return_unit\n  | _ :: _ -> error (Unexpected_annotation loc)\n\n(* Check that the predicate p holds on all s.[k] for k >= i *)\nlet string_iter p s i =\n  let len = String.length s in\n  let rec aux i =\n    if Compare.Int.(i >= len) then Result.return_unit\n    else p s.[i] >>? fun () -> aux (i + 1)\n  in\n  aux i\n\nlet is_allowed_char = function\n  | 'a' .. 'z' | 'A' .. 'Z' | '_' | '.' | '%' | '@' | '0' .. '9' -> true\n  | _ -> false\n\n(* Valid annotation characters as defined by the allowed_annot_char function from lib_micheline/micheline_parser *)\nlet check_char loc c =\n  if is_allowed_char c then Result.return_unit\n  else error (Unexpected_annotation loc)\n\n(* This constant is defined in lib_micheline/micheline_parser which is not available in the environment. *)\nlet max_annot_length = 255\n\ntype annot_opt =\n  | Field_annot_opt of Non_empty_string.t option\n  | Type_annot_opt of Non_empty_string.t option\n  | Var_annot_opt of Non_empty_string.t option\n\nlet percent = Non_empty_string.of_string_exn \"%\"\n\nlet percent_percent = Non_empty_string.of_string_exn \"%%\"\n\nlet at = Non_empty_string.of_string_exn \"@\"\n\nlet parse_annots loc ?(allow_special_var = false) ?(allow_special_field = false)\n    l =\n  (* allow empty annotations as wildcards but otherwise only accept\n     annotations that start with [a-zA-Z_] *)\n  let sub_or_wildcard wrap s =\n    match Non_empty_string.of_string s with\n    | None -> ok @@ wrap None\n    | Some s -> (\n        match (s :> string).[0] with\n        | 'a' .. 'z' | 'A' .. 'Z' | '_' | '0' .. '9' ->\n            (* check that all characters are valid*)\n            string_iter (check_char loc) (s :> string) 1 >>? fun () ->\n            ok @@ wrap (Some s)\n        | _ -> error (Unexpected_annotation loc))\n  in\n  List.map_e\n    (function\n      | \"@%\" when allow_special_var -> ok @@ Var_annot_opt (Some percent)\n      | \"@%%\" when allow_special_var ->\n          ok @@ Var_annot_opt (Some percent_percent)\n      | \"%@\" when allow_special_field -> ok @@ Field_annot_opt (Some at)\n      | s -> (\n          let len = String.length s in\n          if Compare.Int.(len = 0 || len > max_annot_length) then\n            error (Unexpected_annotation loc)\n          else\n            let rest = String.sub s 1 (len - 1) in\n            match s.[0] with\n            | ':' -> sub_or_wildcard (fun a -> Type_annot_opt a) rest\n            | '@' -> sub_or_wildcard (fun a -> Var_annot_opt a) rest\n            | '%' -> sub_or_wildcard (fun a -> Field_annot_opt a) rest\n            | _ -> error (Unexpected_annotation loc)))\n    l\n\nlet opt_var_of_var_opt = function None -> None | Some a -> Some (Var_annot a)\n\nlet opt_field_of_field_opt = function\n  | None -> None\n  | Some a -> Some (Field_annot a)\n\nlet opt_type_of_type_opt = function\n  | None -> None\n  | Some a -> Some (Type_annot a)\n\nlet classify_annot loc l :\n    (var_annot option list * type_annot option list * field_annot option list)\n    tzresult =\n  try\n    let (_, rv, _, rt, _, rf) =\n      List.fold_left\n        (fun (in_v, rv, in_t, rt, in_f, rf) a ->\n          match (a, in_v, rv, in_t, rt, in_f, rf) with\n          | (Var_annot_opt a, true, _, _, _, _, _)\n          | (Var_annot_opt a, false, [], _, _, _, _) ->\n              (true, opt_var_of_var_opt a :: rv, false, rt, false, rf)\n          | (Type_annot_opt a, _, _, true, _, _, _)\n          | (Type_annot_opt a, _, _, false, [], _, _) ->\n              (false, rv, true, opt_type_of_type_opt a :: rt, false, rf)\n          | (Field_annot_opt a, _, _, _, _, true, _)\n          | (Field_annot_opt a, _, _, _, _, false, []) ->\n              (false, rv, false, rt, true, opt_field_of_field_opt a :: rf)\n          | _ -> raise Exit)\n        (false, [], false, [], false, [])\n        l\n    in\n    ok (List.rev rv, List.rev rt, List.rev rf)\n  with Exit -> error (Ungrouped_annotations loc)\n\nlet get_one_annot loc = function\n  | [] -> Result.return_none\n  | [a] -> ok a\n  | _ -> error (Unexpected_annotation loc)\n\nlet get_two_annot loc = function\n  | [] -> ok (None, None)\n  | [a] -> ok (a, None)\n  | [a; b] -> ok (a, b)\n  | _ -> error (Unexpected_annotation loc)\n\nlet parse_type_annot :\n    Script.location -> string list -> type_annot option tzresult =\n fun loc annot ->\n  parse_annots loc annot >>? classify_annot loc >>? fun (vars, types, fields) ->\n  error_unexpected_annot loc vars >>? fun () ->\n  error_unexpected_annot loc fields >>? fun () -> get_one_annot loc types\n\nlet parse_composed_type_annot :\n    Script.location ->\n    string list ->\n    (type_annot option * field_annot option * field_annot option) tzresult =\n fun loc annot ->\n  parse_annots loc annot >>? classify_annot loc >>? fun (vars, types, fields) ->\n  error_unexpected_annot loc vars >>? fun () ->\n  get_one_annot loc types >>? fun t ->\n  get_two_annot loc fields >|? fun (f1, f2) -> (t, f1, f2)\n\nlet parse_field_annot :\n    Script.location -> string list -> field_annot option tzresult =\n fun loc annot ->\n  parse_annots loc annot >>? classify_annot loc >>? fun (vars, types, fields) ->\n  error_unexpected_annot loc vars >>? fun () ->\n  error_unexpected_annot loc types >>? fun () -> get_one_annot loc fields\n\nlet extract_field_annot :\n    Script.node -> (Script.node * field_annot option) tzresult = function\n  | Prim (loc, prim, args, annot) ->\n      let rec extract_first acc = function\n        | [] -> (None, annot)\n        | s :: rest ->\n            if Compare.Int.(String.length s > 0) && Compare.Char.(s.[0] = '%')\n            then (Some s, List.rev_append acc rest)\n            else extract_first (s :: acc) rest\n      in\n      let (field_annot, annot) = extract_first [] annot in\n      (match field_annot with\n      | None -> Result.return_none\n      | Some field_annot -> parse_field_annot loc [field_annot])\n      >|? fun field_annot -> (Prim (loc, prim, args, annot), field_annot)\n  | expr -> ok (expr, None)\n\nlet check_correct_field :\n    field_annot option -> field_annot option -> unit tzresult =\n fun f1 f2 ->\n  match (f1, f2) with\n  | (None, _) | (_, None) -> Result.return_unit\n  | (Some (Field_annot s1), Some (Field_annot s2)) ->\n      if Non_empty_string.(s1 = s2) then Result.return_unit\n      else\n        error\n          (Inconsistent_field_annotations\n             (\"%\" ^ (s1 :> string), \"%\" ^ (s2 :> string)))\n\nlet parse_var_annot :\n    Script.location ->\n    ?default:var_annot option ->\n    string list ->\n    var_annot option tzresult =\n fun loc ?default annot ->\n  parse_annots loc annot >>? classify_annot loc >>? fun (vars, types, fields) ->\n  error_unexpected_annot loc types >>? fun () ->\n  error_unexpected_annot loc fields >>? fun () ->\n  get_one_annot loc vars >|? function\n  | Some _ as a -> a\n  | None -> ( match default with Some a -> a | None -> None)\n\nlet split_last_dot = function\n  | None -> (None, None)\n  | Some (Field_annot s) -> (\n      match Non_empty_string.split_on_last '.' s with\n      | Some (s1, s2) ->\n          let f =\n            match (s2 :> string) with\n            | \"car\" | \"cdr\" -> None\n            | _ -> Some (Field_annot s2)\n          in\n          (Some (Var_annot s1), f)\n      | None -> (None, Some (Field_annot s)))\n\nlet split_if_special ~loc ~if_special v f =\n  match f with\n  | Some (Field_annot fa) when Non_empty_string.(fa = at) -> (\n      match if_special with\n      | Some special_var -> ok @@ split_last_dot special_var\n      | None -> error (Unexpected_annotation loc))\n  | _ -> ok (v, f)\n\nlet common_prefix v1 v2 =\n  match (v1, v2) with\n  | (Some (Var_annot s1), Some (Var_annot s2)) when Non_empty_string.(s1 = s2)\n    ->\n      v1\n  | (Some _, None) -> v1\n  | (None, Some _) -> v2\n  | (_, _) -> None\n\nlet parse_constr_annot :\n    Script.location ->\n    ?if_special_first:field_annot option ->\n    ?if_special_second:field_annot option ->\n    string list ->\n    (var_annot option\n    * type_annot option\n    * field_annot option\n    * field_annot option)\n    tzresult =\n fun loc ?if_special_first ?if_special_second annot ->\n  parse_annots ~allow_special_field:true loc annot >>? classify_annot loc\n  >>? fun (vars, types, fields) ->\n  get_one_annot loc vars >>? fun v ->\n  get_one_annot loc types >>? fun t ->\n  get_two_annot loc fields >>? fun (f1, f2) ->\n  split_if_special ~loc ~if_special:if_special_first v f1 >>? fun (v1, f1) ->\n  split_if_special ~loc ~if_special:if_special_second v f2 >|? fun (v2, f2) ->\n  let v = match v with None -> common_prefix v1 v2 | Some _ -> v in\n  (v, t, f1, f2)\n\nlet parse_two_var_annot :\n    Script.location ->\n    string list ->\n    (var_annot option * var_annot option) tzresult =\n fun loc annot ->\n  parse_annots loc annot >>? classify_annot loc >>? fun (vars, types, fields) ->\n  error_unexpected_annot loc types >>? fun () ->\n  error_unexpected_annot loc fields >>? fun () -> get_two_annot loc vars\n\nlet var_annot_from_special :\n    field_name:field_annot option ->\n    default:var_annot option ->\n    value_annot:var_annot option ->\n    var_annot option ->\n    var_annot option =\n fun ~field_name ~default ~value_annot v ->\n  match v with\n  | Some (Var_annot va) -> (\n      match (va :> string) with\n      | \"%\" -> field_to_var_annot field_name\n      | \"%%\" -> default\n      | _ -> v)\n  | None -> value_annot\n\nlet parse_destr_annot :\n    Script.location ->\n    string list ->\n    default_accessor:field_annot option ->\n    field_name:field_annot option ->\n    pair_annot:var_annot option ->\n    value_annot:var_annot option ->\n    (var_annot option * field_annot option) tzresult =\n fun loc annot ~default_accessor ~field_name ~pair_annot ~value_annot ->\n  parse_annots loc ~allow_special_var:true annot >>? classify_annot loc\n  >>? fun (vars, types, fields) ->\n  error_unexpected_annot loc types >>? fun () ->\n  get_one_annot loc vars >>? fun v ->\n  get_one_annot loc fields >|? fun f ->\n  let default =\n    gen_access_annot pair_annot field_name ~default:default_accessor\n  in\n  let v = var_annot_from_special ~field_name ~default ~value_annot v in\n  (v, f)\n\nlet parse_unpair_annot :\n    Script.location ->\n    string list ->\n    field_name_car:field_annot option ->\n    field_name_cdr:field_annot option ->\n    pair_annot:var_annot option ->\n    value_annot_car:var_annot option ->\n    value_annot_cdr:var_annot option ->\n    (var_annot option\n    * var_annot option\n    * field_annot option\n    * field_annot option)\n    tzresult =\n fun loc\n     annot\n     ~field_name_car\n     ~field_name_cdr\n     ~pair_annot\n     ~value_annot_car\n     ~value_annot_cdr ->\n  parse_annots loc ~allow_special_var:true annot >>? classify_annot loc\n  >>? fun (vars, types, fields) ->\n  error_unexpected_annot loc types >>? fun () ->\n  get_two_annot loc vars >>? fun (vcar, vcdr) ->\n  get_two_annot loc fields >|? fun (fcar, fcdr) ->\n  let default_car =\n    gen_access_annot pair_annot field_name_car ~default:default_car_annot\n  in\n  let default_cdr =\n    gen_access_annot pair_annot field_name_cdr ~default:default_cdr_annot\n  in\n  let vcar =\n    var_annot_from_special\n      ~field_name:field_name_car\n      ~default:default_car\n      ~value_annot:value_annot_car\n      vcar\n  in\n  let vcdr =\n    var_annot_from_special\n      ~field_name:field_name_cdr\n      ~default:default_cdr\n      ~value_annot:value_annot_cdr\n      vcdr\n  in\n  (vcar, vcdr, fcar, fcdr)\n\nlet parse_entrypoint_annot :\n    Script.location ->\n    ?default:var_annot option ->\n    string list ->\n    (var_annot option * field_annot option) tzresult =\n fun loc ?default annot ->\n  parse_annots loc annot >>? classify_annot loc >>? fun (vars, types, fields) ->\n  error_unexpected_annot loc types >>? fun () ->\n  get_one_annot loc fields >>? fun f ->\n  get_one_annot loc vars >|? function\n  | Some _ as a -> (a, f)\n  | None -> ( match default with Some a -> (a, f) | None -> (None, f))\n\nlet parse_var_type_annot :\n    Script.location ->\n    string list ->\n    (var_annot option * type_annot option) tzresult =\n fun loc annot ->\n  parse_annots loc annot >>? classify_annot loc >>? fun (vars, types, fields) ->\n  error_unexpected_annot loc fields >>? fun () ->\n  get_one_annot loc vars >>? fun v ->\n  get_one_annot loc types >|? fun t -> (v, t)\n" ;
                } ;
                { name = "Script_typed_ir" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\nopen Script_int\nopen Script_ir_annot\n\ntype step_constants = {\n  source : Contract.t;\n  payer : Contract.t;\n  self : Contract.t;\n  amount : Tez.t;\n  chain_id : Chain_id.t;\n  now : Script_timestamp.t;\n  level : Script_int.n Script_int.num;\n}\n\n(* Preliminary definitions. *)\n\ntype never = |\n\ntype address = Contract.t * string\n\ntype ('a, 'b) pair = 'a * 'b\n\ntype ('a, 'b) union = L of 'a | R of 'b\n\ntype operation = packed_internal_operation * Lazy_storage.diffs option\n\ntype 'a ticket = {ticketer : Contract.t; contents : 'a; amount : n num}\n\ntype empty_cell = EmptyCell\n\ntype end_of_stack = empty_cell * empty_cell\n\nmodule Type_size : sig\n  type 'a t\n\n  val merge : 'a t -> 'b t -> 'a t tzresult\n\n  val to_int : 'a t -> Saturation_repr.mul_safe Saturation_repr.t\nend\n\ntype 'a ty_metadata = {annot : type_annot option; size : 'a Type_size.t}\n\ntype _ comparable_ty =\n  | Unit_key : unit ty_metadata -> unit comparable_ty\n  | Never_key : never ty_metadata -> never comparable_ty\n  | Int_key : z num ty_metadata -> z num comparable_ty\n  | Nat_key : n num ty_metadata -> n num comparable_ty\n  | Signature_key : signature ty_metadata -> signature comparable_ty\n  | String_key : Script_string.t ty_metadata -> Script_string.t comparable_ty\n  | Bytes_key : Bytes.t ty_metadata -> Bytes.t comparable_ty\n  | Mutez_key : Tez.t ty_metadata -> Tez.t comparable_ty\n  | Bool_key : bool ty_metadata -> bool comparable_ty\n  | Key_hash_key : public_key_hash ty_metadata -> public_key_hash comparable_ty\n  | Key_key : public_key ty_metadata -> public_key comparable_ty\n  | Timestamp_key :\n      Script_timestamp.t ty_metadata\n      -> Script_timestamp.t comparable_ty\n  | Chain_id_key : Chain_id.t ty_metadata -> Chain_id.t comparable_ty\n  | Address_key : address ty_metadata -> address comparable_ty\n  | Pair_key :\n      ('a comparable_ty * field_annot option)\n      * ('b comparable_ty * field_annot option)\n      * ('a, 'b) pair ty_metadata\n      -> ('a, 'b) pair comparable_ty\n  | Union_key :\n      ('a comparable_ty * field_annot option)\n      * ('b comparable_ty * field_annot option)\n      * ('a, 'b) union ty_metadata\n      -> ('a, 'b) union comparable_ty\n  | Option_key :\n      'v comparable_ty * 'v option ty_metadata\n      -> 'v option comparable_ty\n\nval unit_key : annot:type_annot option -> unit comparable_ty\n\nval never_key : annot:type_annot option -> never comparable_ty\n\nval int_key : annot:type_annot option -> z num comparable_ty\n\nval nat_key : annot:type_annot option -> n num comparable_ty\n\nval signature_key : annot:type_annot option -> signature comparable_ty\n\nval string_key : annot:type_annot option -> Script_string.t comparable_ty\n\nval bytes_key : annot:type_annot option -> Bytes.t comparable_ty\n\nval mutez_key : annot:type_annot option -> Tez.t comparable_ty\n\nval bool_key : annot:type_annot option -> bool comparable_ty\n\nval key_hash_key : annot:type_annot option -> public_key_hash comparable_ty\n\nval key_key : annot:type_annot option -> public_key comparable_ty\n\nval timestamp_key : annot:type_annot option -> Script_timestamp.t comparable_ty\n\nval chain_id_key : annot:type_annot option -> Chain_id.t comparable_ty\n\nval address_key : annot:type_annot option -> address comparable_ty\n\nval pair_key :\n  Script.location ->\n  'a comparable_ty * field_annot option ->\n  'b comparable_ty * field_annot option ->\n  annot:type_annot option ->\n  ('a, 'b) pair comparable_ty tzresult\n\nval pair_3_key :\n  Script.location ->\n  'a comparable_ty * field_annot option ->\n  'b comparable_ty * field_annot option ->\n  'c comparable_ty * field_annot option ->\n  ('a, ('b, 'c) pair) pair comparable_ty tzresult\n\nval union_key :\n  Script.location ->\n  'a comparable_ty * field_annot option ->\n  'b comparable_ty * field_annot option ->\n  annot:type_annot option ->\n  ('a, 'b) union comparable_ty tzresult\n\nval option_key :\n  Script.location ->\n  'v comparable_ty ->\n  annot:type_annot option ->\n  'v option comparable_ty tzresult\n\nmodule type Boxed_set_OPS = sig\n  type t\n\n  type elt\n\n  val empty : t\n\n  val add : elt -> t -> t\n\n  val mem : elt -> t -> bool\n\n  val remove : elt -> t -> t\n\n  val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a\nend\n\nmodule type Boxed_set = sig\n  type elt\n\n  val elt_ty : elt comparable_ty\n\n  module OPS : Boxed_set_OPS with type elt = elt\n\n  val boxed : OPS.t\n\n  val size : int\nend\n\ntype 'elt set = (module Boxed_set with type elt = 'elt)\n\nmodule type Boxed_map_OPS = sig\n  type t\n\n  type key\n\n  type value\n\n  val empty : t\n\n  val add : key -> value -> t -> t\n\n  val remove : key -> t -> t\n\n  val find : key -> t -> value option\n\n  val fold : (key -> value -> 'a -> 'a) -> t -> 'a -> 'a\nend\n\nmodule type Boxed_map = sig\n  type key\n\n  type value\n\n  val key_ty : key comparable_ty\n\n  module OPS : Boxed_map_OPS with type key = key and type value = value\n\n  val boxed : OPS.t\n\n  val size : int\nend\n\ntype ('key, 'value) map =\n  (module Boxed_map with type key = 'key and type value = 'value)\n\nmodule Big_map_overlay : Map.S with type key = Script_expr_hash.t\n\ntype ('key, 'value) big_map_overlay = {\n  map : ('key * 'value option) Big_map_overlay.t;\n  size : int;\n}\n\ntype 'elt boxed_list = {elements : 'elt list; length : int}\n\nmodule SMap : Map.S with type key = Script_string.t\n\ntype view = {\n  input_ty : Script.node;\n  output_ty : Script.node;\n  view_code : Script.node;\n}\n\ntype ('arg, 'storage) script = {\n  code : (('arg, 'storage) pair, (operation boxed_list, 'storage) pair) lambda;\n  arg_type : 'arg ty;\n  storage : 'storage;\n  storage_type : 'storage ty;\n  views : view SMap.t;\n  root_name : field_annot option;\n  code_size : Cache_memory_helpers.sint;\n}\n\n(* ---- Instructions --------------------------------------------------------*)\n\n(*\n\n   The instructions of Michelson are represented in the following\n   Generalized Algebraic Datatypes.\n\n   There are three important aspects in that type declaration.\n\n   First, we follow a tagless approach for values: they are directly\n   represented as OCaml values. This reduces the computational cost of\n   interpretation because there is no need to check the shape of a\n   value before applying an operation to it. To achieve that, the GADT\n   encodes the typing rules of the Michelson programming\n   language. This static information is sufficient for the typechecker\n   to justify the absence of runtime checks.  As a bonus, it also\n   ensures that well-typed Michelson programs cannot go wrong: if the\n   interpreter typechecks then we have the static guarantee that no\n   stack underflow or type error can occur at runtime.\n\n   Second, we maintain the invariant that the stack type always has a\n   distinguished topmost element. This invariant is important to\n   implement the stack as an accumulator followed by a linked list of\n   cells, a so-called A-Stack. This representation is considered in\n   the literature[1] as an efficient representation of the stack for a\n   stack-based abstract machine, mainly because this opens the\n   opportunity for the accumulator to be stored in a hardware\n   register. In the GADT, this invariant is encoded by representing\n   the stack type using two parameters instead of one: the first one\n   is the type of the accumulator while the second is the type of the\n   rest of the stack.\n\n   Third, in this representation, each instruction embeds its\n   potential successor instructions in the control flow. This design\n   choice permits an efficient implementation of the continuation\n   stack in the interpreter. Assigning a precise type to this kind of\n   instruction which is a cell in a linked list of instructions is\n   similar to the typing of delimited continuations: we need to give a\n   type to the stack ['before] the execution of the instruction, a\n   type to the stack ['after] the execution of the instruction and\n   before the execution of the next, and a type for the [`result]ing\n   stack type after the execution of the whole chain of instructions.\n\n   Combining these three aspects, the type [kinstr] needs four\n   parameters:\n\n   ('before_top, 'before, 'result_top, 'result) kinstr\n\n   Notice that we could have chosen to only give two parameters to\n   [kinstr] by manually enforcing each argument to be a pair but this\n   is error-prone: with four parameters, this constraint is enforced\n   by the arity of the type constructor itself.\n\n   Hence, an instruction which has a successor instruction enjoys a\n   type of the form:\n\n   ... * ('after_top, 'after, 'result_top, 'result) kinstr * ... ->\n   ('before_top, 'before, 'result_top, 'result) kinstr\n\n   where ['before_top] and ['before] are the types of the stack top\n   and rest before the instruction chain, ['after_top] and ['after]\n   are the types of the stack top and rest after the instruction\n   chain, and ['result_top] and ['result] are the types of the stack\n   top and rest after the instruction chain. The [IHalt] instruction\n   ends a sequence of instructions and has no successor, as shown by\n   its type:\n\n   IHalt : ('a, 's) kinfo -> ('a, 's, 'a, 's) kinstr\n\n   Each instruction is decorated by some metadata (typically to hold\n   locations). The type for these metadata is [kinfo]: such a value is\n   only used for logging and error reporting and has no impact on the\n   operational semantics.\n\n   Notations:\n   ----------\n\n   In the following declaration, we use 'a, 'b, 'c, 'd, ...  to assign\n   types to stack cell contents while we use 's, 't, 'u, 'v, ... to\n   assign types to stacks.\n\n   The types for the final result and stack rest of a whole sequence\n   of instructions are written 'r and 'f (standing for \"result\" and\n   \"final stack rest\", respectively).\n\n   Instructions for internal execution steps\n   =========================================\n\n   Some instructions encoded in the following type are not present in the\n   source language. They only appear during evaluation to account for\n   intermediate execution steps. Indeed, since the interpreter follows\n   a small-step style, it is sometimes necessary to decompose a\n   source-level instruction (e.g. List_map) into several instructions\n   with smaller steps. This technique seems required to get an\n   efficient tail-recursive interpreter.\n\n   References\n   ==========\n   [1]: http://www.complang.tuwien.ac.at/projects/interpreters.html\n\n *)\nand ('before_top, 'before, 'result_top, 'result) kinstr =\n  (*\n     Stack\n     -----\n  *)\n  | IDrop :\n      ('a, 'b * 's) kinfo * ('b, 's, 'r, 'f) kinstr\n      -> ('a, 'b * 's, 'r, 'f) kinstr\n  | IDup :\n      ('a, 's) kinfo * ('a, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ISwap :\n      ('a, 'b * 's) kinfo * ('b, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 'b * 's, 'r, 'f) kinstr\n  | IConst :\n      ('a, 's) kinfo * 'ty * ('ty, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  (*\n     Pairs\n     -----\n  *)\n  | ICons_pair :\n      ('a, 'b * 's) kinfo * ('a * 'b, 's, 'r, 'f) kinstr\n      -> ('a, 'b * 's, 'r, 'f) kinstr\n  | ICar :\n      ('a * 'b, 's) kinfo * ('a, 's, 'r, 'f) kinstr\n      -> ('a * 'b, 's, 'r, 'f) kinstr\n  | ICdr :\n      ('a * 'b, 's) kinfo * ('b, 's, 'r, 'f) kinstr\n      -> ('a * 'b, 's, 'r, 'f) kinstr\n  | IUnpair :\n      ('a * 'b, 's) kinfo * ('a, 'b * 's, 'r, 'f) kinstr\n      -> ('a * 'b, 's, 'r, 'f) kinstr\n  (*\n     Options\n     -------\n   *)\n  | ICons_some :\n      ('v, 's) kinfo * ('v option, 's, 'r, 'f) kinstr\n      -> ('v, 's, 'r, 'f) kinstr\n  | ICons_none :\n      ('a, 's) kinfo * ('b option, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IIf_none : {\n      kinfo : ('a option, 'b * 's) kinfo;\n      branch_if_none : ('b, 's, 'c, 't) kinstr;\n      branch_if_some : ('a, 'b * 's, 'c, 't) kinstr;\n      k : ('c, 't, 'r, 'f) kinstr;\n    }\n      -> ('a option, 'b * 's, 'r, 'f) kinstr\n  | IOpt_map : {\n      kinfo : ('a option, 's) kinfo;\n      body : ('a, 's, 'b, 's) kinstr;\n      k : ('b option, 's, 'c, 't) kinstr;\n    }\n      -> ('a option, 's, 'c, 't) kinstr\n  (*\n     Unions\n     ------\n   *)\n  | ICons_left :\n      ('a, 's) kinfo * (('a, 'b) union, 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ICons_right :\n      ('b, 's) kinfo * (('a, 'b) union, 's, 'r, 'f) kinstr\n      -> ('b, 's, 'r, 'f) kinstr\n  | IIf_left : {\n      kinfo : (('a, 'b) union, 's) kinfo;\n      branch_if_left : ('a, 's, 'c, 't) kinstr;\n      branch_if_right : ('b, 's, 'c, 't) kinstr;\n      k : ('c, 't, 'r, 'f) kinstr;\n    }\n      -> (('a, 'b) union, 's, 'r, 'f) kinstr\n  (*\n     Lists\n     -----\n  *)\n  | ICons_list :\n      ('a, 'a boxed_list * 's) kinfo * ('a boxed_list, 's, 'r, 'f) kinstr\n      -> ('a, 'a boxed_list * 's, 'r, 'f) kinstr\n  | INil :\n      ('a, 's) kinfo * ('b boxed_list, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IIf_cons : {\n      kinfo : ('a boxed_list, 'b * 's) kinfo;\n      branch_if_cons : ('a, 'a boxed_list * ('b * 's), 'c, 't) kinstr;\n      branch_if_nil : ('b, 's, 'c, 't) kinstr;\n      k : ('c, 't, 'r, 'f) kinstr;\n    }\n      -> ('a boxed_list, 'b * 's, 'r, 'f) kinstr\n  | IList_map :\n      ('a boxed_list, 'c * 's) kinfo\n      * ('a, 'c * 's, 'b, 'c * 's) kinstr\n      * ('b boxed_list, 'c * 's, 'r, 'f) kinstr\n      -> ('a boxed_list, 'c * 's, 'r, 'f) kinstr\n  | IList_iter :\n      ('a boxed_list, 'b * 's) kinfo\n      * ('a, 'b * 's, 'b, 's) kinstr\n      * ('b, 's, 'r, 'f) kinstr\n      -> ('a boxed_list, 'b * 's, 'r, 'f) kinstr\n  | IList_size :\n      ('a boxed_list, 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> ('a boxed_list, 's, 'r, 'f) kinstr\n  (*\n    Sets\n    ----\n  *)\n  | IEmpty_set :\n      ('a, 's) kinfo * 'b comparable_ty * ('b set, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ISet_iter :\n      ('a set, 'b * 's) kinfo\n      * ('a, 'b * 's, 'b, 's) kinstr\n      * ('b, 's, 'r, 'f) kinstr\n      -> ('a set, 'b * 's, 'r, 'f) kinstr\n  | ISet_mem :\n      ('a, 'a set * 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> ('a, 'a set * 's, 'r, 'f) kinstr\n  | ISet_update :\n      ('a, bool * ('a set * 's)) kinfo * ('a set, 's, 'r, 'f) kinstr\n      -> ('a, bool * ('a set * 's), 'r, 'f) kinstr\n  | ISet_size :\n      ('a set, 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> ('a set, 's, 'r, 'f) kinstr\n  (*\n     Maps\n     ----\n   *)\n  | IEmpty_map :\n      ('a, 's) kinfo * 'b comparable_ty * (('b, 'c) map, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IMap_map :\n      (('a, 'b) map, 'd * 's) kinfo\n      * ('a * 'b, 'd * 's, 'c, 'd * 's) kinstr\n      * (('a, 'c) map, 'd * 's, 'r, 'f) kinstr\n      -> (('a, 'b) map, 'd * 's, 'r, 'f) kinstr\n  | IMap_iter :\n      (('a, 'b) map, 'c * 's) kinfo\n      * ('a * 'b, 'c * 's, 'c, 's) kinstr\n      * ('c, 's, 'r, 'f) kinstr\n      -> (('a, 'b) map, 'c * 's, 'r, 'f) kinstr\n  | IMap_mem :\n      ('a, ('a, 'b) map * 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> ('a, ('a, 'b) map * 's, 'r, 'f) kinstr\n  | IMap_get :\n      ('a, ('a, 'b) map * 's) kinfo * ('b option, 's, 'r, 'f) kinstr\n      -> ('a, ('a, 'b) map * 's, 'r, 'f) kinstr\n  | IMap_update :\n      ('a, 'b option * (('a, 'b) map * 's)) kinfo\n      * (('a, 'b) map, 's, 'r, 'f) kinstr\n      -> ('a, 'b option * (('a, 'b) map * 's), 'r, 'f) kinstr\n  | IMap_get_and_update :\n      ('a, 'b option * (('a, 'b) map * 's)) kinfo\n      * ('b option, ('a, 'b) map * 's, 'r, 'f) kinstr\n      -> ('a, 'b option * (('a, 'b) map * 's), 'r, 'f) kinstr\n  | IMap_size :\n      (('a, 'b) map, 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (('a, 'b) map, 's, 'r, 'f) kinstr\n  (*\n     Big maps\n     --------\n  *)\n  | IEmpty_big_map :\n      ('a, 's) kinfo\n      * 'b comparable_ty\n      * 'c ty\n      * (('b, 'c) big_map, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IBig_map_mem :\n      ('a, ('a, 'b) big_map * 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> ('a, ('a, 'b) big_map * 's, 'r, 'f) kinstr\n  | IBig_map_get :\n      ('a, ('a, 'b) big_map * 's) kinfo * ('b option, 's, 'r, 'f) kinstr\n      -> ('a, ('a, 'b) big_map * 's, 'r, 'f) kinstr\n  | IBig_map_update :\n      ('a, 'b option * (('a, 'b) big_map * 's)) kinfo\n      * (('a, 'b) big_map, 's, 'r, 'f) kinstr\n      -> ('a, 'b option * (('a, 'b) big_map * 's), 'r, 'f) kinstr\n  | IBig_map_get_and_update :\n      ('a, 'b option * (('a, 'b) big_map * 's)) kinfo\n      * ('b option, ('a, 'b) big_map * 's, 'r, 'f) kinstr\n      -> ('a, 'b option * (('a, 'b) big_map * 's), 'r, 'f) kinstr\n  (*\n     Strings\n     -------\n  *)\n  | IConcat_string :\n      (Script_string.t boxed_list, 's) kinfo\n      * (Script_string.t, 's, 'r, 'f) kinstr\n      -> (Script_string.t boxed_list, 's, 'r, 'f) kinstr\n  | IConcat_string_pair :\n      (Script_string.t, Script_string.t * 's) kinfo\n      * (Script_string.t, 's, 'r, 'f) kinstr\n      -> (Script_string.t, Script_string.t * 's, 'r, 'f) kinstr\n  | ISlice_string :\n      (n num, n num * (Script_string.t * 's)) kinfo\n      * (Script_string.t option, 's, 'r, 'f) kinstr\n      -> (n num, n num * (Script_string.t * 's), 'r, 'f) kinstr\n  | IString_size :\n      (Script_string.t, 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (Script_string.t, 's, 'r, 'f) kinstr\n  (*\n     Bytes\n     -----\n  *)\n  | IConcat_bytes :\n      (bytes boxed_list, 's) kinfo * (bytes, 's, 'r, 'f) kinstr\n      -> (bytes boxed_list, 's, 'r, 'f) kinstr\n  | IConcat_bytes_pair :\n      (bytes, bytes * 's) kinfo * (bytes, 's, 'r, 'f) kinstr\n      -> (bytes, bytes * 's, 'r, 'f) kinstr\n  | ISlice_bytes :\n      (n num, n num * (bytes * 's)) kinfo * (bytes option, 's, 'r, 'f) kinstr\n      -> (n num, n num * (bytes * 's), 'r, 'f) kinstr\n  | IBytes_size :\n      (bytes, 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (bytes, 's, 'r, 'f) kinstr\n  (*\n     Timestamps\n     ----------\n   *)\n  | IAdd_seconds_to_timestamp :\n      (z num, Script_timestamp.t * 's) kinfo\n      * (Script_timestamp.t, 's, 'r, 'f) kinstr\n      -> (z num, Script_timestamp.t * 's, 'r, 'f) kinstr\n  | IAdd_timestamp_to_seconds :\n      (Script_timestamp.t, z num * 's) kinfo\n      * (Script_timestamp.t, 's, 'r, 'f) kinstr\n      -> (Script_timestamp.t, z num * 's, 'r, 'f) kinstr\n  | ISub_timestamp_seconds :\n      (Script_timestamp.t, z num * 's) kinfo\n      * (Script_timestamp.t, 's, 'r, 'f) kinstr\n      -> (Script_timestamp.t, z num * 's, 'r, 'f) kinstr\n  | IDiff_timestamps :\n      (Script_timestamp.t, Script_timestamp.t * 's) kinfo\n      * (z num, 's, 'r, 'f) kinstr\n      -> (Script_timestamp.t, Script_timestamp.t * 's, 'r, 'f) kinstr\n  (*\n     Tez\n     ---\n    *)\n  | IAdd_tez :\n      (Tez.t, Tez.t * 's) kinfo * (Tez.t, 's, 'r, 'f) kinstr\n      -> (Tez.t, Tez.t * 's, 'r, 'f) kinstr\n  | ISub_tez :\n      (Tez.t, Tez.t * 's) kinfo * (Tez.t option, 's, 'r, 'f) kinstr\n      -> (Tez.t, Tez.t * 's, 'r, 'f) kinstr\n  | ISub_tez_legacy :\n      (Tez.t, Tez.t * 's) kinfo * (Tez.t, 's, 'r, 'f) kinstr\n      -> (Tez.t, Tez.t * 's, 'r, 'f) kinstr\n  | IMul_teznat :\n      (Tez.t, n num * 's) kinfo * (Tez.t, 's, 'r, 'f) kinstr\n      -> (Tez.t, n num * 's, 'r, 'f) kinstr\n  | IMul_nattez :\n      (n num, Tez.t * 's) kinfo * (Tez.t, 's, 'r, 'f) kinstr\n      -> (n num, Tez.t * 's, 'r, 'f) kinstr\n  | IEdiv_teznat :\n      (Tez.t, n num * 's) kinfo\n      * ((Tez.t, Tez.t) pair option, 's, 'r, 'f) kinstr\n      -> (Tez.t, n num * 's, 'r, 'f) kinstr\n  | IEdiv_tez :\n      (Tez.t, Tez.t * 's) kinfo\n      * ((n num, Tez.t) pair option, 's, 'r, 'f) kinstr\n      -> (Tez.t, Tez.t * 's, 'r, 'f) kinstr\n  (*\n     Booleans\n     --------\n   *)\n  | IOr :\n      (bool, bool * 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (bool, bool * 's, 'r, 'f) kinstr\n  | IAnd :\n      (bool, bool * 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (bool, bool * 's, 'r, 'f) kinstr\n  | IXor :\n      (bool, bool * 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (bool, bool * 's, 'r, 'f) kinstr\n  | INot :\n      (bool, 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (bool, 's, 'r, 'f) kinstr\n  (*\n     Integers\n     --------\n  *)\n  | IIs_nat :\n      (z num, 's) kinfo * (n num option, 's, 'r, 'f) kinstr\n      -> (z num, 's, 'r, 'f) kinstr\n  | INeg :\n      ('a num, 's) kinfo * (z num, 's, 'r, 'f) kinstr\n      -> ('a num, 's, 'r, 'f) kinstr\n  | IAbs_int :\n      (z num, 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (z num, 's, 'r, 'f) kinstr\n  | IInt_nat :\n      (n num, 's) kinfo * (z num, 's, 'r, 'f) kinstr\n      -> (n num, 's, 'r, 'f) kinstr\n  | IAdd_int :\n      ('a num, 'b num * 's) kinfo * (z num, 's, 'r, 'f) kinstr\n      -> ('a num, 'b num * 's, 'r, 'f) kinstr\n  | IAdd_nat :\n      (n num, n num * 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (n num, n num * 's, 'r, 'f) kinstr\n  | ISub_int :\n      ('a num, 'b num * 's) kinfo * (z num, 's, 'r, 'f) kinstr\n      -> ('a num, 'b num * 's, 'r, 'f) kinstr\n  | IMul_int :\n      ('a num, 'b num * 's) kinfo * (z num, 's, 'r, 'f) kinstr\n      -> ('a num, 'b num * 's, 'r, 'f) kinstr\n  | IMul_nat :\n      (n num, 'a num * 's) kinfo * ('a num, 's, 'r, 'f) kinstr\n      -> (n num, 'a num * 's, 'r, 'f) kinstr\n  | IEdiv_int :\n      ('a num, 'b num * 's) kinfo\n      * ((z num, n num) pair option, 's, 'r, 'f) kinstr\n      -> ('a num, 'b num * 's, 'r, 'f) kinstr\n  | IEdiv_nat :\n      (n num, 'a num * 's) kinfo\n      * (('a num, n num) pair option, 's, 'r, 'f) kinstr\n      -> (n num, 'a num * 's, 'r, 'f) kinstr\n  | ILsl_nat :\n      (n num, n num * 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (n num, n num * 's, 'r, 'f) kinstr\n  | ILsr_nat :\n      (n num, n num * 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (n num, n num * 's, 'r, 'f) kinstr\n  | IOr_nat :\n      (n num, n num * 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (n num, n num * 's, 'r, 'f) kinstr\n  | IAnd_nat :\n      (n num, n num * 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (n num, n num * 's, 'r, 'f) kinstr\n  | IAnd_int_nat :\n      (z num, n num * 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (z num, n num * 's, 'r, 'f) kinstr\n  | IXor_nat :\n      (n num, n num * 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (n num, n num * 's, 'r, 'f) kinstr\n  | INot_int :\n      ('a num, 's) kinfo * (z num, 's, 'r, 'f) kinstr\n      -> ('a num, 's, 'r, 'f) kinstr\n  (*\n     Control\n     -------\n  *)\n  | IIf : {\n      kinfo : (bool, 'a * 's) kinfo;\n      branch_if_true : ('a, 's, 'b, 'u) kinstr;\n      branch_if_false : ('a, 's, 'b, 'u) kinstr;\n      k : ('b, 'u, 'r, 'f) kinstr;\n    }\n      -> (bool, 'a * 's, 'r, 'f) kinstr\n  | ILoop :\n      (bool, 'a * 's) kinfo\n      * ('a, 's, bool, 'a * 's) kinstr\n      * ('a, 's, 'r, 'f) kinstr\n      -> (bool, 'a * 's, 'r, 'f) kinstr\n  | ILoop_left :\n      (('a, 'b) union, 's) kinfo\n      * ('a, 's, ('a, 'b) union, 's) kinstr\n      * ('b, 's, 'r, 'f) kinstr\n      -> (('a, 'b) union, 's, 'r, 'f) kinstr\n  | IDip :\n      ('a, 'b * 's) kinfo\n      * ('b, 's, 'c, 't) kinstr\n      * ('a, 'c * 't, 'r, 'f) kinstr\n      -> ('a, 'b * 's, 'r, 'f) kinstr\n  | IExec :\n      ('a, ('a, 'b) lambda * 's) kinfo * ('b, 's, 'r, 'f) kinstr\n      -> ('a, ('a, 'b) lambda * 's, 'r, 'f) kinstr\n  | IApply :\n      ('a, ('a * 'b, 'c) lambda * 's) kinfo\n      * 'a ty\n      * (('b, 'c) lambda, 's, 'r, 'f) kinstr\n      -> ('a, ('a * 'b, 'c) lambda * 's, 'r, 'f) kinstr\n  | ILambda :\n      ('a, 's) kinfo\n      * ('b, 'c) lambda\n      * (('b, 'c) lambda, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IFailwith :\n      ('a, 's) kinfo * Script.location * 'a ty\n      -> ('a, 's, 'r, 'f) kinstr\n  (*\n     Comparison\n     ----------\n  *)\n  | ICompare :\n      ('a, 'a * 's) kinfo * 'a comparable_ty * (z num, 's, 'r, 'f) kinstr\n      -> ('a, 'a * 's, 'r, 'f) kinstr\n  (*\n     Comparators\n     -----------\n  *)\n  | IEq :\n      (z num, 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (z num, 's, 'r, 'f) kinstr\n  | INeq :\n      (z num, 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (z num, 's, 'r, 'f) kinstr\n  | ILt :\n      (z num, 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (z num, 's, 'r, 'f) kinstr\n  | IGt :\n      (z num, 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (z num, 's, 'r, 'f) kinstr\n  | ILe :\n      (z num, 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (z num, 's, 'r, 'f) kinstr\n  | IGe :\n      (z num, 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (z num, 's, 'r, 'f) kinstr\n  (*\n     Protocol\n     --------\n  *)\n  | IAddress :\n      ('a typed_contract, 's) kinfo * (address, 's, 'r, 'f) kinstr\n      -> ('a typed_contract, 's, 'r, 'f) kinstr\n  | IContract :\n      (address, 's) kinfo\n      * 'a ty\n      * string\n      * ('a typed_contract option, 's, 'r, 'f) kinstr\n      -> (address, 's, 'r, 'f) kinstr\n  | IView :\n      ('a, address * 's) kinfo\n      * ('a, 'b) view_signature\n      * ('b option, 's, 'r, 'f) kinstr\n      -> ('a, address * 's, 'r, 'f) kinstr\n  | ITransfer_tokens :\n      ('a, Tez.t * ('a typed_contract * 's)) kinfo\n      * (operation, 's, 'r, 'f) kinstr\n      -> ('a, Tez.t * ('a typed_contract * 's), 'r, 'f) kinstr\n  | IImplicit_account :\n      (public_key_hash, 's) kinfo * (unit typed_contract, 's, 'r, 'f) kinstr\n      -> (public_key_hash, 's, 'r, 'f) kinstr\n  | ICreate_contract : {\n      kinfo : (public_key_hash option, Tez.t * ('a * 's)) kinfo;\n      storage_type : 'a ty;\n      arg_type : 'b ty;\n      lambda : ('b * 'a, operation boxed_list * 'a) lambda;\n      views : view SMap.t;\n      root_name : field_annot option;\n      k : (operation, address * 's, 'r, 'f) kinstr;\n    }\n      -> (public_key_hash option, Tez.t * ('a * 's), 'r, 'f) kinstr\n  | ISet_delegate :\n      (public_key_hash option, 's) kinfo * (operation, 's, 'r, 'f) kinstr\n      -> (public_key_hash option, 's, 'r, 'f) kinstr\n  | INow :\n      ('a, 's) kinfo * (Script_timestamp.t, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IBalance :\n      ('a, 's) kinfo * (Tez.t, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ILevel :\n      ('a, 's) kinfo * (n num, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ICheck_signature :\n      (public_key, signature * (bytes * 's)) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (public_key, signature * (bytes * 's), 'r, 'f) kinstr\n  | IHash_key :\n      (public_key, 's) kinfo * (public_key_hash, 's, 'r, 'f) kinstr\n      -> (public_key, 's, 'r, 'f) kinstr\n  | IPack :\n      ('a, 's) kinfo * 'a ty * (bytes, 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IUnpack :\n      (bytes, 's) kinfo * 'a ty * ('a option, 's, 'r, 'f) kinstr\n      -> (bytes, 's, 'r, 'f) kinstr\n  | IBlake2b :\n      (bytes, 's) kinfo * (bytes, 's, 'r, 'f) kinstr\n      -> (bytes, 's, 'r, 'f) kinstr\n  | ISha256 :\n      (bytes, 's) kinfo * (bytes, 's, 'r, 'f) kinstr\n      -> (bytes, 's, 'r, 'f) kinstr\n  | ISha512 :\n      (bytes, 's) kinfo * (bytes, 's, 'r, 'f) kinstr\n      -> (bytes, 's, 'r, 'f) kinstr\n  | ISource :\n      ('a, 's) kinfo * (address, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ISender :\n      ('a, 's) kinfo * (address, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ISelf :\n      ('a, 's) kinfo\n      * 'b ty\n      * string\n      * ('b typed_contract, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ISelf_address :\n      ('a, 's) kinfo * (address, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IAmount :\n      ('a, 's) kinfo * (Tez.t, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ISapling_empty_state :\n      ('a, 's) kinfo\n      * Sapling.Memo_size.t\n      * (Sapling.state, 'a * 's, 'b, 'f) kinstr\n      -> ('a, 's, 'b, 'f) kinstr\n  | ISapling_verify_update :\n      (Sapling.transaction, Sapling.state * 's) kinfo\n      * ((z num, Sapling.state) pair option, 's, 'r, 'f) kinstr\n      -> (Sapling.transaction, Sapling.state * 's, 'r, 'f) kinstr\n  | IDig :\n      ('a, 's) kinfo\n      (*\n         There is a prefix of length [n] common to the input stack\n         of type ['a * 's] and an intermediary stack of type ['d * 'u].\n      *)\n      * int\n        (*\n         Under this common prefix, the input stack has type ['b * 'c * 't] and\n         the intermediary stack type ['c * 't] because we removed the ['b] from\n         the input stack. This value of type ['b] is pushed on top of the\n         stack passed to the continuation.\n      *)\n      * ('b, 'c * 't, 'c, 't, 'a, 's, 'd, 'u) stack_prefix_preservation_witness\n      * ('b, 'd * 'u, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IDug :\n      ('a, 'b * 's) kinfo\n      (*\n         The input stack has type ['a * 'b * 's].\n\n         There is a prefix of length [n] common to its substack\n         of type ['b * 's] and the output stack of type ['d * 'u].\n      *)\n      * int\n        (*\n         Under this common prefix, the first stack has type ['c * 't]\n         and the second has type ['a * 'c * 't] because we have pushed\n         the topmost element of this input stack under the common prefix.\n      *)\n      * ('c, 't, 'a, 'c * 't, 'b, 's, 'd, 'u) stack_prefix_preservation_witness\n      * ('d, 'u, 'r, 'f) kinstr\n      -> ('a, 'b * 's, 'r, 'f) kinstr\n  | IDipn :\n      ('a, 's) kinfo\n      (*\n         The body of Dipn is applied under a prefix of size [n]...\n      *)\n      * int\n        (*\n         ... the relation between the types of the input and output stacks\n         is characterized by the following witness.\n         (See forthcoming comments about [stack_prefix_preservation_witness].)\n      *)\n      * ('c, 't, 'd, 'v, 'a, 's, 'b, 'u) stack_prefix_preservation_witness\n      * ('c, 't, 'd, 'v) kinstr\n      * ('b, 'u, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IDropn :\n      ('a, 's) kinfo\n      (*\n         The input stack enjoys a prefix of length [n]...\n      *)\n      * int\n        (*\n         ... and the following value witnesses that under this prefix\n         the stack has type ['b * 'u].\n      *)\n      * ('b, 'u, 'b, 'u, 'a, 's, 'a, 's) stack_prefix_preservation_witness\n      (*\n         This stack is passed to the continuation since we drop the\n         entire prefix.\n      *)\n      * ('b, 'u, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IChainId :\n      ('a, 's) kinfo * (Chain_id.t, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | INever : (never, 's) kinfo -> (never, 's, 'r, 'f) kinstr\n  | IVoting_power :\n      (public_key_hash, 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (public_key_hash, 's, 'r, 'f) kinstr\n  | ITotal_voting_power :\n      ('a, 's) kinfo * (n num, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IKeccak :\n      (bytes, 's) kinfo * (bytes, 's, 'r, 'f) kinstr\n      -> (bytes, 's, 'r, 'f) kinstr\n  | ISha3 :\n      (bytes, 's) kinfo * (bytes, 's, 'r, 'f) kinstr\n      -> (bytes, 's, 'r, 'f) kinstr\n  | IAdd_bls12_381_g1 :\n      (Bls12_381.G1.t, Bls12_381.G1.t * 's) kinfo\n      * (Bls12_381.G1.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.G1.t, Bls12_381.G1.t * 's, 'r, 'f) kinstr\n  | IAdd_bls12_381_g2 :\n      (Bls12_381.G2.t, Bls12_381.G2.t * 's) kinfo\n      * (Bls12_381.G2.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.G2.t, Bls12_381.G2.t * 's, 'r, 'f) kinstr\n  | IAdd_bls12_381_fr :\n      (Bls12_381.Fr.t, Bls12_381.Fr.t * 's) kinfo\n      * (Bls12_381.Fr.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.Fr.t, Bls12_381.Fr.t * 's, 'r, 'f) kinstr\n  | IMul_bls12_381_g1 :\n      (Bls12_381.G1.t, Bls12_381.Fr.t * 's) kinfo\n      * (Bls12_381.G1.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.G1.t, Bls12_381.Fr.t * 's, 'r, 'f) kinstr\n  | IMul_bls12_381_g2 :\n      (Bls12_381.G2.t, Bls12_381.Fr.t * 's) kinfo\n      * (Bls12_381.G2.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.G2.t, Bls12_381.Fr.t * 's, 'r, 'f) kinstr\n  | IMul_bls12_381_fr :\n      (Bls12_381.Fr.t, Bls12_381.Fr.t * 's) kinfo\n      * (Bls12_381.Fr.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.Fr.t, Bls12_381.Fr.t * 's, 'r, 'f) kinstr\n  | IMul_bls12_381_z_fr :\n      (Bls12_381.Fr.t, 'a num * 's) kinfo * (Bls12_381.Fr.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.Fr.t, 'a num * 's, 'r, 'f) kinstr\n  | IMul_bls12_381_fr_z :\n      ('a num, Bls12_381.Fr.t * 's) kinfo * (Bls12_381.Fr.t, 's, 'r, 'f) kinstr\n      -> ('a num, Bls12_381.Fr.t * 's, 'r, 'f) kinstr\n  | IInt_bls12_381_fr :\n      (Bls12_381.Fr.t, 's) kinfo * (z num, 's, 'r, 'f) kinstr\n      -> (Bls12_381.Fr.t, 's, 'r, 'f) kinstr\n  | INeg_bls12_381_g1 :\n      (Bls12_381.G1.t, 's) kinfo * (Bls12_381.G1.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.G1.t, 's, 'r, 'f) kinstr\n  | INeg_bls12_381_g2 :\n      (Bls12_381.G2.t, 's) kinfo * (Bls12_381.G2.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.G2.t, 's, 'r, 'f) kinstr\n  | INeg_bls12_381_fr :\n      (Bls12_381.Fr.t, 's) kinfo * (Bls12_381.Fr.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.Fr.t, 's, 'r, 'f) kinstr\n  | IPairing_check_bls12_381 :\n      ((Bls12_381.G1.t, Bls12_381.G2.t) pair boxed_list, 's) kinfo\n      * (bool, 's, 'r, 'f) kinstr\n      -> ((Bls12_381.G1.t, Bls12_381.G2.t) pair boxed_list, 's, 'r, 'f) kinstr\n  | IComb :\n      ('a, 's) kinfo\n      * int\n      * ('a * 's, 'b * 'u) comb_gadt_witness\n      * ('b, 'u, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IUncomb :\n      ('a, 's) kinfo\n      * int\n      * ('a * 's, 'b * 'u) uncomb_gadt_witness\n      * ('b, 'u, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IComb_get :\n      ('t, 's) kinfo\n      * int\n      * ('t, 'v) comb_get_gadt_witness\n      * ('v, 's, 'r, 'f) kinstr\n      -> ('t, 's, 'r, 'f) kinstr\n  | IComb_set :\n      ('a, 'b * 's) kinfo\n      * int\n      * ('a, 'b, 'c) comb_set_gadt_witness\n      * ('c, 's, 'r, 'f) kinstr\n      -> ('a, 'b * 's, 'r, 'f) kinstr\n  | IDup_n :\n      ('a, 's) kinfo\n      * int\n      * ('a * 's, 't) dup_n_gadt_witness\n      * ('t, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ITicket :\n      ('a, n num * 's) kinfo * ('a ticket, 's, 'r, 'f) kinstr\n      -> ('a, n num * 's, 'r, 'f) kinstr\n  | IRead_ticket :\n      ('a ticket, 's) kinfo\n      * (address * ('a * n num), 'a ticket * 's, 'r, 'f) kinstr\n      -> ('a ticket, 's, 'r, 'f) kinstr\n  | ISplit_ticket :\n      ('a ticket, (n num * n num) * 's) kinfo\n      * (('a ticket * 'a ticket) option, 's, 'r, 'f) kinstr\n      -> ('a ticket, (n num * n num) * 's, 'r, 'f) kinstr\n  | IJoin_tickets :\n      ('a ticket * 'a ticket, 's) kinfo\n      * 'a comparable_ty\n      * ('a ticket option, 's, 'r, 'f) kinstr\n      -> ('a ticket * 'a ticket, 's, 'r, 'f) kinstr\n  | IOpen_chest :\n      (Timelock.chest_key, Timelock.chest * (n num * 's)) kinfo\n      * ((bytes, bool) union, 's, 'r, 'f) kinstr\n      -> (Timelock.chest_key, Timelock.chest * (n num * 's), 'r, 'f) kinstr\n  (*\n\n     Internal control instructions\n     =============================\n\n     The following instructions are not available in the source language.\n     They are used by the internals of the interpreter.\n  *)\n  | IHalt : ('a, 's) kinfo -> ('a, 's, 'a, 's) kinstr\n  | ILog :\n      ('a, 's) kinfo * logging_event * logger * ('a, 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n\nand logging_event =\n  | LogEntry : logging_event\n  | LogExit : ('b, 'u) kinfo -> logging_event\n\nand ('arg, 'ret) lambda =\n  | Lam :\n      ('arg, end_of_stack, 'ret, end_of_stack) kdescr * Script.node\n      -> ('arg, 'ret) lambda\n[@@coq_force_gadt]\n\nand 'arg typed_contract = 'arg ty * address\n\n(*\n\n  Control stack\n  =============\n\n  The control stack is a list of [kinstr].\n\n  Since [kinstr] denotes a list  of instructions, the control stack\n  can be seen as a list of instruction sequences, each representing a\n  form of delimited continuation (i.e. a control stack fragment). The\n  [continuation] GADT ensures that the input and output stack types of the\n  continuations are consistent.\n\n  Loops have a special treatment because their control stack is reused\n  as is for the next iteration. This avoids the reallocation of a\n  control stack cell at each iteration.\n\n  To implement [step] as a tail-recursive function, we implement\n  higher-order iterators (i.e. MAPs and ITERs) using internal instructions\n. Roughly speaking, these instructions help in decomposing the execution\n  of [I f c] (where [I] is an higher-order iterator over a container [c])\n  into three phases: to start the iteration, to execute [f] if there are\n  elements to be processed in [c], and to loop.\n\n  Dip also has a dedicated constructor in the control stack.  This\n  allows the stack prefix to be restored after the execution of the\n  [Dip]'s body.\n\n  Following the same style as in [kinstr], [continuation] has four\n  arguments, two for each stack types. More precisely, with\n\n            [('bef_top, 'bef, 'aft_top, 'aft) continuation]\n\n  we encode the fact that the stack before executing the continuation\n  has type [('bef_top * 'bef)] and that the stack after this execution\n  has type [('aft_top * 'aft)].\n\n*)\nand (_, _, _, _) continuation =\n  (* This continuation returns immediately. *)\n  | KNil : ('r, 'f, 'r, 'f) continuation\n  (* This continuation starts with the next instruction to execute. *)\n  | KCons :\n      ('a, 's, 'b, 't) kinstr * ('b, 't, 'r, 'f) continuation\n      -> ('a, 's, 'r, 'f) continuation\n  (* This continuation represents a call frame: it stores the caller's\n     stack of type ['s] and the continuation which expects the callee's\n     result on top of the stack. *)\n  | KReturn :\n      's * ('a, 's, 'r, 'f) continuation\n      -> ('a, end_of_stack, 'r, 'f) continuation\n  (* This continuation is useful when stack head requires some wrapping or\n     unwrapping before it can be passed forward. For instance this continuation\n     is used after a [MAP] instruction applied to an option in order to wrap the\n     result back in a [Some] constructor.\n\n     /!\\ When using it, make sure the function runs in constant time or that gas\n     has been properly charged beforehand.\n     Also make sure it runs with a small, bounded stack.\n  *)\n  | KMap_head :\n      ('a -> 'b) * ('b, 's, 'r, 'f) continuation\n      -> ('a, 's, 'r, 'f) continuation\n  (* This continuation comes right after a [Dip i] to restore the topmost\n     element ['b] of the stack after having executed [i] in the substack\n     of type ['a * 's]. *)\n  | KUndip :\n      'b * ('b, 'a * 's, 'r, 'f) continuation\n      -> ('a, 's, 'r, 'f) continuation\n  (* This continuation is executed at each iteration of a loop with\n     a Boolean condition. *)\n  | KLoop_in :\n      ('a, 's, bool, 'a * 's) kinstr * ('a, 's, 'r, 'f) continuation\n      -> (bool, 'a * 's, 'r, 'f) continuation\n  (* This continuation is executed at each iteration of a loop with\n     a condition encoded by a sum type. *)\n  | KLoop_in_left :\n      ('a, 's, ('a, 'b) union, 's) kinstr * ('b, 's, 'r, 'f) continuation\n      -> (('a, 'b) union, 's, 'r, 'f) continuation\n  (* This continuation is executed at each iteration of a traversal.\n     (Used in List, Map and Set.) *)\n  | KIter :\n      ('a, 'b * 's, 'b, 's) kinstr * 'a list * ('b, 's, 'r, 'f) continuation\n      -> ('b, 's, 'r, 'f) continuation\n  (* This continuation represents each step of a List.map. *)\n  | KList_enter_body :\n      ('a, 'c * 's, 'b, 'c * 's) kinstr\n      * 'a list\n      * 'b list\n      * int\n      * ('b boxed_list, 'c * 's, 'r, 'f) continuation\n      -> ('c, 's, 'r, 'f) continuation\n  (* This continuation represents what is done after each step of a List.map. *)\n  | KList_exit_body :\n      ('a, 'c * 's, 'b, 'c * 's) kinstr\n      * 'a list\n      * 'b list\n      * int\n      * ('b boxed_list, 'c * 's, 'r, 'f) continuation\n      -> ('b, 'c * 's, 'r, 'f) continuation\n  (* This continuation represents each step of a Map.map. *)\n  | KMap_enter_body :\n      ('a * 'b, 'd * 's, 'c, 'd * 's) kinstr\n      * ('a * 'b) list\n      * ('a, 'c) map\n      * (('a, 'c) map, 'd * 's, 'r, 'f) continuation\n      -> ('d, 's, 'r, 'f) continuation\n  (* This continuation represents what is done after each step of a Map.map. *)\n  | KMap_exit_body :\n      ('a * 'b, 'd * 's, 'c, 'd * 's) kinstr\n      * ('a * 'b) list\n      * ('a, 'c) map\n      * 'a\n      * (('a, 'c) map, 'd * 's, 'r, 'f) continuation\n      -> ('c, 'd * 's, 'r, 'f) continuation\n  (* This continuation represents what is done after returning from a view.\n     It holds the original step constants value prior to entering the view. *)\n  | KView_exit :\n      step_constants * ('a, 's, 'r, 'f) continuation\n      -> ('a, 's, 'r, 'f) continuation\n  (* This continuation instruments the execution with a [logger]. *)\n  | KLog :\n      ('a, 's, 'r, 'f) continuation * logger\n      -> ('a, 's, 'r, 'f) continuation\n\n(*\n\n    Execution instrumentation\n    =========================\n\n   One can observe the context and the stack at some specific points\n   of an execution step. This feature is implemented by calling back\n   some [logging_function]s defined in a record of type [logger]\n   passed as argument to the step function.\n\n   A [logger] is typically embedded in an [KLog] continuation by the\n   client to trigger an evaluation instrumented with some logging. The\n   logger is then automatically propagated to the logging instruction\n   [ILog] as well as to any instructions that need to generate a\n   backtrace when it fails (e.g., [IFailwith], [IMul_teznat], ...).\n\n*)\nand ('a, 's, 'b, 'f, 'c, 'u) logging_function =\n  ('a, 's, 'b, 'f) kinstr ->\n  context ->\n  Script.location ->\n  ('c, 'u) stack_ty ->\n  'c * 'u ->\n  unit\n\nand execution_trace =\n  (Script.location * Gas.t * (Script.expr * string option) list) list\n\nand logger = {\n  log_interp : 'a 's 'b 'f 'c 'u. ('a, 's, 'b, 'f, 'c, 'u) logging_function;\n      (** [log_interp] is called at each call of the internal function\n          [interp]. [interp] is called when starting the interpretation of\n          a script and subsequently at each [Exec] instruction. *)\n  log_entry : 'a 's 'b 'f. ('a, 's, 'b, 'f, 'a, 's) logging_function;\n      (** [log_entry] is called {i before} executing each instruction but\n          {i after} gas for this instruction has been successfully\n          consumed. *)\n  log_control : 'a 's 'b 'f. ('a, 's, 'b, 'f) continuation -> unit;\n      (** [log_control] is called {i before} the interpretation of the\n          current continuation. *)\n  log_exit : 'a 's 'b 'f 'c 'u. ('a, 's, 'b, 'f, 'c, 'u) logging_function;\n      (** [log_exit] is called {i after} executing each instruction. *)\n  get_log : unit -> execution_trace option tzresult Lwt.t;\n      (** [get_log] allows to obtain an execution trace, if any was\n          produced. *)\n}\n\n(* ---- Auxiliary types -----------------------------------------------------*)\nand 'ty ty =\n  | Unit_t : unit ty_metadata -> unit ty\n  | Int_t : z num ty_metadata -> z num ty\n  | Nat_t : n num ty_metadata -> n num ty\n  | Signature_t : signature ty_metadata -> signature ty\n  | String_t : Script_string.t ty_metadata -> Script_string.t ty\n  | Bytes_t : Bytes.t ty_metadata -> bytes ty\n  | Mutez_t : Tez.t ty_metadata -> Tez.t ty\n  | Key_hash_t : public_key_hash ty_metadata -> public_key_hash ty\n  | Key_t : public_key ty_metadata -> public_key ty\n  | Timestamp_t : Script_timestamp.t ty_metadata -> Script_timestamp.t ty\n  | Address_t : address ty_metadata -> address ty\n  | Bool_t : bool ty_metadata -> bool ty\n  | Pair_t :\n      ('a ty * field_annot option * var_annot option)\n      * ('b ty * field_annot option * var_annot option)\n      * ('a, 'b) pair ty_metadata\n      -> ('a, 'b) pair ty\n  | Union_t :\n      ('a ty * field_annot option)\n      * ('b ty * field_annot option)\n      * ('a, 'b) union ty_metadata\n      -> ('a, 'b) union ty\n  | Lambda_t :\n      'arg ty * 'ret ty * ('arg, 'ret) lambda ty_metadata\n      -> ('arg, 'ret) lambda ty\n  | Option_t : 'v ty * 'v option ty_metadata -> 'v option ty\n  | List_t : 'v ty * 'v boxed_list ty_metadata -> 'v boxed_list ty\n  | Set_t : 'v comparable_ty * 'v set ty_metadata -> 'v set ty\n  | Map_t :\n      'k comparable_ty * 'v ty * ('k, 'v) map ty_metadata\n      -> ('k, 'v) map ty\n  | Big_map_t :\n      'k comparable_ty * 'v ty * ('k, 'v) big_map ty_metadata\n      -> ('k, 'v) big_map ty\n  | Contract_t :\n      'arg ty * 'arg typed_contract ty_metadata\n      -> 'arg typed_contract ty\n  | Sapling_transaction_t :\n      Sapling.Memo_size.t * Sapling.transaction ty_metadata\n      -> Sapling.transaction ty\n  | Sapling_state_t :\n      Sapling.Memo_size.t * Sapling.state ty_metadata\n      -> Sapling.state ty\n  | Operation_t : operation ty_metadata -> operation ty\n  | Chain_id_t : Chain_id.t ty_metadata -> Chain_id.t ty\n  | Never_t : never ty_metadata -> never ty\n  | Bls12_381_g1_t : Bls12_381.G1.t ty_metadata -> Bls12_381.G1.t ty\n  | Bls12_381_g2_t : Bls12_381.G2.t ty_metadata -> Bls12_381.G2.t ty\n  | Bls12_381_fr_t : Bls12_381.Fr.t ty_metadata -> Bls12_381.Fr.t ty\n  | Ticket_t : 'a comparable_ty * 'a ticket ty_metadata -> 'a ticket ty\n  | Chest_key_t : Timelock.chest_key ty_metadata -> Timelock.chest_key ty\n  | Chest_t : Timelock.chest ty_metadata -> Timelock.chest ty\n\nand ('top_ty, 'resty) stack_ty =\n  | Item_t :\n      'ty ty * ('ty2, 'rest) stack_ty * var_annot option\n      -> ('ty, 'ty2 * 'rest) stack_ty\n  | Bot_t : (empty_cell, empty_cell) stack_ty\n\nand ('key, 'value) big_map = {\n  id : Big_map.Id.t option;\n  diff : ('key, 'value) big_map_overlay;\n  key_type : 'key comparable_ty;\n  value_type : 'value ty;\n}\n\nand ('a, 's, 'r, 'f) kdescr = {\n  kloc : Script.location;\n  kbef : ('a, 's) stack_ty;\n  kaft : ('r, 'f) stack_ty;\n  kinstr : ('a, 's, 'r, 'f) kinstr;\n}\n\nand ('a, 's) kinfo = {iloc : Script.location; kstack_ty : ('a, 's) stack_ty}\n\n(*\n\n   Several instructions work under an arbitrary deep stack prefix\n   (e.g, IDipn, IDropn, etc). To convince the typechecker that\n   these instructions are well-typed, we must provide a witness\n   to statically characterize the relationship between the input\n   and the output stacks. The inhabitants of the following GADT\n   act as such witnesses.\n\n   More precisely, a value [w] of type\n\n   [(c, t, d, v, a, s, b, u) stack_prefix_preservation_witness]\n\n   proves that there is a common prefix between an input stack\n   of type [a * s] and an output stack of type [b * u]. This prefix\n   is as deep as the number of [KPrefix] application in [w]. When\n   used with an operation parameterized by a natural number [n]\n   characterizing the depth at which the operation must be applied,\n   [w] is the Peano encoding of [n].\n\n   When this prefix is removed from the two stacks, the input stack\n   has type [c * t] while the output stack has type [d * v].\n\n*)\nand (_, _, _, _, _, _, _, _) stack_prefix_preservation_witness =\n  | KPrefix :\n      ('y, 'u) kinfo\n      * ('c, 'v, 'd, 'w, 'x, 's, 'y, 'u) stack_prefix_preservation_witness\n      -> ( 'c,\n           'v,\n           'd,\n           'w,\n           'a,\n           'x * 's,\n           'a,\n           'y * 'u )\n         stack_prefix_preservation_witness\n  | KRest : ('a, 's, 'b, 'u, 'a, 's, 'b, 'u) stack_prefix_preservation_witness\n\nand ('before, 'after) comb_gadt_witness =\n  | Comb_one : ('a * ('x * 'before), 'a * ('x * 'before)) comb_gadt_witness\n  | Comb_succ :\n      ('before, 'b * 'after) comb_gadt_witness\n      -> ('a * 'before, ('a * 'b) * 'after) comb_gadt_witness\n\nand ('before, 'after) uncomb_gadt_witness =\n  | Uncomb_one : ('rest, 'rest) uncomb_gadt_witness\n  | Uncomb_succ :\n      ('b * 'before, 'after) uncomb_gadt_witness\n      -> (('a * 'b) * 'before, 'a * 'after) uncomb_gadt_witness\n\nand ('before, 'after) comb_get_gadt_witness =\n  | Comb_get_zero : ('b, 'b) comb_get_gadt_witness\n  | Comb_get_one : ('a * 'b, 'a) comb_get_gadt_witness\n  | Comb_get_plus_two :\n      ('before, 'after) comb_get_gadt_witness\n      -> ('a * 'before, 'after) comb_get_gadt_witness\n\nand ('value, 'before, 'after) comb_set_gadt_witness =\n  | Comb_set_zero : ('value, _, 'value) comb_set_gadt_witness\n  | Comb_set_one : ('value, 'hd * 'tl, 'value * 'tl) comb_set_gadt_witness\n  | Comb_set_plus_two :\n      ('value, 'before, 'after) comb_set_gadt_witness\n      -> ('value, 'a * 'before, 'a * 'after) comb_set_gadt_witness\n[@@coq_force_gadt]\n\n(*\n\n   [dup_n_gadt_witness ('s, 't)] ensures that there exists at least\n   [n] elements in ['s] and that the [n]-th element of ['s] is of type\n   ['t]. Here [n] follows Peano's encoding (0 and successor).\n   Besides, [0] corresponds to the topmost element of ['s].\n\n   This relational predicate is defined by induction on [n].\n\n*)\nand (_, _) dup_n_gadt_witness =\n  | Dup_n_zero : ('a * 'rest, 'a) dup_n_gadt_witness\n  | Dup_n_succ :\n      ('stack, 'b) dup_n_gadt_witness\n      -> ('a * 'stack, 'b) dup_n_gadt_witness\n\nand ('a, 'b) view_signature =\n  | View_signature of {\n      name : Script_string.t;\n      input_ty : 'a ty;\n      output_ty : 'b ty;\n    }\n\nval kinfo_of_kinstr : ('a, 's, 'b, 'f) kinstr -> ('a, 's) kinfo\n\ntype kinstr_rewritek = {\n  apply : 'b 'u 'r 'f. ('b, 'u, 'r, 'f) kinstr -> ('b, 'u, 'r, 'f) kinstr;\n}\n\nval kinstr_rewritek :\n  ('a, 's, 'r, 'f) kinstr -> kinstr_rewritek -> ('a, 's, 'r, 'f) kinstr\n\nval ty_size : 'a ty -> 'a Type_size.t\n\nval comparable_ty_size : 'a comparable_ty -> 'a Type_size.t\n\nval unit_t : annot:type_annot option -> unit ty\n\nval int_t : annot:type_annot option -> z num ty\n\nval nat_t : annot:type_annot option -> n num ty\n\nval signature_t : annot:type_annot option -> signature ty\n\nval string_t : annot:type_annot option -> Script_string.t ty\n\nval bytes_t : annot:type_annot option -> Bytes.t ty\n\nval mutez_t : annot:type_annot option -> Tez.t ty\n\nval key_hash_t : annot:type_annot option -> public_key_hash ty\n\nval key_t : annot:type_annot option -> public_key ty\n\nval timestamp_t : annot:type_annot option -> Script_timestamp.t ty\n\nval address_t : annot:type_annot option -> address ty\n\nval bool_t : annot:type_annot option -> bool ty\n\nval pair_t :\n  Script.location ->\n  'a ty * field_annot option * var_annot option ->\n  'b ty * field_annot option * var_annot option ->\n  annot:type_annot option ->\n  ('a, 'b) pair ty tzresult\n\nval union_t :\n  Script.location ->\n  'a ty * field_annot option ->\n  'b ty * field_annot option ->\n  annot:type_annot option ->\n  ('a, 'b) union ty tzresult\n\nval union_bytes_bool_t : (Bytes.t, bool) union ty\n\nval lambda_t :\n  Script.location ->\n  'arg ty ->\n  'ret ty ->\n  annot:type_annot option ->\n  ('arg, 'ret) lambda ty tzresult\n\nval option_t :\n  Script.location -> 'v ty -> annot:type_annot option -> 'v option ty tzresult\n\n(* the quote is used to indicate where the annotation will go *)\n\nval option_mutez'_t : _ ty_metadata -> Tez.t option ty\n\nval option_string'_t : _ ty_metadata -> Script_string.t option ty\n\nval option_bytes'_t : _ ty_metadata -> Bytes.t option ty\n\nval option_nat_t : n num option ty\n\nval option_pair_nat_nat_t : (n num, n num) pair option ty\n\nval option_pair_nat'_nat'_t : _ ty_metadata -> (n num, n num) pair option ty\n\nval option_pair_nat_mutez'_t : _ ty_metadata -> (n num, Tez.t) pair option ty\n\nval option_pair_mutez'_mutez'_t : _ ty_metadata -> (Tez.t, Tez.t) pair option ty\n\nval option_pair_int'_nat_t : _ ty_metadata -> (z num, n num) pair option ty\n\nval option_pair_int_nat'_t : _ ty_metadata -> (z num, n num) pair option ty\n\nval list_t :\n  Script.location ->\n  'v ty ->\n  annot:type_annot option ->\n  'v boxed_list ty tzresult\n\nval list_operation_t : operation boxed_list ty\n\nval set_t :\n  Script.location ->\n  'v comparable_ty ->\n  annot:type_annot option ->\n  'v set ty tzresult\n\nval map_t :\n  Script.location ->\n  'k comparable_ty ->\n  'v ty ->\n  annot:type_annot option ->\n  ('k, 'v) map ty tzresult\n\nval big_map_t :\n  Script.location ->\n  'k comparable_ty ->\n  'v ty ->\n  annot:type_annot option ->\n  ('k, 'v) big_map ty tzresult\n\nval contract_t :\n  Script.location ->\n  'arg ty ->\n  annot:type_annot option ->\n  'arg typed_contract ty tzresult\n\nval contract_unit_t : unit typed_contract ty\n\nval sapling_transaction_t :\n  memo_size:Sapling.Memo_size.t ->\n  annot:type_annot option ->\n  Sapling.transaction ty\n\nval sapling_state_t :\n  memo_size:Sapling.Memo_size.t -> annot:type_annot option -> Sapling.state ty\n\nval operation_t : annot:type_annot option -> operation ty\n\nval chain_id_t : annot:type_annot option -> Chain_id.t ty\n\nval never_t : annot:type_annot option -> never ty\n\nval bls12_381_g1_t : annot:type_annot option -> Bls12_381.G1.t ty\n\nval bls12_381_g2_t : annot:type_annot option -> Bls12_381.G2.t ty\n\nval bls12_381_fr_t : annot:type_annot option -> Bls12_381.Fr.t ty\n\nval ticket_t :\n  Script.location ->\n  'a comparable_ty ->\n  annot:type_annot option ->\n  'a ticket ty tzresult\n\nval chest_key_t : annot:type_annot option -> Timelock.chest_key ty\n\nval chest_t : annot:type_annot option -> Timelock.chest ty\n\n(**\n\n   The following functions named `X_traverse` for X in { kinstr, ty,\n   comparable_ty, value } provide tail recursive top down traversals\n   over the values of these types.\n\n   The traversal goes through a value and rewrites an accumulator\n   along the way starting from some [init]ial value for the\n   accumulator.\n\n   All these traversals follow the same recursion scheme: the\n   user-provided function is first called on the toplevel value, then\n   the traversal recurses on the direct subvalues of the same type.\n\n   Hence, the user-provided function must only compute the\n   contribution of the value on the accumulator minus the contribution\n   of its subvalues of the same type.\n\n*)\ntype 'a kinstr_traverse = {\n  apply : 'b 'u 'r 'f. 'a -> ('b, 'u, 'r, 'f) kinstr -> 'a;\n}\n\nval kinstr_traverse :\n  ('a, 'b, 'c, 'd) kinstr -> 'ret -> 'ret kinstr_traverse -> 'ret\n\ntype 'a ty_traverse = {\n  apply : 't. 'a -> 't ty -> 'a;\n  apply_comparable : 't. 'a -> 't comparable_ty -> 'a;\n}\n\nval comparable_ty_traverse : 'a comparable_ty -> 'r -> 'r ty_traverse -> 'r\n\nval ty_traverse : 'a ty -> 'r -> 'r ty_traverse -> 'r\n\ntype 'accu stack_ty_traverse = {\n  apply : 'ty 's. 'accu -> ('ty, 's) stack_ty -> 'accu;\n}\n\nval stack_ty_traverse : ('a, 's) stack_ty -> 'r -> 'r stack_ty_traverse -> 'r\n\ntype 'a value_traverse = {\n  apply : 't. 'a -> 't ty -> 't -> 'a;\n  apply_comparable : 't. 'a -> 't comparable_ty -> 't -> 'a;\n}\n\nval value_traverse :\n  ('t ty, 't comparable_ty) union -> 't -> 'r -> 'r value_traverse -> 'r\n\nval stack_top_ty : ('a, 'b * 's) stack_ty -> 'a ty\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\nopen Script_int\nopen Script_ir_annot\n\n(*\n\n    The step function of the interpreter is parametrized by a bunch of values called the step constants.\n    These values are indeed constants during the call of a smart contract with the notable exception of\n    the IView instruction which modifies `source`, `self`, and `amount` and the KView_exit continuation\n    which restores them.\n    ======================\n\n*)\ntype step_constants = {\n  source : Contract.t;\n      (** The address calling this contract, as returned by SENDER. *)\n  payer : Contract.t;\n      (** The address of the implicit account that initiated the chain of contract calls, as returned by SOURCE. *)\n  self : Contract.t;\n      (** The address of the contract being executed, as returned by SELF and SELF_ADDRESS.\n     Also used:\n     - as ticketer in TICKET\n     - as caller in VIEW, TRANSFER_TOKENS, and CREATE_CONTRACT *)\n  amount : Tez.t;\n      (** The amount of the current transaction, as returned by AMOUNT. *)\n  chain_id : Chain_id.t;\n      (** The chain id of the chain, as returned by CHAIN_ID. *)\n  now : Script_timestamp.t;\n      (** The earliest time at which the current block could have been timestamped, as returned by NOW. *)\n  level : Script_int.n Script_int.num;\n      (** The level of the current block, as returned by LEVEL. *)\n}\n\n(* Preliminary definitions. *)\n\ntype never = |\n\ntype address = Contract.t * string\n\ntype ('a, 'b) pair = 'a * 'b\n\ntype ('a, 'b) union = L of 'a | R of 'b\n\ntype operation = packed_internal_operation * Lazy_storage.diffs option\n\ntype 'a ticket = {ticketer : Contract.t; contents : 'a; amount : n num}\n\nmodule type TYPE_SIZE = sig\n  (* A type size represents the size of its type parameter.\n     This constraint is enforced inside this module (Script_type_ir), hence there\n     should be no way to construct a type size outside of it.\n\n     It allows keeping type metadata and types non-private.\n\n     This module is here because we want three levels of visibility over this\n     code:\n     - inside this submodule, we have [type 'a t = int]\n     - outside of [Script_typed_ir], the ['a t] type is abstract and we have\n        the invariant that whenever [x : 'a t] we have that [x] is exactly\n        the size of ['a].\n     - in-between (inside [Script_typed_ir] but outside the [Type_size]\n        submodule), the type is abstract but we have access to unsafe\n        constructors that can break the invariant.\n  *)\n  type 'a t\n\n  val merge : 'a t -> 'b t -> 'a t tzresult\n\n  val to_int : 'a t -> Saturation_repr.mul_safe Saturation_repr.t\n\n  (* Unsafe constructors, to be used only safely and inside this module *)\n\n  val one : _ t\n\n  val two : _ t\n\n  val three : _ t\n\n  val four : (_, _) pair option t\n\n  val compound1 : Script.location -> _ t -> _ t tzresult\n\n  val compound2 : Script.location -> _ t -> _ t -> _ t tzresult\nend\n\nmodule Type_size : TYPE_SIZE = struct\n  type 'a t = int\n\n  let () =\n    (* static-like check that all [t] values fit in a [mul_safe] *)\n    let (_ : Saturation_repr.mul_safe Saturation_repr.t) =\n      Saturation_repr.mul_safe_of_int_exn Constants.michelson_maximum_type_size\n    in\n    ()\n\n  let to_int = Saturation_repr.mul_safe_of_int_exn\n\n  let one = 1\n\n  let two = 2\n\n  let three = 3\n\n  let four = 4\n\n  let merge x y =\n    if Compare.Int.(x = y) then ok x\n    else error @@ Script_tc_errors.Inconsistent_type_sizes (x, y)\n\n  let of_int loc size =\n    let max_size = Constants.michelson_maximum_type_size in\n    if Compare.Int.(size <= max_size) then ok size\n    else error (Script_tc_errors.Type_too_large (loc, max_size))\n\n  let compound1 loc size = of_int loc (1 + size)\n\n  let compound2 loc size1 size2 = of_int loc (1 + size1 + size2)\nend\n\ntype empty_cell = EmptyCell\n\ntype end_of_stack = empty_cell * empty_cell\n\ntype 'a ty_metadata = {annot : type_annot option; size : 'a Type_size.t}\n\ntype _ comparable_ty =\n  | Unit_key : unit ty_metadata -> unit comparable_ty\n  | Never_key : never ty_metadata -> never comparable_ty\n  | Int_key : z num ty_metadata -> z num comparable_ty\n  | Nat_key : n num ty_metadata -> n num comparable_ty\n  | Signature_key : signature ty_metadata -> signature comparable_ty\n  | String_key : Script_string.t ty_metadata -> Script_string.t comparable_ty\n  | Bytes_key : Bytes.t ty_metadata -> Bytes.t comparable_ty\n  | Mutez_key : Tez.t ty_metadata -> Tez.t comparable_ty\n  | Bool_key : bool ty_metadata -> bool comparable_ty\n  | Key_hash_key : public_key_hash ty_metadata -> public_key_hash comparable_ty\n  | Key_key : public_key ty_metadata -> public_key comparable_ty\n  | Timestamp_key :\n      Script_timestamp.t ty_metadata\n      -> Script_timestamp.t comparable_ty\n  | Chain_id_key : Chain_id.t ty_metadata -> Chain_id.t comparable_ty\n  | Address_key : address ty_metadata -> address comparable_ty\n  | Pair_key :\n      ('a comparable_ty * field_annot option)\n      * ('b comparable_ty * field_annot option)\n      * ('a, 'b) pair ty_metadata\n      -> ('a, 'b) pair comparable_ty\n  | Union_key :\n      ('a comparable_ty * field_annot option)\n      * ('b comparable_ty * field_annot option)\n      * ('a, 'b) union ty_metadata\n      -> ('a, 'b) union comparable_ty\n  | Option_key :\n      'v comparable_ty * 'v option ty_metadata\n      -> 'v option comparable_ty\n\nlet comparable_ty_metadata : type a. a comparable_ty -> a ty_metadata = function\n  | Unit_key meta -> meta\n  | Never_key meta -> meta\n  | Int_key meta -> meta\n  | Nat_key meta -> meta\n  | Signature_key meta -> meta\n  | String_key meta -> meta\n  | Bytes_key meta -> meta\n  | Mutez_key meta -> meta\n  | Bool_key meta -> meta\n  | Key_hash_key meta -> meta\n  | Key_key meta -> meta\n  | Timestamp_key meta -> meta\n  | Chain_id_key meta -> meta\n  | Address_key meta -> meta\n  | Pair_key (_, _, meta) -> meta\n  | Union_key (_, _, meta) -> meta\n  | Option_key (_, meta) -> meta\n\nlet comparable_ty_size t = (comparable_ty_metadata t).size\n\nlet unit_key ~annot = Unit_key {annot; size = Type_size.one}\n\nlet never_key ~annot = Never_key {annot; size = Type_size.one}\n\nlet int_key ~annot = Int_key {annot; size = Type_size.one}\n\nlet nat_key ~annot = Nat_key {annot; size = Type_size.one}\n\nlet signature_key ~annot = Signature_key {annot; size = Type_size.one}\n\nlet string_key ~annot = String_key {annot; size = Type_size.one}\n\nlet bytes_key ~annot = Bytes_key {annot; size = Type_size.one}\n\nlet mutez_key ~annot = Mutez_key {annot; size = Type_size.one}\n\nlet bool_key ~annot = Bool_key {annot; size = Type_size.one}\n\nlet key_hash_key ~annot = Key_hash_key {annot; size = Type_size.one}\n\nlet key_key ~annot = Key_key {annot; size = Type_size.one}\n\nlet timestamp_key ~annot = Timestamp_key {annot; size = Type_size.one}\n\nlet chain_id_key ~annot = Chain_id_key {annot; size = Type_size.one}\n\nlet address_key ~annot = Address_key {annot; size = Type_size.one}\n\nlet pair_key loc (l, fannot_l) (r, fannot_r) ~annot =\n  Type_size.compound2 loc (comparable_ty_size l) (comparable_ty_size r)\n  >|? fun size -> Pair_key ((l, fannot_l), (r, fannot_r), {annot; size})\n\nlet pair_3_key loc l m r =\n  pair_key loc m r ~annot:None >>? fun r -> pair_key loc l (r, None) ~annot:None\n\nlet union_key loc (l, fannot_l) (r, fannot_r) ~annot =\n  Type_size.compound2 loc (comparable_ty_size l) (comparable_ty_size r)\n  >|? fun size -> Union_key ((l, fannot_l), (r, fannot_r), {annot; size})\n\nlet option_key loc t ~annot =\n  Type_size.compound1 loc (comparable_ty_size t) >|? fun size ->\n  Option_key (t, {annot; size})\n\n(*\n\n   This signature contains the exact set of functions used in the\n   protocol. We do not include all [Set.S] because this would\n   increase the size of the first class modules used to represent\n   [boxed_set].\n\n   Warning: for any change in this signature, there must be a\n   change in [Script_typed_ir_size.value_size] which updates\n   [boxing_space] in the case for sets.\n\n*)\nmodule type Boxed_set_OPS = sig\n  type t\n\n  type elt\n\n  val empty : t\n\n  val add : elt -> t -> t\n\n  val mem : elt -> t -> bool\n\n  val remove : elt -> t -> t\n\n  val fold : (elt -> 'a -> 'a) -> t -> 'a -> 'a\nend\n\nmodule type Boxed_set = sig\n  type elt\n\n  val elt_ty : elt comparable_ty\n\n  module OPS : Boxed_set_OPS with type elt = elt\n\n  val boxed : OPS.t\n\n  val size : int\nend\n\ntype 'elt set = (module Boxed_set with type elt = 'elt)\n\n(*\n\n   Same remark as for [Boxed_set_OPS]. (See below.)\n\n*)\nmodule type Boxed_map_OPS = sig\n  type t\n\n  type key\n\n  type value\n\n  val empty : t\n\n  val add : key -> value -> t -> t\n\n  val remove : key -> t -> t\n\n  val find : key -> t -> value option\n\n  val fold : (key -> value -> 'a -> 'a) -> t -> 'a -> 'a\nend\n\nmodule type Boxed_map = sig\n  type key\n\n  type value\n\n  val key_ty : key comparable_ty\n\n  module OPS : Boxed_map_OPS with type key = key and type value = value\n\n  val boxed : OPS.t\n\n  val size : int\nend\n\ntype ('key, 'value) map =\n  (module Boxed_map with type key = 'key and type value = 'value)\n\nmodule Big_map_overlay = Map.Make (struct\n  type t = Script_expr_hash.t\n\n  let compare = Script_expr_hash.compare\nend)\n\ntype ('key, 'value) big_map_overlay = {\n  map : ('key * 'value option) Big_map_overlay.t;\n  size : int;\n}\n\ntype 'elt boxed_list = {elements : 'elt list; length : int}\n\nmodule SMap = Map.Make (Script_string)\n\ntype view = {\n  input_ty : Script.node;\n  output_ty : Script.node;\n  view_code : Script.node;\n}\n\ntype ('arg, 'storage) script = {\n  code : (('arg, 'storage) pair, (operation boxed_list, 'storage) pair) lambda;\n  arg_type : 'arg ty;\n  storage : 'storage;\n  storage_type : 'storage ty;\n  views : view SMap.t;\n  root_name : field_annot option;\n  code_size : Cache_memory_helpers.sint;\n      (* This is an over-approximation of the value size in memory, in\n         bytes, of the contract's static part, that is its source\n         code. This includes the code of the contract as well as the code\n         of the views. The storage size is not taken into account by this\n         field as it has a dynamic size. *)\n}\n\n(* ---- Instructions --------------------------------------------------------*)\nand ('before_top, 'before, 'result_top, 'result) kinstr =\n  (*\n     Stack\n     -----\n  *)\n  | IDrop :\n      ('a, 'b * 's) kinfo * ('b, 's, 'r, 'f) kinstr\n      -> ('a, 'b * 's, 'r, 'f) kinstr\n  | IDup :\n      ('a, 's) kinfo * ('a, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ISwap :\n      ('a, 'b * 's) kinfo * ('b, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 'b * 's, 'r, 'f) kinstr\n  | IConst :\n      ('a, 's) kinfo * 'ty * ('ty, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  (*\n     Pairs\n     -----\n  *)\n  | ICons_pair :\n      ('a, 'b * 's) kinfo * ('a * 'b, 's, 'r, 'f) kinstr\n      -> ('a, 'b * 's, 'r, 'f) kinstr\n  | ICar :\n      ('a * 'b, 's) kinfo * ('a, 's, 'r, 'f) kinstr\n      -> ('a * 'b, 's, 'r, 'f) kinstr\n  | ICdr :\n      ('a * 'b, 's) kinfo * ('b, 's, 'r, 'f) kinstr\n      -> ('a * 'b, 's, 'r, 'f) kinstr\n  | IUnpair :\n      ('a * 'b, 's) kinfo * ('a, 'b * 's, 'r, 'f) kinstr\n      -> ('a * 'b, 's, 'r, 'f) kinstr\n  (*\n     Options\n     -------\n   *)\n  | ICons_some :\n      ('v, 's) kinfo * ('v option, 's, 'r, 'f) kinstr\n      -> ('v, 's, 'r, 'f) kinstr\n  | ICons_none :\n      ('a, 's) kinfo * ('b option, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IIf_none : {\n      kinfo : ('a option, 'b * 's) kinfo;\n      branch_if_none : ('b, 's, 'c, 't) kinstr;\n      branch_if_some : ('a, 'b * 's, 'c, 't) kinstr;\n      k : ('c, 't, 'r, 'f) kinstr;\n    }\n      -> ('a option, 'b * 's, 'r, 'f) kinstr\n  | IOpt_map : {\n      kinfo : ('a option, 's) kinfo;\n      body : ('a, 's, 'b, 's) kinstr;\n      k : ('b option, 's, 'c, 't) kinstr;\n    }\n      -> ('a option, 's, 'c, 't) kinstr\n  (*\n     Unions\n     ------\n   *)\n  | ICons_left :\n      ('a, 's) kinfo * (('a, 'b) union, 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ICons_right :\n      ('b, 's) kinfo * (('a, 'b) union, 's, 'r, 'f) kinstr\n      -> ('b, 's, 'r, 'f) kinstr\n  | IIf_left : {\n      kinfo : (('a, 'b) union, 's) kinfo;\n      branch_if_left : ('a, 's, 'c, 't) kinstr;\n      branch_if_right : ('b, 's, 'c, 't) kinstr;\n      k : ('c, 't, 'r, 'f) kinstr;\n    }\n      -> (('a, 'b) union, 's, 'r, 'f) kinstr\n  (*\n     Lists\n     -----\n  *)\n  | ICons_list :\n      ('a, 'a boxed_list * 's) kinfo * ('a boxed_list, 's, 'r, 'f) kinstr\n      -> ('a, 'a boxed_list * 's, 'r, 'f) kinstr\n  | INil :\n      ('a, 's) kinfo * ('b boxed_list, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IIf_cons : {\n      kinfo : ('a boxed_list, 'b * 's) kinfo;\n      branch_if_cons : ('a, 'a boxed_list * ('b * 's), 'c, 't) kinstr;\n      branch_if_nil : ('b, 's, 'c, 't) kinstr;\n      k : ('c, 't, 'r, 'f) kinstr;\n    }\n      -> ('a boxed_list, 'b * 's, 'r, 'f) kinstr\n  | IList_map :\n      ('a boxed_list, 'c * 's) kinfo\n      * ('a, 'c * 's, 'b, 'c * 's) kinstr\n      * ('b boxed_list, 'c * 's, 'r, 'f) kinstr\n      -> ('a boxed_list, 'c * 's, 'r, 'f) kinstr\n  | IList_iter :\n      ('a boxed_list, 'b * 's) kinfo\n      * ('a, 'b * 's, 'b, 's) kinstr\n      * ('b, 's, 'r, 'f) kinstr\n      -> ('a boxed_list, 'b * 's, 'r, 'f) kinstr\n  | IList_size :\n      ('a boxed_list, 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> ('a boxed_list, 's, 'r, 'f) kinstr\n  (*\n    Sets\n    ----\n  *)\n  | IEmpty_set :\n      ('a, 's) kinfo * 'b comparable_ty * ('b set, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ISet_iter :\n      ('a set, 'b * 's) kinfo\n      * ('a, 'b * 's, 'b, 's) kinstr\n      * ('b, 's, 'r, 'f) kinstr\n      -> ('a set, 'b * 's, 'r, 'f) kinstr\n  | ISet_mem :\n      ('a, 'a set * 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> ('a, 'a set * 's, 'r, 'f) kinstr\n  | ISet_update :\n      ('a, bool * ('a set * 's)) kinfo * ('a set, 's, 'r, 'f) kinstr\n      -> ('a, bool * ('a set * 's), 'r, 'f) kinstr\n  | ISet_size :\n      ('a set, 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> ('a set, 's, 'r, 'f) kinstr\n  (*\n     Maps\n     ----\n   *)\n  | IEmpty_map :\n      ('a, 's) kinfo * 'b comparable_ty * (('b, 'c) map, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IMap_map :\n      (('a, 'b) map, 'd * 's) kinfo\n      * ('a * 'b, 'd * 's, 'c, 'd * 's) kinstr\n      * (('a, 'c) map, 'd * 's, 'r, 'f) kinstr\n      -> (('a, 'b) map, 'd * 's, 'r, 'f) kinstr\n  | IMap_iter :\n      (('a, 'b) map, 'c * 's) kinfo\n      * ('a * 'b, 'c * 's, 'c, 's) kinstr\n      * ('c, 's, 'r, 'f) kinstr\n      -> (('a, 'b) map, 'c * 's, 'r, 'f) kinstr\n  | IMap_mem :\n      ('a, ('a, 'b) map * 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> ('a, ('a, 'b) map * 's, 'r, 'f) kinstr\n  | IMap_get :\n      ('a, ('a, 'b) map * 's) kinfo * ('b option, 's, 'r, 'f) kinstr\n      -> ('a, ('a, 'b) map * 's, 'r, 'f) kinstr\n  | IMap_update :\n      ('a, 'b option * (('a, 'b) map * 's)) kinfo\n      * (('a, 'b) map, 's, 'r, 'f) kinstr\n      -> ('a, 'b option * (('a, 'b) map * 's), 'r, 'f) kinstr\n  | IMap_get_and_update :\n      ('a, 'b option * (('a, 'b) map * 's)) kinfo\n      * ('b option, ('a, 'b) map * 's, 'r, 'f) kinstr\n      -> ('a, 'b option * (('a, 'b) map * 's), 'r, 'f) kinstr\n  | IMap_size :\n      (('a, 'b) map, 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (('a, 'b) map, 's, 'r, 'f) kinstr\n  (*\n     Big maps\n     --------\n  *)\n  | IEmpty_big_map :\n      ('a, 's) kinfo\n      * 'b comparable_ty\n      * 'c ty\n      * (('b, 'c) big_map, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IBig_map_mem :\n      ('a, ('a, 'b) big_map * 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> ('a, ('a, 'b) big_map * 's, 'r, 'f) kinstr\n  | IBig_map_get :\n      ('a, ('a, 'b) big_map * 's) kinfo * ('b option, 's, 'r, 'f) kinstr\n      -> ('a, ('a, 'b) big_map * 's, 'r, 'f) kinstr\n  | IBig_map_update :\n      ('a, 'b option * (('a, 'b) big_map * 's)) kinfo\n      * (('a, 'b) big_map, 's, 'r, 'f) kinstr\n      -> ('a, 'b option * (('a, 'b) big_map * 's), 'r, 'f) kinstr\n  | IBig_map_get_and_update :\n      ('a, 'b option * (('a, 'b) big_map * 's)) kinfo\n      * ('b option, ('a, 'b) big_map * 's, 'r, 'f) kinstr\n      -> ('a, 'b option * (('a, 'b) big_map * 's), 'r, 'f) kinstr\n  (*\n     Strings\n     -------\n  *)\n  | IConcat_string :\n      (Script_string.t boxed_list, 's) kinfo\n      * (Script_string.t, 's, 'r, 'f) kinstr\n      -> (Script_string.t boxed_list, 's, 'r, 'f) kinstr\n  | IConcat_string_pair :\n      (Script_string.t, Script_string.t * 's) kinfo\n      * (Script_string.t, 's, 'r, 'f) kinstr\n      -> (Script_string.t, Script_string.t * 's, 'r, 'f) kinstr\n  | ISlice_string :\n      (n num, n num * (Script_string.t * 's)) kinfo\n      * (Script_string.t option, 's, 'r, 'f) kinstr\n      -> (n num, n num * (Script_string.t * 's), 'r, 'f) kinstr\n  | IString_size :\n      (Script_string.t, 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (Script_string.t, 's, 'r, 'f) kinstr\n  (*\n     Bytes\n     -----\n  *)\n  | IConcat_bytes :\n      (bytes boxed_list, 's) kinfo * (bytes, 's, 'r, 'f) kinstr\n      -> (bytes boxed_list, 's, 'r, 'f) kinstr\n  | IConcat_bytes_pair :\n      (bytes, bytes * 's) kinfo * (bytes, 's, 'r, 'f) kinstr\n      -> (bytes, bytes * 's, 'r, 'f) kinstr\n  | ISlice_bytes :\n      (n num, n num * (bytes * 's)) kinfo * (bytes option, 's, 'r, 'f) kinstr\n      -> (n num, n num * (bytes * 's), 'r, 'f) kinstr\n  | IBytes_size :\n      (bytes, 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (bytes, 's, 'r, 'f) kinstr\n  (*\n     Timestamps\n     ----------\n   *)\n  | IAdd_seconds_to_timestamp :\n      (z num, Script_timestamp.t * 's) kinfo\n      * (Script_timestamp.t, 's, 'r, 'f) kinstr\n      -> (z num, Script_timestamp.t * 's, 'r, 'f) kinstr\n  | IAdd_timestamp_to_seconds :\n      (Script_timestamp.t, z num * 's) kinfo\n      * (Script_timestamp.t, 's, 'r, 'f) kinstr\n      -> (Script_timestamp.t, z num * 's, 'r, 'f) kinstr\n  | ISub_timestamp_seconds :\n      (Script_timestamp.t, z num * 's) kinfo\n      * (Script_timestamp.t, 's, 'r, 'f) kinstr\n      -> (Script_timestamp.t, z num * 's, 'r, 'f) kinstr\n  | IDiff_timestamps :\n      (Script_timestamp.t, Script_timestamp.t * 's) kinfo\n      * (z num, 's, 'r, 'f) kinstr\n      -> (Script_timestamp.t, Script_timestamp.t * 's, 'r, 'f) kinstr\n  (*\n     Tez\n     ---\n    *)\n  | IAdd_tez :\n      (Tez.t, Tez.t * 's) kinfo * (Tez.t, 's, 'r, 'f) kinstr\n      -> (Tez.t, Tez.t * 's, 'r, 'f) kinstr\n  | ISub_tez :\n      (Tez.t, Tez.t * 's) kinfo * (Tez.t option, 's, 'r, 'f) kinstr\n      -> (Tez.t, Tez.t * 's, 'r, 'f) kinstr\n  | ISub_tez_legacy :\n      (Tez.t, Tez.t * 's) kinfo * (Tez.t, 's, 'r, 'f) kinstr\n      -> (Tez.t, Tez.t * 's, 'r, 'f) kinstr\n  | IMul_teznat :\n      (Tez.t, n num * 's) kinfo * (Tez.t, 's, 'r, 'f) kinstr\n      -> (Tez.t, n num * 's, 'r, 'f) kinstr\n  | IMul_nattez :\n      (n num, Tez.t * 's) kinfo * (Tez.t, 's, 'r, 'f) kinstr\n      -> (n num, Tez.t * 's, 'r, 'f) kinstr\n  | IEdiv_teznat :\n      (Tez.t, n num * 's) kinfo\n      * ((Tez.t, Tez.t) pair option, 's, 'r, 'f) kinstr\n      -> (Tez.t, n num * 's, 'r, 'f) kinstr\n  | IEdiv_tez :\n      (Tez.t, Tez.t * 's) kinfo\n      * ((n num, Tez.t) pair option, 's, 'r, 'f) kinstr\n      -> (Tez.t, Tez.t * 's, 'r, 'f) kinstr\n  (*\n     Booleans\n     --------\n   *)\n  | IOr :\n      (bool, bool * 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (bool, bool * 's, 'r, 'f) kinstr\n  | IAnd :\n      (bool, bool * 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (bool, bool * 's, 'r, 'f) kinstr\n  | IXor :\n      (bool, bool * 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (bool, bool * 's, 'r, 'f) kinstr\n  | INot :\n      (bool, 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (bool, 's, 'r, 'f) kinstr\n  (*\n     Integers\n     --------\n  *)\n  | IIs_nat :\n      (z num, 's) kinfo * (n num option, 's, 'r, 'f) kinstr\n      -> (z num, 's, 'r, 'f) kinstr\n  | INeg :\n      ('a num, 's) kinfo * (z num, 's, 'r, 'f) kinstr\n      -> ('a num, 's, 'r, 'f) kinstr\n  | IAbs_int :\n      (z num, 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (z num, 's, 'r, 'f) kinstr\n  | IInt_nat :\n      (n num, 's) kinfo * (z num, 's, 'r, 'f) kinstr\n      -> (n num, 's, 'r, 'f) kinstr\n  | IAdd_int :\n      ('a num, 'b num * 's) kinfo * (z num, 's, 'r, 'f) kinstr\n      -> ('a num, 'b num * 's, 'r, 'f) kinstr\n  | IAdd_nat :\n      (n num, n num * 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (n num, n num * 's, 'r, 'f) kinstr\n  | ISub_int :\n      ('a num, 'b num * 's) kinfo * (z num, 's, 'r, 'f) kinstr\n      -> ('a num, 'b num * 's, 'r, 'f) kinstr\n  | IMul_int :\n      ('a num, 'b num * 's) kinfo * (z num, 's, 'r, 'f) kinstr\n      -> ('a num, 'b num * 's, 'r, 'f) kinstr\n  | IMul_nat :\n      (n num, 'a num * 's) kinfo * ('a num, 's, 'r, 'f) kinstr\n      -> (n num, 'a num * 's, 'r, 'f) kinstr\n  | IEdiv_int :\n      ('a num, 'b num * 's) kinfo\n      * ((z num, n num) pair option, 's, 'r, 'f) kinstr\n      -> ('a num, 'b num * 's, 'r, 'f) kinstr\n  | IEdiv_nat :\n      (n num, 'a num * 's) kinfo\n      * (('a num, n num) pair option, 's, 'r, 'f) kinstr\n      -> (n num, 'a num * 's, 'r, 'f) kinstr\n  | ILsl_nat :\n      (n num, n num * 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (n num, n num * 's, 'r, 'f) kinstr\n  | ILsr_nat :\n      (n num, n num * 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (n num, n num * 's, 'r, 'f) kinstr\n  | IOr_nat :\n      (n num, n num * 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (n num, n num * 's, 'r, 'f) kinstr\n  (* Even though `IAnd_nat` and `IAnd_int_nat` could be merged into a single\n     instruction from both the type and behavior point of views, their gas costs\n     differ too much (see `cost_N_IAnd_nat` and `cost_N_IAnd_int_nat` in\n     `Michelson_v1_gas.Cost_of.Generated_costs`), so we keep them separated. *)\n  | IAnd_nat :\n      (n num, n num * 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (n num, n num * 's, 'r, 'f) kinstr\n  | IAnd_int_nat :\n      (z num, n num * 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (z num, n num * 's, 'r, 'f) kinstr\n  | IXor_nat :\n      (n num, n num * 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (n num, n num * 's, 'r, 'f) kinstr\n  | INot_int :\n      ('a num, 's) kinfo * (z num, 's, 'r, 'f) kinstr\n      -> ('a num, 's, 'r, 'f) kinstr\n  (*\n     Control\n     -------\n  *)\n  | IIf : {\n      kinfo : (bool, 'a * 's) kinfo;\n      branch_if_true : ('a, 's, 'b, 'u) kinstr;\n      branch_if_false : ('a, 's, 'b, 'u) kinstr;\n      k : ('b, 'u, 'r, 'f) kinstr;\n    }\n      -> (bool, 'a * 's, 'r, 'f) kinstr\n  | ILoop :\n      (bool, 'a * 's) kinfo\n      * ('a, 's, bool, 'a * 's) kinstr\n      * ('a, 's, 'r, 'f) kinstr\n      -> (bool, 'a * 's, 'r, 'f) kinstr\n  | ILoop_left :\n      (('a, 'b) union, 's) kinfo\n      * ('a, 's, ('a, 'b) union, 's) kinstr\n      * ('b, 's, 'r, 'f) kinstr\n      -> (('a, 'b) union, 's, 'r, 'f) kinstr\n  | IDip :\n      ('a, 'b * 's) kinfo\n      * ('b, 's, 'c, 't) kinstr\n      * ('a, 'c * 't, 'r, 'f) kinstr\n      -> ('a, 'b * 's, 'r, 'f) kinstr\n  | IExec :\n      ('a, ('a, 'b) lambda * 's) kinfo * ('b, 's, 'r, 'f) kinstr\n      -> ('a, ('a, 'b) lambda * 's, 'r, 'f) kinstr\n  | IApply :\n      ('a, ('a * 'b, 'c) lambda * 's) kinfo\n      * 'a ty\n      * (('b, 'c) lambda, 's, 'r, 'f) kinstr\n      -> ('a, ('a * 'b, 'c) lambda * 's, 'r, 'f) kinstr\n  | ILambda :\n      ('a, 's) kinfo\n      * ('b, 'c) lambda\n      * (('b, 'c) lambda, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IFailwith :\n      ('a, 's) kinfo * Script.location * 'a ty\n      -> ('a, 's, 'r, 'f) kinstr\n  (*\n     Comparison\n     ----------\n  *)\n  | ICompare :\n      ('a, 'a * 's) kinfo * 'a comparable_ty * (z num, 's, 'r, 'f) kinstr\n      -> ('a, 'a * 's, 'r, 'f) kinstr\n  (*\n     Comparators\n     -----------\n  *)\n  | IEq :\n      (z num, 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (z num, 's, 'r, 'f) kinstr\n  | INeq :\n      (z num, 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (z num, 's, 'r, 'f) kinstr\n  | ILt :\n      (z num, 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (z num, 's, 'r, 'f) kinstr\n  | IGt :\n      (z num, 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (z num, 's, 'r, 'f) kinstr\n  | ILe :\n      (z num, 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (z num, 's, 'r, 'f) kinstr\n  | IGe :\n      (z num, 's) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (z num, 's, 'r, 'f) kinstr\n  (*\n     Protocol\n     --------\n  *)\n  | IAddress :\n      ('a typed_contract, 's) kinfo * (address, 's, 'r, 'f) kinstr\n      -> ('a typed_contract, 's, 'r, 'f) kinstr\n  | IContract :\n      (address, 's) kinfo\n      * 'a ty\n      * string\n      * ('a typed_contract option, 's, 'r, 'f) kinstr\n      -> (address, 's, 'r, 'f) kinstr\n  | IView :\n      ('a, address * 's) kinfo\n      * ('a, 'b) view_signature\n      * ('b option, 's, 'r, 'f) kinstr\n      -> ('a, address * 's, 'r, 'f) kinstr\n  | ITransfer_tokens :\n      ('a, Tez.t * ('a typed_contract * 's)) kinfo\n      * (operation, 's, 'r, 'f) kinstr\n      -> ('a, Tez.t * ('a typed_contract * 's), 'r, 'f) kinstr\n  | IImplicit_account :\n      (public_key_hash, 's) kinfo * (unit typed_contract, 's, 'r, 'f) kinstr\n      -> (public_key_hash, 's, 'r, 'f) kinstr\n  | ICreate_contract : {\n      kinfo : (public_key_hash option, Tez.t * ('a * 's)) kinfo;\n      storage_type : 'a ty;\n      arg_type : 'b ty;\n      lambda : ('b * 'a, operation boxed_list * 'a) lambda;\n      views : view SMap.t;\n      root_name : field_annot option;\n      k : (operation, address * 's, 'r, 'f) kinstr;\n    }\n      -> (public_key_hash option, Tez.t * ('a * 's), 'r, 'f) kinstr\n  | ISet_delegate :\n      (public_key_hash option, 's) kinfo * (operation, 's, 'r, 'f) kinstr\n      -> (public_key_hash option, 's, 'r, 'f) kinstr\n  | INow :\n      ('a, 's) kinfo * (Script_timestamp.t, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IBalance :\n      ('a, 's) kinfo * (Tez.t, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ILevel :\n      ('a, 's) kinfo * (n num, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ICheck_signature :\n      (public_key, signature * (bytes * 's)) kinfo * (bool, 's, 'r, 'f) kinstr\n      -> (public_key, signature * (bytes * 's), 'r, 'f) kinstr\n  | IHash_key :\n      (public_key, 's) kinfo * (public_key_hash, 's, 'r, 'f) kinstr\n      -> (public_key, 's, 'r, 'f) kinstr\n  | IPack :\n      ('a, 's) kinfo * 'a ty * (bytes, 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IUnpack :\n      (bytes, 's) kinfo * 'a ty * ('a option, 's, 'r, 'f) kinstr\n      -> (bytes, 's, 'r, 'f) kinstr\n  | IBlake2b :\n      (bytes, 's) kinfo * (bytes, 's, 'r, 'f) kinstr\n      -> (bytes, 's, 'r, 'f) kinstr\n  | ISha256 :\n      (bytes, 's) kinfo * (bytes, 's, 'r, 'f) kinstr\n      -> (bytes, 's, 'r, 'f) kinstr\n  | ISha512 :\n      (bytes, 's) kinfo * (bytes, 's, 'r, 'f) kinstr\n      -> (bytes, 's, 'r, 'f) kinstr\n  | ISource :\n      ('a, 's) kinfo * (address, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ISender :\n      ('a, 's) kinfo * (address, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ISelf :\n      ('a, 's) kinfo\n      * 'b ty\n      * string\n      * ('b typed_contract, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ISelf_address :\n      ('a, 's) kinfo * (address, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IAmount :\n      ('a, 's) kinfo * (Tez.t, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ISapling_empty_state :\n      ('a, 's) kinfo\n      * Sapling.Memo_size.t\n      * (Sapling.state, 'a * 's, 'b, 'f) kinstr\n      -> ('a, 's, 'b, 'f) kinstr\n  | ISapling_verify_update :\n      (Sapling.transaction, Sapling.state * 's) kinfo\n      * ((z num, Sapling.state) pair option, 's, 'r, 'f) kinstr\n      -> (Sapling.transaction, Sapling.state * 's, 'r, 'f) kinstr\n  | IDig :\n      ('a, 's) kinfo\n      * int\n      * ('b, 'c * 't, 'c, 't, 'a, 's, 'd, 'u) stack_prefix_preservation_witness\n      * ('b, 'd * 'u, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IDug :\n      ('a, 'b * 's) kinfo\n      * int\n      * ('c, 't, 'a, 'c * 't, 'b, 's, 'd, 'u) stack_prefix_preservation_witness\n      * ('d, 'u, 'r, 'f) kinstr\n      -> ('a, 'b * 's, 'r, 'f) kinstr\n  | IDipn :\n      ('a, 's) kinfo\n      * int\n      * ('c, 't, 'd, 'v, 'a, 's, 'b, 'u) stack_prefix_preservation_witness\n      * ('c, 't, 'd, 'v) kinstr\n      * ('b, 'u, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IDropn :\n      ('a, 's) kinfo\n      * int\n      * ('b, 'u, 'b, 'u, 'a, 's, 'a, 's) stack_prefix_preservation_witness\n      * ('b, 'u, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IChainId :\n      ('a, 's) kinfo * (Chain_id.t, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | INever : (never, 's) kinfo -> (never, 's, 'r, 'f) kinstr\n  | IVoting_power :\n      (public_key_hash, 's) kinfo * (n num, 's, 'r, 'f) kinstr\n      -> (public_key_hash, 's, 'r, 'f) kinstr\n  | ITotal_voting_power :\n      ('a, 's) kinfo * (n num, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IKeccak :\n      (bytes, 's) kinfo * (bytes, 's, 'r, 'f) kinstr\n      -> (bytes, 's, 'r, 'f) kinstr\n  | ISha3 :\n      (bytes, 's) kinfo * (bytes, 's, 'r, 'f) kinstr\n      -> (bytes, 's, 'r, 'f) kinstr\n  | IAdd_bls12_381_g1 :\n      (Bls12_381.G1.t, Bls12_381.G1.t * 's) kinfo\n      * (Bls12_381.G1.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.G1.t, Bls12_381.G1.t * 's, 'r, 'f) kinstr\n  | IAdd_bls12_381_g2 :\n      (Bls12_381.G2.t, Bls12_381.G2.t * 's) kinfo\n      * (Bls12_381.G2.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.G2.t, Bls12_381.G2.t * 's, 'r, 'f) kinstr\n  | IAdd_bls12_381_fr :\n      (Bls12_381.Fr.t, Bls12_381.Fr.t * 's) kinfo\n      * (Bls12_381.Fr.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.Fr.t, Bls12_381.Fr.t * 's, 'r, 'f) kinstr\n  | IMul_bls12_381_g1 :\n      (Bls12_381.G1.t, Bls12_381.Fr.t * 's) kinfo\n      * (Bls12_381.G1.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.G1.t, Bls12_381.Fr.t * 's, 'r, 'f) kinstr\n  | IMul_bls12_381_g2 :\n      (Bls12_381.G2.t, Bls12_381.Fr.t * 's) kinfo\n      * (Bls12_381.G2.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.G2.t, Bls12_381.Fr.t * 's, 'r, 'f) kinstr\n  | IMul_bls12_381_fr :\n      (Bls12_381.Fr.t, Bls12_381.Fr.t * 's) kinfo\n      * (Bls12_381.Fr.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.Fr.t, Bls12_381.Fr.t * 's, 'r, 'f) kinstr\n  | IMul_bls12_381_z_fr :\n      (Bls12_381.Fr.t, 'a num * 's) kinfo * (Bls12_381.Fr.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.Fr.t, 'a num * 's, 'r, 'f) kinstr\n  | IMul_bls12_381_fr_z :\n      ('a num, Bls12_381.Fr.t * 's) kinfo * (Bls12_381.Fr.t, 's, 'r, 'f) kinstr\n      -> ('a num, Bls12_381.Fr.t * 's, 'r, 'f) kinstr\n  | IInt_bls12_381_fr :\n      (Bls12_381.Fr.t, 's) kinfo * (z num, 's, 'r, 'f) kinstr\n      -> (Bls12_381.Fr.t, 's, 'r, 'f) kinstr\n  | INeg_bls12_381_g1 :\n      (Bls12_381.G1.t, 's) kinfo * (Bls12_381.G1.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.G1.t, 's, 'r, 'f) kinstr\n  | INeg_bls12_381_g2 :\n      (Bls12_381.G2.t, 's) kinfo * (Bls12_381.G2.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.G2.t, 's, 'r, 'f) kinstr\n  | INeg_bls12_381_fr :\n      (Bls12_381.Fr.t, 's) kinfo * (Bls12_381.Fr.t, 's, 'r, 'f) kinstr\n      -> (Bls12_381.Fr.t, 's, 'r, 'f) kinstr\n  | IPairing_check_bls12_381 :\n      ((Bls12_381.G1.t, Bls12_381.G2.t) pair boxed_list, 's) kinfo\n      * (bool, 's, 'r, 'f) kinstr\n      -> ((Bls12_381.G1.t, Bls12_381.G2.t) pair boxed_list, 's, 'r, 'f) kinstr\n  | IComb :\n      ('a, 's) kinfo\n      * int\n      * ('a * 's, 'b * 'u) comb_gadt_witness\n      * ('b, 'u, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IUncomb :\n      ('a, 's) kinfo\n      * int\n      * ('a * 's, 'b * 'u) uncomb_gadt_witness\n      * ('b, 'u, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | IComb_get :\n      ('t, 's) kinfo\n      * int\n      * ('t, 'v) comb_get_gadt_witness\n      * ('v, 's, 'r, 'f) kinstr\n      -> ('t, 's, 'r, 'f) kinstr\n  | IComb_set :\n      ('a, 'b * 's) kinfo\n      * int\n      * ('a, 'b, 'c) comb_set_gadt_witness\n      * ('c, 's, 'r, 'f) kinstr\n      -> ('a, 'b * 's, 'r, 'f) kinstr\n  | IDup_n :\n      ('a, 's) kinfo\n      * int\n      * ('a * 's, 't) dup_n_gadt_witness\n      * ('t, 'a * 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n  | ITicket :\n      ('a, n num * 's) kinfo * ('a ticket, 's, 'r, 'f) kinstr\n      -> ('a, n num * 's, 'r, 'f) kinstr\n  | IRead_ticket :\n      ('a ticket, 's) kinfo\n      * (address * ('a * n num), 'a ticket * 's, 'r, 'f) kinstr\n      -> ('a ticket, 's, 'r, 'f) kinstr\n  | ISplit_ticket :\n      ('a ticket, (n num * n num) * 's) kinfo\n      * (('a ticket * 'a ticket) option, 's, 'r, 'f) kinstr\n      -> ('a ticket, (n num * n num) * 's, 'r, 'f) kinstr\n  | IJoin_tickets :\n      ('a ticket * 'a ticket, 's) kinfo\n      * 'a comparable_ty\n      * ('a ticket option, 's, 'r, 'f) kinstr\n      -> ('a ticket * 'a ticket, 's, 'r, 'f) kinstr\n  | IOpen_chest :\n      (Timelock.chest_key, Timelock.chest * (n num * 's)) kinfo\n      * ((bytes, bool) union, 's, 'r, 'f) kinstr\n      -> (Timelock.chest_key, Timelock.chest * (n num * 's), 'r, 'f) kinstr\n  (*\n     Internal control instructions\n     -----------------------------\n  *)\n  | IHalt : ('a, 's) kinfo -> ('a, 's, 'a, 's) kinstr\n  | ILog :\n      ('a, 's) kinfo * logging_event * logger * ('a, 's, 'r, 'f) kinstr\n      -> ('a, 's, 'r, 'f) kinstr\n\nand logging_event =\n  | LogEntry : logging_event\n  | LogExit : ('b, 'u) kinfo -> logging_event\n\nand ('arg, 'ret) lambda =\n  | Lam :\n      ('arg, end_of_stack, 'ret, end_of_stack) kdescr * Script.node\n      -> ('arg, 'ret) lambda\n[@@coq_force_gadt]\n\nand 'arg typed_contract = 'arg ty * address\n\nand (_, _, _, _) continuation =\n  | KNil : ('r, 'f, 'r, 'f) continuation\n  | KCons :\n      ('a, 's, 'b, 't) kinstr * ('b, 't, 'r, 'f) continuation\n      -> ('a, 's, 'r, 'f) continuation\n  | KReturn :\n      's * ('a, 's, 'r, 'f) continuation\n      -> ('a, end_of_stack, 'r, 'f) continuation\n  | KMap_head :\n      ('a -> 'b) * ('b, 's, 'r, 'f) continuation\n      -> ('a, 's, 'r, 'f) continuation\n  | KUndip :\n      'b * ('b, 'a * 's, 'r, 'f) continuation\n      -> ('a, 's, 'r, 'f) continuation\n  | KLoop_in :\n      ('a, 's, bool, 'a * 's) kinstr * ('a, 's, 'r, 'f) continuation\n      -> (bool, 'a * 's, 'r, 'f) continuation\n  | KLoop_in_left :\n      ('a, 's, ('a, 'b) union, 's) kinstr * ('b, 's, 'r, 'f) continuation\n      -> (('a, 'b) union, 's, 'r, 'f) continuation\n  | KIter :\n      ('a, 'b * 's, 'b, 's) kinstr * 'a list * ('b, 's, 'r, 'f) continuation\n      -> ('b, 's, 'r, 'f) continuation\n  | KList_enter_body :\n      ('a, 'c * 's, 'b, 'c * 's) kinstr\n      * 'a list\n      * 'b list\n      * int\n      * ('b boxed_list, 'c * 's, 'r, 'f) continuation\n      -> ('c, 's, 'r, 'f) continuation\n  | KList_exit_body :\n      ('a, 'c * 's, 'b, 'c * 's) kinstr\n      * 'a list\n      * 'b list\n      * int\n      * ('b boxed_list, 'c * 's, 'r, 'f) continuation\n      -> ('b, 'c * 's, 'r, 'f) continuation\n  | KMap_enter_body :\n      ('a * 'b, 'd * 's, 'c, 'd * 's) kinstr\n      * ('a * 'b) list\n      * ('a, 'c) map\n      * (('a, 'c) map, 'd * 's, 'r, 'f) continuation\n      -> ('d, 's, 'r, 'f) continuation\n  | KMap_exit_body :\n      ('a * 'b, 'd * 's, 'c, 'd * 's) kinstr\n      * ('a * 'b) list\n      * ('a, 'c) map\n      * 'a\n      * (('a, 'c) map, 'd * 's, 'r, 'f) continuation\n      -> ('c, 'd * 's, 'r, 'f) continuation\n  | KView_exit :\n      step_constants * ('a, 's, 'r, 'f) continuation\n      -> ('a, 's, 'r, 'f) continuation\n  | KLog :\n      ('a, 's, 'r, 'f) continuation * logger\n      -> ('a, 's, 'r, 'f) continuation\n\nand ('a, 's, 'b, 'f, 'c, 'u) logging_function =\n  ('a, 's, 'b, 'f) kinstr ->\n  context ->\n  Script.location ->\n  ('c, 'u) stack_ty ->\n  'c * 'u ->\n  unit\n\nand execution_trace =\n  (Script.location * Gas.t * (Script.expr * string option) list) list\n\nand logger = {\n  log_interp : 'a 's 'b 'f 'c 'u. ('a, 's, 'b, 'f, 'c, 'u) logging_function;\n  log_entry : 'a 's 'b 'f. ('a, 's, 'b, 'f, 'a, 's) logging_function;\n  log_control : 'a 's 'b 'f. ('a, 's, 'b, 'f) continuation -> unit;\n  log_exit : 'a 's 'b 'f 'c 'u. ('a, 's, 'b, 'f, 'c, 'u) logging_function;\n  get_log : unit -> execution_trace option tzresult Lwt.t;\n}\n\n(* ---- Auxiliary types -----------------------------------------------------*)\nand 'ty ty =\n  | Unit_t : unit ty_metadata -> unit ty\n  | Int_t : z num ty_metadata -> z num ty\n  | Nat_t : n num ty_metadata -> n num ty\n  | Signature_t : signature ty_metadata -> signature ty\n  | String_t : Script_string.t ty_metadata -> Script_string.t ty\n  | Bytes_t : Bytes.t ty_metadata -> bytes ty\n  | Mutez_t : Tez.t ty_metadata -> Tez.t ty\n  | Key_hash_t : public_key_hash ty_metadata -> public_key_hash ty\n  | Key_t : public_key ty_metadata -> public_key ty\n  | Timestamp_t : Script_timestamp.t ty_metadata -> Script_timestamp.t ty\n  | Address_t : address ty_metadata -> address ty\n  | Bool_t : bool ty_metadata -> bool ty\n  | Pair_t :\n      ('a ty * field_annot option * var_annot option)\n      * ('b ty * field_annot option * var_annot option)\n      * ('a, 'b) pair ty_metadata\n      -> ('a, 'b) pair ty\n  | Union_t :\n      ('a ty * field_annot option)\n      * ('b ty * field_annot option)\n      * ('a, 'b) union ty_metadata\n      -> ('a, 'b) union ty\n  | Lambda_t :\n      'arg ty * 'ret ty * ('arg, 'ret) lambda ty_metadata\n      -> ('arg, 'ret) lambda ty\n  | Option_t : 'v ty * 'v option ty_metadata -> 'v option ty\n  | List_t : 'v ty * 'v boxed_list ty_metadata -> 'v boxed_list ty\n  | Set_t : 'v comparable_ty * 'v set ty_metadata -> 'v set ty\n  | Map_t :\n      'k comparable_ty * 'v ty * ('k, 'v) map ty_metadata\n      -> ('k, 'v) map ty\n  | Big_map_t :\n      'k comparable_ty * 'v ty * ('k, 'v) big_map ty_metadata\n      -> ('k, 'v) big_map ty\n  | Contract_t :\n      'arg ty * 'arg typed_contract ty_metadata\n      -> 'arg typed_contract ty\n  | Sapling_transaction_t :\n      Sapling.Memo_size.t * Sapling.transaction ty_metadata\n      -> Sapling.transaction ty\n  | Sapling_state_t :\n      Sapling.Memo_size.t * Sapling.state ty_metadata\n      -> Sapling.state ty\n  | Operation_t : operation ty_metadata -> operation ty\n  | Chain_id_t : Chain_id.t ty_metadata -> Chain_id.t ty\n  | Never_t : never ty_metadata -> never ty\n  | Bls12_381_g1_t : Bls12_381.G1.t ty_metadata -> Bls12_381.G1.t ty\n  | Bls12_381_g2_t : Bls12_381.G2.t ty_metadata -> Bls12_381.G2.t ty\n  | Bls12_381_fr_t : Bls12_381.Fr.t ty_metadata -> Bls12_381.Fr.t ty\n  | Ticket_t : 'a comparable_ty * 'a ticket ty_metadata -> 'a ticket ty\n  | Chest_key_t : Timelock.chest_key ty_metadata -> Timelock.chest_key ty\n  | Chest_t : Timelock.chest ty_metadata -> Timelock.chest ty\n\nand ('top_ty, 'resty) stack_ty =\n  | Item_t :\n      'ty ty * ('ty2, 'rest) stack_ty * var_annot option\n      -> ('ty, 'ty2 * 'rest) stack_ty\n  | Bot_t : (empty_cell, empty_cell) stack_ty\n\nand ('key, 'value) big_map = {\n  id : Big_map.Id.t option;\n  diff : ('key, 'value) big_map_overlay;\n  key_type : 'key comparable_ty;\n  value_type : 'value ty;\n}\n\nand ('a, 's, 'r, 'f) kdescr = {\n  kloc : Script.location;\n  kbef : ('a, 's) stack_ty;\n  kaft : ('r, 'f) stack_ty;\n  kinstr : ('a, 's, 'r, 'f) kinstr;\n}\n\nand ('a, 's) kinfo = {iloc : Script.location; kstack_ty : ('a, 's) stack_ty}\n\nand (_, _, _, _, _, _, _, _) stack_prefix_preservation_witness =\n  | KPrefix :\n      ('y, 'u) kinfo\n      * ('c, 'v, 'd, 'w, 'x, 's, 'y, 'u) stack_prefix_preservation_witness\n      -> ( 'c,\n           'v,\n           'd,\n           'w,\n           'a,\n           'x * 's,\n           'a,\n           'y * 'u )\n         stack_prefix_preservation_witness\n  | KRest : ('a, 's, 'b, 'u, 'a, 's, 'b, 'u) stack_prefix_preservation_witness\n\nand ('before, 'after) comb_gadt_witness =\n  | Comb_one : ('a * ('x * 'before), 'a * ('x * 'before)) comb_gadt_witness\n  | Comb_succ :\n      ('before, 'b * 'after) comb_gadt_witness\n      -> ('a * 'before, ('a * 'b) * 'after) comb_gadt_witness\n\nand ('before, 'after) uncomb_gadt_witness =\n  | Uncomb_one : ('rest, 'rest) uncomb_gadt_witness\n  | Uncomb_succ :\n      ('b * 'before, 'after) uncomb_gadt_witness\n      -> (('a * 'b) * 'before, 'a * 'after) uncomb_gadt_witness\n\nand ('before, 'after) comb_get_gadt_witness =\n  | Comb_get_zero : ('b, 'b) comb_get_gadt_witness\n  | Comb_get_one : ('a * 'b, 'a) comb_get_gadt_witness\n  | Comb_get_plus_two :\n      ('before, 'after) comb_get_gadt_witness\n      -> ('a * 'before, 'after) comb_get_gadt_witness\n\nand ('value, 'before, 'after) comb_set_gadt_witness =\n  | Comb_set_zero : ('value, _, 'value) comb_set_gadt_witness\n  | Comb_set_one : ('value, 'hd * 'tl, 'value * 'tl) comb_set_gadt_witness\n  | Comb_set_plus_two :\n      ('value, 'before, 'after) comb_set_gadt_witness\n      -> ('value, 'a * 'before, 'a * 'after) comb_set_gadt_witness\n[@@coq_force_gadt]\n\nand (_, _) dup_n_gadt_witness =\n  | Dup_n_zero : ('a * 'rest, 'a) dup_n_gadt_witness\n  | Dup_n_succ :\n      ('stack, 'b) dup_n_gadt_witness\n      -> ('a * 'stack, 'b) dup_n_gadt_witness\n\nand ('a, 'b) view_signature =\n  | View_signature of {\n      name : Script_string.t;\n      input_ty : 'a ty;\n      output_ty : 'b ty;\n    }\n\nlet kinfo_of_kinstr : type a s b f. (a, s, b, f) kinstr -> (a, s) kinfo =\n fun i ->\n  match i with\n  | IDrop (kinfo, _) -> kinfo\n  | IDup (kinfo, _) -> kinfo\n  | ISwap (kinfo, _) -> kinfo\n  | IConst (kinfo, _, _) -> kinfo\n  | ICons_pair (kinfo, _) -> kinfo\n  | ICar (kinfo, _) -> kinfo\n  | ICdr (kinfo, _) -> kinfo\n  | IUnpair (kinfo, _) -> kinfo\n  | ICons_some (kinfo, _) -> kinfo\n  | ICons_none (kinfo, _) -> kinfo\n  | IIf_none {kinfo; _} -> kinfo\n  | IOpt_map {kinfo; _} -> kinfo\n  | ICons_left (kinfo, _) -> kinfo\n  | ICons_right (kinfo, _) -> kinfo\n  | IIf_left {kinfo; _} -> kinfo\n  | ICons_list (kinfo, _) -> kinfo\n  | INil (kinfo, _) -> kinfo\n  | IIf_cons {kinfo; _} -> kinfo\n  | IList_map (kinfo, _, _) -> kinfo\n  | IList_iter (kinfo, _, _) -> kinfo\n  | IList_size (kinfo, _) -> kinfo\n  | IEmpty_set (kinfo, _, _) -> kinfo\n  | ISet_iter (kinfo, _, _) -> kinfo\n  | ISet_mem (kinfo, _) -> kinfo\n  | ISet_update (kinfo, _) -> kinfo\n  | ISet_size (kinfo, _) -> kinfo\n  | IEmpty_map (kinfo, _, _) -> kinfo\n  | IMap_map (kinfo, _, _) -> kinfo\n  | IMap_iter (kinfo, _, _) -> kinfo\n  | IMap_mem (kinfo, _) -> kinfo\n  | IMap_get (kinfo, _) -> kinfo\n  | IMap_update (kinfo, _) -> kinfo\n  | IMap_get_and_update (kinfo, _) -> kinfo\n  | IMap_size (kinfo, _) -> kinfo\n  | IEmpty_big_map (kinfo, _, _, _) -> kinfo\n  | IBig_map_mem (kinfo, _) -> kinfo\n  | IBig_map_get (kinfo, _) -> kinfo\n  | IBig_map_update (kinfo, _) -> kinfo\n  | IBig_map_get_and_update (kinfo, _) -> kinfo\n  | IConcat_string (kinfo, _) -> kinfo\n  | IConcat_string_pair (kinfo, _) -> kinfo\n  | ISlice_string (kinfo, _) -> kinfo\n  | IString_size (kinfo, _) -> kinfo\n  | IConcat_bytes (kinfo, _) -> kinfo\n  | IConcat_bytes_pair (kinfo, _) -> kinfo\n  | ISlice_bytes (kinfo, _) -> kinfo\n  | IBytes_size (kinfo, _) -> kinfo\n  | IAdd_seconds_to_timestamp (kinfo, _) -> kinfo\n  | IAdd_timestamp_to_seconds (kinfo, _) -> kinfo\n  | ISub_timestamp_seconds (kinfo, _) -> kinfo\n  | IDiff_timestamps (kinfo, _) -> kinfo\n  | IAdd_tez (kinfo, _) -> kinfo\n  | ISub_tez (kinfo, _) -> kinfo\n  | ISub_tez_legacy (kinfo, _) -> kinfo\n  | IMul_teznat (kinfo, _) -> kinfo\n  | IMul_nattez (kinfo, _) -> kinfo\n  | IEdiv_teznat (kinfo, _) -> kinfo\n  | IEdiv_tez (kinfo, _) -> kinfo\n  | IOr (kinfo, _) -> kinfo\n  | IAnd (kinfo, _) -> kinfo\n  | IXor (kinfo, _) -> kinfo\n  | INot (kinfo, _) -> kinfo\n  | IIs_nat (kinfo, _) -> kinfo\n  | INeg (kinfo, _) -> kinfo\n  | IAbs_int (kinfo, _) -> kinfo\n  | IInt_nat (kinfo, _) -> kinfo\n  | IAdd_int (kinfo, _) -> kinfo\n  | IAdd_nat (kinfo, _) -> kinfo\n  | ISub_int (kinfo, _) -> kinfo\n  | IMul_int (kinfo, _) -> kinfo\n  | IMul_nat (kinfo, _) -> kinfo\n  | IEdiv_int (kinfo, _) -> kinfo\n  | IEdiv_nat (kinfo, _) -> kinfo\n  | ILsl_nat (kinfo, _) -> kinfo\n  | ILsr_nat (kinfo, _) -> kinfo\n  | IOr_nat (kinfo, _) -> kinfo\n  | IAnd_nat (kinfo, _) -> kinfo\n  | IAnd_int_nat (kinfo, _) -> kinfo\n  | IXor_nat (kinfo, _) -> kinfo\n  | INot_int (kinfo, _) -> kinfo\n  | IIf {kinfo; _} -> kinfo\n  | ILoop (kinfo, _, _) -> kinfo\n  | ILoop_left (kinfo, _, _) -> kinfo\n  | IDip (kinfo, _, _) -> kinfo\n  | IExec (kinfo, _) -> kinfo\n  | IApply (kinfo, _, _) -> kinfo\n  | ILambda (kinfo, _, _) -> kinfo\n  | IFailwith (kinfo, _, _) -> kinfo\n  | ICompare (kinfo, _, _) -> kinfo\n  | IEq (kinfo, _) -> kinfo\n  | INeq (kinfo, _) -> kinfo\n  | ILt (kinfo, _) -> kinfo\n  | IGt (kinfo, _) -> kinfo\n  | ILe (kinfo, _) -> kinfo\n  | IGe (kinfo, _) -> kinfo\n  | IAddress (kinfo, _) -> kinfo\n  | IContract (kinfo, _, _, _) -> kinfo\n  | ITransfer_tokens (kinfo, _) -> kinfo\n  | IView (kinfo, _, _) -> kinfo\n  | IImplicit_account (kinfo, _) -> kinfo\n  | ICreate_contract {kinfo; _} -> kinfo\n  | ISet_delegate (kinfo, _) -> kinfo\n  | INow (kinfo, _) -> kinfo\n  | IBalance (kinfo, _) -> kinfo\n  | ILevel (kinfo, _) -> kinfo\n  | ICheck_signature (kinfo, _) -> kinfo\n  | IHash_key (kinfo, _) -> kinfo\n  | IPack (kinfo, _, _) -> kinfo\n  | IUnpack (kinfo, _, _) -> kinfo\n  | IBlake2b (kinfo, _) -> kinfo\n  | ISha256 (kinfo, _) -> kinfo\n  | ISha512 (kinfo, _) -> kinfo\n  | ISource (kinfo, _) -> kinfo\n  | ISender (kinfo, _) -> kinfo\n  | ISelf (kinfo, _, _, _) -> kinfo\n  | ISelf_address (kinfo, _) -> kinfo\n  | IAmount (kinfo, _) -> kinfo\n  | ISapling_empty_state (kinfo, _, _) -> kinfo\n  | ISapling_verify_update (kinfo, _) -> kinfo\n  | IDig (kinfo, _, _, _) -> kinfo\n  | IDug (kinfo, _, _, _) -> kinfo\n  | IDipn (kinfo, _, _, _, _) -> kinfo\n  | IDropn (kinfo, _, _, _) -> kinfo\n  | IChainId (kinfo, _) -> kinfo\n  | INever kinfo -> kinfo\n  | IVoting_power (kinfo, _) -> kinfo\n  | ITotal_voting_power (kinfo, _) -> kinfo\n  | IKeccak (kinfo, _) -> kinfo\n  | ISha3 (kinfo, _) -> kinfo\n  | IAdd_bls12_381_g1 (kinfo, _) -> kinfo\n  | IAdd_bls12_381_g2 (kinfo, _) -> kinfo\n  | IAdd_bls12_381_fr (kinfo, _) -> kinfo\n  | IMul_bls12_381_g1 (kinfo, _) -> kinfo\n  | IMul_bls12_381_g2 (kinfo, _) -> kinfo\n  | IMul_bls12_381_fr (kinfo, _) -> kinfo\n  | IMul_bls12_381_z_fr (kinfo, _) -> kinfo\n  | IMul_bls12_381_fr_z (kinfo, _) -> kinfo\n  | IInt_bls12_381_fr (kinfo, _) -> kinfo\n  | INeg_bls12_381_g1 (kinfo, _) -> kinfo\n  | INeg_bls12_381_g2 (kinfo, _) -> kinfo\n  | INeg_bls12_381_fr (kinfo, _) -> kinfo\n  | IPairing_check_bls12_381 (kinfo, _) -> kinfo\n  | IComb (kinfo, _, _, _) -> kinfo\n  | IUncomb (kinfo, _, _, _) -> kinfo\n  | IComb_get (kinfo, _, _, _) -> kinfo\n  | IComb_set (kinfo, _, _, _) -> kinfo\n  | IDup_n (kinfo, _, _, _) -> kinfo\n  | ITicket (kinfo, _) -> kinfo\n  | IRead_ticket (kinfo, _) -> kinfo\n  | ISplit_ticket (kinfo, _) -> kinfo\n  | IJoin_tickets (kinfo, _, _) -> kinfo\n  | IHalt kinfo -> kinfo\n  | ILog (kinfo, _, _, _) -> kinfo\n  | IOpen_chest (kinfo, _) -> kinfo\n\ntype kinstr_rewritek = {\n  apply : 'b 'u 'r 'f. ('b, 'u, 'r, 'f) kinstr -> ('b, 'u, 'r, 'f) kinstr;\n}\n\nlet kinstr_rewritek :\n    type a s r f. (a, s, r, f) kinstr -> kinstr_rewritek -> (a, s, r, f) kinstr\n    =\n fun i f ->\n  match i with\n  | IDrop (kinfo, k) -> IDrop (kinfo, f.apply k)\n  | IDup (kinfo, k) -> IDup (kinfo, f.apply k)\n  | ISwap (kinfo, k) -> ISwap (kinfo, f.apply k)\n  | IConst (kinfo, x, k) -> IConst (kinfo, x, f.apply k)\n  | ICons_pair (kinfo, k) -> ICons_pair (kinfo, f.apply k)\n  | ICar (kinfo, k) -> ICar (kinfo, f.apply k)\n  | ICdr (kinfo, k) -> ICdr (kinfo, f.apply k)\n  | IUnpair (kinfo, k) -> IUnpair (kinfo, f.apply k)\n  | ICons_some (kinfo, k) -> ICons_some (kinfo, f.apply k)\n  | ICons_none (kinfo, k) -> ICons_none (kinfo, f.apply k)\n  | IIf_none {kinfo; branch_if_none; branch_if_some; k} ->\n      IIf_none\n        {\n          kinfo;\n          branch_if_none = f.apply branch_if_none;\n          branch_if_some = f.apply branch_if_some;\n          k = f.apply k;\n        }\n  | IOpt_map {kinfo; body; k} ->\n      let body = f.apply body in\n      let k = f.apply k in\n      IOpt_map {kinfo; body; k}\n  | ICons_left (kinfo, k) -> ICons_left (kinfo, f.apply k)\n  | ICons_right (kinfo, k) -> ICons_right (kinfo, f.apply k)\n  | IIf_left {kinfo; branch_if_left; branch_if_right; k} ->\n      IIf_left\n        {\n          kinfo;\n          branch_if_left = f.apply branch_if_left;\n          branch_if_right = f.apply branch_if_right;\n          k = f.apply k;\n        }\n  | ICons_list (kinfo, k) -> ICons_list (kinfo, f.apply k)\n  | INil (kinfo, k) -> INil (kinfo, f.apply k)\n  | IIf_cons {kinfo; branch_if_cons; branch_if_nil; k} ->\n      IIf_cons\n        {\n          kinfo;\n          branch_if_cons = f.apply branch_if_cons;\n          branch_if_nil = f.apply branch_if_nil;\n          k = f.apply k;\n        }\n  | IList_map (kinfo, body, k) -> IList_map (kinfo, f.apply body, f.apply k)\n  | IList_iter (kinfo, body, k) -> IList_iter (kinfo, f.apply body, f.apply k)\n  | IList_size (kinfo, k) -> IList_size (kinfo, f.apply k)\n  | IEmpty_set (kinfo, ty, k) -> IEmpty_set (kinfo, ty, f.apply k)\n  | ISet_iter (kinfo, body, k) -> ISet_iter (kinfo, f.apply body, f.apply k)\n  | ISet_mem (kinfo, k) -> ISet_mem (kinfo, f.apply k)\n  | ISet_update (kinfo, k) -> ISet_update (kinfo, f.apply k)\n  | ISet_size (kinfo, k) -> ISet_size (kinfo, f.apply k)\n  | IEmpty_map (kinfo, cty, k) -> IEmpty_map (kinfo, cty, f.apply k)\n  | IMap_map (kinfo, body, k) -> IMap_map (kinfo, f.apply body, f.apply k)\n  | IMap_iter (kinfo, body, k) -> IMap_iter (kinfo, f.apply body, f.apply k)\n  | IMap_mem (kinfo, k) -> IMap_mem (kinfo, f.apply k)\n  | IMap_get (kinfo, k) -> IMap_get (kinfo, f.apply k)\n  | IMap_update (kinfo, k) -> IMap_update (kinfo, f.apply k)\n  | IMap_get_and_update (kinfo, k) -> IMap_get_and_update (kinfo, f.apply k)\n  | IMap_size (kinfo, k) -> IMap_size (kinfo, f.apply k)\n  | IEmpty_big_map (kinfo, cty, ty, k) ->\n      IEmpty_big_map (kinfo, cty, ty, f.apply k)\n  | IBig_map_mem (kinfo, k) -> IBig_map_mem (kinfo, f.apply k)\n  | IBig_map_get (kinfo, k) -> IBig_map_get (kinfo, f.apply k)\n  | IBig_map_update (kinfo, k) -> IBig_map_update (kinfo, f.apply k)\n  | IBig_map_get_and_update (kinfo, k) ->\n      IBig_map_get_and_update (kinfo, f.apply k)\n  | IConcat_string (kinfo, k) -> IConcat_string (kinfo, f.apply k)\n  | IConcat_string_pair (kinfo, k) -> IConcat_string_pair (kinfo, f.apply k)\n  | ISlice_string (kinfo, k) -> ISlice_string (kinfo, f.apply k)\n  | IString_size (kinfo, k) -> IString_size (kinfo, f.apply k)\n  | IConcat_bytes (kinfo, k) -> IConcat_bytes (kinfo, f.apply k)\n  | IConcat_bytes_pair (kinfo, k) -> IConcat_bytes_pair (kinfo, f.apply k)\n  | ISlice_bytes (kinfo, k) -> ISlice_bytes (kinfo, f.apply k)\n  | IBytes_size (kinfo, k) -> IBytes_size (kinfo, f.apply k)\n  | IAdd_seconds_to_timestamp (kinfo, k) ->\n      IAdd_seconds_to_timestamp (kinfo, f.apply k)\n  | IAdd_timestamp_to_seconds (kinfo, k) ->\n      IAdd_timestamp_to_seconds (kinfo, f.apply k)\n  | ISub_timestamp_seconds (kinfo, k) ->\n      ISub_timestamp_seconds (kinfo, f.apply k)\n  | IDiff_timestamps (kinfo, k) -> IDiff_timestamps (kinfo, f.apply k)\n  | IAdd_tez (kinfo, k) -> IAdd_tez (kinfo, f.apply k)\n  | ISub_tez (kinfo, k) -> ISub_tez (kinfo, f.apply k)\n  | ISub_tez_legacy (kinfo, k) -> ISub_tez_legacy (kinfo, f.apply k)\n  | IMul_teznat (kinfo, k) -> IMul_teznat (kinfo, f.apply k)\n  | IMul_nattez (kinfo, k) -> IMul_nattez (kinfo, f.apply k)\n  | IEdiv_teznat (kinfo, k) -> IEdiv_teznat (kinfo, f.apply k)\n  | IEdiv_tez (kinfo, k) -> IEdiv_tez (kinfo, f.apply k)\n  | IOr (kinfo, k) -> IOr (kinfo, f.apply k)\n  | IAnd (kinfo, k) -> IAnd (kinfo, f.apply k)\n  | IXor (kinfo, k) -> IXor (kinfo, f.apply k)\n  | INot (kinfo, k) -> INot (kinfo, f.apply k)\n  | IIs_nat (kinfo, k) -> IIs_nat (kinfo, f.apply k)\n  | INeg (kinfo, k) -> INeg (kinfo, f.apply k)\n  | IAbs_int (kinfo, k) -> IAbs_int (kinfo, f.apply k)\n  | IInt_nat (kinfo, k) -> IInt_nat (kinfo, f.apply k)\n  | IAdd_int (kinfo, k) -> IAdd_int (kinfo, f.apply k)\n  | IAdd_nat (kinfo, k) -> IAdd_nat (kinfo, f.apply k)\n  | ISub_int (kinfo, k) -> ISub_int (kinfo, f.apply k)\n  | IMul_int (kinfo, k) -> IMul_int (kinfo, f.apply k)\n  | IMul_nat (kinfo, k) -> IMul_nat (kinfo, f.apply k)\n  | IEdiv_int (kinfo, k) -> IEdiv_int (kinfo, f.apply k)\n  | IEdiv_nat (kinfo, k) -> IEdiv_nat (kinfo, f.apply k)\n  | ILsl_nat (kinfo, k) -> ILsl_nat (kinfo, f.apply k)\n  | ILsr_nat (kinfo, k) -> ILsr_nat (kinfo, f.apply k)\n  | IOr_nat (kinfo, k) -> IOr_nat (kinfo, f.apply k)\n  | IAnd_nat (kinfo, k) -> IAnd_nat (kinfo, f.apply k)\n  | IAnd_int_nat (kinfo, k) -> IAnd_int_nat (kinfo, f.apply k)\n  | IXor_nat (kinfo, k) -> IXor_nat (kinfo, f.apply k)\n  | INot_int (kinfo, k) -> INot_int (kinfo, f.apply k)\n  | IIf {kinfo; branch_if_true; branch_if_false; k} ->\n      IIf\n        {\n          kinfo;\n          branch_if_true = f.apply branch_if_true;\n          branch_if_false = f.apply branch_if_false;\n          k = f.apply k;\n        }\n  | ILoop (kinfo, kbody, k) -> ILoop (kinfo, f.apply kbody, f.apply k)\n  | ILoop_left (kinfo, kl, kr) -> ILoop_left (kinfo, f.apply kl, f.apply kr)\n  | IDip (kinfo, body, k) -> IDip (kinfo, f.apply body, f.apply k)\n  | IExec (kinfo, k) -> IExec (kinfo, f.apply k)\n  | IApply (kinfo, ty, k) -> IApply (kinfo, ty, f.apply k)\n  | ILambda (kinfo, l, k) -> ILambda (kinfo, l, f.apply k)\n  | IFailwith (kinfo, i, ty) -> IFailwith (kinfo, i, ty)\n  | ICompare (kinfo, ty, k) -> ICompare (kinfo, ty, f.apply k)\n  | IEq (kinfo, k) -> IEq (kinfo, f.apply k)\n  | INeq (kinfo, k) -> INeq (kinfo, f.apply k)\n  | ILt (kinfo, k) -> ILt (kinfo, f.apply k)\n  | IGt (kinfo, k) -> IGt (kinfo, f.apply k)\n  | ILe (kinfo, k) -> ILe (kinfo, f.apply k)\n  | IGe (kinfo, k) -> IGe (kinfo, f.apply k)\n  | IAddress (kinfo, k) -> IAddress (kinfo, f.apply k)\n  | IContract (kinfo, ty, code, k) -> IContract (kinfo, ty, code, f.apply k)\n  | ITransfer_tokens (kinfo, k) -> ITransfer_tokens (kinfo, f.apply k)\n  | IView (kinfo, view_signature, k) -> IView (kinfo, view_signature, f.apply k)\n  | IImplicit_account (kinfo, k) -> IImplicit_account (kinfo, f.apply k)\n  | ICreate_contract\n      {kinfo; storage_type; arg_type; lambda; views; root_name; k} ->\n      let k = f.apply k in\n      ICreate_contract\n        {kinfo; storage_type; arg_type; lambda; views; root_name; k}\n  | ISet_delegate (kinfo, k) -> ISet_delegate (kinfo, f.apply k)\n  | INow (kinfo, k) -> INow (kinfo, f.apply k)\n  | IBalance (kinfo, k) -> IBalance (kinfo, f.apply k)\n  | ILevel (kinfo, k) -> ILevel (kinfo, f.apply k)\n  | ICheck_signature (kinfo, k) -> ICheck_signature (kinfo, f.apply k)\n  | IHash_key (kinfo, k) -> IHash_key (kinfo, f.apply k)\n  | IPack (kinfo, ty, k) -> IPack (kinfo, ty, f.apply k)\n  | IUnpack (kinfo, ty, k) -> IUnpack (kinfo, ty, f.apply k)\n  | IBlake2b (kinfo, k) -> IBlake2b (kinfo, f.apply k)\n  | ISha256 (kinfo, k) -> ISha256 (kinfo, f.apply k)\n  | ISha512 (kinfo, k) -> ISha512 (kinfo, f.apply k)\n  | ISource (kinfo, k) -> ISource (kinfo, f.apply k)\n  | ISender (kinfo, k) -> ISender (kinfo, f.apply k)\n  | ISelf (kinfo, ty, s, k) -> ISelf (kinfo, ty, s, f.apply k)\n  | ISelf_address (kinfo, k) -> ISelf_address (kinfo, f.apply k)\n  | IAmount (kinfo, k) -> IAmount (kinfo, f.apply k)\n  | ISapling_empty_state (kinfo, s, k) ->\n      ISapling_empty_state (kinfo, s, f.apply k)\n  | ISapling_verify_update (kinfo, k) ->\n      ISapling_verify_update (kinfo, f.apply k)\n  | IDig (kinfo, n, p, k) -> IDig (kinfo, n, p, f.apply k)\n  | IDug (kinfo, n, p, k) -> IDug (kinfo, n, p, f.apply k)\n  | IDipn (kinfo, n, p, k1, k2) -> IDipn (kinfo, n, p, f.apply k1, f.apply k2)\n  | IDropn (kinfo, n, p, k) -> IDropn (kinfo, n, p, f.apply k)\n  | IChainId (kinfo, k) -> IChainId (kinfo, f.apply k)\n  | INever kinfo -> INever kinfo\n  | IVoting_power (kinfo, k) -> IVoting_power (kinfo, f.apply k)\n  | ITotal_voting_power (kinfo, k) -> ITotal_voting_power (kinfo, f.apply k)\n  | IKeccak (kinfo, k) -> IKeccak (kinfo, f.apply k)\n  | ISha3 (kinfo, k) -> ISha3 (kinfo, f.apply k)\n  | IAdd_bls12_381_g1 (kinfo, k) -> IAdd_bls12_381_g1 (kinfo, f.apply k)\n  | IAdd_bls12_381_g2 (kinfo, k) -> IAdd_bls12_381_g2 (kinfo, f.apply k)\n  | IAdd_bls12_381_fr (kinfo, k) -> IAdd_bls12_381_fr (kinfo, f.apply k)\n  | IMul_bls12_381_g1 (kinfo, k) -> IMul_bls12_381_g1 (kinfo, f.apply k)\n  | IMul_bls12_381_g2 (kinfo, k) -> IMul_bls12_381_g2 (kinfo, f.apply k)\n  | IMul_bls12_381_fr (kinfo, k) -> IMul_bls12_381_fr (kinfo, f.apply k)\n  | IMul_bls12_381_z_fr (kinfo, k) -> IMul_bls12_381_z_fr (kinfo, f.apply k)\n  | IMul_bls12_381_fr_z (kinfo, k) -> IMul_bls12_381_fr_z (kinfo, f.apply k)\n  | IInt_bls12_381_fr (kinfo, k) -> IInt_bls12_381_fr (kinfo, f.apply k)\n  | INeg_bls12_381_g1 (kinfo, k) -> INeg_bls12_381_g1 (kinfo, f.apply k)\n  | INeg_bls12_381_g2 (kinfo, k) -> INeg_bls12_381_g2 (kinfo, f.apply k)\n  | INeg_bls12_381_fr (kinfo, k) -> INeg_bls12_381_fr (kinfo, f.apply k)\n  | IPairing_check_bls12_381 (kinfo, k) ->\n      IPairing_check_bls12_381 (kinfo, f.apply k)\n  | IComb (kinfo, n, p, k) -> IComb (kinfo, n, p, f.apply k)\n  | IUncomb (kinfo, n, p, k) -> IUncomb (kinfo, n, p, f.apply k)\n  | IComb_get (kinfo, n, p, k) -> IComb_get (kinfo, n, p, f.apply k)\n  | IComb_set (kinfo, n, p, k) -> IComb_set (kinfo, n, p, f.apply k)\n  | IDup_n (kinfo, n, p, k) -> IDup_n (kinfo, n, p, f.apply k)\n  | ITicket (kinfo, k) -> ITicket (kinfo, f.apply k)\n  | IRead_ticket (kinfo, k) -> IRead_ticket (kinfo, f.apply k)\n  | ISplit_ticket (kinfo, k) -> ISplit_ticket (kinfo, f.apply k)\n  | IJoin_tickets (kinfo, ty, k) -> IJoin_tickets (kinfo, ty, f.apply k)\n  | IHalt kinfo -> IHalt kinfo\n  | ILog (kinfo, event, logger, k) -> ILog (kinfo, event, logger, k)\n  | IOpen_chest (kinfo, k) -> IOpen_chest (kinfo, f.apply k)\n\nlet ty_metadata : type a. a ty -> a ty_metadata = function\n  | Unit_t meta -> meta\n  | Never_t meta -> meta\n  | Int_t meta -> meta\n  | Nat_t meta -> meta\n  | Signature_t meta -> meta\n  | String_t meta -> meta\n  | Bytes_t meta -> meta\n  | Mutez_t meta -> meta\n  | Bool_t meta -> meta\n  | Key_hash_t meta -> meta\n  | Key_t meta -> meta\n  | Timestamp_t meta -> meta\n  | Chain_id_t meta -> meta\n  | Address_t meta -> meta\n  | Pair_t (_, _, meta) -> meta\n  | Union_t (_, _, meta) -> meta\n  | Option_t (_, meta) -> meta\n  | Lambda_t (_, _, meta) -> meta\n  | List_t (_, meta) -> meta\n  | Set_t (_, meta) -> meta\n  | Map_t (_, _, meta) -> meta\n  | Big_map_t (_, _, meta) -> meta\n  | Ticket_t (_, meta) -> meta\n  | Contract_t (_, meta) -> meta\n  | Sapling_transaction_t (_, meta) -> meta\n  | Sapling_state_t (_, meta) -> meta\n  | Operation_t meta -> meta\n  | Bls12_381_g1_t meta -> meta\n  | Bls12_381_g2_t meta -> meta\n  | Bls12_381_fr_t meta -> meta\n  | Chest_t meta -> meta\n  | Chest_key_t meta -> meta\n\nlet ty_size t = (ty_metadata t).size\n\nlet unit_t ~annot = Unit_t {annot; size = Type_size.one}\n\nlet int_t ~annot = Int_t {annot; size = Type_size.one}\n\nlet nat_t ~annot = Nat_t {annot; size = Type_size.one}\n\nlet signature_t ~annot = Signature_t {annot; size = Type_size.one}\n\nlet string_t ~annot = String_t {annot; size = Type_size.one}\n\nlet bytes_t ~annot = Bytes_t {annot; size = Type_size.one}\n\nlet mutez_t ~annot = Mutez_t {annot; size = Type_size.one}\n\nlet key_hash_t ~annot = Key_hash_t {annot; size = Type_size.one}\n\nlet key_t ~annot = Key_t {annot; size = Type_size.one}\n\nlet timestamp_t ~annot = Timestamp_t {annot; size = Type_size.one}\n\nlet address_t ~annot = Address_t {annot; size = Type_size.one}\n\nlet bool_t ~annot = Bool_t {annot; size = Type_size.one}\n\nlet pair_t loc (l, fannot_l, vannot_l) (r, fannot_r, vannot_r) ~annot =\n  Type_size.compound2 loc (ty_size l) (ty_size r) >|? fun size ->\n  Pair_t ((l, fannot_l, vannot_l), (r, fannot_r, vannot_r), {annot; size})\n\nlet union_t loc (l, fannot_l) (r, fannot_r) ~annot =\n  Type_size.compound2 loc (ty_size l) (ty_size r) >|? fun size ->\n  Union_t ((l, fannot_l), (r, fannot_r), {annot; size})\n\nlet union_bytes_bool_t =\n  Union_t\n    ( (bytes_t ~annot:None, None),\n      (bool_t ~annot:None, None),\n      {annot = None; size = Type_size.three} )\n\nlet lambda_t loc l r ~annot =\n  Type_size.compound2 loc (ty_size l) (ty_size r) >|? fun size ->\n  Lambda_t (l, r, {annot; size})\n\nlet option_t loc t ~annot =\n  Type_size.compound1 loc (ty_size t) >|? fun size -> Option_t (t, {annot; size})\n\nlet option_mutez'_t meta =\n  let {annot; size = _} = meta in\n  Option_t (mutez_t ~annot, {annot = None; size = Type_size.two})\n\nlet option_string'_t meta =\n  let {annot; size = _} = meta in\n  Option_t (string_t ~annot, {annot = None; size = Type_size.two})\n\nlet option_bytes'_t meta =\n  let {annot; size = _} = meta in\n  Option_t (bytes_t ~annot, {annot = None; size = Type_size.two})\n\nlet option_nat_t =\n  Option_t (nat_t ~annot:None, {annot = None; size = Type_size.two})\n\nlet option_pair_nat_nat_t =\n  Option_t\n    ( Pair_t\n        ( (nat_t ~annot:None, None, None),\n          (nat_t ~annot:None, None, None),\n          {annot = None; size = Type_size.three} ),\n      {annot = None; size = Type_size.four} )\n\nlet option_pair_nat'_nat'_t meta =\n  let {annot; size = _} = meta in\n  Option_t\n    ( Pair_t\n        ( (nat_t ~annot, None, None),\n          (nat_t ~annot, None, None),\n          {annot = None; size = Type_size.three} ),\n      {annot = None; size = Type_size.four} )\n\nlet option_pair_nat_mutez'_t meta =\n  let {annot; size = _} = meta in\n  Option_t\n    ( Pair_t\n        ( (nat_t ~annot:None, None, None),\n          (mutez_t ~annot, None, None),\n          {annot = None; size = Type_size.three} ),\n      {annot = None; size = Type_size.four} )\n\nlet option_pair_mutez'_mutez'_t meta =\n  let {annot; size = _} = meta in\n  Option_t\n    ( Pair_t\n        ( (mutez_t ~annot, None, None),\n          (mutez_t ~annot, None, None),\n          {annot = None; size = Type_size.three} ),\n      {annot = None; size = Type_size.four} )\n\nlet option_pair_int'_nat_t meta =\n  let {annot; size = _} = meta in\n  Option_t\n    ( Pair_t\n        ( (int_t ~annot, None, None),\n          (nat_t ~annot:None, None, None),\n          {annot = None; size = Type_size.three} ),\n      {annot = None; size = Type_size.four} )\n\nlet option_pair_int_nat'_t meta =\n  let {annot; size = _} = meta in\n  Option_t\n    ( Pair_t\n        ( (int_t ~annot:None, None, None),\n          (nat_t ~annot, None, None),\n          {annot = None; size = Type_size.three} ),\n      {annot = None; size = Type_size.four} )\n\nlet list_t loc t ~annot =\n  Type_size.compound1 loc (ty_size t) >|? fun size -> List_t (t, {annot; size})\n\nlet operation_t ~annot = Operation_t {annot; size = Type_size.one}\n\nlet list_operation_t =\n  List_t (operation_t ~annot:None, {annot = None; size = Type_size.two})\n\nlet set_t loc t ~annot =\n  Type_size.compound1 loc (comparable_ty_size t) >|? fun size ->\n  Set_t (t, {annot; size})\n\nlet map_t loc l r ~annot =\n  Type_size.compound2 loc (comparable_ty_size l) (ty_size r) >|? fun size ->\n  Map_t (l, r, {annot; size})\n\nlet big_map_t loc l r ~annot =\n  Type_size.compound2 loc (comparable_ty_size l) (ty_size r) >|? fun size ->\n  Big_map_t (l, r, {annot; size})\n\nlet contract_t loc t ~annot =\n  Type_size.compound1 loc (ty_size t) >|? fun size ->\n  Contract_t (t, {annot; size})\n\nlet contract_unit_t =\n  Contract_t (unit_t ~annot:None, {annot = None; size = Type_size.two})\n\nlet sapling_transaction_t ~memo_size ~annot =\n  Sapling_transaction_t (memo_size, {annot; size = Type_size.one})\n\nlet sapling_state_t ~memo_size ~annot =\n  Sapling_state_t (memo_size, {annot; size = Type_size.one})\n\nlet chain_id_t ~annot = Chain_id_t {annot; size = Type_size.one}\n\nlet never_t ~annot = Never_t {annot; size = Type_size.one}\n\nlet bls12_381_g1_t ~annot = Bls12_381_g1_t {annot; size = Type_size.one}\n\nlet bls12_381_g2_t ~annot = Bls12_381_g2_t {annot; size = Type_size.one}\n\nlet bls12_381_fr_t ~annot = Bls12_381_fr_t {annot; size = Type_size.one}\n\nlet ticket_t loc t ~annot =\n  Type_size.compound1 loc (comparable_ty_size t) >|? fun size ->\n  Ticket_t (t, {annot; size})\n\nlet chest_key_t ~annot = Chest_key_t {annot; size = Type_size.one}\n\nlet chest_t ~annot = Chest_t {annot; size = Type_size.one}\n\ntype 'a kinstr_traverse = {\n  apply : 'b 'u 'r 'f. 'a -> ('b, 'u, 'r, 'f) kinstr -> 'a;\n}\n\nlet kinstr_traverse i init f =\n  let rec aux :\n      type ret a s r f. 'accu -> (a, s, r, f) kinstr -> ('accu -> ret) -> ret =\n   fun accu t continue ->\n    let accu = f.apply accu t in\n    let next k =\n      (aux [@ocaml.tailcall]) accu k @@ fun accu ->\n      (continue [@ocaml.tailcall]) accu\n    in\n    let next2 k1 k2 =\n      (aux [@ocaml.tailcall]) accu k1 @@ fun accu ->\n      (aux [@ocaml.tailcall]) accu k2 @@ fun accu ->\n      (continue [@ocaml.tailcall]) accu\n    in\n    let next3 k1 k2 k3 =\n      (aux [@ocaml.tailcall]) accu k1 @@ fun accu ->\n      (aux [@ocaml.tailcall]) accu k2 @@ fun accu ->\n      (aux [@ocaml.tailcall]) accu k3 @@ fun accu ->\n      (continue [@ocaml.tailcall]) accu\n    in\n    let return () = (continue [@ocaml.tailcall]) accu in\n    match t with\n    | IDrop (_, k) -> (next [@ocaml.tailcall]) k\n    | IDup (_, k) -> (next [@ocaml.tailcall]) k\n    | ISwap (_, k) -> (next [@ocaml.tailcall]) k\n    | IConst (_, _, k) -> (next [@ocaml.tailcall]) k\n    | ICons_pair (_, k) -> (next [@ocaml.tailcall]) k\n    | ICar (_, k) -> (next [@ocaml.tailcall]) k\n    | ICdr (_, k) -> (next [@ocaml.tailcall]) k\n    | IUnpair (_, k) -> (next [@ocaml.tailcall]) k\n    | ICons_some (_, k) -> (next [@ocaml.tailcall]) k\n    | ICons_none (_, k) -> (next [@ocaml.tailcall]) k\n    | IIf_none {kinfo = _; branch_if_none = k1; branch_if_some = k2; k} ->\n        (next3 [@ocaml.tailcall]) k1 k2 k\n    | IOpt_map {kinfo = _; body; k} -> (next2 [@ocaml.tailcall]) body k\n    | ICons_left (_, k) -> (next [@ocaml.tailcall]) k\n    | ICons_right (_, k) -> (next [@ocaml.tailcall]) k\n    | IIf_left {kinfo = _; branch_if_left = k1; branch_if_right = k2; k} ->\n        (next3 [@ocaml.tailcall]) k1 k2 k\n    | ICons_list (_, k) -> (next [@ocaml.tailcall]) k\n    | INil (_, k) -> (next [@ocaml.tailcall]) k\n    | IIf_cons {kinfo = _; branch_if_nil = k1; branch_if_cons = k2; k} ->\n        (next3 [@ocaml.tailcall]) k1 k2 k\n    | IList_map (_, k1, k2) -> (next2 [@ocaml.tailcall]) k1 k2\n    | IList_iter (_, k1, k2) -> (next2 [@ocaml.tailcall]) k1 k2\n    | IList_size (_, k) -> (next [@ocaml.tailcall]) k\n    | IEmpty_set (_, _, k) -> (next [@ocaml.tailcall]) k\n    | ISet_iter (_, k1, k2) -> (next2 [@ocaml.tailcall]) k1 k2\n    | ISet_mem (_, k) -> (next [@ocaml.tailcall]) k\n    | ISet_update (_, k) -> (next [@ocaml.tailcall]) k\n    | ISet_size (_, k) -> (next [@ocaml.tailcall]) k\n    | IEmpty_map (_, _, k) -> (next [@ocaml.tailcall]) k\n    | IMap_map (_, k1, k2) -> (next2 [@ocaml.tailcall]) k1 k2\n    | IMap_iter (_, k1, k2) -> (next2 [@ocaml.tailcall]) k1 k2\n    | IMap_mem (_, k) -> (next [@ocaml.tailcall]) k\n    | IMap_get (_, k) -> (next [@ocaml.tailcall]) k\n    | IMap_update (_, k) -> (next [@ocaml.tailcall]) k\n    | IMap_get_and_update (_, k) -> (next [@ocaml.tailcall]) k\n    | IMap_size (_, k) -> (next [@ocaml.tailcall]) k\n    | IEmpty_big_map (_, _, _, k) -> (next [@ocaml.tailcall]) k\n    | IBig_map_mem (_, k) -> (next [@ocaml.tailcall]) k\n    | IBig_map_get (_, k) -> (next [@ocaml.tailcall]) k\n    | IBig_map_update (_, k) -> (next [@ocaml.tailcall]) k\n    | IBig_map_get_and_update (_, k) -> (next [@ocaml.tailcall]) k\n    | IConcat_string (_, k) -> (next [@ocaml.tailcall]) k\n    | IConcat_string_pair (_, k) -> (next [@ocaml.tailcall]) k\n    | ISlice_string (_, k) -> (next [@ocaml.tailcall]) k\n    | IString_size (_, k) -> (next [@ocaml.tailcall]) k\n    | IConcat_bytes (_, k) -> (next [@ocaml.tailcall]) k\n    | IConcat_bytes_pair (_, k) -> (next [@ocaml.tailcall]) k\n    | ISlice_bytes (_, k) -> (next [@ocaml.tailcall]) k\n    | IBytes_size (_, k) -> (next [@ocaml.tailcall]) k\n    | IAdd_seconds_to_timestamp (_, k) -> (next [@ocaml.tailcall]) k\n    | IAdd_timestamp_to_seconds (_, k) -> (next [@ocaml.tailcall]) k\n    | ISub_timestamp_seconds (_, k) -> (next [@ocaml.tailcall]) k\n    | IDiff_timestamps (_, k) -> (next [@ocaml.tailcall]) k\n    | IAdd_tez (_, k) -> (next [@ocaml.tailcall]) k\n    | ISub_tez (_, k) -> (next [@ocaml.tailcall]) k\n    | ISub_tez_legacy (_, k) -> (next [@ocaml.tailcall]) k\n    | IMul_teznat (_, k) -> (next [@ocaml.tailcall]) k\n    | IMul_nattez (_, k) -> (next [@ocaml.tailcall]) k\n    | IEdiv_teznat (_, k) -> (next [@ocaml.tailcall]) k\n    | IEdiv_tez (_, k) -> (next [@ocaml.tailcall]) k\n    | IOr (_, k) -> (next [@ocaml.tailcall]) k\n    | IAnd (_, k) -> (next [@ocaml.tailcall]) k\n    | IXor (_, k) -> (next [@ocaml.tailcall]) k\n    | INot (_, k) -> (next [@ocaml.tailcall]) k\n    | IIs_nat (_, k) -> (next [@ocaml.tailcall]) k\n    | INeg (_, k) -> (next [@ocaml.tailcall]) k\n    | IAbs_int (_, k) -> (next [@ocaml.tailcall]) k\n    | IInt_nat (_, k) -> (next [@ocaml.tailcall]) k\n    | IAdd_int (_, k) -> (next [@ocaml.tailcall]) k\n    | IAdd_nat (_, k) -> (next [@ocaml.tailcall]) k\n    | ISub_int (_, k) -> (next [@ocaml.tailcall]) k\n    | IMul_int (_, k) -> (next [@ocaml.tailcall]) k\n    | IMul_nat (_, k) -> (next [@ocaml.tailcall]) k\n    | IEdiv_int (_, k) -> (next [@ocaml.tailcall]) k\n    | IEdiv_nat (_, k) -> (next [@ocaml.tailcall]) k\n    | ILsl_nat (_, k) -> (next [@ocaml.tailcall]) k\n    | ILsr_nat (_, k) -> (next [@ocaml.tailcall]) k\n    | IOr_nat (_, k) -> (next [@ocaml.tailcall]) k\n    | IAnd_nat (_, k) -> (next [@ocaml.tailcall]) k\n    | IAnd_int_nat (_, k) -> (next [@ocaml.tailcall]) k\n    | IXor_nat (_, k) -> (next [@ocaml.tailcall]) k\n    | INot_int (_, k) -> (next [@ocaml.tailcall]) k\n    | IIf {kinfo = _; branch_if_true = k1; branch_if_false = k2; k} ->\n        (next3 [@ocaml.tailcall]) k1 k2 k\n    | ILoop (_, k1, k2) -> (next2 [@ocaml.tailcall]) k1 k2\n    | ILoop_left (_, k1, k2) -> (next2 [@ocaml.tailcall]) k1 k2\n    | IDip (_, k1, k2) -> (next2 [@ocaml.tailcall]) k1 k2\n    | IExec (_, k) -> (next [@ocaml.tailcall]) k\n    | IApply (_, _, k) -> (next [@ocaml.tailcall]) k\n    | ILambda (_, _, k) -> (next [@ocaml.tailcall]) k\n    | IFailwith (_, _, _) -> (return [@ocaml.tailcall]) ()\n    | ICompare (_, _, k) -> (next [@ocaml.tailcall]) k\n    | IEq (_, k) -> (next [@ocaml.tailcall]) k\n    | INeq (_, k) -> (next [@ocaml.tailcall]) k\n    | ILt (_, k) -> (next [@ocaml.tailcall]) k\n    | IGt (_, k) -> (next [@ocaml.tailcall]) k\n    | ILe (_, k) -> (next [@ocaml.tailcall]) k\n    | IGe (_, k) -> (next [@ocaml.tailcall]) k\n    | IAddress (_, k) -> (next [@ocaml.tailcall]) k\n    | IContract (_, _, _, k) -> (next [@ocaml.tailcall]) k\n    | IView (_, _, k) -> (next [@ocaml.tailcall]) k\n    | ITransfer_tokens (_, k) -> (next [@ocaml.tailcall]) k\n    | IImplicit_account (_, k) -> (next [@ocaml.tailcall]) k\n    | ICreate_contract {k; _} -> (next [@ocaml.tailcall]) k\n    | ISet_delegate (_, k) -> (next [@ocaml.tailcall]) k\n    | INow (_, k) -> (next [@ocaml.tailcall]) k\n    | IBalance (_, k) -> (next [@ocaml.tailcall]) k\n    | ILevel (_, k) -> (next [@ocaml.tailcall]) k\n    | ICheck_signature (_, k) -> (next [@ocaml.tailcall]) k\n    | IHash_key (_, k) -> (next [@ocaml.tailcall]) k\n    | IPack (_, _, k) -> (next [@ocaml.tailcall]) k\n    | IUnpack (_, _, k) -> (next [@ocaml.tailcall]) k\n    | IBlake2b (_, k) -> (next [@ocaml.tailcall]) k\n    | ISha256 (_, k) -> (next [@ocaml.tailcall]) k\n    | ISha512 (_, k) -> (next [@ocaml.tailcall]) k\n    | ISource (_, k) -> (next [@ocaml.tailcall]) k\n    | ISender (_, k) -> (next [@ocaml.tailcall]) k\n    | ISelf (_, _, _, k) -> (next [@ocaml.tailcall]) k\n    | ISelf_address (_, k) -> (next [@ocaml.tailcall]) k\n    | IAmount (_, k) -> (next [@ocaml.tailcall]) k\n    | ISapling_empty_state (_, _, k) -> (next [@ocaml.tailcall]) k\n    | ISapling_verify_update (_, k) -> (next [@ocaml.tailcall]) k\n    | IDig (_, _, _, k) -> (next [@ocaml.tailcall]) k\n    | IDug (_, _, _, k) -> (next [@ocaml.tailcall]) k\n    | IDipn (_, _, _, k1, k2) -> (next2 [@ocaml.tailcall]) k1 k2\n    | IDropn (_, _, _, k) -> (next [@ocaml.tailcall]) k\n    | IChainId (_, k) -> (next [@ocaml.tailcall]) k\n    | INever _ -> (return [@ocaml.tailcall]) ()\n    | IVoting_power (_, k) -> (next [@ocaml.tailcall]) k\n    | ITotal_voting_power (_, k) -> (next [@ocaml.tailcall]) k\n    | IKeccak (_, k) -> (next [@ocaml.tailcall]) k\n    | ISha3 (_, k) -> (next [@ocaml.tailcall]) k\n    | IAdd_bls12_381_g1 (_, k) -> (next [@ocaml.tailcall]) k\n    | IAdd_bls12_381_g2 (_, k) -> (next [@ocaml.tailcall]) k\n    | IAdd_bls12_381_fr (_, k) -> (next [@ocaml.tailcall]) k\n    | IMul_bls12_381_g1 (_, k) -> (next [@ocaml.tailcall]) k\n    | IMul_bls12_381_g2 (_, k) -> (next [@ocaml.tailcall]) k\n    | IMul_bls12_381_fr (_, k) -> (next [@ocaml.tailcall]) k\n    | IMul_bls12_381_z_fr (_, k) -> (next [@ocaml.tailcall]) k\n    | IMul_bls12_381_fr_z (_, k) -> (next [@ocaml.tailcall]) k\n    | IInt_bls12_381_fr (_, k) -> (next [@ocaml.tailcall]) k\n    | INeg_bls12_381_g1 (_, k) -> (next [@ocaml.tailcall]) k\n    | INeg_bls12_381_g2 (_, k) -> (next [@ocaml.tailcall]) k\n    | INeg_bls12_381_fr (_, k) -> (next [@ocaml.tailcall]) k\n    | IPairing_check_bls12_381 (_, k) -> (next [@ocaml.tailcall]) k\n    | IComb (_, _, _, k) -> (next [@ocaml.tailcall]) k\n    | IUncomb (_, _, _, k) -> (next [@ocaml.tailcall]) k\n    | IComb_get (_, _, _, k) -> (next [@ocaml.tailcall]) k\n    | IComb_set (_, _, _, k) -> (next [@ocaml.tailcall]) k\n    | IDup_n (_, _, _, k) -> (next [@ocaml.tailcall]) k\n    | ITicket (_, k) -> (next [@ocaml.tailcall]) k\n    | IRead_ticket (_, k) -> (next [@ocaml.tailcall]) k\n    | ISplit_ticket (_, k) -> (next [@ocaml.tailcall]) k\n    | IJoin_tickets (_, _, k) -> (next [@ocaml.tailcall]) k\n    | IOpen_chest (_, k) -> (next [@ocaml.tailcall]) k\n    | IHalt _ -> (return [@ocaml.tailcall]) ()\n    | ILog (_, _, _, k) -> (next [@ocaml.tailcall]) k\n  in\n  aux init i (fun accu -> accu)\n\ntype 'a ty_traverse = {\n  apply : 't. 'a -> 't ty -> 'a;\n  apply_comparable : 't. 'a -> 't comparable_ty -> 'a;\n}\n\nlet (ty_traverse, comparable_ty_traverse) =\n  let rec aux :\n      type t ret accu.\n      accu ty_traverse -> accu -> t comparable_ty -> (accu -> ret) -> ret =\n   fun f accu ty continue ->\n    let accu = f.apply_comparable accu ty in\n    let next2 ty1 ty2 =\n      (aux [@ocaml.tailcall]) f accu ty1 @@ fun accu ->\n      (aux [@ocaml.tailcall]) f accu ty2 @@ fun accu ->\n      (continue [@ocaml.tailcall]) accu\n    in\n    let next ty1 =\n      (aux [@ocaml.tailcall]) f accu ty1 @@ fun accu ->\n      (continue [@ocaml.tailcall]) accu\n    in\n    let return () = (continue [@ocaml.tailcall]) accu in\n    match ty with\n    | Unit_key _ | Int_key _ | Nat_key _ | Signature_key _ | String_key _\n    | Bytes_key _ | Mutez_key _ | Key_hash_key _ | Key_key _ | Timestamp_key _\n    | Address_key _ | Bool_key _ | Chain_id_key _ | Never_key _ ->\n        (return [@ocaml.tailcall]) ()\n    | Pair_key ((ty1, _), (ty2, _), _) -> (next2 [@ocaml.tailcall]) ty1 ty2\n    | Union_key ((ty1, _), (ty2, _), _) -> (next2 [@ocaml.tailcall]) ty1 ty2\n    | Option_key (ty, _) -> (next [@ocaml.tailcall]) ty\n  and aux' :\n      type ret t accu. accu ty_traverse -> accu -> t ty -> (accu -> ret) -> ret\n      =\n   fun f accu ty continue ->\n    let accu = f.apply accu ty in\n    match (ty : t ty) with\n    | Unit_t _ | Int_t _ | Nat_t _ | Signature_t _ | String_t _ | Bytes_t _\n    | Mutez_t _ | Key_hash_t _ | Key_t _ | Timestamp_t _ | Address_t _\n    | Bool_t _\n    | Sapling_transaction_t (_, _)\n    | Sapling_state_t (_, _)\n    | Operation_t _ | Chain_id_t _ | Never_t _ | Bls12_381_g1_t _\n    | Bls12_381_g2_t _ | Bls12_381_fr_t _ ->\n        (continue [@ocaml.tailcall]) accu\n    | Ticket_t (cty, _) -> aux f accu cty continue\n    | Chest_key_t _ | Chest_t _ -> (continue [@ocaml.tailcall]) accu\n    | Pair_t ((ty1, _, _), (ty2, _, _), _) ->\n        (next2' [@ocaml.tailcall]) f accu ty1 ty2 continue\n    | Union_t ((ty1, _), (ty2, _), _) ->\n        (next2' [@ocaml.tailcall]) f accu ty1 ty2 continue\n    | Lambda_t (ty1, ty2, _) ->\n        (next2' [@ocaml.tailcall]) f accu ty1 ty2 continue\n    | Option_t (ty1, _) -> (next' [@ocaml.tailcall]) f accu ty1 continue\n    | List_t (ty1, _) -> (next' [@ocaml.tailcall]) f accu ty1 continue\n    | Set_t (cty, _) -> (aux [@ocaml.tailcall]) f accu cty @@ continue\n    | Map_t (cty, ty1, _) ->\n        (aux [@ocaml.tailcall]) f accu cty @@ fun accu ->\n        (next' [@ocaml.tailcall]) f accu ty1 continue\n    | Big_map_t (cty, ty1, _) ->\n        (aux [@ocaml.tailcall]) f accu cty @@ fun accu ->\n        (next' [@ocaml.tailcall]) f accu ty1 continue\n    | Contract_t (ty1, _) -> (next' [@ocaml.tailcall]) f accu ty1 continue\n  and next2' :\n      type a b ret accu.\n      accu ty_traverse -> accu -> a ty -> b ty -> (accu -> ret) -> ret =\n   fun f accu ty1 ty2 continue ->\n    (aux' [@ocaml.tailcall]) f accu ty1 @@ fun accu ->\n    (aux' [@ocaml.tailcall]) f accu ty2 @@ fun accu ->\n    (continue [@ocaml.tailcall]) accu\n  and next' :\n      type a ret accu. accu ty_traverse -> accu -> a ty -> (accu -> ret) -> ret\n      =\n   fun f accu ty1 continue ->\n    (aux' [@ocaml.tailcall]) f accu ty1 @@ fun accu ->\n    (continue [@ocaml.tailcall]) accu\n  in\n  ( (fun ty init f -> aux' f init ty (fun accu -> accu)),\n    fun cty init f -> aux f init cty (fun accu -> accu) )\n\ntype 'accu stack_ty_traverse = {\n  apply : 'ty 's. 'accu -> ('ty, 's) stack_ty -> 'accu;\n}\n\nlet stack_ty_traverse (type a t) (sty : (a, t) stack_ty) init f =\n  let rec aux : type b u. 'accu -> (b, u) stack_ty -> 'accu =\n   fun accu sty ->\n    match sty with\n    | Bot_t -> f.apply accu sty\n    | Item_t (_, sty', _) -> aux (f.apply accu sty) sty'\n  in\n  aux init sty\n\ntype 'a value_traverse = {\n  apply : 't. 'a -> 't ty -> 't -> 'a;\n  apply_comparable : 't. 'a -> 't comparable_ty -> 't -> 'a;\n}\n\nlet value_traverse (type t) (ty : (t ty, t comparable_ty) union) (x : t) init f\n    =\n  let rec aux : type ret t. 'accu -> t ty -> t -> ('accu -> ret) -> ret =\n   fun accu ty x continue ->\n    let accu = f.apply accu ty x in\n    let next2 ty1 ty2 x1 x2 =\n      (aux [@ocaml.tailcall]) accu ty1 x1 @@ fun accu ->\n      (aux [@ocaml.tailcall]) accu ty2 x2 @@ fun accu ->\n      (continue [@ocaml.tailcall]) accu\n    in\n    let next ty1 x1 =\n      (aux [@ocaml.tailcall]) accu ty1 x1 @@ fun accu ->\n      (continue [@ocaml.tailcall]) accu\n    in\n    let return () = (continue [@ocaml.tailcall]) accu in\n    let rec on_list ty' accu = function\n      | [] -> (continue [@ocaml.tailcall]) accu\n      | x :: xs ->\n          (aux [@ocaml.tailcall]) accu ty' x @@ fun accu ->\n          (on_list [@ocaml.tailcall]) ty' accu xs\n    in\n    match ty with\n    | Unit_t _ | Int_t _ | Nat_t _ | Signature_t _ | String_t _ | Bytes_t _\n    | Mutez_t _ | Key_hash_t _ | Key_t _ | Timestamp_t _ | Address_t _\n    | Bool_t _\n    | Sapling_transaction_t (_, _)\n    | Sapling_state_t (_, _)\n    | Operation_t _ | Chain_id_t _ | Never_t _ | Bls12_381_g1_t _\n    | Bls12_381_g2_t _ | Bls12_381_fr_t _ | Chest_key_t _ | Chest_t _\n    | Lambda_t (_, _, _) ->\n        (return [@ocaml.tailcall]) ()\n    | Pair_t ((ty1, _, _), (ty2, _, _), _) ->\n        (next2 [@ocaml.tailcall]) ty1 ty2 (fst x) (snd x)\n    | Union_t ((ty1, _), (ty2, _), _) -> (\n        match x with\n        | L l -> (next [@ocaml.tailcall]) ty1 l\n        | R r -> (next [@ocaml.tailcall]) ty2 r)\n    | Option_t (ty, _) -> (\n        match x with\n        | None -> return ()\n        | Some v -> (next [@ocaml.tailcall]) ty v)\n    | Ticket_t (cty, _) -> (aux' [@ocaml.tailcall]) accu cty x.contents continue\n    | List_t (ty', _) -> on_list ty' accu x.elements\n    | Map_t (kty, ty', _) ->\n        let module M = (val x) in\n        let bindings = M.OPS.fold (fun k v bs -> (k, v) :: bs) M.boxed [] in\n        on_bindings accu kty ty' continue bindings\n    | Set_t (ty', _) ->\n        let module M = (val x) in\n        let elements = M.OPS.fold (fun x s -> x :: s) M.boxed [] in\n        on_list' accu ty' elements continue\n    | Big_map_t (_, _, _) ->\n        (* For big maps, there is no obvious recursion scheme so we\n           delegate this case to the client. *)\n        (return [@ocaml.tailcall]) ()\n    | Contract_t (_, _) -> (return [@ocaml.tailcall]) ()\n  and on_list' :\n      type ret t. 'accu -> t comparable_ty -> t list -> ('accu -> ret) -> ret =\n   fun accu ty' xs continue ->\n    match xs with\n    | [] -> (continue [@ocaml.tailcall]) accu\n    | x :: xs ->\n        (aux' [@ocaml.tailcall]) accu ty' x @@ fun accu ->\n        (on_list' [@ocaml.tailcall]) accu ty' xs continue\n  and on_bindings :\n      type ret k v.\n      'accu -> k comparable_ty -> v ty -> ('accu -> ret) -> (k * v) list -> ret\n      =\n   fun accu kty ty' continue xs ->\n    match xs with\n    | [] -> (continue [@ocaml.tailcall]) accu\n    | (k, v) :: xs ->\n        (aux' [@ocaml.tailcall]) accu kty k @@ fun accu ->\n        (aux [@ocaml.tailcall]) accu ty' v @@ fun accu ->\n        (on_bindings [@ocaml.tailcall]) accu kty ty' continue xs\n  and aux' : type ret t. 'accu -> t comparable_ty -> t -> ('accu -> ret) -> ret\n      =\n   fun accu ty x continue ->\n    let accu = f.apply_comparable accu ty x in\n    let next2 ty1 ty2 x1 x2 =\n      (aux' [@ocaml.tailcall]) accu ty1 x1 @@ fun accu ->\n      (aux' [@ocaml.tailcall]) accu ty2 x2 @@ fun accu ->\n      (continue [@ocaml.tailcall]) accu\n    in\n    let next ty1 x1 =\n      (aux' [@ocaml.tailcall]) accu ty1 x1 @@ fun accu ->\n      (continue [@ocaml.tailcall]) accu\n    in\n    let return () = (continue [@ocaml.tailcall]) accu in\n    match ty with\n    | Unit_key _ | Int_key _ | Nat_key _ | Signature_key _ | String_key _\n    | Bytes_key _ | Mutez_key _ | Key_hash_key _ | Key_key _ | Timestamp_key _\n    | Address_key _ | Bool_key _ | Chain_id_key _ | Never_key _ ->\n        (return [@ocaml.tailcall]) ()\n    | Pair_key ((ty1, _), (ty2, _), _) ->\n        (next2 [@ocaml.tailcall]) ty1 ty2 (fst x) (snd x)\n    | Union_key ((ty1, _), (ty2, _), _) -> (\n        match x with\n        | L l -> (next [@ocaml.tailcall]) ty1 l\n        | R r -> (next [@ocaml.tailcall]) ty2 r)\n    | Option_key (ty, _) -> (\n        match x with\n        | None -> (return [@ocaml.tailcall]) ()\n        | Some v -> (next [@ocaml.tailcall]) ty v)\n  in\n  match ty with\n  | L ty -> aux init ty x (fun accu -> accu)\n  | R cty -> aux' init cty x (fun accu -> accu)\n  [@@coq_axiom_with_reason \"local mutually recursive definition not handled\"]\n\nlet stack_top_ty : type a b s. (a, b * s) stack_ty -> a ty = function\n  | Item_t (ty, _, _) -> ty\n" ;
                } ;
                { name = "Script_typed_ir_size" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** This module provides overapproximation of memory footprint for\n   Michelson-related values.\n\n   These overapproximations are used by the cache to evaluate its own\n   memory footprint and enforce declared limit over its size.\n\n*)\n\n(** [value_size ty v] returns an overapproximation of the size of the\n   in-memory representation of [v] of type [ty]. *)\nval value_size :\n  'a Script_typed_ir.ty -> 'a -> Cache_memory_helpers.nodes_and_size\n\n(** [ty_size ty] returns an overapproximation of the size of the\n   in-memory representation of type [ty]. *)\nval ty_size : 'a Script_typed_ir.ty -> Cache_memory_helpers.nodes_and_size\n\n(** [comparable_ty_size cty] returns an overapproximation of the size\n   of the in-memory representation of comparable type [cty]. *)\nval comparable_ty_size :\n  'a Script_typed_ir.comparable_ty -> Cache_memory_helpers.nodes_and_size\n\n(** [lambda_size l] returns an overapproximation of the size of the\n    internal IR for the Michelson lambda abstraction [l]. *)\nval lambda_size :\n  ('a, 'b) Script_typed_ir.lambda -> Cache_memory_helpers.nodes_and_size\n\n(** [kinstr_size i] returns an overapproximation of the size of the\n    internal IR [i]. *)\nval kinstr_size :\n  ('a, 's, 'r, 'f) Script_typed_ir.kinstr -> Cache_memory_helpers.nodes_and_size\n\n(** [node_size root] returns the size of the in-memory representation\n   of [root] in bytes. This is an over-approximation of the memory\n   actually consumed by [root] since no sharing is taken into\n   account. *)\nval node_size : Script_repr.node -> Cache_memory_helpers.nodes_and_size\n\n(** Pointwise addition (reexport from {!Cache_memory_helpers}) *)\nval ( ++ ) :\n  Cache_memory_helpers.nodes_and_size ->\n  Cache_memory_helpers.nodes_and_size ->\n  Cache_memory_helpers.nodes_and_size\n\n(** Zero vector (reexport from {!Cache_memory_helpers}) *)\nval zero : Cache_memory_helpers.nodes_and_size\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\nopen Script_typed_ir\ninclude Cache_memory_helpers\n\nlet script_string_size s = Script_string.to_string s |> string_size\n\n(* Memo-sizes are 16-bit integers *)\nlet sapling_memo_size_size = !!0\n\nlet (comparable_ty_size, ty_size) =\n  let base {annot = _; size = _} = hh3w in\n  let apply_comparable :\n      type a. nodes_and_size -> a comparable_ty -> nodes_and_size =\n   fun accu cty ->\n    match cty with\n    | Unit_key a -> ret_succ_adding accu (base a)\n    | Int_key a -> ret_succ_adding accu (base a)\n    | Nat_key a -> ret_succ_adding accu (base a)\n    | Signature_key a -> ret_succ_adding accu (base a)\n    | String_key a -> ret_succ_adding accu (base a)\n    | Bytes_key a -> ret_succ_adding accu (base a)\n    | Mutez_key a -> ret_succ_adding accu (base a)\n    | Key_hash_key a -> ret_succ_adding accu (base a)\n    | Key_key a -> ret_succ_adding accu (base a)\n    | Timestamp_key a -> ret_succ_adding accu (base a)\n    | Address_key a -> ret_succ_adding accu (base a)\n    | Bool_key a -> ret_succ_adding accu (base a)\n    | Chain_id_key a -> ret_succ_adding accu (base a)\n    | Never_key a -> ret_succ_adding accu (base a)\n    | Pair_key ((_ty1, _fa1), (_ty2, _fa2), a) ->\n        ret_succ_adding accu @@ (base a +! hh6w)\n    | Union_key ((_ty1, _fa1), (_ty2, _fa2), a) ->\n        ret_succ_adding accu @@ (base a +! hh6w)\n    | Option_key (_ty, a) -> ret_succ_adding accu @@ (base a +! word_size)\n  and apply : type a. nodes_and_size -> a ty -> nodes_and_size =\n   fun accu ty ->\n    match ty with\n    | Unit_t a -> ret_succ_adding accu @@ base a\n    | Int_t a -> ret_succ_adding accu @@ base a\n    | Nat_t a -> ret_succ_adding accu @@ base a\n    | Signature_t a -> ret_succ_adding accu @@ base a\n    | String_t a -> ret_succ_adding accu @@ base a\n    | Bytes_t a -> ret_succ_adding accu @@ base a\n    | Mutez_t a -> ret_succ_adding accu @@ base a\n    | Key_hash_t a -> ret_succ_adding accu @@ base a\n    | Key_t a -> ret_succ_adding accu @@ base a\n    | Timestamp_t a -> ret_succ_adding accu @@ base a\n    | Address_t a -> ret_succ_adding accu @@ base a\n    | Bool_t a -> ret_succ_adding accu @@ base a\n    | Operation_t a -> ret_succ_adding accu @@ base a\n    | Chain_id_t a -> ret_succ_adding accu @@ base a\n    | Never_t a -> ret_succ_adding accu @@ base a\n    | Bls12_381_g1_t a -> ret_succ_adding accu @@ base a\n    | Bls12_381_g2_t a -> ret_succ_adding accu @@ base a\n    | Bls12_381_fr_t a -> ret_succ_adding accu @@ base a\n    | Chest_key_t a -> ret_succ_adding accu @@ base a\n    | Chest_t a -> ret_succ_adding accu @@ base a\n    | Pair_t ((_ty1, _fa1, _va1), (_ty2, _fa2, _va2), a) ->\n        ret_succ_adding accu @@ (base a +! hh8w)\n    | Union_t ((_ty1, _fa1), (_ty2, _fa2), a) ->\n        ret_succ_adding accu @@ (base a +! hh6w)\n    | Lambda_t (_ty1, _ty2, a) ->\n        ret_succ_adding accu @@ (base a +! (word_size *? 2))\n    | Option_t (_ty, a) -> ret_succ_adding accu @@ (base a +! word_size)\n    | List_t (_ty, a) -> ret_succ_adding accu @@ (base a +! word_size)\n    | Set_t (_cty, a) -> ret_succ_adding accu @@ (base a +! word_size)\n    | Map_t (_cty, _ty, a) ->\n        ret_succ_adding accu @@ (base a +! (word_size *? 2))\n    | Big_map_t (_cty, _ty, a) ->\n        ret_succ_adding accu @@ (base a +! (word_size *? 2))\n    | Contract_t (_ty, a) -> ret_succ_adding accu @@ (base a +! word_size)\n    | Sapling_transaction_t (_m, a) ->\n        ret_succ_adding accu @@ (base a +! sapling_memo_size_size +! word_size)\n    | Sapling_state_t (_m, a) ->\n        ret_succ_adding accu @@ (base a +! sapling_memo_size_size +! word_size)\n    | Ticket_t (_cty, a) -> ret_succ_adding accu @@ (base a +! word_size)\n  in\n  let f = ({apply; apply_comparable} : nodes_and_size ty_traverse) in\n  ( (fun cty -> comparable_ty_traverse cty zero f),\n    fun ty -> ty_traverse ty zero f )\n\nlet stack_ty_size s =\n  let apply : type a s. nodes_and_size -> (a, s) stack_ty -> nodes_and_size =\n   fun accu s ->\n    match s with\n    | Bot_t -> ret_succ accu\n    | Item_t (ty, _, _annot) -> ret_succ_adding (accu ++ ty_size ty) h3w\n  in\n  stack_ty_traverse s zero {apply}\n\nlet script_nat_size n = Script_int.to_zint n |> z_size\n\nlet script_int_size n = Script_int.to_zint n |> z_size\n\nlet signature_size = h3w +? Signature.size\n\nlet key_hash_size (x : Signature.public_key_hash) =\n  h1w\n  +? Signature.(\n       match x with\n       | Ed25519 _ -> Ed25519.Public_key_hash.size\n       | Secp256k1 _ -> Secp256k1.Public_key_hash.size\n       | P256 _ -> P256.Public_key_hash.size)\n\nlet public_key_size (x : public_key) =\n  let ks = Signature.Public_key.size x in\n  h1w +? ks\n\nlet mutez_size = h2w\n\nlet timestamp_size x = Script_timestamp.to_zint x |> z_size\n\nlet contract_size = Contract.in_memory_size\n\nlet address_size ((c, s) : address) = h2w +! contract_size c +! string_size s\n\nlet view_signature_size (View_signature {name; input_ty; output_ty}) =\n  ret_adding\n    (ty_size input_ty ++ ty_size output_ty)\n    (h3w +! script_string_size name)\n\nlet script_expr_hash_size = Script_expr_hash.size\n\nlet peano_shape_proof =\n  let scale = header_size +! h1w in\n  fun k -> scale *? k\n\nlet stack_prefix_preservation_witness_size =\n  let kinfo_size = h2w in\n  let scale = header_size +! (h2w +! kinfo_size) in\n  fun k -> scale *? k\n\nlet comb_gadt_witness_size = peano_shape_proof\n\nlet uncomb_gadt_witness_size = peano_shape_proof\n\nlet comb_get_gadt_witness_size = peano_shape_proof\n\nlet comb_set_gadt_witness_size = peano_shape_proof\n\nlet dup_n_gadt_witness_size = peano_shape_proof\n\nlet contract_size (arg_ty, address) =\n  ret_adding (ty_size arg_ty) (h2w +! address_size address)\n\nlet sapling_state_size {Sapling.id; diff; memo_size = _} =\n  h3w\n  +! option_size (fun x -> z_size (Sapling.Id.unparse_to_z x)) id\n  +! Sapling.diff_in_memory_size diff\n  +! sapling_memo_size_size\n\nlet operation_size\n    (operation :\n      packed_internal_operation * Lazy_storage.diffs_item list option) =\n  let (poi, diffs) = operation in\n  ret_adding\n    (Operation.packed_internal_operation_in_memory_size poi\n    ++ option_size_vec Lazy_storage.diffs_in_memory_size diffs)\n    h2w\n\nlet chain_id_size = h1w +? Chain_id.size\n\n(* [contents] is handle by the recursion scheme in [value_size] *)\nlet ticket_size {ticketer; contents = _; amount} =\n  h3w +! Contract.in_memory_size ticketer +! script_nat_size amount\n\nlet chest_size chest =\n  (*\n     type chest = {\n       locked_value : locked_value;\n       rsa_public : rsa_public;\n       ciphertext : ciphertext;\n     }\n  *)\n  let locked_value_size = 256 in\n  let rsa_public_size = 256 in\n  let ciphertext_size = Timelock.get_plaintext_size chest in\n  h3w +? (locked_value_size + rsa_public_size + ciphertext_size)\n\nlet chest_key_size _ =\n  (*\n     type chest_key = {\n       unlocked_value : unlocked_value;\n       proof : time_lock_proof\n     }\n  *)\n  let unlocked_value_size = 256 in\n  let proof_size = 256 in\n  h2w +? (unlocked_value_size + proof_size)\n\nlet view_size {input_ty; output_ty; view_code} =\n  ret_adding\n    (node_size input_ty ++ node_size output_ty ++ node_size view_code)\n    h3w\n\nlet views_size views =\n  SMap.fold\n    (fun k view accu ->\n      ret_adding (accu ++ view_size view) (script_string_size k +! h4w))\n    views\n    zero\n\nlet kinfo_size {iloc = _; kstack_ty = _} = h2w\n\n(* The following mutually recursive functions are mostly\n   tail-recursive and the only recursive call that is not a tailcall\n   cannot be nested. (See [big_map_size].) For this reason, these\n   functions should not trigger stack overflows. *)\nlet rec value_size :\n    type a.\n    count_lambda_nodes:bool ->\n    nodes_and_size ->\n    (a ty, a comparable_ty) union ->\n    a ->\n    nodes_and_size =\n fun ~count_lambda_nodes accu ty x ->\n  let apply : type a. nodes_and_size -> a ty -> a -> nodes_and_size =\n   fun accu ty x ->\n    match ty with\n    | Unit_t _ -> ret_succ accu\n    | Int_t _ -> ret_succ_adding accu (script_int_size x)\n    | Nat_t _ -> ret_succ_adding accu (script_nat_size x)\n    | Signature_t _ -> ret_succ_adding accu signature_size\n    | String_t _ -> ret_succ_adding accu (script_string_size x)\n    | Bytes_t _ -> ret_succ_adding accu (bytes_size x)\n    | Mutez_t _ -> ret_succ_adding accu mutez_size\n    | Key_hash_t _ -> ret_succ_adding accu (key_hash_size x)\n    | Key_t _ -> ret_succ_adding accu (public_key_size x)\n    | Timestamp_t _ -> ret_succ_adding accu (timestamp_size x)\n    | Address_t _ -> ret_succ_adding accu (address_size x)\n    | Bool_t _ -> ret_succ accu\n    | Pair_t (_, _, _) -> ret_succ_adding accu h2w\n    | Union_t (_, _, _) -> ret_succ_adding accu h1w\n    | Lambda_t (_, _, _) ->\n        (lambda_size [@ocaml.tailcall]) ~count_lambda_nodes (ret_succ accu) x\n    | Option_t (_, _) -> ret_succ_adding accu (option_size (fun _ -> !!0) x)\n    | List_t (_, _) -> ret_succ_adding accu (h2w +! (h2w *? x.length))\n    | Set_t (_, _) ->\n        let module M = (val x) in\n        let boxing_space = !!300 in\n        ret_succ_adding accu (boxing_space +! (h4w *? M.size))\n    | Map_t (_, _, _) ->\n        let module M = (val x) in\n        let boxing_space = !!300 in\n        ret_succ_adding accu (boxing_space +! (h5w *? M.size))\n    | Big_map_t (cty, ty', _) ->\n        (big_map_size [@ocaml.tailcall])\n          ~count_lambda_nodes\n          (ret_succ accu)\n          cty\n          ty'\n          x\n    | Contract_t (_, _) -> ret_succ (accu ++ contract_size x)\n    | Sapling_transaction_t (_, _) ->\n        ret_succ_adding accu (Sapling.transaction_in_memory_size x)\n    | Sapling_state_t (_, _) -> ret_succ_adding accu (sapling_state_size x)\n    | Operation_t _ -> ret_succ (accu ++ operation_size x)\n    | Chain_id_t _ -> ret_succ_adding accu chain_id_size\n    | Never_t _ -> ( match x with _ -> .)\n    (* Related to https://gitlab.com/dannywillems/ocaml-bls12-381/-/issues/56.\n       Since the update to blst as a backend for bls12-381, size_in_bytes is not\n       the correct value for the allocated memory.\n       There is 1 word for the OCaml block header, 1 word for the C pointer and\n       a certain number of words for the actual value of the algebraic object\n       whose size is fixed and defined by the object itself.\n       For G1, it allocates 3 C values of type blst_fp which is 48 bytes.\n       For G2, it allocates 3 C values of type blst_fp2 which is 48 * 2 bytes.\n       For Fr, it allocates 1 C value of type blst_fr which is 32 bytes.\n    *)\n    | Bls12_381_g1_t _ -> ret_succ_adding accu !!((2 * 8) + (3 * 48))\n    | Bls12_381_g2_t _ -> ret_succ_adding accu !!((2 * 8) + (3 * 48 * 2))\n    | Bls12_381_fr_t _ -> ret_succ_adding accu !!((2 * 8) + 32)\n    | Ticket_t (_, _) -> ret_succ_adding accu (ticket_size x)\n    | Chest_key_t _ -> ret_succ_adding accu (chest_key_size x)\n    | Chest_t _ -> ret_succ_adding accu (chest_size x)\n  in\n  let apply_comparable :\n      type a. nodes_and_size -> a comparable_ty -> a -> nodes_and_size =\n   fun accu ty x ->\n    match ty with\n    | Unit_key _ -> ret_succ accu\n    | Int_key _ -> ret_succ_adding accu (script_int_size x)\n    | Nat_key _ -> ret_succ_adding accu (script_nat_size x)\n    | Signature_key _ -> ret_succ_adding accu signature_size\n    | String_key _ -> ret_succ_adding accu (script_string_size x)\n    | Bytes_key _ -> ret_succ_adding accu (bytes_size x)\n    | Mutez_key _ -> ret_succ_adding accu mutez_size\n    | Key_hash_key _ -> ret_succ_adding accu (key_hash_size x)\n    | Key_key _ -> ret_succ_adding accu (public_key_size x)\n    | Timestamp_key _ -> ret_succ_adding accu (timestamp_size x)\n    | Address_key _ -> ret_succ_adding accu (address_size x)\n    | Bool_key _ -> ret_succ accu\n    | Pair_key (_, _, _) -> ret_succ_adding accu h2w\n    | Union_key (_, _, _) -> ret_succ_adding accu h1w\n    | Option_key (_, _) -> ret_succ_adding accu (option_size (fun _ -> !!0) x)\n    | Chain_id_key _ -> ret_succ_adding accu chain_id_size\n    | Never_key _ -> ( match x with _ -> .)\n  in\n  value_traverse ty x accu {apply; apply_comparable}\n [@@coq_axiom_with_reason \"unreachable expressions '.' not handled for now\"]\n\nand big_map_size :\n    type a b.\n    count_lambda_nodes:bool ->\n    nodes_and_size ->\n    a comparable_ty ->\n    b ty ->\n    (a, b) big_map ->\n    nodes_and_size =\n fun ~count_lambda_nodes accu cty ty' {id; diff; key_type; value_type} ->\n  (* [Map.bindings] cannot overflow and only consumes a\n     logarithmic amount of stack. *)\n  let diff_size =\n    let map_size =\n      Big_map_overlay.fold\n        (fun _key_hash (key, value) accu ->\n          let accu = ret_succ_adding accu !!script_expr_hash_size in\n          (* The following recursive call cannot introduce a stack\n             overflow because this would require a key of type\n             big_map while big_map is not comparable. *)\n          let accu = value_size ~count_lambda_nodes accu (R cty) key in\n          match value with\n          | None -> accu\n          | Some value ->\n              (value_size [@ocaml.tailcall])\n                ~count_lambda_nodes\n                accu\n                (L ty')\n                value)\n        diff.map\n        accu\n    in\n\n    ret_adding map_size h2w\n  in\n  let big_map_id_size s = z_size (Big_map.Id.unparse_to_z s) in\n  let id_size = option_size big_map_id_size id in\n  ret_adding\n    (comparable_ty_size key_type ++ ty_size value_type ++ diff_size)\n    (h4w +! id_size)\n\nand lambda_size :\n    type i o.\n    count_lambda_nodes:bool -> nodes_and_size -> (i, o) lambda -> nodes_and_size\n    =\n fun ~count_lambda_nodes accu (Lam (kdescr, node)) ->\n  (* We assume that the nodes' size have already been counted if the\n     lambda is not a toplevel lambda. *)\n  let accu =\n    ret_adding (accu ++ if count_lambda_nodes then node_size node else zero) h2w\n  in\n  (kdescr_size [@ocaml.tailcall]) ~count_lambda_nodes:false accu kdescr\n\nand kdescr_size :\n    type a s r f.\n    count_lambda_nodes:bool ->\n    nodes_and_size ->\n    (a, s, r, f) kdescr ->\n    nodes_and_size =\n fun ~count_lambda_nodes accu {kloc = _; kbef; kaft; kinstr} ->\n  let accu =\n    ret_adding (accu ++ stack_ty_size kbef ++ stack_ty_size kaft) h4w\n  in\n  (kinstr_size [@ocaml.tailcall]) ~count_lambda_nodes accu kinstr\n\nand kinstr_size :\n    type a s r f.\n    count_lambda_nodes:bool ->\n    nodes_and_size ->\n    (a, s, r, f) kinstr ->\n    nodes_and_size =\n fun ~count_lambda_nodes accu t ->\n  let base kinfo = h2w +! kinfo_size kinfo in\n  let apply :\n      type a s r f. nodes_and_size -> (a, s, r, f) kinstr -> nodes_and_size =\n   fun accu t ->\n    match t with\n    | IDrop (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IDup (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ISwap (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IConst (kinfo, x, k) ->\n        let accu = ret_succ_adding accu (base kinfo +! word_size) in\n        (value_size [@ocaml.tailcall])\n          ~count_lambda_nodes\n          accu\n          (L (stack_top_ty (kinfo_of_kinstr k).kstack_ty))\n          x\n    | ICons_pair (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ICar (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ICdr (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IUnpair (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ICons_some (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ICons_none (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IIf_none {kinfo; _} -> ret_succ_adding accu (base kinfo)\n    | IOpt_map {kinfo; _} -> ret_succ_adding accu (base kinfo)\n    | ICons_left (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ICons_right (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IIf_left {kinfo; _} -> ret_succ_adding accu (base kinfo)\n    | ICons_list (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | INil (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IIf_cons {kinfo; _} -> ret_succ_adding accu (base kinfo)\n    | IList_map (kinfo, _, _) -> ret_succ_adding accu (base kinfo)\n    | IList_iter (kinfo, _, _) -> ret_succ_adding accu (base kinfo)\n    | IList_size (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IEmpty_set (kinfo, cty, _) ->\n        ret_succ_adding\n          (accu ++ comparable_ty_size cty)\n          (base kinfo +! word_size)\n    | ISet_iter (kinfo, _, _) -> ret_succ_adding accu (base kinfo)\n    | ISet_mem (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ISet_update (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ISet_size (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IEmpty_map (kinfo, cty, _) ->\n        ret_succ_adding\n          (accu ++ comparable_ty_size cty)\n          (base kinfo +! word_size)\n    | IMap_map (kinfo, _, _) -> ret_succ_adding accu (base kinfo +! word_size)\n    | IMap_iter (kinfo, _, _) -> ret_succ_adding accu (base kinfo +! word_size)\n    | IMap_mem (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IMap_get (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IMap_update (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IMap_get_and_update (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IMap_size (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IEmpty_big_map (kinfo, cty, ty, _) ->\n        ret_succ_adding\n          (accu ++ comparable_ty_size cty ++ ty_size ty)\n          (base kinfo +! (word_size *? 2))\n    | IBig_map_mem (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IBig_map_get (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IBig_map_update (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IBig_map_get_and_update (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IConcat_string (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IConcat_string_pair (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ISlice_string (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IString_size (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IConcat_bytes (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IConcat_bytes_pair (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ISlice_bytes (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IBytes_size (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IAdd_seconds_to_timestamp (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IAdd_timestamp_to_seconds (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ISub_timestamp_seconds (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IDiff_timestamps (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IAdd_tez (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ISub_tez (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ISub_tez_legacy (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IMul_teznat (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IMul_nattez (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IEdiv_teznat (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IEdiv_tez (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IOr (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IAnd (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IXor (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | INot (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IIs_nat (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | INeg (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IAbs_int (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IInt_nat (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IAdd_int (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IAdd_nat (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ISub_int (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IMul_int (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IMul_nat (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IEdiv_int (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IEdiv_nat (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ILsl_nat (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ILsr_nat (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IOr_nat (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IAnd_nat (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IAnd_int_nat (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IXor_nat (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | INot_int (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IIf {kinfo; _} -> ret_succ_adding accu (base kinfo)\n    | ILoop (kinfo, _, _) -> ret_succ_adding accu (base kinfo)\n    | ILoop_left (kinfo, _, _) -> ret_succ_adding accu (base kinfo +! word_size)\n    | IDip (kinfo, _, _) -> ret_succ_adding accu (base kinfo +! word_size)\n    | IExec (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IApply (kinfo, ty, _) ->\n        ret_succ_adding (accu ++ ty_size ty) (base kinfo +! word_size)\n    | ILambda (kinfo, lambda, _) ->\n        let accu = ret_succ_adding accu (base kinfo +! word_size) in\n        (lambda_size [@ocaml.tailcall]) ~count_lambda_nodes accu lambda\n    | IFailwith (kinfo, _, ty) ->\n        ret_succ_adding (accu ++ ty_size ty) (base kinfo +! word_size)\n    | ICompare (kinfo, cty, _) ->\n        ret_succ_adding\n          (accu ++ comparable_ty_size cty)\n          (base kinfo +! word_size)\n    | IEq (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | INeq (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ILt (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IGt (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ILe (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IGe (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IAddress (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IContract (kinfo, ty, s, _) ->\n        ret_succ_adding\n          (accu ++ ty_size ty)\n          (base kinfo +! string_size s +! (word_size *? 2))\n    | IView (kinfo, s, _) ->\n        ret_succ_adding (accu ++ view_signature_size s) (base kinfo +! word_size)\n    | ITransfer_tokens (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IImplicit_account (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ICreate_contract\n        {kinfo; storage_type; arg_type; lambda; root_name = _; views; k = _} ->\n        let accu =\n          ret_succ_adding\n            (accu ++ ty_size storage_type ++ ty_size arg_type\n           ++ views_size views)\n            (base kinfo +! (word_size *? 4))\n        in\n        (lambda_size [@ocaml.tailcall]) ~count_lambda_nodes accu lambda\n    | ISet_delegate (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | INow (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IBalance (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ILevel (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ICheck_signature (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IHash_key (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IPack (kinfo, ty, _) ->\n        ret_succ_adding (accu ++ ty_size ty) (base kinfo +! word_size)\n    | IUnpack (kinfo, ty, _) ->\n        ret_succ_adding (accu ++ ty_size ty) (base kinfo +! word_size)\n    | IBlake2b (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ISha256 (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ISha512 (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ISource (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ISender (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ISelf (kinfo, ty, s, _) ->\n        ret_succ_adding\n          (accu ++ ty_size ty)\n          (base kinfo +! (word_size *? 2) +! string_size s)\n    | ISelf_address (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IAmount (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ISapling_empty_state (kinfo, _m, _) ->\n        ret_succ_adding accu (base kinfo +! word_size +! sapling_memo_size_size)\n    | ISapling_verify_update (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IDig (kinfo, n, _, _) ->\n        ret_succ_adding\n          accu\n          (base kinfo +! (word_size *? 2)\n          +! stack_prefix_preservation_witness_size n)\n    | IDug (kinfo, n, _, _) ->\n        ret_succ_adding\n          accu\n          (base kinfo +! (word_size *? 2)\n          +! stack_prefix_preservation_witness_size n)\n    | IDipn (kinfo, n, _, _, _) ->\n        ret_succ_adding\n          accu\n          (base kinfo +! (word_size *? 2)\n          +! stack_prefix_preservation_witness_size n)\n    | IDropn (kinfo, n, _, _) ->\n        ret_succ_adding\n          accu\n          (base kinfo +! (word_size *? 2)\n          +! stack_prefix_preservation_witness_size n)\n    | IChainId (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | INever kinfo -> ret_succ_adding accu (kinfo_size kinfo)\n    | IVoting_power (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ITotal_voting_power (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IKeccak (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ISha3 (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IAdd_bls12_381_g1 (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IAdd_bls12_381_g2 (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IAdd_bls12_381_fr (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IMul_bls12_381_g1 (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IMul_bls12_381_g2 (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IMul_bls12_381_fr (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IMul_bls12_381_z_fr (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IMul_bls12_381_fr_z (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IInt_bls12_381_fr (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | INeg_bls12_381_g1 (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | INeg_bls12_381_g2 (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | INeg_bls12_381_fr (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IPairing_check_bls12_381 (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IComb (kinfo, n, _, _) ->\n        ret_succ_adding\n          accu\n          (base kinfo +! (word_size *? 2) +! comb_gadt_witness_size n)\n    | IUncomb (kinfo, n, _, _) ->\n        ret_succ_adding\n          accu\n          (base kinfo +! (word_size *? 2) +! uncomb_gadt_witness_size n)\n    | IComb_get (kinfo, n, _, _) ->\n        ret_succ_adding\n          accu\n          (base kinfo +! (word_size *? 2) +! comb_get_gadt_witness_size n)\n    | IComb_set (kinfo, n, _, _) ->\n        ret_succ_adding\n          accu\n          (base kinfo +! (word_size *? 2) +! comb_set_gadt_witness_size n)\n    | IDup_n (kinfo, n, _, _) ->\n        ret_succ_adding\n          accu\n          (base kinfo +! (word_size *? 2) +! dup_n_gadt_witness_size n)\n    | ITicket (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IRead_ticket (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | ISplit_ticket (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IJoin_tickets (kinfo, cty, _) ->\n        ret_succ_adding\n          (accu ++ comparable_ty_size cty)\n          (base kinfo +! word_size)\n    | IOpen_chest (kinfo, _) -> ret_succ_adding accu (base kinfo)\n    | IHalt kinfo -> ret_succ_adding accu (h1w +! kinfo_size kinfo)\n    | ILog (_, _, _, _) ->\n        (* This instruction is ignored because it is only used for testing. *)\n        accu\n  in\n  kinstr_traverse t accu {apply}\n\nlet rec kinstr_extra_size : type a s r f. (a, s, r, f) kinstr -> nodes_and_size\n    =\n fun t ->\n  let ret_zero x = (Nodes.zero, x) in\n  let apply :\n      type a s r f. nodes_and_size -> (a, s, r, f) kinstr -> nodes_and_size =\n   fun accu t ->\n    let stack_prefix_preservation_witness_size n = ret_zero (!!24 *? n) in\n    let dup_n_gadt_witness_size n = ret_zero (!!16 *? n) in\n    let comb n = ret_zero (!!16 *? n) in\n    let if_join k =\n      let kinfo = Script_typed_ir.kinfo_of_kinstr k in\n      stack_ty_size kinfo.kstack_ty\n    in\n    let self_size =\n      match t with\n      (* Op n *)\n      | IDig (_, n, _, _) -> stack_prefix_preservation_witness_size n\n      | IDug (_, n, _, _) -> stack_prefix_preservation_witness_size n\n      | IDipn (_, n, _, _, _) -> stack_prefix_preservation_witness_size n\n      | IDropn (_, n, _, _) -> stack_prefix_preservation_witness_size n\n      | IComb (_, n, _, _) -> comb n\n      | IUncomb (_, n, _, _) -> comb n\n      | IComb_get (_, n, _, _) -> comb (n / 2)\n      | IComb_set (_, n, _, _) -> comb (n / 2)\n      | IDup_n (_, n, _, _) -> dup_n_gadt_witness_size n\n      (* Whole stack types after conditionals and loops. *)\n      | IIf {k; _} -> if_join k\n      | IIf_cons {k; _} -> if_join k\n      | IIf_none {k; _} -> if_join k\n      | IIf_left {k; _} -> if_join k\n      (* Every instruction whose elaboration uses [merge_types],\n         [check_item_ty], [comparable_of_ty], or [ty_of_comparable_ty]\n         to create a type that is embedded in the IR. *)\n      | IJoin_tickets (_, _, k) -> (\n          let kinfo = Script_typed_ir.kinfo_of_kinstr k in\n          match kinfo.kstack_ty with Item_t (ty, _, _) -> ty_size ty)\n      | ITicket (_, k) -> (\n          let kinfo = Script_typed_ir.kinfo_of_kinstr k in\n          match kinfo.kstack_ty with Item_t (ty, _, _) -> ty_size ty)\n      | IRead_ticket (_, k) -> (\n          let kinfo = Script_typed_ir.kinfo_of_kinstr k in\n          match kinfo.kstack_ty with Item_t (ty, _, _) -> ty_size ty)\n      | ICons_list (_, k) -> (\n          let kinfo = Script_typed_ir.kinfo_of_kinstr k in\n          match kinfo.kstack_ty with Item_t (ty, _, _) -> ty_size ty)\n      | IMap_update (_, k) -> (\n          let kinfo = Script_typed_ir.kinfo_of_kinstr k in\n          match kinfo.kstack_ty with Item_t (ty, _, _) -> ty_size ty)\n      | IMap_get_and_update (_, k) -> (\n          let kinfo = Script_typed_ir.kinfo_of_kinstr k in\n          match kinfo.kstack_ty with Item_t (ty, _, _) -> ty_size ty)\n      | IBig_map_get_and_update (_, k) -> (\n          let kinfo = Script_typed_ir.kinfo_of_kinstr k in\n          match kinfo.kstack_ty with Item_t (ty, _, _) -> ty_size ty)\n      | IApply (_, ty, _) -> ty_size ty\n      | ICompare (_, ty, _) -> comparable_ty_size ty\n      | IList_iter (_, body, _) -> (\n          let kinfo = Script_typed_ir.kinfo_of_kinstr body in\n          match kinfo.kstack_ty with Item_t (ty, _, _) -> ty_size ty)\n      | IList_map (_, body, _) -> (\n          let kinfo = Script_typed_ir.kinfo_of_kinstr body in\n          match kinfo.kstack_ty with Item_t (ty, _, _) -> ty_size ty)\n      | ISet_iter (_, body, _) -> (\n          let kinfo = Script_typed_ir.kinfo_of_kinstr body in\n          match kinfo.kstack_ty with Item_t (ty, _, _) -> ty_size ty)\n      | IMap_map (_, body, _) -> (\n          let kinfo = Script_typed_ir.kinfo_of_kinstr body in\n          match kinfo.kstack_ty with Item_t (ty, _, _) -> ty_size ty)\n      | IMap_iter (_, body, _) -> (\n          let kinfo = Script_typed_ir.kinfo_of_kinstr body in\n          match kinfo.kstack_ty with Item_t (ty, _, _) -> ty_size ty)\n      | ILambda (_, lambda, _) -> lambda_extra_size lambda\n      | ICreate_contract {lambda; _} -> lambda_extra_size lambda\n      | _ -> zero\n    in\n    ret_succ (accu ++ self_size)\n  in\n  kinstr_traverse t zero {apply}\n\nand lambda_extra_size : type i o. (i, o) lambda -> nodes_and_size =\n fun (Lam ({kinstr; _}, _)) -> kinstr_extra_size kinstr\n\nlet lambda_size lam =\n  (*\n\n      The following formula has been obtained through a regression\n      over the corpus of mainnet contracts in Granada.\n\n  *)\n  let (lambda_nodes, lambda_size) =\n    lambda_size ~count_lambda_nodes:true zero lam\n  in\n  let (lambda_extra_size_nodes, lambda_extra_size) = lambda_extra_size lam in\n  let size = (lambda_size *? 157 /? 100) +! (lambda_extra_size *? 18 /? 100) in\n  (Nodes.add lambda_nodes lambda_extra_size_nodes, size)\n\nlet kinstr_size kinstr =\n  let (kinstr_extra_size_nodes, kinstr_extra_size) = kinstr_extra_size kinstr in\n  let (kinstr_nodes, kinstr_size) =\n    kinstr_size ~count_lambda_nodes:true zero kinstr\n  in\n  let size = (kinstr_size *? 157 /? 100) +! (kinstr_extra_size *? 18 /? 100) in\n  (Nodes.add kinstr_nodes kinstr_extra_size_nodes, size)\n\nlet value_size ty x = value_size ~count_lambda_nodes:true zero (L ty) x\n" ;
                } ;
                { name = "Script_typed_ir_size_costs" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** [node_size_cost ~nodes] returns the cost of having called\n    a function in {!Script_typed_ir_size} that returned [nodes]. *)\nval nodes_cost : nodes:Cache_memory_helpers.Nodes.t -> Gas_limit_repr.cost\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nmodule S = Saturation_repr\n\n(** FIXME insert proper gas constants (the gas constant below was fitted on\n    a non-standard machine) *)\nlet nodes_cost ~nodes =\n  let open S in\n  let nodes = Cache_memory_helpers.Nodes.to_int nodes in\n  let coeff = safe_int 45 in\n  Gas_limit_repr.atomic_step_cost (mul coeff (S.safe_int nodes))\n" ;
                } ;
                { name = "Michelson_v1_gas" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\nmodule Cost_of : sig\n  val manager_operation : Gas.cost\n\n  module Interpreter : sig\n    val drop : Gas.cost\n\n    val dup : Gas.cost\n\n    val swap : Gas.cost\n\n    val cons_some : Gas.cost\n\n    val cons_none : Gas.cost\n\n    val if_none : Gas.cost\n\n    val opt_map : Gas.cost\n\n    val cons_pair : Gas.cost\n\n    val unpair : Gas.cost\n\n    val car : Gas.cost\n\n    val cdr : Gas.cost\n\n    val cons_left : Gas.cost\n\n    val cons_right : Gas.cost\n\n    val if_left : Gas.cost\n\n    val cons_list : Gas.cost\n\n    val nil : Gas.cost\n\n    val if_cons : Gas.cost\n\n    val list_map : 'a Script_typed_ir.boxed_list -> Gas.cost\n\n    val list_size : Gas.cost\n\n    val list_iter : 'a Script_typed_ir.boxed_list -> Gas.cost\n\n    val empty_set : Gas.cost\n\n    val set_iter : 'a Script_typed_ir.set -> Gas.cost\n\n    val set_mem : 'a -> 'a Script_typed_ir.set -> Gas.cost\n\n    val set_update : 'a -> 'a Script_typed_ir.set -> Gas.cost\n\n    val set_size : Gas.cost\n\n    val empty_map : Gas.cost\n\n    val map_map : ('k, 'v) Script_typed_ir.map -> Gas.cost\n\n    val map_iter : ('k, 'v) Script_typed_ir.map -> Gas.cost\n\n    val map_mem : 'k -> ('k, 'v) Script_typed_ir.map -> Gas.cost\n\n    val map_get : 'k -> ('k, 'v) Script_typed_ir.map -> Gas.cost\n\n    val map_update : 'k -> ('k, 'v) Script_typed_ir.map -> Gas.cost\n\n    val map_get_and_update : 'k -> ('k, 'v) Script_typed_ir.map -> Gas.cost\n\n    val big_map_mem : (_, _) Script_typed_ir.big_map_overlay -> Gas.cost\n\n    val big_map_get : (_, _) Script_typed_ir.big_map_overlay -> Gas.cost\n\n    val big_map_update : (_, _) Script_typed_ir.big_map_overlay -> Gas.cost\n\n    val big_map_get_and_update :\n      (_, _) Script_typed_ir.big_map_overlay -> Gas.cost\n\n    val map_size : Gas.cost\n\n    val add_seconds_timestamp :\n      'a Script_int.num -> Script_timestamp.t -> Gas.cost\n\n    val add_timestamp_seconds :\n      Script_timestamp.t -> 'a Script_int.num -> Gas.cost\n\n    val sub_timestamp_seconds :\n      Script_timestamp.t -> 'a Script_int.num -> Gas.cost\n\n    val diff_timestamps : Script_timestamp.t -> Script_timestamp.t -> Gas.cost\n\n    val concat_string_pair : Script_string.t -> Script_string.t -> Gas.cost\n\n    val slice_string : Script_string.t -> Gas.cost\n\n    val string_size : Gas.cost\n\n    val concat_bytes_pair : bytes -> bytes -> Gas.cost\n\n    val slice_bytes : bytes -> Gas.cost\n\n    val bytes_size : Gas.cost\n\n    val add_tez : Gas.cost\n\n    val sub_tez : Gas.cost\n\n    val sub_tez_legacy : Gas.cost\n\n    val mul_teznat : Gas.cost\n\n    val mul_nattez : Gas.cost\n\n    val bool_or : Gas.cost\n\n    val bool_and : Gas.cost\n\n    val bool_xor : Gas.cost\n\n    val bool_not : Gas.cost\n\n    val is_nat : Gas.cost\n\n    val abs_int : Alpha_context.Script_int.z Script_int.num -> Gas.cost\n\n    val int_nat : Gas.cost\n\n    val neg : 'a Script_int.num -> Gas.cost\n\n    val add_int : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n\n    val add_nat :\n      Alpha_context.Script_int.n Script_int.num ->\n      Alpha_context.Script_int.n Script_int.num ->\n      Gas.cost\n\n    val sub_int : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n\n    val mul_int : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n\n    val mul_nat :\n      Alpha_context.Script_int.n Script_int.num -> 'a Script_int.num -> Gas.cost\n\n    val ediv_teznat : 'a -> 'b Script_int.num -> Gas.cost\n\n    val ediv_tez : Gas.cost\n\n    val ediv_int : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n\n    val ediv_nat :\n      Alpha_context.Script_int.n Script_int.num -> 'a Script_int.num -> Gas.cost\n\n    val eq : Gas.cost\n\n    val lsl_nat : 'a Script_int.num -> Gas.cost\n\n    val lsr_nat : 'a Script_int.num -> Gas.cost\n\n    val or_nat : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n\n    val and_nat : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n\n    val and_int_nat :\n      Alpha_context.Script_int.z Script_int.num ->\n      Alpha_context.Script_int.n Script_int.num ->\n      Gas.cost\n\n    val xor_nat : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n\n    val not_int : 'a Script_int.num -> Gas.cost\n\n    val if_ : Gas.cost\n\n    val loop : Gas.cost\n\n    val loop_left : Gas.cost\n\n    val dip : Gas.cost\n\n    val check_signature : Signature.public_key -> bytes -> Gas.cost\n\n    val blake2b : bytes -> Gas.cost\n\n    val sha256 : bytes -> Gas.cost\n\n    val sha512 : bytes -> Gas.cost\n\n    val dign : int -> Gas.cost\n\n    val dugn : int -> Gas.cost\n\n    val dipn : int -> Gas.cost\n\n    val dropn : int -> Gas.cost\n\n    val voting_power : Gas.cost\n\n    val total_voting_power : Gas.cost\n\n    val keccak : bytes -> Gas.cost\n\n    val sha3 : bytes -> Gas.cost\n\n    val add_bls12_381_g1 : Gas.cost\n\n    val add_bls12_381_g2 : Gas.cost\n\n    val add_bls12_381_fr : Gas.cost\n\n    val mul_bls12_381_g1 : Gas.cost\n\n    val mul_bls12_381_g2 : Gas.cost\n\n    val mul_bls12_381_fr : Gas.cost\n\n    val mul_bls12_381_fr_z : 'a Script_int.num -> Gas.cost\n\n    val mul_bls12_381_z_fr : 'a Script_int.num -> Gas.cost\n\n    val int_bls12_381_fr : Gas.cost\n\n    val neg_bls12_381_g1 : Gas.cost\n\n    val neg_bls12_381_g2 : Gas.cost\n\n    val neg_bls12_381_fr : Gas.cost\n\n    val neq : Gas.cost\n\n    val pairing_check_bls12_381 : 'a Script_typed_ir.boxed_list -> Gas.cost\n\n    val comb : int -> Gas.cost\n\n    val uncomb : int -> Gas.cost\n\n    val comb_get : int -> Gas.cost\n\n    val comb_set : int -> Gas.cost\n\n    val dupn : int -> Gas.cost\n\n    val compare : 'a Script_typed_ir.comparable_ty -> 'a -> 'a -> Gas.cost\n\n    val concat_string_precheck : 'a Script_typed_ir.boxed_list -> Gas.cost\n\n    val concat_string :\n      Saturation_repr.may_saturate Saturation_repr.t -> Gas.cost\n\n    val concat_bytes :\n      Saturation_repr.may_saturate Saturation_repr.t -> Gas.cost\n\n    val halt : Gas.cost\n\n    val const : Gas.cost\n\n    val empty_big_map : Gas.cost\n\n    val lt : Gas.cost\n\n    val le : Gas.cost\n\n    val gt : Gas.cost\n\n    val ge : Gas.cost\n\n    val exec : Gas.cost\n\n    val apply : Gas.cost\n\n    val lambda : Gas.cost\n\n    val address : Gas.cost\n\n    val contract : Gas.cost\n\n    val view : Gas.cost\n\n    val view_mem :\n      Script_string.t -> Script_typed_ir.view Script_typed_ir.SMap.t -> Gas.cost\n\n    val view_get :\n      Script_string.t -> Script_typed_ir.view Script_typed_ir.SMap.t -> Gas.cost\n\n    val view_update :\n      Script_string.t -> Script_typed_ir.view Script_typed_ir.SMap.t -> Gas.cost\n\n    val transfer_tokens : Gas.cost\n\n    val implicit_account : Gas.cost\n\n    val create_contract : Gas.cost\n\n    val set_delegate : Gas.cost\n\n    val balance : Gas.cost\n\n    val level : Gas.cost\n\n    val now : Gas.cost\n\n    val hash_key : Signature.Public_key.t -> Gas.cost\n\n    val source : Gas.cost\n\n    val sender : Gas.cost\n\n    val self : Gas.cost\n\n    val self_address : Gas.cost\n\n    val amount : Gas.cost\n\n    val chain_id : Gas.cost\n\n    val unpack : bytes -> Gas.cost\n\n    val unpack_failed : string -> Gas.cost\n\n    val sapling_empty_state : Gas.cost\n\n    val sapling_verify_update : inputs:int -> outputs:int -> Gas.cost\n\n    val ticket : Gas.cost\n\n    val read_ticket : Gas.cost\n\n    val split_ticket :\n      'a Script_int.num -> 'a Script_int.num -> 'a Script_int.num -> Gas.cost\n\n    val join_tickets :\n      'a Script_typed_ir.comparable_ty ->\n      'a Script_typed_ir.ticket ->\n      'a Script_typed_ir.ticket ->\n      Gas.cost\n\n    val open_chest : chest:Timelock.chest -> time:Z.t -> Gas.cost\n\n    module Control : sig\n      val nil : Gas.cost\n\n      val cons : Gas.cost\n\n      val return : Gas.cost\n\n      val view_exit : Gas.cost\n\n      val map_head : Gas.cost\n\n      val undip : Gas.cost\n\n      val loop_in : Gas.cost\n\n      val loop_in_left : Gas.cost\n\n      val iter : Gas.cost\n\n      val list_enter_body : 'a list -> int -> Gas.cost\n\n      val list_exit_body : Gas.cost\n\n      val map_enter_body : Gas.cost\n\n      val map_exit_body : 'k -> ('k, 'v) Script_typed_ir.map -> Gas.cost\n    end\n  end\n\n  module Typechecking : sig\n    val public_key_optimized : Gas.cost\n\n    val public_key_readable : Gas.cost\n\n    val key_hash_optimized : Gas.cost\n\n    val key_hash_readable : Gas.cost\n\n    val signature_optimized : Gas.cost\n\n    val signature_readable : Gas.cost\n\n    val chain_id_optimized : Gas.cost\n\n    val chain_id_readable : Gas.cost\n\n    val address_optimized : Gas.cost\n\n    val contract_optimized : Gas.cost\n\n    val contract_readable : Gas.cost\n\n    val bls12_381_g1 : Gas.cost\n\n    val bls12_381_g2 : Gas.cost\n\n    val bls12_381_fr : Gas.cost\n\n    val check_printable : string -> Gas.cost\n\n    val merge_cycle : Gas.cost\n\n    val parse_type_cycle : Gas.cost\n\n    val parse_instr_cycle : Gas.cost\n\n    val parse_data_cycle : Gas.cost\n\n    val comparable_ty_of_ty_cycle : Gas.cost\n\n    val check_dupable_cycle : Gas.cost\n\n    val bool : Gas.cost\n\n    val unit : Gas.cost\n\n    val timestamp_readable : Gas.cost\n\n    val contract : Gas.cost\n\n    val contract_exists : Gas.cost\n\n    val proof_argument : int -> Gas.cost\n\n    val chest_key : Gas.cost\n\n    val chest : bytes:int -> Gas.cost\n  end\n\n  module Unparsing : sig\n    val public_key_optimized : Gas.cost\n\n    val public_key_readable : Gas.cost\n\n    val key_hash_optimized : Gas.cost\n\n    val key_hash_readable : Gas.cost\n\n    val signature_optimized : Gas.cost\n\n    val signature_readable : Gas.cost\n\n    val chain_id_optimized : Gas.cost\n\n    val chain_id_readable : Gas.cost\n\n    val timestamp_readable : Gas.cost\n\n    val address_optimized : Gas.cost\n\n    val contract_optimized : Gas.cost\n\n    val contract_readable : Gas.cost\n\n    val bls12_381_g1 : Gas.cost\n\n    val bls12_381_g2 : Gas.cost\n\n    val bls12_381_fr : Gas.cost\n\n    val unparse_type : 'a Script_typed_ir.ty -> Gas.cost\n\n    val unparse_comparable_type : 'a Script_typed_ir.comparable_ty -> Gas.cost\n\n    val unparse_instr_cycle : Gas.cost\n\n    val unparse_data_cycle : Gas.cost\n\n    val unit : Gas.cost\n\n    val contract : Gas.cost\n\n    val operation : bytes -> Gas.cost\n\n    val sapling_transaction : Sapling.transaction -> Gas.cost\n\n    val sapling_diff : Sapling.diff -> Gas.cost\n\n    val chest_key : Gas.cost\n\n    val chest : plaintext_size:int -> Gas.cost\n  end\nend\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2019-2020 Nomadic Labs <contact@nomadic-labs.com>           *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\nopen Gas\nmodule S = Saturation_repr\n\nmodule Cost_of = struct\n  module S_syntax = struct\n    (* This is a good enough approximation. S.numbits 0 = 0 *)\n    let log2 x = S.safe_int (1 + S.numbits x)\n\n    let ( + ) = S.add\n\n    let ( * ) = S.mul\n\n    let ( lsr ) = S.shift_right\n  end\n\n  let z_bytes (z : Z.t) =\n    let bits = Z.numbits z in\n    (7 + bits) / 8\n\n  let int_bytes (z : 'a Script_int.num) = z_bytes (Script_int.to_zint z)\n\n  let manager_operation = step_cost @@ S.safe_int 1_000\n\n  module Generated_costs = struct\n    (* Automatically generated costs functions. *)\n\n    (* model N_IAbs_int *)\n    (* Approximating 0.065045 x term *)\n    let cost_N_IAbs_int size = S.safe_int (25 + (size lsr 4))\n\n    (* model N_IAdd_bls12_381_fr *)\n    (* when benchmarking, compile bls12-381-unix without ADX *)\n    let cost_N_IAdd_bls12_381_fr = S.safe_int 45\n\n    (* model N_IAdd_bls12_381_g1 *)\n    (* when benchmarking, compile bls12-381-unix without ADX *)\n    let cost_N_IAdd_bls12_381_g1 = S.safe_int 925\n\n    (* model N_IAdd_bls12_381_g2 *)\n    (* when benchmarking, compile bls12-381-unix without ADX *)\n    let cost_N_IAdd_bls12_381_g2 = S.safe_int 2_520\n\n    let cost_linear_op_int size1 size2 =\n      let open S_syntax in\n      let v0 = S.safe_int (Compare.Int.max size1 size2) in\n      S.safe_int 55 + ((v0 lsr 4) + (v0 lsr 7))\n\n    (* model N_IAdd_int *)\n    (* Approximating 0.078154 x term *)\n    let cost_N_IAdd_int = cost_linear_op_int\n\n    (* model N_IAdd_nat *)\n    (* Approximating 0.077807 x term *)\n    let cost_N_IAdd_nat = cost_linear_op_int\n\n    (* model N_IAdd_seconds_to_timestamp *)\n    (* Approximating 0.078056 x term *)\n    let cost_N_IAdd_seconds_to_timestamp = cost_linear_op_int\n\n    (* model N_IAdd_tez *)\n    let cost_N_IAdd_tez = S.safe_int 20\n\n    (* model N_IAdd_timestamp_to_seconds *)\n    (* Approximating 0.077771 x term *)\n    let cost_N_IAdd_timestamp_to_seconds = cost_linear_op_int\n\n    (* model N_IAddress *)\n    let cost_N_IAddress = S.safe_int 10\n\n    (* model N_IAmount *)\n    let cost_N_IAmount = S.safe_int 15\n\n    (* model N_IAnd *)\n    let cost_N_IAnd = S.safe_int 20\n\n    (* model N_IAnd_int_nat *)\n    (* Approximating 0.076804 x 2 x term *)\n    let cost_N_IAnd_int_nat size1 size2 =\n      let open S_syntax in\n      let v0 = S.safe_int (Compare.Int.min size1 size2) in\n      S.safe_int 50 + ((v0 lsr 3) + (v0 lsr 6))\n\n    (* model N_IAnd_nat *)\n    (* Approximating 0.076804 x term *)\n    (* The difference with `cost_N_IAnd_int_nat` comes from Zarith, where the\n       complexity of `Z.logand` depends on the sign of the argument. *)\n    let cost_N_IAnd_nat size1 size2 =\n      let open S_syntax in\n      let v0 = S.safe_int (Compare.Int.min size1 size2) in\n      S.safe_int 50 + ((v0 lsr 4) + (v0 lsr 7))\n\n    (* model N_IApply *)\n    let cost_N_IApply = S.safe_int 160\n\n    (* model N_IBlake2b *)\n    (* Approximating 1.120804 x term *)\n    let cost_N_IBlake2b size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 430 + v0 + (v0 lsr 3)\n\n    (* model N_IBytes_size *)\n    let cost_N_IBytes_size = S.safe_int 15\n\n    (* model N_ICar *)\n    let cost_N_ICar = S.safe_int 10\n\n    (* model N_ICdr *)\n    let cost_N_ICdr = S.safe_int 10\n\n    (* model N_IChainId *)\n    let cost_N_IChainId = S.safe_int 15\n\n    (* model N_ICheck_signature_ed25519 *)\n    (* Approximating 1.123507 x term *)\n    let cost_N_ICheck_signature_ed25519 size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 65_800 + (v0 + (v0 lsr 3))\n\n    (* model N_ICheck_signature_p256 *)\n    (* Approximating 1.111539 x term *)\n    let cost_N_ICheck_signature_p256 size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 990_000 + (v0 + (v0 lsr 3))\n\n    (* model N_ICheck_signature_secp256k1 *)\n    (* Approximating 1.125404 x term *)\n    let cost_N_ICheck_signature_secp256k1 size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 51_600 + (v0 + (v0 lsr 3))\n\n    (* model N_IComb *)\n    (* Approximating 3.531001 x term *)\n    (* Note: size >= 2, so the cost is never 0 *)\n    let cost_N_IComb size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      (S.safe_int 3 * v0) + (v0 lsr 1) + (v0 lsr 5)\n\n    (* model N_IComb_get *)\n    (* Approximating 0.573180 x term *)\n    let cost_N_IComb_get size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 30 + (v0 lsr 1) + (v0 lsr 4)\n\n    (* model N_IComb_set *)\n    (* Approximating 1.287531 x term *)\n    let cost_N_IComb_set size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 40 + (v0 + (v0 lsr 2) + (v0 lsr 5))\n\n    (* Model N_ICompare *)\n    (* Approximating 0.024413 x term *)\n    let cost_N_ICompare size1 size2 =\n      let open S_syntax in\n      let v0 = S.safe_int (Compare.Int.min size1 size2) in\n      S.safe_int 35 + ((v0 lsr 6) + (v0 lsr 7))\n\n    (* model N_IConcat_bytes_pair *)\n    (* Approximating 0.065017 x term *)\n    let cost_N_IConcat_bytes_pair size1 size2 =\n      let open S_syntax in\n      let v0 = S.safe_int size1 + S.safe_int size2 in\n      S.safe_int 65 + (v0 lsr 4)\n\n    (* model N_IConcat_string_pair *)\n    (* Approximating 0.061402 x term *)\n    let cost_N_IConcat_string_pair size1 size2 =\n      let open S_syntax in\n      let v0 = S.safe_int size1 + S.safe_int size2 in\n      S.safe_int 65 + (v0 lsr 4)\n\n    (* model N_ICons_list *)\n    let cost_N_ICons_list = S.safe_int 15\n\n    (* model N_ICons_none *)\n    let cost_N_ICons_none = S.safe_int 15\n\n    (* model N_ICons_pair *)\n    let cost_N_ICons_pair = S.safe_int 15\n\n    (* model N_ICons_some *)\n    let cost_N_ICons_some = S.safe_int 15\n\n    (* model N_IConst *)\n    let cost_N_IConst = S.safe_int 10\n\n    (* model N_IContract *)\n    let cost_N_IContract = S.safe_int 30\n\n    (* model N_ICreate_contract *)\n    let cost_N_ICreate_contract = S.safe_int 30\n\n    (* model N_IDiff_timestamps *)\n    (* Approximating 0.077922 x term *)\n    let cost_N_IDiff_timestamps = cost_linear_op_int\n\n    (* model N_IDig *)\n    (* Approximating 6.750442 x term *)\n    let cost_N_IDig size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 60 + ((S.safe_int 6 * v0) + (v0 lsr 1) + (v0 lsr 2))\n\n    (* model N_IDip *)\n    let cost_N_IDip = S.safe_int 15\n\n    (* model N_IDipN *)\n    (* Approximating 1.708122 x term *)\n    let cost_N_IDipN size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 45 + (v0 + (v0 lsr 1) + (v0 lsr 3))\n\n    (* model N_IView *)\n    let cost_N_IView = S.safe_int 1460\n\n    (* model N_IDrop *)\n    let cost_N_IDrop = S.safe_int 10\n\n    (* model N_IDropN *)\n    (* Approximating 2.713108 x term *)\n    let cost_N_IDropN size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 60 + (S.safe_int 2 * v0) + (v0 lsr 1) + (v0 lsr 3)\n\n    (* model N_IDug *)\n    (* Approximating 6.718396 x term *)\n    let cost_N_IDug size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 60 + ((S.safe_int 6 * v0) + (v0 lsr 1) + (v0 lsr 2))\n\n    (* model N_IDup *)\n    let cost_N_IDup = S.safe_int 10\n\n    (* model N_IDupN *)\n    (* Approximating 1.129785 x term *)\n    let cost_N_IDupN size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 20 + v0 + (v0 lsr 3)\n\n    let cost_div_int size1 size2 =\n      let q = size1 - size2 in\n      if Compare.Int.(q < 0) then S.safe_int 140\n      else\n        let open S_syntax in\n        let v0 = S.safe_int q * S.safe_int size2 in\n        S.safe_int 140 + (v0 lsr 10) + (v0 lsr 11) + (v0 lsr 13)\n\n    (* model N_IEdiv_int *)\n    (* Approximating 0.001591 x term *)\n    let cost_N_IEdiv_int = cost_div_int\n\n    (* model N_IEdiv_nat *)\n    (* Approximating 0.001605 x term *)\n    let cost_N_IEdiv_nat = cost_div_int\n\n    (* model N_IEdiv_tez *)\n    let cost_N_IEdiv_tez = S.safe_int 140\n\n    (* model N_IEdiv_teznat *)\n    let cost_N_IEdiv_teznat = S.safe_int 140\n\n    (* model N_IEmpty_big_map *)\n    let cost_N_IEmpty_big_map = S.safe_int 15\n\n    (* model N_IEmpty_map *)\n    let cost_N_IEmpty_map = S.safe_int 220\n\n    (* model N_IEmpty_set *)\n    let cost_N_IEmpty_set = S.safe_int 220\n\n    (* model N_IEq *)\n    let cost_N_IEq = S.safe_int 15\n\n    (* model N_IExec *)\n    let cost_N_IExec = S.safe_int 15\n\n    (* model N_IFailwith *)\n    (* let cost_N_IFailwith = S.safe_int 105 *)\n\n    (* model N_IGe *)\n    let cost_N_IGe = S.safe_int 15\n\n    (* model N_IGt *)\n    let cost_N_IGt = S.safe_int 15\n\n    (* model N_IHalt *)\n    let cost_N_IHalt = S.safe_int 15\n\n    (* model N_IHash_key *)\n    let cost_N_IHash_key = S.safe_int 655\n\n    (* model N_IIf *)\n    let cost_N_IIf = S.safe_int 10\n\n    (* model N_IIf_cons *)\n    let cost_N_IIf_cons = S.safe_int 10\n\n    (* model N_IIf_left *)\n    let cost_N_IIf_left = S.safe_int 10\n\n    (* model N_IIf_none *)\n    let cost_N_IIf_none = S.safe_int 10\n\n    (* model N_IOpt_map *)\n    let cost_opt_map = S.safe_int 15\n\n    (* model N_IImplicit_account *)\n    let cost_N_IImplicit_account = S.safe_int 10\n\n    (* model N_IInt_bls12_381_z_fr *)\n    (* when benchmarking, compile bls12-381-unix without ADX *)\n    let cost_N_IInt_bls12_381_z_fr = S.safe_int 125\n\n    (* model N_IInt_nat *)\n    let cost_N_IInt_nat = S.safe_int 15\n\n    (* model N_IIs_nat *)\n    let cost_N_IIs_nat = S.safe_int 15\n\n    (* model N_IKeccak *)\n    (* Approximating 8.276352 x term *)\n    let cost_N_IKeccak size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 1350 + ((S.safe_int 8 * v0) + (v0 lsr 2))\n\n    (* model N_ILambda *)\n    let cost_N_ILambda = S.safe_int 10\n\n    (* model N_ILe *)\n    let cost_N_ILe = S.safe_int 15\n\n    (* model N_ILeft *)\n    let cost_N_ILeft = S.safe_int 15\n\n    (* model N_ILevel *)\n    let cost_N_ILevel = S.safe_int 15\n\n    (* model N_IList_iter *)\n    let cost_N_IList_iter _ = S.safe_int 25\n\n    (* model N_IList_map *)\n    let cost_N_IList_map _ = S.safe_int 25\n\n    (* model N_IList_size *)\n    let cost_N_IList_size = S.safe_int 15\n\n    (* model N_ILoop *)\n    let cost_N_ILoop = S.safe_int 10\n\n    (* model N_ILoop_left *)\n    let cost_N_ILoop_left = S.safe_int 10\n\n    (* model N_ILsl_nat *)\n    (* Approximating 0.115642 x term *)\n    let cost_N_ILsl_nat size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 60 + ((v0 lsr 4) + (v0 lsr 5) + (v0 lsr 6))\n\n    (* model N_ILsr_nat *)\n    (* Approximating 0.115565 x term *)\n    let cost_N_ILsr_nat size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 60 + ((v0 lsr 4) + (v0 lsr 5) + (v0 lsr 6))\n\n    (* model N_ILt *)\n    let cost_N_ILt = S.safe_int 15\n\n    (* model N_IMap_get *)\n    (* Approximating 0.048359 x term *)\n    let cost_N_IMap_get size1 size2 =\n      let open S_syntax in\n      let v0 = size1 * log2 size2 in\n      S.safe_int 110 + (v0 lsr 5) + (v0 lsr 6)\n\n    (* model N_IMap_get_and_update *)\n    (* Approximating 0.145661 x term *)\n    let cost_N_IMap_get_and_update size1 size2 =\n      let open S_syntax in\n      let v0 = size1 * log2 size2 in\n      S.safe_int 135 + (v0 lsr 3) + (v0 lsr 6)\n\n    (* model N_IMap_iter *)\n    (* Approximating 7.621331 x term *)\n    let cost_N_IMap_iter size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 70 + (S.safe_int 7 * v0) + (v0 lsr 1) + (v0 lsr 3)\n\n    (* model N_IMap_map *)\n    (* Approximating 7.46280485884 x term *)\n    let cost_N_IMap_map size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 265 + ((S.safe_int 7 * v0) + (v0 lsr 1))\n\n    (* model N_IMap_mem *)\n    (* Approximating 0.048446 x term *)\n    let cost_N_IMap_mem size1 size2 =\n      let open S_syntax in\n      let v0 = size1 * log2 size2 in\n      S.safe_int 110 + (v0 lsr 5) + (v0 lsr 6)\n\n    (* model N_IMap_size *)\n    let cost_N_IMap_size = S.safe_int 15\n\n    (* model N_IMap_update *)\n    (* Approximating 0.097072 x term *)\n    let cost_N_IMap_update size1 size2 =\n      let open S_syntax in\n      let v0 = size1 * log2 size2 in\n      S.safe_int 130 + (v0 lsr 4) + (v0 lsr 5)\n\n    (* model N_IMul_bls12_381_fr *)\n    (* when benchmarking, compile bls12-381-unix without ADX *)\n    let cost_N_IMul_bls12_381_fr = S.safe_int 65\n\n    (* model N_IMul_bls12_381_fr_z *)\n    (* Approximating 1.059386 x term *)\n    (* when benchmarking, compile bls12-381-unix without ADX *)\n    let cost_N_IMul_bls12_381_fr_z size1 =\n      let open S_syntax in\n      let v0 = S.safe_int size1 in\n      S.safe_int 330 + v0 + (v0 lsr 4)\n\n    (* model N_IMul_bls12_381_g1 *)\n    (* when benchmarking, compile bls12-381-unix without ADX *)\n    let cost_N_IMul_bls12_381_g1 = S.safe_int 103_000\n\n    (* model N_IMul_bls12_381_g2 *)\n    (* when benchmarking, compile bls12-381-unix without ADX *)\n    let cost_N_IMul_bls12_381_g2 = S.safe_int 220_000\n\n    (* model N_IMul_bls12_381_z_fr *)\n    (* Approximating 1.068674 x term *)\n    (* when benchmarking, compile bls12-381-unix without ADX *)\n    let cost_N_IMul_bls12_381_z_fr size1 =\n      let open S_syntax in\n      let v0 = S.safe_int size1 in\n      S.safe_int 330 + v0 + (v0 lsr 4)\n\n    let cost_mul size1 size2 =\n      let open S_syntax in\n      let a = S.add (S.safe_int size1) (S.safe_int size2) in\n      let v0 = a * log2 a in\n      S.safe_int 100 + (v0 lsr 1) + (v0 lsr 2) + (v0 lsr 4)\n\n    (* model N_IMul_int *)\n    (* Approximating 0.857931 x term *)\n    let cost_N_IMul_int = cost_mul\n\n    (* model N_IMul_nat *)\n    (* Approximating 0.861823 x term *)\n    let cost_N_IMul_nat = cost_mul\n\n    (* model N_IMul_nattez *)\n    let cost_N_IMul_nattez = S.safe_int 50\n\n    (* model N_IMul_teznat *)\n    let cost_N_IMul_teznat = S.safe_int 50\n\n    (* model N_INeg_bls12_381_fr *)\n    (* when benchmarking, compile bls12-381-unix without ADX *)\n    let cost_N_INeg_bls12_381_fr = S.safe_int 45\n\n    (* model N_INeg_bls12_381_g1 *)\n    (* when benchmarking, compile bls12-381-unix without ADX *)\n    let cost_N_INeg_bls12_381_g1 = S.safe_int 60\n\n    (* model N_INeg_bls12_381_g2 *)\n    (* when benchmarking, compile bls12-381-unix without ADX *)\n    let cost_N_INeg_bls12_381_g2 = S.safe_int 85\n\n    (* model N_INeg *)\n    (* Approximating 0.066076 x term *)\n    let cost_N_INeg size =\n      let open S_syntax in\n      S.safe_int 40 + (S.safe_int size lsr 4)\n\n    (* model N_INeq *)\n    let cost_N_INeq = S.safe_int 15\n\n    (* model N_INil *)\n    let cost_N_INil = S.safe_int 15\n\n    (* model N_INot *)\n    let cost_N_INot = S.safe_int 10\n\n    (* model N_INot_int *)\n    (* Approximating 0.075541 x term *)\n    let cost_N_INot_int size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 50 + ((v0 lsr 4) + (v0 lsr 7))\n\n    (* model N_INow *)\n    let cost_N_INow = S.safe_int 15\n\n    (* model N_IOpen_chest *)\n    (* 612000 + chest * 19 + time * 19050 *)\n    let cost_N_IOpen_chest ~chest ~time =\n      let open S_syntax in\n      let v0 = S.safe_int chest in\n      let v1 = S.safe_int time in\n      S.safe_int 612_000 + (S.safe_int 19 * v0) + (S.safe_int 19050 * v1)\n\n    (* model N_IOr *)\n    let cost_N_IOr = S.safe_int 15\n\n    (* model N_IOr_nat *)\n    (* Approximating 0.075758 x term *)\n    let cost_N_IOr_nat = cost_linear_op_int\n\n    (* model N_IPairing_check_bls12_381 *)\n    (* when benchmarking, compile bls12-381-unix without ADX *)\n    let cost_N_IPairing_check_bls12_381 size =\n      S.add (S.safe_int 450_000) (S.mul (S.safe_int 342_500) (S.safe_int size))\n\n    (* model N_IRead_ticket *)\n    let cost_N_IRead_ticket = S.safe_int 15\n\n    (* model N_IRight *)\n    let cost_N_IRight = S.safe_int 15\n\n    (* model N_ISapling_empty_state *)\n    let cost_N_ISapling_empty_state = S.safe_int 15\n\n    (* model N_ISapling_verify_update *)\n    (* Approximating 1.27167 x term *)\n    (* Approximating 38.72115 x term *)\n    let cost_N_ISapling_verify_update size1 size2 =\n      let open S_syntax in\n      let v1 = S.safe_int size1 in\n      let v0 = S.safe_int size2 in\n      S.safe_int 84_050 + (v1 + (v1 lsr 2)) + (S.safe_int 39 * v0)\n\n    (* model N_ISelf_address *)\n    let cost_N_ISelf_address = S.safe_int 15\n\n    (* model N_ISelf *)\n    let cost_N_ISelf = S.safe_int 15\n\n    (* model N_ISender *)\n    let cost_N_ISender = S.safe_int 15\n\n    (* model N_ISet_delegate *)\n    let cost_N_ISet_delegate = S.safe_int 40\n\n    (* model N_ISet_iter *)\n    (* Approximating 7.633555 x term *)\n    let cost_N_ISet_iter size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 70 + (S.safe_int 7 * v0) + (v0 lsr 1) + (v0 lsr 3)\n\n    (* model N_ISet_size *)\n    let cost_N_ISet_size = S.safe_int 15\n\n    (* model N_ISha256 *)\n    (* Approximating 4.763264 x term *)\n    let cost_N_ISha256 size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 600 + ((S.safe_int 4 * v0) + (v0 lsr 1) + (v0 lsr 2))\n\n    (* model N_ISha3 *)\n    (* Approximating 8.362339 x term *)\n    let cost_N_ISha3 = cost_N_IKeccak\n\n    (* model N_ISha512 *)\n    (* Approximating 3.074641 x term *)\n    let cost_N_ISha512 size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 680 + (S.safe_int 3 * v0)\n\n    (* model N_ISlice_bytes *)\n    (* Approximating 0.065752 x term *)\n    let cost_N_ISlice_bytes size =\n      let open S_syntax in\n      S.safe_int 40 + (S.safe_int size lsr 4)\n\n    (* model N_ISlice_string *)\n    (* Approximating 0.065688 x term *)\n    let cost_N_ISlice_string size =\n      let open S_syntax in\n      S.safe_int 40 + (S.safe_int size lsr 4)\n\n    (* model N_ISource *)\n    let cost_N_ISource = S.safe_int 15\n\n    (* model N_ISplit_ticket *)\n    (* Approximating 0.132362 x term *)\n    let cost_N_ISplit_ticket size1 size2 =\n      let open S_syntax in\n      let v1 = S.safe_int (Compare.Int.max size1 size2) in\n      S.safe_int 55 + (v1 lsr 3)\n\n    (* model N_IString_size *)\n    let cost_N_IString_size = S.safe_int 15\n\n    (* model N_ISub_int *)\n    (* Approximating 0.077849 x term *)\n    let cost_N_ISub_int = cost_linear_op_int\n\n    (* model N_ISub_tez *)\n    let cost_N_ISub_tez = S.safe_int 20\n\n    (* model N_ISub_tez_legacy *)\n    let cost_N_ISub_tez_legacy = S.safe_int 20\n\n    (* model N_ISub_timestamp_seconds *)\n    (* Approximating 0.077794 x term *)\n    let cost_N_ISub_timestamp_seconds = cost_linear_op_int\n\n    (* model N_ISwap *)\n    let cost_N_ISwap = S.safe_int 10\n\n    (* model N_ITicket *)\n    let cost_N_ITicket = S.safe_int 15\n\n    (* model N_ITotal_voting_power *)\n    let cost_N_ITotal_voting_power = S.safe_int 370\n\n    (* model N_ITransfer_tokens *)\n    let cost_N_ITransfer_tokens = S.safe_int 30\n\n    (* model N_IUncomb *)\n    (* Approximating 3.944710 x term *)\n    let cost_N_IUncomb size =\n      let open S_syntax in\n      let v0 = S.safe_int size in\n      S.safe_int 25 + (S.safe_int 4 * v0)\n\n    (* model N_IUnpair *)\n    let cost_N_IUnpair = S.safe_int 10\n\n    (* model N_IVoting_power *)\n    let cost_N_IVoting_power = S.safe_int 530\n\n    (* model N_IXor *)\n    let cost_N_IXor = S.safe_int 20\n\n    (* model N_IXor_nat *)\n    (* Approximating 0.075601 x term *)\n    let cost_N_IXor_nat = cost_linear_op_int\n\n    (* model N_KCons *)\n    let cost_N_KCons = S.safe_int 15\n\n    (* model N_KIter *)\n    let cost_N_KIter = S.safe_int 20\n\n    (* model N_KList_enter_body *)\n    (* Approximating 1.672196 x term *)\n    let cost_N_KList_enter_body xs size_ys =\n      match xs with\n      | [] ->\n          let open S_syntax in\n          let v0 = S.safe_int size_ys in\n          S.safe_int 40 + (v0 + (v0 lsr 1) + (v0 lsr 3))\n      | _ :: _ -> S.safe_int 70\n\n    (* model N_KList_exit_body *)\n    let cost_N_KList_exit_body = S.safe_int 30\n\n    (* model N_KLoop_in *)\n    let cost_N_KLoop_in = S.safe_int 15\n\n    (* model N_KLoop_in_left *)\n    let cost_N_KLoop_in_left = S.safe_int 15\n\n    (* model N_KMap_enter_body *)\n    let cost_N_KMap_enter_body = S.safe_int 165\n\n    (* model N_KNil *)\n    let cost_N_KNil = S.safe_int 20\n\n    (* model N_KReturn *)\n    let cost_N_KReturn = S.safe_int 15\n\n    (* model N_KView_exit *)\n    let cost_N_KView_exit = S.safe_int 20\n\n    (* model N_KMap_head *)\n    let const_N_KMap_head = S.safe_int 20\n\n    (* model N_KUndip *)\n    let cost_N_KUndip = S.safe_int 15\n\n    (* model DECODING_BLS_FR *)\n    (* when benchmarking, compile bls12-381-unix without ADX, see\n       https://gitlab.com/dannywillems/ocaml-bls12-381/-/blob/71d0b4d467fbfaa6452d702fcc408d7a70916a80/README.md#install\n    *)\n    let cost_DECODING_BLS_FR = S.safe_int 150\n\n    (* model DECODING_BLS_G1 *)\n    (* when benchmarking, compile bls12-381-unix without ADX *)\n    let cost_DECODING_BLS_G1 = S.safe_int 65_300\n\n    (* model DECODING_BLS_G2 *)\n    (* when benchmarking, compile bls12-381-unix without ADX *)\n    let cost_DECODING_BLS_G2 = S.safe_int 73_300\n\n    (* model B58CHECK_DECODING_CHAIN_ID *)\n    let cost_B58CHECK_DECODING_CHAIN_ID = S.safe_int 1_600\n\n    (* model B58CHECK_DECODING_PUBLIC_KEY_HASH_ed25519 *)\n    let cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_ed25519 = S.safe_int 3_300\n\n    (* model B58CHECK_DECODING_PUBLIC_KEY_HASH_p256 *)\n    let cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_p256 = S.safe_int 3_300\n\n    (* model B58CHECK_DECODING_PUBLIC_KEY_HASH_secp256k1 *)\n    let cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_secp256k1 = S.safe_int 3_300\n\n    (* model B58CHECK_DECODING_PUBLIC_KEY_ed25519 *)\n    let cost_B58CHECK_DECODING_PUBLIC_KEY_ed25519 = S.safe_int 4_200\n\n    (* model B58CHECK_DECODING_PUBLIC_KEY_p256 *)\n    let cost_B58CHECK_DECODING_PUBLIC_KEY_p256 = S.safe_int 325_000\n\n    (* model B58CHECK_DECODING_PUBLIC_KEY_secp256k1 *)\n    let cost_B58CHECK_DECODING_PUBLIC_KEY_secp256k1 = S.safe_int 9_000\n\n    (* model B58CHECK_DECODING_SIGNATURE_ed25519 *)\n    let cost_B58CHECK_DECODING_SIGNATURE_ed25519 = S.safe_int 6_400\n\n    (* model B58CHECK_DECODING_SIGNATURE_p256 *)\n    let cost_B58CHECK_DECODING_SIGNATURE_p256 = S.safe_int 6_400\n\n    (* model B58CHECK_DECODING_SIGNATURE_secp256k1 *)\n    let cost_B58CHECK_DECODING_SIGNATURE_secp256k1 = S.safe_int 6_400\n\n    (* model ENCODING_BLS_FR *)\n    let cost_ENCODING_BLS_FR = S.safe_int 80\n\n    (* model ENCODING_BLS_G1 *)\n    let cost_ENCODING_BLS_G1 = S.safe_int 3200\n\n    (* model ENCODING_BLS_G2 *)\n    let cost_ENCODING_BLS_G2 = S.safe_int 3900\n\n    (* model B58CHECK_ENCODING_CHAIN_ID *)\n    let cost_B58CHECK_ENCODING_CHAIN_ID = S.safe_int 1_800\n\n    (* model B58CHECK_ENCODING_PUBLIC_KEY_HASH_ed25519 *)\n    let cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_ed25519 = S.safe_int 3_200\n\n    (* model B58CHECK_ENCODING_PUBLIC_KEY_HASH_p256 *)\n    let cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_p256 = S.safe_int 3_200\n\n    (* model B58CHECK_ENCODING_PUBLIC_KEY_HASH_secp256k1 *)\n    let cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_secp256k1 = S.safe_int 3_200\n\n    (* model B58CHECK_ENCODING_PUBLIC_KEY_ed25519 *)\n    let cost_B58CHECK_ENCODING_PUBLIC_KEY_ed25519 = S.safe_int 4_500\n\n    (* model B58CHECK_ENCODING_PUBLIC_KEY_p256 *)\n    let cost_B58CHECK_ENCODING_PUBLIC_KEY_p256 = S.safe_int 4_550\n\n    (* model B58CHECK_ENCODING_PUBLIC_KEY_secp256k1 *)\n    let cost_B58CHECK_ENCODING_PUBLIC_KEY_secp256k1 = S.safe_int 4_950\n\n    (* model B58CHECK_ENCODING_SIGNATURE_ed25519 *)\n    let cost_B58CHECK_ENCODING_SIGNATURE_ed25519 = S.safe_int 8_300\n\n    (* model B58CHECK_ENCODING_SIGNATURE_p256 *)\n    let cost_B58CHECK_ENCODING_SIGNATURE_p256 = S.safe_int 8_300\n\n    (* model B58CHECK_ENCODING_SIGNATURE_secp256k1 *)\n    let cost_B58CHECK_ENCODING_SIGNATURE_secp256k1 = S.safe_int 8_300\n\n    (* model DECODING_CHAIN_ID *)\n    let cost_DECODING_CHAIN_ID = S.safe_int 50\n\n    (* model DECODING_PUBLIC_KEY_HASH_ed25519 *)\n    let cost_DECODING_PUBLIC_KEY_HASH_ed25519 = S.safe_int 50\n\n    (* model DECODING_PUBLIC_KEY_HASH_p256 *)\n    let cost_DECODING_PUBLIC_KEY_HASH_p256 = S.safe_int 50\n\n    (* model DECODING_PUBLIC_KEY_HASH_secp256k1 *)\n    let cost_DECODING_PUBLIC_KEY_HASH_secp256k1 = S.safe_int 50\n\n    (* model DECODING_PUBLIC_KEY_ed25519 *)\n    let cost_DECODING_PUBLIC_KEY_ed25519 = S.safe_int 60\n\n    (* model DECODING_PUBLIC_KEY_p256 *)\n    let cost_DECODING_PUBLIC_KEY_p256 = S.safe_int 320_000\n\n    (* model DECODING_PUBLIC_KEY_secp256k1 *)\n    let cost_DECODING_PUBLIC_KEY_secp256k1 = S.safe_int 4_900\n\n    (* model DECODING_SIGNATURE_ed25519 *)\n    let cost_DECODING_SIGNATURE_ed25519 = S.safe_int 35\n\n    (* model DECODING_SIGNATURE_p256 *)\n    let cost_DECODING_SIGNATURE_p256 = S.safe_int 35\n\n    (* model DECODING_SIGNATURE_secp256k1 *)\n    let cost_DECODING_SIGNATURE_secp256k1 = S.safe_int 35\n\n    (* model DECODING_Chest_key *)\n    let cost_DECODING_Chest_key = S.safe_int 5900\n\n    (* model DECODING_Chest *)\n    (* Approximating 0.039349 x term *)\n    let cost_DECODING_Chest ~bytes =\n      let open S_syntax in\n      let v0 = S.safe_int bytes in\n      S.safe_int 7400 + (v0 lsr 5) + (v0 lsr 7)\n\n    (* model ENCODING_CHAIN_ID *)\n    let cost_ENCODING_CHAIN_ID = S.safe_int 50\n\n    (* model ENCODING_PUBLIC_KEY_HASH_ed25519 *)\n    let cost_ENCODING_PUBLIC_KEY_HASH_ed25519 = S.safe_int 70\n\n    (* model ENCODING_PUBLIC_KEY_HASH_p256 *)\n    let cost_ENCODING_PUBLIC_KEY_HASH_p256 = S.safe_int 70\n\n    (* model ENCODING_PUBLIC_KEY_HASH_secp256k1 *)\n    let cost_ENCODING_PUBLIC_KEY_HASH_secp256k1 = S.safe_int 70\n\n    (* model ENCODING_PUBLIC_KEY_ed25519 *)\n    let cost_ENCODING_PUBLIC_KEY_ed25519 = S.safe_int 80\n\n    (* model ENCODING_PUBLIC_KEY_p256 *)\n    let cost_ENCODING_PUBLIC_KEY_p256 = S.safe_int 90\n\n    (* model ENCODING_PUBLIC_KEY_secp256k1 *)\n    let cost_ENCODING_PUBLIC_KEY_secp256k1 = S.safe_int 455\n\n    (* model ENCODING_SIGNATURE_ed25519 *)\n    let cost_ENCODING_SIGNATURE_ed25519 = S.safe_int 45\n\n    (* model ENCODING_SIGNATURE_p256 *)\n    let cost_ENCODING_SIGNATURE_p256 = S.safe_int 45\n\n    (* model ENCODING_SIGNATURE_secp256k1 *)\n    let cost_ENCODING_SIGNATURE_secp256k1 = S.safe_int 45\n\n    (* model ENCODING_Chest_key *)\n    let cost_ENCODING_Chest_key = S.safe_int 13500\n\n    (* model ENCODING_Chest *)\n    (* Approximating 0.120086 x term *)\n    let cost_ENCODING_Chest ~plaintext_size =\n      let open S_syntax in\n      let v0 = S.safe_int plaintext_size in\n      S.safe_int 16630 + (v0 lsr 3)\n\n    (* model TIMESTAMP_READABLE_DECODING *)\n    let cost_TIMESTAMP_READABLE_DECODING = S.safe_int 100\n\n    (* model TIMESTAMP_READABLE_ENCODING *)\n    let cost_TIMESTAMP_READABLE_ENCODING = S.safe_int 820\n\n    (* model CHECK_PRINTABLE *)\n    let cost_CHECK_PRINTABLE size =\n      let open S_syntax in\n      S.safe_int 14 + (S.safe_int 10 * S.safe_int size)\n\n    (* model MERGE_TYPES\n       This is the estimated cost of one iteration of merge_types, extracted\n       and copied manually from the parameter fit for the MERGE_TYPES benchmark\n       (the model is parametric on the size of the type, which we don't have\n       access to in O(1)). *)\n    let cost_MERGE_TYPES = S.safe_int 220\n\n    (* model TYPECHECKING_CODE\n       This is the cost of one iteration of parse_instr, extracted by hand from the\n       parameter fit for the TYPECHECKING_CODE benchmark. *)\n    let cost_TYPECHECKING_CODE = S.safe_int 220\n\n    (* model UNPARSING_CODE\n       This is the cost of one iteration of unparse_instr, extracted by hand from the\n       parameter fit for the UNPARSING_CODE benchmark. *)\n    let cost_UNPARSING_CODE = S.safe_int 115\n\n    (* model TYPECHECKING_DATA\n       This is the cost of one iteration of parse_data, extracted by hand from the\n       parameter fit for the TYPECHECKING_DATA benchmark. *)\n    let cost_TYPECHECKING_DATA = S.safe_int 100\n\n    (* model UNPARSING_DATA\n       This is the cost of one iteration of unparse_data, extracted by hand from the\n       parameter fit for the UNPARSING_DATA benchmark. *)\n    let cost_UNPARSING_DATA = S.safe_int 45\n\n    (* model PARSE_TYPE\n       This is the cost of one iteration of parse_ty, extracted by hand from the\n       parameter fit for the PARSE_TYPE benchmark. *)\n    let cost_PARSE_TYPE = S.safe_int 60\n\n    (* model UNPARSE_TYPE\n       This is the cost of one iteration of unparse_ty, extracted by hand from the\n       parameter fit for the UNPARSE_TYPE benchmark. *)\n    let cost_UNPARSE_TYPE type_size = S.mul (S.safe_int 20) type_size\n\n    (* TODO: Add benchmarked value from [Unparse_comparable_type_benchmark]. *)\n    let cost_UNPARSE_COMPARABLE_TYPE type_size = S.mul (S.safe_int 20) type_size\n\n    (* TODO: benchmark *)\n    let cost_COMPARABLE_TY_OF_TY = S.safe_int 120\n\n    (* model SAPLING_TRANSACTION_ENCODING *)\n    let cost_SAPLING_TRANSACTION_ENCODING ~inputs ~outputs =\n      S.safe_int (1500 + (inputs * 160) + (outputs * 320))\n\n    (* model SAPLING_DIFF_ENCODING *)\n    let cost_SAPLING_DIFF_ENCODING ~nfs ~cms =\n      S.safe_int ((nfs * 22) + (cms * 215))\n  end\n\n  module Interpreter = struct\n    open Generated_costs\n\n    let drop = atomic_step_cost cost_N_IDrop\n\n    let dup = atomic_step_cost cost_N_IDup\n\n    let swap = atomic_step_cost cost_N_ISwap\n\n    let cons_some = atomic_step_cost cost_N_ICons_some\n\n    let cons_none = atomic_step_cost cost_N_ICons_none\n\n    let if_none = atomic_step_cost cost_N_IIf_none\n\n    let opt_map = atomic_step_cost cost_opt_map\n\n    let cons_pair = atomic_step_cost cost_N_ICons_pair\n\n    let unpair = atomic_step_cost cost_N_IUnpair\n\n    let car = atomic_step_cost cost_N_ICar\n\n    let cdr = atomic_step_cost cost_N_ICdr\n\n    let cons_left = atomic_step_cost cost_N_ILeft\n\n    let cons_right = atomic_step_cost cost_N_IRight\n\n    let if_left = atomic_step_cost cost_N_IIf_left\n\n    let cons_list = atomic_step_cost cost_N_ICons_list\n\n    let nil = atomic_step_cost cost_N_INil\n\n    let if_cons = atomic_step_cost cost_N_IIf_cons\n\n    let list_map : 'a Script_typed_ir.boxed_list -> Gas.cost =\n     fun {length; _} -> atomic_step_cost (cost_N_IList_map length)\n\n    let list_size = atomic_step_cost cost_N_IList_size\n\n    let list_iter : 'a Script_typed_ir.boxed_list -> Gas.cost =\n     fun {length; _} -> atomic_step_cost (cost_N_IList_iter length)\n\n    let empty_set = atomic_step_cost cost_N_IEmpty_set\n\n    let set_iter (type a) ((module Box) : a Script_typed_ir.set) =\n      atomic_step_cost (cost_N_ISet_iter Box.size)\n\n    let set_size = atomic_step_cost cost_N_ISet_size\n\n    let empty_map = atomic_step_cost cost_N_IEmpty_map\n\n    let map_map (type k v) ((module Box) : (k, v) Script_typed_ir.map) =\n      atomic_step_cost (cost_N_IMap_map Box.size)\n\n    let map_iter (type k v) ((module Box) : (k, v) Script_typed_ir.map) =\n      atomic_step_cost (cost_N_IMap_iter Box.size)\n\n    let map_size = atomic_step_cost cost_N_IMap_size\n\n    let big_map_elt_size = S.safe_int Script_expr_hash.size\n\n    let big_map_mem ({size; _} : _ Script_typed_ir.big_map_overlay) =\n      atomic_step_cost (cost_N_IMap_mem big_map_elt_size (S.safe_int size))\n\n    let big_map_get ({size; _} : _ Script_typed_ir.big_map_overlay) =\n      atomic_step_cost (cost_N_IMap_get big_map_elt_size (S.safe_int size))\n\n    let big_map_update ({size; _} : _ Script_typed_ir.big_map_overlay) =\n      atomic_step_cost (cost_N_IMap_update big_map_elt_size (S.safe_int size))\n\n    let big_map_get_and_update ({size; _} : _ Script_typed_ir.big_map_overlay) =\n      atomic_step_cost\n        (cost_N_IMap_get_and_update big_map_elt_size (S.safe_int size))\n\n    let add_seconds_timestamp :\n        'a Script_int.num -> Script_timestamp.t -> Gas.cost =\n     fun seconds timestamp ->\n      let seconds_bytes = int_bytes seconds in\n      let timestamp_bytes = z_bytes (Script_timestamp.to_zint timestamp) in\n      atomic_step_cost\n        (cost_N_IAdd_seconds_to_timestamp seconds_bytes timestamp_bytes)\n\n    let add_timestamp_seconds :\n        Script_timestamp.t -> 'a Script_int.num -> Gas.cost =\n     fun timestamp seconds ->\n      let seconds_bytes = int_bytes seconds in\n      let timestamp_bytes = z_bytes (Script_timestamp.to_zint timestamp) in\n      atomic_step_cost\n        (cost_N_IAdd_timestamp_to_seconds timestamp_bytes seconds_bytes)\n\n    let sub_timestamp_seconds :\n        Script_timestamp.t -> 'a Script_int.num -> Gas.cost =\n     fun timestamp seconds ->\n      let seconds_bytes = int_bytes seconds in\n      let timestamp_bytes = z_bytes (Script_timestamp.to_zint timestamp) in\n      atomic_step_cost\n        (cost_N_ISub_timestamp_seconds timestamp_bytes seconds_bytes)\n\n    let diff_timestamps t1 t2 =\n      let t1_bytes = z_bytes (Script_timestamp.to_zint t1) in\n      let t2_bytes = z_bytes (Script_timestamp.to_zint t2) in\n      atomic_step_cost (cost_N_IDiff_timestamps t1_bytes t2_bytes)\n\n    let concat_string_pair s1 s2 =\n      atomic_step_cost\n        (cost_N_IConcat_string_pair\n           (Script_string.length s1)\n           (Script_string.length s2))\n\n    let slice_string s =\n      atomic_step_cost (cost_N_ISlice_string (Script_string.length s))\n\n    let string_size = atomic_step_cost cost_N_IString_size\n\n    let concat_bytes_pair b1 b2 =\n      atomic_step_cost\n        (cost_N_IConcat_bytes_pair (Bytes.length b1) (Bytes.length b2))\n\n    let slice_bytes b = atomic_step_cost (cost_N_ISlice_bytes (Bytes.length b))\n\n    let bytes_size = atomic_step_cost cost_N_IBytes_size\n\n    let add_tez = atomic_step_cost cost_N_IAdd_tez\n\n    let sub_tez = atomic_step_cost cost_N_ISub_tez\n\n    let sub_tez_legacy = atomic_step_cost cost_N_ISub_tez_legacy\n\n    let mul_teznat = atomic_step_cost cost_N_IMul_teznat\n\n    let mul_nattez = atomic_step_cost cost_N_IMul_nattez\n\n    let bool_or = atomic_step_cost cost_N_IOr\n\n    let bool_and = atomic_step_cost cost_N_IAnd\n\n    let bool_xor = atomic_step_cost cost_N_IXor\n\n    let bool_not = atomic_step_cost cost_N_INot\n\n    let is_nat = atomic_step_cost cost_N_IIs_nat\n\n    let abs_int i = atomic_step_cost (cost_N_IAbs_int (int_bytes i))\n\n    let int_nat = atomic_step_cost cost_N_IInt_nat\n\n    let neg i = atomic_step_cost (cost_N_INeg (int_bytes i))\n\n    let add_int i1 i2 =\n      atomic_step_cost (cost_N_IAdd_int (int_bytes i1) (int_bytes i2))\n\n    let add_nat i1 i2 =\n      atomic_step_cost (cost_N_IAdd_nat (int_bytes i1) (int_bytes i2))\n\n    let sub_int i1 i2 =\n      atomic_step_cost (cost_N_ISub_int (int_bytes i1) (int_bytes i2))\n\n    let mul_int i1 i2 =\n      atomic_step_cost (cost_N_IMul_int (int_bytes i1) (int_bytes i2))\n\n    let mul_nat i1 i2 =\n      atomic_step_cost (cost_N_IMul_nat (int_bytes i1) (int_bytes i2))\n\n    let ediv_teznat _tez _n = atomic_step_cost cost_N_IEdiv_teznat\n\n    let ediv_tez = atomic_step_cost cost_N_IEdiv_tez\n\n    let ediv_int i1 i2 =\n      atomic_step_cost (cost_N_IEdiv_int (int_bytes i1) (int_bytes i2))\n\n    let ediv_nat i1 i2 =\n      atomic_step_cost (cost_N_IEdiv_nat (int_bytes i1) (int_bytes i2))\n\n    let eq = atomic_step_cost cost_N_IEq\n\n    let lsl_nat shifted = atomic_step_cost (cost_N_ILsl_nat (int_bytes shifted))\n\n    let lsr_nat shifted = atomic_step_cost (cost_N_ILsr_nat (int_bytes shifted))\n\n    let or_nat n1 n2 =\n      atomic_step_cost (cost_N_IOr_nat (int_bytes n1) (int_bytes n2))\n\n    let and_nat n1 n2 =\n      atomic_step_cost (cost_N_IAnd_nat (int_bytes n1) (int_bytes n2))\n\n    let and_int_nat n1 n2 =\n      atomic_step_cost (cost_N_IAnd_int_nat (int_bytes n1) (int_bytes n2))\n\n    let xor_nat n1 n2 =\n      atomic_step_cost (cost_N_IXor_nat (int_bytes n1) (int_bytes n2))\n\n    let not_int i = atomic_step_cost (cost_N_INot_int (int_bytes i))\n\n    let if_ = atomic_step_cost cost_N_IIf\n\n    let loop = atomic_step_cost cost_N_ILoop\n\n    let loop_left = atomic_step_cost cost_N_ILoop_left\n\n    let dip = atomic_step_cost cost_N_IDip\n\n    let view = atomic_step_cost cost_N_IView\n\n    let check_signature (pkey : Signature.public_key) b =\n      let cost =\n        match pkey with\n        | Ed25519 _ -> cost_N_ICheck_signature_ed25519 (Bytes.length b)\n        | Secp256k1 _ -> cost_N_ICheck_signature_secp256k1 (Bytes.length b)\n        | P256 _ -> cost_N_ICheck_signature_p256 (Bytes.length b)\n      in\n      atomic_step_cost cost\n\n    let blake2b b = atomic_step_cost (cost_N_IBlake2b (Bytes.length b))\n\n    let sha256 b = atomic_step_cost (cost_N_ISha256 (Bytes.length b))\n\n    let sha512 b = atomic_step_cost (cost_N_ISha512 (Bytes.length b))\n\n    let dign n = atomic_step_cost (cost_N_IDig n)\n\n    let dugn n = atomic_step_cost (cost_N_IDug n)\n\n    let dipn n = atomic_step_cost (cost_N_IDipN n)\n\n    let dropn n = atomic_step_cost (cost_N_IDropN n)\n\n    let voting_power = atomic_step_cost cost_N_IVoting_power\n\n    let total_voting_power = atomic_step_cost cost_N_ITotal_voting_power\n\n    let keccak b = atomic_step_cost (cost_N_IKeccak (Bytes.length b))\n\n    let sha3 b = atomic_step_cost (cost_N_ISha3 (Bytes.length b))\n\n    let add_bls12_381_g1 = atomic_step_cost cost_N_IAdd_bls12_381_g1\n\n    let add_bls12_381_g2 = atomic_step_cost cost_N_IAdd_bls12_381_g2\n\n    let add_bls12_381_fr = atomic_step_cost cost_N_IAdd_bls12_381_fr\n\n    let mul_bls12_381_g1 = atomic_step_cost cost_N_IMul_bls12_381_g1\n\n    let mul_bls12_381_g2 = atomic_step_cost cost_N_IMul_bls12_381_g2\n\n    let mul_bls12_381_fr = atomic_step_cost cost_N_IMul_bls12_381_fr\n\n    let mul_bls12_381_fr_z z =\n      atomic_step_cost (cost_N_IMul_bls12_381_fr_z (int_bytes z))\n\n    let mul_bls12_381_z_fr z =\n      atomic_step_cost (cost_N_IMul_bls12_381_z_fr (int_bytes z))\n\n    let int_bls12_381_fr = atomic_step_cost cost_N_IInt_bls12_381_z_fr\n\n    let neg_bls12_381_g1 = atomic_step_cost cost_N_INeg_bls12_381_g1\n\n    let neg_bls12_381_g2 = atomic_step_cost cost_N_INeg_bls12_381_g2\n\n    let neg_bls12_381_fr = atomic_step_cost cost_N_INeg_bls12_381_fr\n\n    let neq = atomic_step_cost cost_N_INeq\n\n    let pairing_check_bls12_381 (l : 'a Script_typed_ir.boxed_list) =\n      atomic_step_cost (cost_N_IPairing_check_bls12_381 l.length)\n\n    let comb n = atomic_step_cost (cost_N_IComb n)\n\n    let uncomb n = atomic_step_cost (cost_N_IUncomb n)\n\n    let comb_get n = atomic_step_cost (cost_N_IComb_get n)\n\n    let comb_set n = atomic_step_cost (cost_N_IComb_set n)\n\n    let dupn n = atomic_step_cost (cost_N_IDupN n)\n\n    let sapling_verify_update ~inputs ~outputs =\n      atomic_step_cost (cost_N_ISapling_verify_update inputs outputs)\n\n    let sapling_empty_state = atomic_step_cost cost_N_ISapling_empty_state\n\n    let halt = atomic_step_cost cost_N_IHalt\n\n    let const = atomic_step_cost cost_N_IConst\n\n    let empty_big_map = atomic_step_cost cost_N_IEmpty_big_map\n\n    let lt = atomic_step_cost cost_N_ILt\n\n    let le = atomic_step_cost cost_N_ILe\n\n    let gt = atomic_step_cost cost_N_IGt\n\n    let ge = atomic_step_cost cost_N_IGe\n\n    let exec = atomic_step_cost cost_N_IExec\n\n    let apply = atomic_step_cost cost_N_IApply\n\n    let lambda = atomic_step_cost cost_N_ILambda\n\n    let address = atomic_step_cost cost_N_IAddress\n\n    let contract = atomic_step_cost cost_N_IContract\n\n    let transfer_tokens = atomic_step_cost cost_N_ITransfer_tokens\n\n    let implicit_account = atomic_step_cost cost_N_IImplicit_account\n\n    let create_contract = atomic_step_cost cost_N_ICreate_contract\n\n    let set_delegate = atomic_step_cost cost_N_ISet_delegate\n\n    let level = atomic_step_cost cost_N_ILevel\n\n    let now = atomic_step_cost cost_N_INow\n\n    let source = atomic_step_cost cost_N_ISource\n\n    let sender = atomic_step_cost cost_N_ISender\n\n    let self = atomic_step_cost cost_N_ISelf\n\n    let self_address = atomic_step_cost cost_N_ISelf_address\n\n    let amount = atomic_step_cost cost_N_IAmount\n\n    let chain_id = atomic_step_cost cost_N_IChainId\n\n    let ticket = atomic_step_cost cost_N_ITicket\n\n    let read_ticket = atomic_step_cost cost_N_IRead_ticket\n\n    let hash_key _ = atomic_step_cost cost_N_IHash_key\n\n    let split_ticket _ amount_a amount_b =\n      atomic_step_cost\n        (cost_N_ISplit_ticket (int_bytes amount_a) (int_bytes amount_b))\n\n    let open_chest ~chest ~time =\n      let plaintext = Timelock.get_plaintext_size chest in\n      let log_time = Z.log2 Z.(add one time) in\n      atomic_step_cost (cost_N_IOpen_chest ~chest:plaintext ~time:log_time)\n\n    (* --------------------------------------------------------------------- *)\n    (* Semi-hand-crafted models *)\n\n    let compare_unit = atomic_step_cost (S.safe_int 10)\n\n    let compare_pair_tag = atomic_step_cost (S.safe_int 10)\n\n    let compare_union_tag = atomic_step_cost (S.safe_int 10)\n\n    let compare_option_tag = atomic_step_cost (S.safe_int 10)\n\n    let compare_bool = atomic_step_cost (cost_N_ICompare 1 1)\n\n    let compare_signature = atomic_step_cost (S.safe_int 92)\n\n    let compare_string s1 s2 =\n      atomic_step_cost\n        (cost_N_ICompare (Script_string.length s1) (Script_string.length s2))\n\n    let compare_bytes b1 b2 =\n      atomic_step_cost (cost_N_ICompare (Bytes.length b1) (Bytes.length b2))\n\n    let compare_mutez = atomic_step_cost (cost_N_ICompare 8 8)\n\n    let compare_int i1 i2 =\n      atomic_step_cost (cost_N_ICompare (int_bytes i1) (int_bytes i2))\n\n    let compare_nat n1 n2 =\n      atomic_step_cost (cost_N_ICompare (int_bytes n1) (int_bytes n2))\n\n    let compare_key_hash =\n      let sz = Signature.Public_key_hash.size in\n      atomic_step_cost (cost_N_ICompare sz sz)\n\n    let compare_key = atomic_step_cost (S.safe_int 92)\n\n    let compare_timestamp t1 t2 =\n      atomic_step_cost\n        (cost_N_ICompare\n           (z_bytes (Script_timestamp.to_zint t1))\n           (z_bytes (Script_timestamp.to_zint t2)))\n\n    (* Maximum size of an entrypoint in bytes *)\n    let entrypoint_size = 31\n\n    let compare_address =\n      let sz = Signature.Public_key_hash.size + entrypoint_size in\n      atomic_step_cost (cost_N_ICompare sz sz)\n\n    let compare_chain_id = atomic_step_cost (S.safe_int 30)\n\n    (* Defunctionalized CPS *)\n    type cont =\n      | Compare : 'a Script_typed_ir.comparable_ty * 'a * 'a * cont -> cont\n      | Return : cont\n\n    let compare : type a. a Script_typed_ir.comparable_ty -> a -> a -> cost =\n     fun ty x y ->\n      let rec compare :\n          type a.\n          a Script_typed_ir.comparable_ty -> a -> a -> cost -> cont -> cost =\n       fun ty x y acc k ->\n        match ty with\n        | Unit_key _ -> (apply [@tailcall]) Gas.(acc +@ compare_unit) k\n        | Never_key _ -> ( match x with _ -> .)\n        | Bool_key _ -> (apply [@tailcall]) Gas.(acc +@ compare_bool) k\n        | String_key _ -> (apply [@tailcall]) Gas.(acc +@ compare_string x y) k\n        | Signature_key _ ->\n            (apply [@tailcall]) Gas.(acc +@ compare_signature) k\n        | Bytes_key _ -> (apply [@tailcall]) Gas.(acc +@ compare_bytes x y) k\n        | Mutez_key _ -> (apply [@tailcall]) Gas.(acc +@ compare_mutez) k\n        | Int_key _ -> (apply [@tailcall]) Gas.(acc +@ compare_int x y) k\n        | Nat_key _ -> (apply [@tailcall]) Gas.(acc +@ compare_nat x y) k\n        | Key_hash_key _ -> (apply [@tailcall]) Gas.(acc +@ compare_key_hash) k\n        | Key_key _ -> (apply [@tailcall]) Gas.(acc +@ compare_key) k\n        | Timestamp_key _ ->\n            (apply [@tailcall]) Gas.(acc +@ compare_timestamp x y) k\n        | Address_key _ -> (apply [@tailcall]) Gas.(acc +@ compare_address) k\n        | Chain_id_key _ -> (apply [@tailcall]) Gas.(acc +@ compare_chain_id) k\n        | Pair_key ((tl, _), (tr, _), _) ->\n            (* Reasonable over-approximation of the cost of lexicographic comparison. *)\n            let (xl, xr) = x in\n            let (yl, yr) = y in\n            (compare [@tailcall])\n              tl\n              xl\n              yl\n              Gas.(acc +@ compare_pair_tag)\n              (Compare (tr, xr, yr, k))\n        | Union_key ((tl, _), (tr, _), _) -> (\n            match (x, y) with\n            | (L x, L y) ->\n                (compare [@tailcall]) tl x y Gas.(acc +@ compare_union_tag) k\n            | (L _, R _) -> (apply [@tailcall]) Gas.(acc +@ compare_union_tag) k\n            | (R _, L _) -> (apply [@tailcall]) Gas.(acc +@ compare_union_tag) k\n            | (R x, R y) ->\n                (compare [@tailcall]) tr x y Gas.(acc +@ compare_union_tag) k)\n        | Option_key (t, _) -> (\n            match (x, y) with\n            | (None, None) ->\n                (apply [@tailcall]) Gas.(acc +@ compare_option_tag) k\n            | (None, Some _) ->\n                (apply [@tailcall]) Gas.(acc +@ compare_option_tag) k\n            | (Some _, None) ->\n                (apply [@tailcall]) Gas.(acc +@ compare_option_tag) k\n            | (Some x, Some y) ->\n                (compare [@tailcall]) t x y Gas.(acc +@ compare_option_tag) k)\n      and apply cost k =\n        match k with\n        | Compare (ty, x, y, k) -> (compare [@tailcall]) ty x y cost k\n        | Return -> cost\n      in\n      compare ty x y Gas.free Return\n     [@@coq_axiom_with_reason \"non top-level mutually recursive function\"]\n\n    let view_mem (elt : Script_string.t)\n        (m : Script_typed_ir.view Script_typed_ir.SMap.t) =\n      let open S_syntax in\n      let per_elt_cost =\n        compare (Script_typed_ir.string_key ~annot:None) elt elt\n      in\n      let size = S.safe_int (Script_typed_ir.SMap.cardinal m) in\n      let intercept = atomic_step_cost (S.safe_int 80) in\n      Gas.(intercept +@ (log2 size *@ per_elt_cost))\n\n    let view_get = view_mem\n\n    let view_update (elt : Script_string.t)\n        (m : Script_typed_ir.view Script_typed_ir.SMap.t) =\n      let open S_syntax in\n      let per_elt_cost =\n        compare (Script_typed_ir.string_key ~annot:None) elt elt\n      in\n      let size = S.safe_int (Script_typed_ir.SMap.cardinal m) in\n      let intercept = atomic_step_cost (S.safe_int 80) in\n      Gas.(intercept +@ (S.safe_int 2 * log2 size *@ per_elt_cost))\n\n    let set_mem (type a) (elt : a) ((module Box) : a Script_typed_ir.set) =\n      let open S_syntax in\n      let per_elt_cost = compare Box.elt_ty elt elt in\n      let size = S.safe_int Box.size in\n      let intercept = atomic_step_cost (S.safe_int 115) in\n      Gas.(intercept +@ (log2 size *@ per_elt_cost))\n\n    let set_update (type a) (elt : a) ((module Box) : a Script_typed_ir.set) =\n      let open S_syntax in\n      let per_elt_cost = compare Box.elt_ty elt elt in\n      let size = S.safe_int Box.size in\n      let intercept = atomic_step_cost (S.safe_int 130) in\n      (* The 2 factor reflects the update vs mem overhead as benchmarked\n         on non-structured data *)\n      Gas.(intercept +@ (S.safe_int 2 * log2 size *@ per_elt_cost))\n\n    let map_mem (type k v) (elt : k) ((module Box) : (k, v) Script_typed_ir.map)\n        =\n      let open S_syntax in\n      let per_elt_cost = compare Box.key_ty elt elt in\n      let size = S.safe_int Box.size in\n      let intercept = atomic_step_cost (S.safe_int 80) in\n      Gas.(intercept +@ (log2 size *@ per_elt_cost))\n\n    let map_get = map_mem\n\n    let map_update (type k v) (elt : k)\n        ((module Box) : (k, v) Script_typed_ir.map) =\n      let open S_syntax in\n      let per_elt_cost = compare Box.key_ty elt elt in\n      let size = S.safe_int Box.size in\n      let intercept = atomic_step_cost (S.safe_int 80) in\n      (* The 2 factor reflects the update vs mem overhead as benchmarked\n         on non-structured data *)\n      Gas.(intercept +@ (S.safe_int 2 * log2 size *@ per_elt_cost))\n\n    let map_get_and_update (type k v) (elt : k)\n        ((module Box) : (k, v) Script_typed_ir.map) =\n      let open S_syntax in\n      let per_elt_cost = compare Box.key_ty elt elt in\n      let size = S.safe_int Box.size in\n      let intercept = atomic_step_cost (S.safe_int 80) in\n      (* The 3 factor reflects the update vs mem overhead as benchmarked\n         on non-structured data *)\n      Gas.(intercept +@ (S.safe_int 3 * log2 size *@ per_elt_cost))\n\n    let join_tickets :\n        'a Script_typed_ir.comparable_ty ->\n        'a Script_typed_ir.ticket ->\n        'a Script_typed_ir.ticket ->\n        Gas.cost =\n     fun ty ticket_a ticket_b ->\n      let contents_comparison =\n        compare ty ticket_a.contents ticket_b.contents\n      in\n      Gas.(\n        contents_comparison +@ compare_address\n        +@ add_nat ticket_a.amount ticket_b.amount)\n\n    (* Continuations *)\n    module Control = struct\n      let nil = atomic_step_cost cost_N_KNil\n\n      let cons = atomic_step_cost cost_N_KCons\n\n      let return = atomic_step_cost cost_N_KReturn\n\n      let view_exit = atomic_step_cost cost_N_KView_exit\n\n      let map_head = atomic_step_cost const_N_KMap_head\n\n      let undip = atomic_step_cost cost_N_KUndip\n\n      let loop_in = atomic_step_cost cost_N_KLoop_in\n\n      let loop_in_left = atomic_step_cost cost_N_KLoop_in_left\n\n      let iter = atomic_step_cost cost_N_KIter\n\n      let list_enter_body xs ys_len =\n        atomic_step_cost (cost_N_KList_enter_body xs ys_len)\n\n      let list_exit_body = atomic_step_cost cost_N_KList_exit_body\n\n      let map_enter_body = atomic_step_cost cost_N_KMap_enter_body\n\n      let map_exit_body (type k v) (key : k) (map : (k, v) Script_typed_ir.map)\n          =\n        map_update key map\n    end\n\n    (* --------------------------------------------------------------------- *)\n    (* Hand-crafted models *)\n\n    (* The cost functions below where not benchmarked, a cost model was derived\n       from looking at similar instructions. *)\n\n    (* Cost for Concat_string is paid in two steps: when entering the interpreter,\n       the user pays for the cost of computing the information necessary to compute\n       the actual gas (so it's meta-gas): indeed, one needs to run through the\n       list of strings to compute the total allocated cost.\n       [concat_string_precheck] corresponds to the meta-gas cost of this computation.\n    *)\n    let concat_string_precheck (l : 'a Script_typed_ir.boxed_list) =\n      (* we set the precheck to be slightly more expensive than cost_N_IList_iter *)\n      atomic_step_cost (S.mul (S.safe_int l.length) (S.safe_int 10))\n\n    (* This is the cost of allocating a string and blitting existing ones into it. *)\n    let concat_string total_bytes =\n      atomic_step_cost\n        S.(add (S.safe_int 100) (S.ediv total_bytes (S.safe_int 10)))\n\n    (* Same story as Concat_string. *)\n    let concat_bytes total_bytes =\n      atomic_step_cost\n        S.(add (S.safe_int 100) (S.ediv total_bytes (S.safe_int 10)))\n\n    (* Cost of access taken care of in Contract_storage.get_balance_carbonated *)\n    let balance = Gas.free\n\n    (* Cost of Unpack pays two integer comparisons, and a Bytes slice *)\n    let unpack bytes =\n      let blen = Bytes.length bytes in\n      let open S_syntax in\n      atomic_step_cost (S.safe_int 260 + (S.safe_int blen lsr 3))\n\n    (* TODO benchmark *)\n    (* FIXME: imported from 006, needs proper benchmarks *)\n    let unpack_failed bytes =\n      (* We cannot instrument failed deserialization,\n         so we take worst case fees: a set of size 1 bytes values. *)\n      let blen = String.length bytes in\n      let len = S.safe_int blen in\n      let d = Z.numbits (Z.of_int blen) in\n      (len *@ alloc_mbytes_cost 1)\n      +@ len\n         *@ (S.safe_int d *@ (alloc_cost (S.safe_int 3) +@ step_cost S.one))\n  end\n\n  module Typechecking = struct\n    open Generated_costs\n\n    let public_key_optimized =\n      atomic_step_cost\n      @@ S.(\n           max\n             cost_DECODING_PUBLIC_KEY_ed25519\n             (max\n                cost_DECODING_PUBLIC_KEY_secp256k1\n                cost_DECODING_PUBLIC_KEY_p256))\n\n    let public_key_readable =\n      atomic_step_cost\n      @@ S.(\n           max\n             cost_B58CHECK_DECODING_PUBLIC_KEY_ed25519\n             (max\n                cost_B58CHECK_DECODING_PUBLIC_KEY_secp256k1\n                cost_B58CHECK_DECODING_PUBLIC_KEY_p256))\n\n    let key_hash_optimized =\n      atomic_step_cost\n      @@ S.(\n           max\n             cost_DECODING_PUBLIC_KEY_HASH_ed25519\n             (max\n                cost_DECODING_PUBLIC_KEY_HASH_secp256k1\n                cost_DECODING_PUBLIC_KEY_HASH_p256))\n\n    let key_hash_readable =\n      atomic_step_cost\n      @@ S.(\n           max\n             cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_ed25519\n             (max\n                cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_secp256k1\n                cost_B58CHECK_DECODING_PUBLIC_KEY_HASH_p256))\n\n    let signature_optimized =\n      atomic_step_cost\n      @@ S.(\n           max\n             cost_DECODING_SIGNATURE_ed25519\n             (max\n                cost_DECODING_SIGNATURE_secp256k1\n                cost_DECODING_SIGNATURE_p256))\n\n    let signature_readable =\n      atomic_step_cost\n      @@ S.(\n           max\n             cost_B58CHECK_DECODING_SIGNATURE_ed25519\n             (max\n                cost_B58CHECK_DECODING_SIGNATURE_secp256k1\n                cost_B58CHECK_DECODING_SIGNATURE_p256))\n\n    let chain_id_optimized = atomic_step_cost cost_DECODING_CHAIN_ID\n\n    let chain_id_readable = atomic_step_cost cost_B58CHECK_DECODING_CHAIN_ID\n\n    (* Reasonable approximation *)\n    let address_optimized = key_hash_optimized\n\n    (* Reasonable approximation *)\n    let contract_optimized = key_hash_optimized\n\n    (* Reasonable approximation *)\n    let contract_readable = key_hash_readable\n\n    let bls12_381_g1 = atomic_step_cost cost_DECODING_BLS_G1\n\n    let bls12_381_g2 = atomic_step_cost cost_DECODING_BLS_G2\n\n    let bls12_381_fr = atomic_step_cost cost_DECODING_BLS_FR\n\n    let check_printable s =\n      atomic_step_cost (cost_CHECK_PRINTABLE (String.length s))\n\n    let merge_cycle = atomic_step_cost cost_MERGE_TYPES\n\n    let parse_type_cycle = atomic_step_cost cost_PARSE_TYPE\n\n    let parse_instr_cycle = atomic_step_cost cost_TYPECHECKING_CODE\n\n    let parse_data_cycle = atomic_step_cost cost_TYPECHECKING_DATA\n\n    let comparable_ty_of_ty_cycle = atomic_step_cost cost_COMPARABLE_TY_OF_TY\n\n    (* Cost of a cycle of checking that a type is dupable *)\n    (* TODO: bench *)\n    let check_dupable_cycle = atomic_step_cost cost_TYPECHECKING_DATA\n\n    let bool = free\n\n    let unit = free\n\n    let timestamp_readable = atomic_step_cost cost_TIMESTAMP_READABLE_DECODING\n\n    (* Reasonable estimate. *)\n    let contract = Gas.(S.safe_int 2 *@ public_key_readable)\n\n    (* Balance stored at /contracts/index/hash/balance, on 64 bits *)\n    let contract_exists =\n      Gas.cost_of_repr @@ Storage_costs.read_access ~path_length:4 ~read_bytes:8\n\n    (* Constructing proof arguments consists in a decreasing loop in the result\n       monad, allocating at each step. We charge a reasonable overapproximation. *)\n    let proof_argument n =\n      atomic_step_cost (S.mul (S.safe_int n) (S.safe_int 50))\n\n    let chest_key = atomic_step_cost cost_DECODING_Chest_key\n\n    let chest ~bytes = atomic_step_cost (cost_DECODING_Chest ~bytes)\n  end\n\n  module Unparsing = struct\n    open Generated_costs\n\n    let public_key_optimized =\n      atomic_step_cost\n      @@ S.(\n           max\n             cost_ENCODING_PUBLIC_KEY_ed25519\n             (max\n                cost_ENCODING_PUBLIC_KEY_secp256k1\n                cost_ENCODING_PUBLIC_KEY_p256))\n\n    let public_key_readable =\n      atomic_step_cost\n      @@ S.(\n           max\n             cost_B58CHECK_ENCODING_PUBLIC_KEY_ed25519\n             (max\n                cost_B58CHECK_ENCODING_PUBLIC_KEY_secp256k1\n                cost_B58CHECK_ENCODING_PUBLIC_KEY_p256))\n\n    let key_hash_optimized =\n      atomic_step_cost\n      @@ S.(\n           max\n             cost_ENCODING_PUBLIC_KEY_HASH_ed25519\n             (max\n                cost_ENCODING_PUBLIC_KEY_HASH_secp256k1\n                cost_ENCODING_PUBLIC_KEY_HASH_p256))\n\n    let key_hash_readable =\n      atomic_step_cost\n      @@ S.(\n           max\n             cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_ed25519\n             (max\n                cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_secp256k1\n                cost_B58CHECK_ENCODING_PUBLIC_KEY_HASH_p256))\n\n    let signature_optimized =\n      atomic_step_cost\n      @@ S.(\n           max\n             cost_ENCODING_SIGNATURE_ed25519\n             (max\n                cost_ENCODING_SIGNATURE_secp256k1\n                cost_ENCODING_SIGNATURE_p256))\n\n    let signature_readable =\n      atomic_step_cost\n      @@ S.(\n           max\n             cost_B58CHECK_ENCODING_SIGNATURE_ed25519\n             (max\n                cost_B58CHECK_ENCODING_SIGNATURE_secp256k1\n                cost_B58CHECK_ENCODING_SIGNATURE_p256))\n\n    let chain_id_optimized = atomic_step_cost cost_ENCODING_CHAIN_ID\n\n    let chain_id_readable = atomic_step_cost cost_B58CHECK_ENCODING_CHAIN_ID\n\n    let timestamp_readable = atomic_step_cost cost_TIMESTAMP_READABLE_ENCODING\n\n    (* Reasonable approximation *)\n    let address_optimized = key_hash_optimized\n\n    (* Reasonable approximation *)\n    let contract_optimized = key_hash_optimized\n\n    (* Reasonable approximation *)\n    let contract_readable = key_hash_readable\n\n    let bls12_381_g1 = atomic_step_cost cost_ENCODING_BLS_G1\n\n    let bls12_381_g2 = atomic_step_cost cost_ENCODING_BLS_G2\n\n    let bls12_381_fr = atomic_step_cost cost_ENCODING_BLS_FR\n\n    let unparse_type ty =\n      atomic_step_cost\n      @@ cost_UNPARSE_TYPE Script_typed_ir.(ty_size ty |> Type_size.to_int)\n\n    let unparse_comparable_type comp_ty =\n      atomic_step_cost\n      @@ cost_UNPARSE_COMPARABLE_TYPE\n           Script_typed_ir.(comparable_ty_size comp_ty |> Type_size.to_int)\n\n    let unparse_instr_cycle = atomic_step_cost cost_UNPARSING_CODE\n\n    let unparse_data_cycle = atomic_step_cost cost_UNPARSING_DATA\n\n    let unit = Gas.free\n\n    (* Reasonable estimate. *)\n    let contract = Gas.(S.safe_int 2 *@ public_key_readable)\n\n    (* Reuse 006 costs. *)\n    let operation bytes = Script.bytes_node_cost bytes\n\n    let sapling_transaction (t : Sapling.transaction) =\n      let inputs = List.length t.inputs in\n      let outputs = List.length t.outputs in\n      atomic_step_cost (cost_SAPLING_TRANSACTION_ENCODING ~inputs ~outputs)\n\n    let sapling_diff (d : Sapling.diff) =\n      let nfs = List.length d.nullifiers in\n      let cms = List.length d.commitments_and_ciphertexts in\n      atomic_step_cost (cost_SAPLING_DIFF_ENCODING ~nfs ~cms)\n\n    let chest_key = atomic_step_cost cost_ENCODING_Chest_key\n\n    let chest ~plaintext_size =\n      atomic_step_cost (cost_ENCODING_Chest ~plaintext_size)\n  end\nend\n" ;
                } ;
                { name = "Script_list" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Empty list. *)\nval empty : 'a Script_typed_ir.boxed_list\n\n(** Prepend an element. *)\nval cons : 'a -> 'a Script_typed_ir.boxed_list -> 'a Script_typed_ir.boxed_list\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Script_typed_ir\n\nlet empty : 'a boxed_list = {elements = []; length = 0}\n\nlet cons : 'a -> 'a boxed_list -> 'a boxed_list =\n fun elt l -> {length = 1 + l.length; elements = elt :: l.elements}\n" ;
                } ;
                { name = "Script_comparable" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nval compare_comparable : 'a Script_typed_ir.comparable_ty -> 'a -> 'a -> int\n\nval compare_address : Script_typed_ir.address -> Script_typed_ir.address -> int\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\nopen Script_typed_ir\n\nlet compare_address (x, ex) (y, ey) =\n  let lres = Contract.compare x y in\n  if Compare.Int.(lres = 0) then Compare.String.compare ex ey else lres\n\ntype compare_comparable_cont =\n  | Compare_comparable :\n      'a comparable_ty * 'a * 'a * compare_comparable_cont\n      -> compare_comparable_cont\n  | Compare_comparable_return : compare_comparable_cont\n\nlet compare_comparable : type a. a comparable_ty -> a -> a -> int =\n  let rec compare_comparable :\n      type a. a comparable_ty -> compare_comparable_cont -> a -> a -> int =\n   fun kind k x y ->\n    match (kind, x, y) with\n    | (Unit_key _, (), ()) -> (apply [@tailcall]) 0 k\n    | (Never_key _, _, _) -> .\n    | (Signature_key _, x, y) -> (apply [@tailcall]) (Signature.compare x y) k\n    | (String_key _, x, y) -> (apply [@tailcall]) (Script_string.compare x y) k\n    | (Bool_key _, x, y) -> (apply [@tailcall]) (Compare.Bool.compare x y) k\n    | (Mutez_key _, x, y) -> (apply [@tailcall]) (Tez.compare x y) k\n    | (Key_hash_key _, x, y) ->\n        (apply [@tailcall]) (Signature.Public_key_hash.compare x y) k\n    | (Key_key _, x, y) ->\n        (apply [@tailcall]) (Signature.Public_key.compare x y) k\n    | (Int_key _, x, y) -> (apply [@tailcall]) (Script_int.compare x y) k\n    | (Nat_key _, x, y) -> (apply [@tailcall]) (Script_int.compare x y) k\n    | (Timestamp_key _, x, y) ->\n        (apply [@tailcall]) (Script_timestamp.compare x y) k\n    | (Address_key _, x, y) -> (apply [@tailcall]) (compare_address x y) k\n    | (Bytes_key _, x, y) -> (apply [@tailcall]) (Compare.Bytes.compare x y) k\n    | (Chain_id_key _, x, y) -> (apply [@tailcall]) (Chain_id.compare x y) k\n    | (Pair_key ((tl, _), (tr, _), _), (lx, rx), (ly, ry)) ->\n        (compare_comparable [@tailcall])\n          tl\n          (Compare_comparable (tr, rx, ry, k))\n          lx\n          ly\n    | (Union_key ((tl, _), _, _), L x, L y) ->\n        (compare_comparable [@tailcall]) tl k x y\n    | (Union_key _, L _, R _) -> -1\n    | (Union_key _, R _, L _) -> 1\n    | (Union_key (_, (tr, _), _), R x, R y) ->\n        (compare_comparable [@tailcall]) tr k x y\n    | (Option_key _, None, None) -> (apply [@tailcall]) 0 k\n    | (Option_key _, None, Some _) -> -1\n    | (Option_key _, Some _, None) -> 1\n    | (Option_key (t, _), Some x, Some y) ->\n        (compare_comparable [@tailcall]) t k x y\n  and apply ret k =\n    match (ret, k) with\n    | (0, Compare_comparable (ty, x, y, k)) ->\n        (compare_comparable [@tailcall]) ty k x y\n    | (0, Compare_comparable_return) -> 0\n    | (ret, _) ->\n        (* ret <> 0, we perform an early exit *)\n        if Compare.Int.(ret > 0) then 1 else -1\n  in\n  fun t -> compare_comparable t Compare_comparable_return\n  [@@coq_axiom_with_reason \"non top-level mutually recursive function\"]\n" ;
                } ;
                { name = "Script_set" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\nval empty : 'a Script_typed_ir.comparable_ty -> 'a Script_typed_ir.set\n\nval fold : ('elt -> 'acc -> 'acc) -> 'elt Script_typed_ir.set -> 'acc -> 'acc\n\nval update : 'a -> bool -> 'a Script_typed_ir.set -> 'a Script_typed_ir.set\n\nval mem : 'elt -> 'elt Script_typed_ir.set -> bool\n\nval size : 'elt Script_typed_ir.set -> Script_int.n Script_int.num\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\nopen Script_typed_ir\n\nlet empty : type a. a comparable_ty -> a set =\n fun ty ->\n  let module OPS = Set.Make (struct\n    type t = a\n\n    let compare = Script_comparable.compare_comparable ty\n  end) in\n  (module struct\n    type elt = a\n\n    let elt_ty = ty\n\n    module OPS = OPS\n\n    let boxed = OPS.empty\n\n    let size = 0\n  end)\n\nlet update : type a. a -> bool -> a set -> a set =\n fun v b (module Box) ->\n  (module struct\n    type elt = a\n\n    let elt_ty = Box.elt_ty\n\n    module OPS = Box.OPS\n\n    let boxed =\n      if b then Box.OPS.add v Box.boxed else Box.OPS.remove v Box.boxed\n\n    let size =\n      let mem = Box.OPS.mem v Box.boxed in\n      if mem then if b then Box.size else Box.size - 1\n      else if b then Box.size + 1\n      else Box.size\n  end)\n\nlet mem : type elt. elt -> elt set -> bool =\n fun v (module Box) -> Box.OPS.mem v Box.boxed\n\nlet fold : type elt acc. (elt -> acc -> acc) -> elt set -> acc -> acc =\n fun f (module Box) -> Box.OPS.fold f Box.boxed\n\nlet size : type elt. elt set -> Script_int.n Script_int.num =\n fun (module Box) -> Script_int.(abs (of_int Box.size))\n" ;
                } ;
                { name = "Script_map" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\nval empty : 'a Script_typed_ir.comparable_ty -> ('a, 'b) Script_typed_ir.map\n\nval fold :\n  ('key -> 'value -> 'acc -> 'acc) ->\n  ('key, 'value) Script_typed_ir.map ->\n  'acc ->\n  'acc\n\nval update :\n  'a ->\n  'b option ->\n  ('a, 'b) Script_typed_ir.map ->\n  ('a, 'b) Script_typed_ir.map\n\nval mem : 'key -> ('key, 'value) Script_typed_ir.map -> bool\n\nval get : 'key -> ('key, 'value) Script_typed_ir.map -> 'value option\n\nval key_ty : ('a, 'b) Script_typed_ir.map -> 'a Script_typed_ir.comparable_ty\n\nval size : ('a, 'b) Script_typed_ir.map -> Script_int.n Script_int.num\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\nopen Script_typed_ir\n\nlet key_ty : type a b. (a, b) map -> a comparable_ty =\n fun (module Box) -> Box.key_ty\n\nlet empty : type a b. a comparable_ty -> (a, b) map =\n fun ty ->\n  let module OPS = Map.Make (struct\n    type t = a\n\n    let compare = Script_comparable.compare_comparable ty\n  end) in\n  (module struct\n    type key = a\n\n    type value = b\n\n    let key_ty = ty\n\n    module OPS = struct\n      type value = b\n\n      include OPS\n\n      type nonrec t = value t\n    end\n\n    let boxed = OPS.empty\n\n    let size = 0\n  end)\n\nlet get : type key value. key -> (key, value) map -> value option =\n fun k (module Box) -> Box.OPS.find k Box.boxed\n\nlet update : type a b. a -> b option -> (a, b) map -> (a, b) map =\n fun k v (module Box) ->\n  let (boxed, size) =\n    let contains =\n      match Box.OPS.find k Box.boxed with None -> false | _ -> true\n    in\n    match v with\n    | Some v -> (Box.OPS.add k v Box.boxed, Box.size + if contains then 0 else 1)\n    | None -> (Box.OPS.remove k Box.boxed, Box.size - if contains then 1 else 0)\n  in\n  (module struct\n    type key = a\n\n    type value = b\n\n    let key_ty = Box.key_ty\n\n    module OPS = Box.OPS\n\n    let boxed = boxed\n\n    let size = size\n  end)\n\nlet mem : type key value. key -> (key, value) map -> bool =\n fun k (module Box) ->\n  match Box.OPS.find k Box.boxed with None -> false | _ -> true\n\nlet fold :\n    type key value acc.\n    (key -> value -> acc -> acc) -> (key, value) map -> acc -> acc =\n fun f (module Box) -> Box.OPS.fold f Box.boxed\n\nlet size : type key value. (key, value) map -> Script_int.n Script_int.num =\n fun (module Box) -> Script_int.(abs (of_int Box.size))\n" ;
                } ;
                { name = "Script_ir_translator" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(* Overview:\n\nThis mli is organized into roughly three parts:\n\n1. A set of new types prefixed with \"ex_\"\nMichelson is encoded in a GADT that preserves certain properties about its\ntype system. If you haven't read about GADT's, check out the relevant section\nin the Tezos docs:\nhttps://tezos.gitlab.io/developer/gadt.html#generalized-algebraic-data-types-gadts \n\nThe idea is that type representing a Michelson type, ['a ty], is parameterized\nby a type 'a. But that 'a can't be just _any_ type; it must be valid according\nto the definition of ['a ty]. Thus, if I give you a value of type ['a ty],\nall you know is that \"there exists some 'a such that 'a ty exists\". You must be\ncareful not to accidentally quantify 'a universally, that is \"for all 'a,\n'a ty exists\", otherwise you'll get an annoying error about 'a trying to escape\nit's scope. We do this by hiding 'a in an existential type. This is what\nex_comparable_ty, ex_ty, ex_stack_ty, etc. do.\n\n2. A set of functions dealing with high-level Michelson types: \nThis module also provides functions for interacting with the list, map,\nset, and big_map Michelson types. \n\n3. A set of functions for parsing and typechecking Michelson.\nFinally, and what you likely came for, the module provides many functions prefixed\nwith \"parse_\" that convert untyped Micheline (which is essentially S-expressions\nwith a few primitive atom types) into the GADT encoding well-typed Michelson. Likewise\nthere is a number of functions prefixed \"unparse_\" that do the reverse. These functions\nconsume gas, and thus are parameterized by an [Alpha_context.t].\n\nThe variety of functions reflects the variety of things one might want to parse,\nfrom [parse_data] for arbitrary Micheline expressions to [parse_contract] for\nwell-formed Michelson contracts.\n*)\n\n(** {1 Michelson Existential Witness types} *)\nopen Alpha_context\n\nopen Script_tc_errors\n\ntype ('ta, 'tb) eq = Eq : ('same, 'same) eq\n\ntype ex_comparable_ty =\n  | Ex_comparable_ty : 'a Script_typed_ir.comparable_ty -> ex_comparable_ty\n\ntype ex_ty = Ex_ty : 'a Script_typed_ir.ty -> ex_ty\n\ntype ex_stack_ty =\n  | Ex_stack_ty : ('a, 's) Script_typed_ir.stack_ty -> ex_stack_ty\n\ntype ex_script = Ex_script : ('a, 'b) Script_typed_ir.script -> ex_script\n\ntype toplevel = {\n  code_field : Script.node;\n  arg_type : Script.node;\n  storage_type : Script.node;\n  views : Script_typed_ir.view Script_typed_ir.SMap.t;\n  root_name : Script_ir_annot.field_annot option;\n}\n\ntype ('arg, 'storage) code = {\n  code :\n    ( ('arg, 'storage) Script_typed_ir.pair,\n      ( Script_typed_ir.operation Script_typed_ir.boxed_list,\n        'storage )\n      Script_typed_ir.pair )\n    Script_typed_ir.lambda;\n  arg_type : 'arg Script_typed_ir.ty;\n  storage_type : 'storage Script_typed_ir.ty;\n  views : Script_typed_ir.view Script_typed_ir.SMap.t;\n  root_name : Script_ir_annot.field_annot option;\n  code_size : Cache_memory_helpers.sint;\n      (** This is an over-approximation of the value size in memory, in\n         bytes, of the contract's static part, that is its source\n         code. This includes the code of the contract as well as the code\n         of the views. The storage size is not taken into account by this\n         field as it has a dynamic size. *)\n}\n\ntype ex_code = Ex_code : ('a, 'c) code -> ex_code\n\ntype 'storage ex_view =\n  | Ex_view :\n      ('input * 'storage, 'output) Script_typed_ir.lambda\n      -> 'storage ex_view\n\ntype ('a, 's, 'b, 'u) cinstr = {\n  apply :\n    'r 'f.\n    ('a, 's) Script_typed_ir.kinfo ->\n    ('b, 'u, 'r, 'f) Script_typed_ir.kinstr ->\n    ('a, 's, 'r, 'f) Script_typed_ir.kinstr;\n}\n\ntype ('a, 's, 'b, 'u) descr = {\n  loc : Script.location;\n  bef : ('a, 's) Script_typed_ir.stack_ty;\n  aft : ('b, 'u) Script_typed_ir.stack_ty;\n  instr : ('a, 's, 'b, 'u) cinstr;\n}\n\ntype tc_context =\n  | Lambda : tc_context\n  | Dip : ('a, 's) Script_typed_ir.stack_ty * tc_context -> tc_context\n  | Toplevel : {\n      storage_type : 'sto Script_typed_ir.ty;\n      param_type : 'param Script_typed_ir.ty;\n      root_name : Script_ir_annot.field_annot option;\n    }\n      -> tc_context\n\ntype ('a, 's) judgement =\n  | Typed : ('a, 's, 'b, 'u) descr -> ('a, 's) judgement\n  | Failed : {\n      descr : 'b 'u. ('b, 'u) Script_typed_ir.stack_ty -> ('a, 's, 'b, 'u) descr;\n    }\n      -> ('a, 's) judgement\n\nval close_descr :\n  ('a, 'b, 'c, 'd) descr -> ('a, 'b, 'c, 'd) Script_typed_ir.kdescr\n\n(** Flag that drives unparsing of typed values to nodes.\n    - [Optimized_legacy] must be kept backward-compatible in order to compute\n      valid hashes (of big map keys).\n    - [Optimized] may be used as long as the result can be read by parse_data.\n    - [Readable] produces with [string] values instead of [bytes] when feasible.\n*)\ntype unparsing_mode = Optimized | Readable | Optimized_legacy\n\ntype merge_type_error_flag = Default_merge_type_error | Fast_merge_type_error\n\n(* ---- Lists, Sets and Maps ----------------------------------------------- *)\n\n(** {2 High-level Michelson Data Types} *)\ntype type_logger =\n  Script.location ->\n  (Script.expr * Script.annot) list ->\n  (Script.expr * Script.annot) list ->\n  unit\n\n(** Create an empty big_map *)\nval empty_big_map :\n  'a Script_typed_ir.comparable_ty ->\n  'b Script_typed_ir.ty ->\n  ('a, 'b) Script_typed_ir.big_map\n\nval big_map_mem :\n  context ->\n  'key ->\n  ('key, 'value) Script_typed_ir.big_map ->\n  (bool * context) tzresult Lwt.t\n\nval big_map_get :\n  context ->\n  'key ->\n  ('key, 'value) Script_typed_ir.big_map ->\n  ('value option * context) tzresult Lwt.t\n\n(** Update a big map. See {!big_map_get_and_update} for details. *)\nval big_map_update :\n  context ->\n  'key ->\n  'value option ->\n  ('key, 'value) Script_typed_ir.big_map ->\n  (('key, 'value) Script_typed_ir.big_map * context) tzresult Lwt.t\n\n(** Update a big map, returning the old value of the given key and the new map.\n\n    This does {i not} modify the underlying storage, only the diff table.\n *)\nval big_map_get_and_update :\n  context ->\n  'key ->\n  'value option ->\n  ('key, 'value) Script_typed_ir.big_map ->\n  (('value option * ('key, 'value) Script_typed_ir.big_map) * context) tzresult\n  Lwt.t\n\nval ty_eq :\n  context ->\n  Script.location ->\n  'ta Script_typed_ir.ty ->\n  'tb Script_typed_ir.ty ->\n  (('ta Script_typed_ir.ty, 'tb Script_typed_ir.ty) eq * context) tzresult\n\nval merge_types :\n  legacy:bool ->\n  merge_type_error_flag:merge_type_error_flag ->\n  Script.location ->\n  'a Script_typed_ir.ty ->\n  'b Script_typed_ir.ty ->\n  ( ('a Script_typed_ir.ty, 'b Script_typed_ir.ty) eq * 'a Script_typed_ir.ty,\n    error trace )\n  Gas_monad.t\n\n(** {3 Parsing and Typechecking Michelson} *)\nval parse_comparable_data :\n  ?type_logger:type_logger ->\n  context ->\n  'a Script_typed_ir.comparable_ty ->\n  Script.node ->\n  ('a * context) tzresult Lwt.t\n\nval parse_data :\n  ?type_logger:type_logger ->\n  context ->\n  legacy:bool ->\n  allow_forged:bool ->\n  'a Script_typed_ir.ty ->\n  Script.node ->\n  ('a * context) tzresult Lwt.t\n\nval unparse_data :\n  context ->\n  unparsing_mode ->\n  'a Script_typed_ir.ty ->\n  'a ->\n  (Script.node * context) tzresult Lwt.t\n\nval unparse_comparable_data :\n  loc:'loc ->\n  context ->\n  unparsing_mode ->\n  'a Script_typed_ir.comparable_ty ->\n  'a ->\n  ('loc Script.michelson_node * context) tzresult Lwt.t\n\nval unparse_code :\n  context ->\n  unparsing_mode ->\n  Script.node ->\n  (Script.node * context) tzresult Lwt.t\n\nval parse_instr :\n  ?type_logger:type_logger ->\n  tc_context ->\n  context ->\n  legacy:bool ->\n  Script.node ->\n  ('a, 's) Script_typed_ir.stack_ty ->\n  (('a, 's) judgement * context) tzresult Lwt.t\n\n(**\n  [parse_ty] specialized for the right-hand side part of a big map type, i.e.\n  the `value` in `big_map key value`.\n*)\nval parse_big_map_value_ty :\n  context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult\n\nval parse_packable_ty :\n  context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult\n\nval parse_parameter_ty :\n  context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult\n\nval parse_comparable_ty :\n  context -> Script.node -> (ex_comparable_ty * context) tzresult\n\nval parse_view_input_ty :\n  context ->\n  stack_depth:int ->\n  legacy:bool ->\n  Script.node ->\n  (ex_ty * context) tzresult\n\nval parse_view_output_ty :\n  context ->\n  stack_depth:int ->\n  legacy:bool ->\n  Script.node ->\n  (ex_ty * context) tzresult\n\nval parse_view_returning :\n  ?type_logger:type_logger ->\n  context ->\n  legacy:bool ->\n  'storage Script_typed_ir.ty ->\n  Script_typed_ir.view ->\n  ('storage ex_view * context) tzresult Lwt.t\n\nval typecheck_views :\n  ?type_logger:type_logger ->\n  context ->\n  legacy:bool ->\n  'storage Script_typed_ir.ty ->\n  Script_typed_ir.view Script_typed_ir.SMap.t ->\n  context tzresult Lwt.t\n\n(**\n  [parse_ty] allowing big_map values, operations, contract and tickets.\n*)\nval parse_any_ty :\n  context -> legacy:bool -> Script.node -> (ex_ty * context) tzresult\n\n(** We expose [parse_ty] for convenience to external tools. Please use\n    specialized versions such as [parse_packable_ty], [parse_parameter_ty],\n    [parse_comparable_ty], or [parse_big_map_value_ty] if possible. *)\nval parse_ty :\n  context ->\n  legacy:bool ->\n  allow_lazy_storage:bool ->\n  allow_operation:bool ->\n  allow_contract:bool ->\n  allow_ticket:bool ->\n  Script.node ->\n  (ex_ty * context) tzresult\n\nval unparse_ty :\n  loc:'loc ->\n  context ->\n  'a Script_typed_ir.ty ->\n  ('loc Script.michelson_node * context) tzresult\n\nval unparse_comparable_ty :\n  loc:'loc ->\n  context ->\n  'a Script_typed_ir.comparable_ty ->\n  ('loc Script.michelson_node * context) tzresult\n\nval ty_of_comparable_ty :\n  'a Script_typed_ir.comparable_ty -> 'a Script_typed_ir.ty\n\nval parse_toplevel :\n  context -> legacy:bool -> Script.expr -> (toplevel * context) tzresult Lwt.t\n\nval add_field_annot :\n  Script_ir_annot.field_annot option ->\n  Script_ir_annot.var_annot option ->\n  ('loc, 'prim) Micheline.node ->\n  ('loc, 'prim) Micheline.node\n\n(** High-level function to typecheck a Michelson script. This function is not\n    used for validating operations but only for the [typecheck_code] RPC.\n\n    If [show_types] is set to [true], details of the typechecking are returned\n    in the [type_map], otherwise the returned [type_map] is empty. *)\nval typecheck_code :\n  legacy:bool ->\n  show_types:bool ->\n  context ->\n  Script.expr ->\n  (type_map * context) tzresult Lwt.t\n\nval serialize_ty_for_error : 'a Script_typed_ir.ty -> Script.expr\n\nval parse_code :\n  ?type_logger:type_logger ->\n  context ->\n  legacy:bool ->\n  code:Script.lazy_expr ->\n  (ex_code * context) tzresult Lwt.t\n\nval parse_storage :\n  ?type_logger:type_logger ->\n  context ->\n  legacy:bool ->\n  allow_forged:bool ->\n  'storage Script_typed_ir.ty ->\n  storage:Script.lazy_expr ->\n  ('storage * context) tzresult Lwt.t\n\n(** Combines [parse_code] and [parse_storage] *)\nval parse_script :\n  ?type_logger:type_logger ->\n  context ->\n  legacy:bool ->\n  allow_forged_in_storage:bool ->\n  Script.t ->\n  (ex_script * context) tzresult Lwt.t\n\n(* Gas accounting may not be perfect in this function, as it is only called by RPCs. *)\nval unparse_script :\n  context ->\n  unparsing_mode ->\n  ('a, 'b) Script_typed_ir.script ->\n  (Script.t * context) tzresult Lwt.t\n\nval parse_contract :\n  legacy:bool ->\n  context ->\n  Script.location ->\n  'a Script_typed_ir.ty ->\n  Contract.t ->\n  entrypoint:string ->\n  (context * 'a Script_typed_ir.typed_contract) tzresult Lwt.t\n\nval parse_contract_for_script :\n  context ->\n  Script.location ->\n  'a Script_typed_ir.ty ->\n  Contract.t ->\n  entrypoint:string ->\n  (context * 'a Script_typed_ir.typed_contract option) tzresult Lwt.t\n\nval find_entrypoint :\n  't Script_typed_ir.ty ->\n  root_name:Script_ir_annot.field_annot option ->\n  string ->\n  ((Script.node -> Script.node) * ex_ty) tzresult\n\nmodule Entrypoints_map : Map.S with type key = string\n\nval list_entrypoints :\n  't Script_typed_ir.ty ->\n  context ->\n  root_name:Script_ir_annot.field_annot option ->\n  (Michelson_v1_primitives.prim list list\n  * (Michelson_v1_primitives.prim list * Script.unlocated_michelson_node)\n    Entrypoints_map.t)\n  tzresult\n\nval pack_data :\n  context -> 'a Script_typed_ir.ty -> 'a -> (bytes * context) tzresult Lwt.t\n\nval hash_comparable_data :\n  context ->\n  'a Script_typed_ir.comparable_ty ->\n  'a ->\n  (Script_expr_hash.t * context) tzresult Lwt.t\n\nval hash_data :\n  context ->\n  'a Script_typed_ir.ty ->\n  'a ->\n  (Script_expr_hash.t * context) tzresult Lwt.t\n\ntype lazy_storage_ids\n\nval no_lazy_storage_id : lazy_storage_ids\n\n(** Traverse the given type, producing a {!lazy_storage_ids} for\n    use with {!extract_lazy_storage_diff}.\n *)\nval collect_lazy_storage :\n  context ->\n  'a Script_typed_ir.ty ->\n  'a ->\n  (lazy_storage_ids * context) tzresult\n\nval list_of_big_map_ids : lazy_storage_ids -> Big_map.Id.t list\n\n(** Produce a lazy storage diff, containing in-memory writes to\n    lazy data structures such as big_maps yet to be committed.\n\n    The resulting diff can be committed to the underlying storage\n    (context) using [Lazy_storage_diff.apply].\n\n @param to_duplicate\n    Lazy data structure reference produced via {!collect_lazy_storage}\n    that can not be reused. Typically collected via traversing\n    the parameters to a smart contract.\n @param to_update\n    Lazy data structure reference produced via {!collect_lazy_storage}\n    that can be reused. Typically collected via traversing the previous\n    storage of a smart contract.\n *)\nval extract_lazy_storage_diff :\n  context ->\n  unparsing_mode ->\n  temporary:bool ->\n  to_duplicate:lazy_storage_ids ->\n  to_update:lazy_storage_ids ->\n  'a Script_typed_ir.ty ->\n  'a ->\n  ('a * Lazy_storage.diffs option * context) tzresult Lwt.t\n\n(* return [None] if none or more than one found *)\nval get_single_sapling_state :\n  context ->\n  'a Script_typed_ir.ty ->\n  'a ->\n  (Sapling.Id.t option * context) tzresult\n\n(** [script_size script] returns an overapproximation of the size of\n    the in-memory representation of [script] as well as the cost\n    associated to computing that overapproximation. *)\nval script_size : ex_script -> int * Gas_limit_repr.cost\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\nopen Micheline\nopen Script\nopen Script_tc_errors\nopen Script_ir_annot\nopen Script_typed_ir\nmodule Typecheck_costs = Michelson_v1_gas.Cost_of.Typechecking\nmodule Unparse_costs = Michelson_v1_gas.Cost_of.Unparsing\n\ntype ex_stack_ty = Ex_stack_ty : ('a, 's) stack_ty -> ex_stack_ty\n\n(*\n\n   The following type represents an instruction parameterized by its\n   continuation. During the elaboration of the typed term, a sequence\n   of instructions in Micheline is read from left to right: hence, the\n   elaboration needs to wait for the next instruction to be elaborated\n   to be able to construct the current instruction.\n\n*)\ntype ('a, 's, 'b, 'u) cinstr = {\n  apply :\n    'r 'f. ('a, 's) kinfo -> ('b, 'u, 'r, 'f) kinstr -> ('a, 's, 'r, 'f) kinstr;\n}\n\n(*\n\n   While a [Script_typed_ir.descr] contains a fully defined\n   instruction, [descr] contains a [cinstr], that is an instruction\n   parameterized by the next instruction, as explained in the previous\n   comment.\n\n*)\ntype ('a, 's, 'b, 'u) descr = {\n  loc : Script.location;\n  bef : ('a, 's) stack_ty;\n  aft : ('b, 'u) stack_ty;\n  instr : ('a, 's, 'b, 'u) cinstr;\n}\n\nlet close_descr {loc; bef; aft; instr} =\n  let kinfo = {iloc = loc; kstack_ty = aft} in\n  let kinfo' = {iloc = loc; kstack_ty = bef} in\n  let kinstr = instr.apply kinfo' (IHalt kinfo) in\n  {kloc = loc; kbef = bef; kaft = aft; kinstr}\n\nlet kinfo_of_descr {loc; bef; _} = {iloc = loc; kstack_ty = bef}\n\nlet compose_descr :\n    type a s b u c v.\n    Script.location ->\n    (a, s, b, u) descr ->\n    (b, u, c, v) descr ->\n    (a, s, c, v) descr =\n fun loc d1 d2 ->\n  {\n    loc;\n    bef = d1.bef;\n    aft = d2.aft;\n    instr =\n      {\n        apply =\n          (fun _ k ->\n            d1.instr.apply\n              (kinfo_of_descr d1)\n              (d2.instr.apply (kinfo_of_descr d2) k));\n      };\n  }\n\ntype tc_context =\n  | Lambda : tc_context\n  | Dip : ('a, 's) stack_ty * tc_context -> tc_context\n  | Toplevel : {\n      storage_type : 'sto ty;\n      param_type : 'param ty;\n      root_name : field_annot option;\n    }\n      -> tc_context\n\ntype unparsing_mode = Optimized | Readable | Optimized_legacy\n\ntype type_logger =\n  Script.location ->\n  (Script.expr * Script.annot) list ->\n  (Script.expr * Script.annot) list ->\n  unit\n\nlet add_dip ty annot prev =\n  match prev with\n  | Lambda | Toplevel _ ->\n      Dip (Item_t (ty, Item_t (unit_t ~annot:None, Bot_t, None), annot), prev)\n  | Dip (stack, _) -> Dip (Item_t (ty, stack, annot), prev)\n\n(* ---- Error helpers -------------------------------------------------------*)\n\nlet location = function\n  | Prim (loc, _, _, _)\n  | Int (loc, _)\n  | String (loc, _)\n  | Bytes (loc, _)\n  | Seq (loc, _) ->\n      loc\n\nlet kind_equal a b =\n  match (a, b) with\n  | (Int_kind, Int_kind)\n  | (String_kind, String_kind)\n  | (Bytes_kind, Bytes_kind)\n  | (Prim_kind, Prim_kind)\n  | (Seq_kind, Seq_kind) ->\n      true\n  | _ -> false\n\nlet kind = function\n  | Int _ -> Int_kind\n  | String _ -> String_kind\n  | Bytes _ -> Bytes_kind\n  | Prim _ -> Prim_kind\n  | Seq _ -> Seq_kind\n\nlet unexpected expr exp_kinds exp_ns exp_prims =\n  match expr with\n  | Int (loc, _) -> Invalid_kind (loc, Prim_kind :: exp_kinds, Int_kind)\n  | String (loc, _) -> Invalid_kind (loc, Prim_kind :: exp_kinds, String_kind)\n  | Bytes (loc, _) -> Invalid_kind (loc, Prim_kind :: exp_kinds, Bytes_kind)\n  | Seq (loc, _) -> Invalid_kind (loc, Prim_kind :: exp_kinds, Seq_kind)\n  | Prim (loc, name, _, _) -> (\n      let open Michelson_v1_primitives in\n      match (namespace name, exp_ns) with\n      | (Type_namespace, Type_namespace)\n      | (Instr_namespace, Instr_namespace)\n      | (Constant_namespace, Constant_namespace) ->\n          Invalid_primitive (loc, exp_prims, name)\n      | (ns, _) -> Invalid_namespace (loc, name, exp_ns, ns))\n\nlet check_kind kinds expr =\n  let kind = kind expr in\n  if List.exists (kind_equal kind) kinds then Result.return_unit\n  else\n    let loc = location expr in\n    error (Invalid_kind (loc, kinds, kind))\n\n(* ---- Unparsing (Typed IR -> Untyped expressions) of types -----------------*)\n\n(* This part contains the unparsing that does not depend on parsing\n   (everything that cannot contain a lambda). The rest is located at\n   the end of the file. *)\n\nlet rec ty_of_comparable_ty : type a. a comparable_ty -> a ty = function\n  | Unit_key tname -> Unit_t tname\n  | Never_key tname -> Never_t tname\n  | Int_key tname -> Int_t tname\n  | Nat_key tname -> Nat_t tname\n  | Signature_key tname -> Signature_t tname\n  | String_key tname -> String_t tname\n  | Bytes_key tname -> Bytes_t tname\n  | Mutez_key tname -> Mutez_t tname\n  | Bool_key tname -> Bool_t tname\n  | Key_hash_key tname -> Key_hash_t tname\n  | Key_key tname -> Key_t tname\n  | Timestamp_key tname -> Timestamp_t tname\n  | Address_key tname -> Address_t tname\n  | Chain_id_key tname -> Chain_id_t tname\n  | Pair_key ((l, al), (r, ar), tname) ->\n      Pair_t\n        ( (ty_of_comparable_ty l, al, None),\n          (ty_of_comparable_ty r, ar, None),\n          tname )\n  | Union_key ((l, al), (r, ar), tname) ->\n      Union_t ((ty_of_comparable_ty l, al), (ty_of_comparable_ty r, ar), tname)\n  | Option_key (t, tname) -> Option_t (ty_of_comparable_ty t, tname)\n\nlet add_field_annot a var = function\n  | Prim (loc, prim, args, annots) ->\n      Prim\n        (loc, prim, args, annots @ unparse_field_annot a @ unparse_var_annot var)\n  | expr -> expr\n\nlet rec unparse_comparable_ty_uncarbonated :\n    type a loc. loc:loc -> a comparable_ty -> loc Script.michelson_node =\n fun ~loc -> function\n  | Unit_key meta -> Prim (loc, T_unit, [], unparse_type_annot meta.annot)\n  | Never_key meta -> Prim (loc, T_never, [], unparse_type_annot meta.annot)\n  | Int_key meta -> Prim (loc, T_int, [], unparse_type_annot meta.annot)\n  | Nat_key meta -> Prim (loc, T_nat, [], unparse_type_annot meta.annot)\n  | Signature_key meta ->\n      Prim (loc, T_signature, [], unparse_type_annot meta.annot)\n  | String_key meta -> Prim (loc, T_string, [], unparse_type_annot meta.annot)\n  | Bytes_key meta -> Prim (loc, T_bytes, [], unparse_type_annot meta.annot)\n  | Mutez_key meta -> Prim (loc, T_mutez, [], unparse_type_annot meta.annot)\n  | Bool_key meta -> Prim (loc, T_bool, [], unparse_type_annot meta.annot)\n  | Key_hash_key meta ->\n      Prim (loc, T_key_hash, [], unparse_type_annot meta.annot)\n  | Key_key meta -> Prim (loc, T_key, [], unparse_type_annot meta.annot)\n  | Timestamp_key meta ->\n      Prim (loc, T_timestamp, [], unparse_type_annot meta.annot)\n  | Address_key meta -> Prim (loc, T_address, [], unparse_type_annot meta.annot)\n  | Chain_id_key meta ->\n      Prim (loc, T_chain_id, [], unparse_type_annot meta.annot)\n  | Pair_key ((l, al), (r, ar), meta) -> (\n      let tl =\n        add_field_annot al None (unparse_comparable_ty_uncarbonated ~loc l)\n      in\n      let tr =\n        add_field_annot ar None (unparse_comparable_ty_uncarbonated ~loc r)\n      in\n      (* Fold [pair a1 (pair ... (pair an-1 an))] into [pair a1 ... an] *)\n      (* Note that the folding does not happen if the pair on the right has a\n         field annotation because this annotation would be lost *)\n      match tr with\n      | Prim (_, T_pair, ts, []) ->\n          Prim (loc, T_pair, tl :: ts, unparse_type_annot meta.annot)\n      | _ -> Prim (loc, T_pair, [tl; tr], unparse_type_annot meta.annot))\n  | Union_key ((l, al), (r, ar), meta) ->\n      let tl =\n        add_field_annot al None (unparse_comparable_ty_uncarbonated ~loc l)\n      in\n      let tr =\n        add_field_annot ar None (unparse_comparable_ty_uncarbonated ~loc r)\n      in\n      Prim (loc, T_or, [tl; tr], unparse_type_annot meta.annot)\n  | Option_key (t, meta) ->\n      Prim\n        ( loc,\n          T_option,\n          [unparse_comparable_ty_uncarbonated ~loc t],\n          unparse_type_annot meta.annot )\n\nlet unparse_memo_size ~loc memo_size =\n  let z = Sapling.Memo_size.unparse_to_z memo_size in\n  Int (loc, z)\n\nlet rec unparse_ty_uncarbonated :\n    type a loc. loc:loc -> a ty -> loc Script.michelson_node =\n fun ~loc ty ->\n  let prim (name, args, annot) = Prim (loc, name, args, annot) in\n  match ty with\n  | Unit_t meta -> prim (T_unit, [], unparse_type_annot meta.annot)\n  | Int_t meta -> prim (T_int, [], unparse_type_annot meta.annot)\n  | Nat_t meta -> prim (T_nat, [], unparse_type_annot meta.annot)\n  | Signature_t meta -> prim (T_signature, [], unparse_type_annot meta.annot)\n  | String_t meta -> prim (T_string, [], unparse_type_annot meta.annot)\n  | Bytes_t meta -> prim (T_bytes, [], unparse_type_annot meta.annot)\n  | Mutez_t meta -> prim (T_mutez, [], unparse_type_annot meta.annot)\n  | Bool_t meta -> prim (T_bool, [], unparse_type_annot meta.annot)\n  | Key_hash_t meta -> prim (T_key_hash, [], unparse_type_annot meta.annot)\n  | Key_t meta -> prim (T_key, [], unparse_type_annot meta.annot)\n  | Timestamp_t meta -> prim (T_timestamp, [], unparse_type_annot meta.annot)\n  | Address_t meta -> prim (T_address, [], unparse_type_annot meta.annot)\n  | Operation_t meta -> prim (T_operation, [], unparse_type_annot meta.annot)\n  | Chain_id_t meta -> prim (T_chain_id, [], unparse_type_annot meta.annot)\n  | Never_t meta -> prim (T_never, [], unparse_type_annot meta.annot)\n  | Bls12_381_g1_t meta ->\n      prim (T_bls12_381_g1, [], unparse_type_annot meta.annot)\n  | Bls12_381_g2_t meta ->\n      prim (T_bls12_381_g2, [], unparse_type_annot meta.annot)\n  | Bls12_381_fr_t meta ->\n      prim (T_bls12_381_fr, [], unparse_type_annot meta.annot)\n  | Contract_t (ut, meta) ->\n      let t = unparse_ty_uncarbonated ~loc ut in\n      prim (T_contract, [t], unparse_type_annot meta.annot)\n  | Pair_t ((utl, l_field, l_var), (utr, r_field, r_var), meta) ->\n      let annot = unparse_type_annot meta.annot in\n      let utl = unparse_ty_uncarbonated ~loc utl in\n      let tl = add_field_annot l_field l_var utl in\n      let utr = unparse_ty_uncarbonated ~loc utr in\n      let tr = add_field_annot r_field r_var utr in\n      (* Fold [pair a1 (pair ... (pair an-1 an))] into [pair a1 ... an] *)\n      (* Note that the folding does not happen if the pair on the right has an\n         annotation because this annotation would be lost *)\n      prim\n        (match tr with\n        | Prim (_, T_pair, ts, []) -> (T_pair, tl :: ts, annot)\n        | _ -> (T_pair, [tl; tr], annot))\n  | Union_t ((utl, l_field), (utr, r_field), meta) ->\n      let annot = unparse_type_annot meta.annot in\n      let utl = unparse_ty_uncarbonated ~loc utl in\n      let tl = add_field_annot l_field None utl in\n      let utr = unparse_ty_uncarbonated ~loc utr in\n      let tr = add_field_annot r_field None utr in\n      prim (T_or, [tl; tr], annot)\n  | Lambda_t (uta, utr, meta) ->\n      let ta = unparse_ty_uncarbonated ~loc uta in\n      let tr = unparse_ty_uncarbonated ~loc utr in\n      prim (T_lambda, [ta; tr], unparse_type_annot meta.annot)\n  | Option_t (ut, meta) ->\n      let annot = unparse_type_annot meta.annot in\n      let ut = unparse_ty_uncarbonated ~loc ut in\n      prim (T_option, [ut], annot)\n  | List_t (ut, meta) ->\n      let t = unparse_ty_uncarbonated ~loc ut in\n      prim (T_list, [t], unparse_type_annot meta.annot)\n  | Ticket_t (ut, meta) ->\n      let t = unparse_comparable_ty_uncarbonated ~loc ut in\n      prim (T_ticket, [t], unparse_type_annot meta.annot)\n  | Set_t (ut, meta) ->\n      let t = unparse_comparable_ty_uncarbonated ~loc ut in\n      prim (T_set, [t], unparse_type_annot meta.annot)\n  | Map_t (uta, utr, meta) ->\n      let ta = unparse_comparable_ty_uncarbonated ~loc uta in\n      let tr = unparse_ty_uncarbonated ~loc utr in\n      prim (T_map, [ta; tr], unparse_type_annot meta.annot)\n  | Big_map_t (uta, utr, meta) ->\n      let ta = unparse_comparable_ty_uncarbonated ~loc uta in\n      let tr = unparse_ty_uncarbonated ~loc utr in\n      prim (T_big_map, [ta; tr], unparse_type_annot meta.annot)\n  | Sapling_transaction_t (memo_size, meta) ->\n      prim\n        ( T_sapling_transaction,\n          [unparse_memo_size ~loc memo_size],\n          unparse_type_annot meta.annot )\n  | Sapling_state_t (memo_size, meta) ->\n      prim\n        ( T_sapling_state,\n          [unparse_memo_size ~loc memo_size],\n          unparse_type_annot meta.annot )\n  | Chest_key_t meta -> prim (T_chest_key, [], unparse_type_annot meta.annot)\n  | Chest_t meta -> prim (T_chest, [], unparse_type_annot meta.annot)\n\nlet unparse_ty ~loc ctxt ty =\n  Gas.consume ctxt (Unparse_costs.unparse_type ty) >|? fun ctxt ->\n  (unparse_ty_uncarbonated ~loc ty, ctxt)\n\nlet unparse_comparable_ty ~loc ctxt comp_ty =\n  Gas.consume ctxt (Unparse_costs.unparse_comparable_type comp_ty)\n  >|? fun ctxt -> (unparse_comparable_ty_uncarbonated ~loc comp_ty, ctxt)\n\nlet[@coq_struct \"function_parameter\"] rec strip_var_annots = function\n  | (Int _ | String _ | Bytes _) as atom -> atom\n  | Seq (loc, args) -> Seq (loc, List.map strip_var_annots args)\n  | Prim (loc, name, args, annots) ->\n      let not_var_annot s = Compare.Char.(s.[0] <> '@') in\n      let annots = List.filter not_var_annot annots in\n      Prim (loc, name, List.map strip_var_annots args, annots)\n\nlet serialize_ty_for_error ty =\n  (*\n    Types are bounded by [Constants.michelson_maximum_type_size], so\n    [unparse_ty_uncarbonated], [strip_var_annots], and [strip_locations] are\n    bounded in time.\n\n    It is hence OK to use them in errors that are not caught in the validation\n    (only once in apply).\n  *)\n  let ty = unparse_ty_uncarbonated ~loc:() ty in\n  Micheline.strip_locations (strip_var_annots ty)\n\nlet[@coq_axiom_with_reason \"gadt\"] rec comparable_ty_of_ty :\n    type a.\n    context -> Script.location -> a ty -> (a comparable_ty * context) tzresult =\n fun ctxt loc ty ->\n  Gas.consume ctxt Typecheck_costs.comparable_ty_of_ty_cycle >>? fun ctxt ->\n  match ty with\n  | Unit_t tname -> ok ((Unit_key tname : a comparable_ty), ctxt)\n  | Never_t tname -> ok (Never_key tname, ctxt)\n  | Int_t tname -> ok (Int_key tname, ctxt)\n  | Nat_t tname -> ok (Nat_key tname, ctxt)\n  | Signature_t tname -> ok (Signature_key tname, ctxt)\n  | String_t tname -> ok (String_key tname, ctxt)\n  | Bytes_t tname -> ok (Bytes_key tname, ctxt)\n  | Mutez_t tname -> ok (Mutez_key tname, ctxt)\n  | Bool_t tname -> ok (Bool_key tname, ctxt)\n  | Key_hash_t tname -> ok (Key_hash_key tname, ctxt)\n  | Key_t tname -> ok (Key_key tname, ctxt)\n  | Timestamp_t tname -> ok (Timestamp_key tname, ctxt)\n  | Address_t tname -> ok (Address_key tname, ctxt)\n  | Chain_id_t tname -> ok (Chain_id_key tname, ctxt)\n  | Pair_t ((l, al, _), (r, ar, _), pname) ->\n      comparable_ty_of_ty ctxt loc l >>? fun (lty, ctxt) ->\n      comparable_ty_of_ty ctxt loc r >|? fun (rty, ctxt) ->\n      (Pair_key ((lty, al), (rty, ar), pname), ctxt)\n  | Union_t ((l, al), (r, ar), tname) ->\n      comparable_ty_of_ty ctxt loc l >>? fun (lty, ctxt) ->\n      comparable_ty_of_ty ctxt loc r >|? fun (rty, ctxt) ->\n      (Union_key ((lty, al), (rty, ar), tname), ctxt)\n  | Option_t (tt, tname) ->\n      comparable_ty_of_ty ctxt loc tt >|? fun (ty, ctxt) ->\n      (Option_key (ty, tname), ctxt)\n  | Lambda_t _ | List_t _ | Ticket_t _ | Set_t _ | Map_t _ | Big_map_t _\n  | Contract_t _ | Operation_t _ | Bls12_381_fr_t _ | Bls12_381_g1_t _\n  | Bls12_381_g2_t _ | Sapling_state_t _ | Sapling_transaction_t _\n  | Chest_key_t _ | Chest_t _ ->\n      let t = serialize_ty_for_error ty in\n      error (Comparable_type_expected (loc, t))\n\nlet rec unparse_stack_uncarbonated :\n    type a s. (a, s) stack_ty -> (Script.expr * Script.annot) list = function\n  | Bot_t -> []\n  | Item_t (ty, rest, annot) ->\n      let uty = unparse_ty_uncarbonated ~loc:() ty in\n      let urest = unparse_stack_uncarbonated rest in\n      (strip_locations uty, unparse_var_annot annot) :: urest\n\nlet serialize_stack_for_error ctxt stack_ty =\n  match Gas.level ctxt with\n  | Unaccounted -> unparse_stack_uncarbonated stack_ty\n  | Limited _ -> []\n\nlet name_of_ty : type a. a ty -> type_annot option = function\n  | Unit_t meta -> meta.annot\n  | Int_t meta -> meta.annot\n  | Nat_t meta -> meta.annot\n  | String_t meta -> meta.annot\n  | Bytes_t meta -> meta.annot\n  | Mutez_t meta -> meta.annot\n  | Bool_t meta -> meta.annot\n  | Key_hash_t meta -> meta.annot\n  | Key_t meta -> meta.annot\n  | Timestamp_t meta -> meta.annot\n  | Address_t meta -> meta.annot\n  | Signature_t meta -> meta.annot\n  | Operation_t meta -> meta.annot\n  | Chain_id_t meta -> meta.annot\n  | Never_t meta -> meta.annot\n  | Contract_t (_, meta) -> meta.annot\n  | Pair_t (_, _, meta) -> meta.annot\n  | Union_t (_, _, meta) -> meta.annot\n  | Lambda_t (_, _, meta) -> meta.annot\n  | Option_t (_, meta) -> meta.annot\n  | List_t (_, meta) -> meta.annot\n  | Ticket_t (_, meta) -> meta.annot\n  | Set_t (_, meta) -> meta.annot\n  | Map_t (_, _, meta) -> meta.annot\n  | Big_map_t (_, _, meta) -> meta.annot\n  | Bls12_381_g1_t meta -> meta.annot\n  | Bls12_381_g2_t meta -> meta.annot\n  | Bls12_381_fr_t meta -> meta.annot\n  | Sapling_state_t (_, meta) -> meta.annot\n  | Sapling_transaction_t (_, meta) -> meta.annot\n  | Chest_key_t meta -> meta.annot\n  | Chest_t meta -> meta.annot\n\nlet unparse_unit ~loc ctxt () = ok (Prim (loc, D_Unit, [], []), ctxt)\n\nlet unparse_int ~loc ctxt v = ok (Int (loc, Script_int.to_zint v), ctxt)\n\nlet unparse_nat ~loc ctxt v = ok (Int (loc, Script_int.to_zint v), ctxt)\n\nlet unparse_string ~loc ctxt s =\n  ok (String (loc, Script_string.to_string s), ctxt)\n\nlet unparse_bytes ~loc ctxt s = ok (Bytes (loc, s), ctxt)\n\nlet unparse_bool ~loc ctxt b =\n  ok (Prim (loc, (if b then D_True else D_False), [], []), ctxt)\n\nlet unparse_timestamp ~loc ctxt mode t =\n  match mode with\n  | Optimized | Optimized_legacy ->\n      ok (Int (loc, Script_timestamp.to_zint t), ctxt)\n  | Readable -> (\n      Gas.consume ctxt Unparse_costs.timestamp_readable >>? fun ctxt ->\n      match Script_timestamp.to_notation t with\n      | None -> ok (Int (loc, Script_timestamp.to_zint t), ctxt)\n      | Some s -> ok (String (loc, s), ctxt))\n\nlet unparse_address ~loc ctxt mode (c, entrypoint) =\n  Gas.consume ctxt Unparse_costs.contract >>? fun ctxt ->\n  (match entrypoint with\n  (* given parse_address, this should not happen *)\n  | \"\" -> error Unparsing_invariant_violated\n  | _ -> ok ())\n  >|? fun () ->\n  match mode with\n  | Optimized | Optimized_legacy ->\n      let entrypoint = match entrypoint with \"default\" -> \"\" | name -> name in\n      let bytes =\n        Data_encoding.Binary.to_bytes_exn\n          Data_encoding.(tup2 Contract.encoding Variable.string)\n          (c, entrypoint)\n      in\n      (Bytes (loc, bytes), ctxt)\n  | Readable ->\n      let notation =\n        match entrypoint with\n        | \"default\" -> Contract.to_b58check c\n        | entrypoint -> Contract.to_b58check c ^ \"%\" ^ entrypoint\n      in\n      (String (loc, notation), ctxt)\n\nlet unparse_contract ~loc ctxt mode (_, address) =\n  unparse_address ~loc ctxt mode address\n\nlet unparse_signature ~loc ctxt mode s =\n  match mode with\n  | Optimized | Optimized_legacy ->\n      Gas.consume ctxt Unparse_costs.signature_optimized >|? fun ctxt ->\n      let bytes = Data_encoding.Binary.to_bytes_exn Signature.encoding s in\n      (Bytes (loc, bytes), ctxt)\n  | Readable ->\n      Gas.consume ctxt Unparse_costs.signature_readable >|? fun ctxt ->\n      (String (loc, Signature.to_b58check s), ctxt)\n\nlet unparse_mutez ~loc ctxt v = ok (Int (loc, Z.of_int64 (Tez.to_mutez v)), ctxt)\n\nlet unparse_key ~loc ctxt mode k =\n  match mode with\n  | Optimized | Optimized_legacy ->\n      Gas.consume ctxt Unparse_costs.public_key_optimized >|? fun ctxt ->\n      let bytes =\n        Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding k\n      in\n      (Bytes (loc, bytes), ctxt)\n  | Readable ->\n      Gas.consume ctxt Unparse_costs.public_key_readable >|? fun ctxt ->\n      (String (loc, Signature.Public_key.to_b58check k), ctxt)\n\nlet unparse_key_hash ~loc ctxt mode k =\n  match mode with\n  | Optimized | Optimized_legacy ->\n      Gas.consume ctxt Unparse_costs.key_hash_optimized >|? fun ctxt ->\n      let bytes =\n        Data_encoding.Binary.to_bytes_exn Signature.Public_key_hash.encoding k\n      in\n      (Bytes (loc, bytes), ctxt)\n  | Readable ->\n      Gas.consume ctxt Unparse_costs.key_hash_readable >|? fun ctxt ->\n      (String (loc, Signature.Public_key_hash.to_b58check k), ctxt)\n\nlet unparse_operation ~loc ctxt (op, _big_map_diff) =\n  let bytes =\n    Data_encoding.Binary.to_bytes_exn Operation.internal_operation_encoding op\n  in\n  Gas.consume ctxt (Unparse_costs.operation bytes) >|? fun ctxt ->\n  (Bytes (loc, bytes), ctxt)\n\nlet unparse_chain_id ~loc ctxt mode chain_id =\n  match mode with\n  | Optimized | Optimized_legacy ->\n      Gas.consume ctxt Unparse_costs.chain_id_optimized >|? fun ctxt ->\n      let bytes =\n        Data_encoding.Binary.to_bytes_exn Chain_id.encoding chain_id\n      in\n      (Bytes (loc, bytes), ctxt)\n  | Readable ->\n      Gas.consume ctxt Unparse_costs.chain_id_readable >|? fun ctxt ->\n      (String (loc, Chain_id.to_b58check chain_id), ctxt)\n\nlet unparse_bls12_381_g1 ~loc ctxt x =\n  Gas.consume ctxt Unparse_costs.bls12_381_g1 >|? fun ctxt ->\n  let bytes = Bls12_381.G1.to_bytes x in\n  (Bytes (loc, bytes), ctxt)\n\nlet unparse_bls12_381_g2 ~loc ctxt x =\n  Gas.consume ctxt Unparse_costs.bls12_381_g2 >|? fun ctxt ->\n  let bytes = Bls12_381.G2.to_bytes x in\n  (Bytes (loc, bytes), ctxt)\n\nlet unparse_bls12_381_fr ~loc ctxt x =\n  Gas.consume ctxt Unparse_costs.bls12_381_fr >|? fun ctxt ->\n  let bytes = Bls12_381.Fr.to_bytes x in\n  (Bytes (loc, bytes), ctxt)\n\nlet unparse_with_data_encoding ~loc ctxt s unparse_cost encoding =\n  Lwt.return\n    ( Gas.consume ctxt unparse_cost >|? fun ctxt ->\n      let bytes = Data_encoding.Binary.to_bytes_exn encoding s in\n      (Bytes (loc, bytes), ctxt) )\n\n(* -- Unparsing data of complex types -- *)\n\ntype ('ty, 'depth) comb_witness =\n  | Comb_Pair : ('t, 'd) comb_witness -> (_ * 't, unit -> 'd) comb_witness\n  | Comb_Any : (_, _) comb_witness\n\nlet unparse_pair (type r) ~loc unparse_l unparse_r ctxt mode\n    (r_comb_witness : (r, unit -> unit -> _) comb_witness) (l, (r : r)) =\n  unparse_l ctxt l >>=? fun (l, ctxt) ->\n  unparse_r ctxt r >|=? fun (r, ctxt) ->\n  (* Fold combs.\n     For combs, three notations are supported:\n     - a) [Pair x1 (Pair x2 ... (Pair xn-1 xn) ...)],\n     - b) [Pair x1 x2 ... xn-1 xn], and\n     - c) [{x1; x2; ...; xn-1; xn}].\n     In readable mode, we always use b),\n     in optimized mode we use the shortest to serialize:\n     - for n=2, [Pair x1 x2],\n     - for n=3, [Pair x1 (Pair x2 x3)],\n     - for n>=4, [{x1; x2; ...; xn}].\n  *)\n  let res =\n    match (mode, r_comb_witness, r) with\n    | (Optimized, Comb_Pair _, Micheline.Seq (_, r)) ->\n        (* Optimized case n > 4 *)\n        Micheline.Seq (loc, l :: r)\n    | ( Optimized,\n        Comb_Pair (Comb_Pair _),\n        Prim (_, D_Pair, [x2; Prim (_, D_Pair, [x3; x4], [])], []) ) ->\n        (* Optimized case n = 4 *)\n        Micheline.Seq (loc, [l; x2; x3; x4])\n    | (Readable, Comb_Pair _, Prim (_, D_Pair, xs, [])) ->\n        (* Readable case n > 2 *)\n        Prim (loc, D_Pair, l :: xs, [])\n    | _ ->\n        (* The remaining cases are:\n            - Optimized n = 2,\n            - Optimized n = 3, and\n            - Readable n = 2,\n            - Optimized_legacy, any n *)\n        Prim (loc, D_Pair, [l; r], [])\n  in\n  (res, ctxt)\n\nlet unparse_union ~loc unparse_l unparse_r ctxt = function\n  | L l ->\n      unparse_l ctxt l >|=? fun (l, ctxt) -> (Prim (loc, D_Left, [l], []), ctxt)\n  | R r ->\n      unparse_r ctxt r >|=? fun (r, ctxt) -> (Prim (loc, D_Right, [r], []), ctxt)\n\nlet unparse_option ~loc unparse_v ctxt = function\n  | Some v ->\n      unparse_v ctxt v >|=? fun (v, ctxt) -> (Prim (loc, D_Some, [v], []), ctxt)\n  | None -> return (Prim (loc, D_None, [], []), ctxt)\n\n(* -- Unparsing data of comparable types -- *)\n\nlet comparable_comb_witness2 :\n    type t. t comparable_ty -> (t, unit -> unit -> unit) comb_witness = function\n  | Pair_key (_, (Pair_key _, _), _) -> Comb_Pair (Comb_Pair Comb_Any)\n  | Pair_key _ -> Comb_Pair Comb_Any\n  | _ -> Comb_Any\n\nlet[@coq_axiom_with_reason \"gadt\"] rec unparse_comparable_data :\n    type a loc.\n    loc:loc ->\n    context ->\n    unparsing_mode ->\n    a comparable_ty ->\n    a ->\n    (loc Script.michelson_node * context) tzresult Lwt.t =\n fun ~loc ctxt mode ty a ->\n  (* No need for stack_depth here. Unlike [unparse_data],\n     [unparse_comparable_data] doesn't call [unparse_code].\n     The stack depth is bounded by the type depth, currently bounded\n     by 1000 (michelson_maximum_type_size). *)\n  Gas.consume ctxt Unparse_costs.unparse_data_cycle\n  (* We could have a smaller cost but let's keep it consistent with\n     [unparse_data] for now. *)\n  >>?=\n  fun ctxt ->\n  match (ty, a) with\n  | (Unit_key _, v) -> Lwt.return @@ unparse_unit ~loc ctxt v\n  | (Int_key _, v) -> Lwt.return @@ unparse_int ~loc ctxt v\n  | (Nat_key _, v) -> Lwt.return @@ unparse_nat ~loc ctxt v\n  | (String_key _, s) -> Lwt.return @@ unparse_string ~loc ctxt s\n  | (Bytes_key _, s) -> Lwt.return @@ unparse_bytes ~loc ctxt s\n  | (Bool_key _, b) -> Lwt.return @@ unparse_bool ~loc ctxt b\n  | (Timestamp_key _, t) -> Lwt.return @@ unparse_timestamp ~loc ctxt mode t\n  | (Address_key _, address) ->\n      Lwt.return @@ unparse_address ~loc ctxt mode address\n  | (Signature_key _, s) -> Lwt.return @@ unparse_signature ~loc ctxt mode s\n  | (Mutez_key _, v) -> Lwt.return @@ unparse_mutez ~loc ctxt v\n  | (Key_key _, k) -> Lwt.return @@ unparse_key ~loc ctxt mode k\n  | (Key_hash_key _, k) -> Lwt.return @@ unparse_key_hash ~loc ctxt mode k\n  | (Chain_id_key _, chain_id) ->\n      Lwt.return @@ unparse_chain_id ~loc ctxt mode chain_id\n  | (Pair_key ((tl, _), (tr, _), _), pair) ->\n      let r_witness = comparable_comb_witness2 tr in\n      let unparse_l ctxt v = unparse_comparable_data ~loc ctxt mode tl v in\n      let unparse_r ctxt v = unparse_comparable_data ~loc ctxt mode tr v in\n      unparse_pair ~loc unparse_l unparse_r ctxt mode r_witness pair\n  | (Union_key ((tl, _), (tr, _), _), v) ->\n      let unparse_l ctxt v = unparse_comparable_data ~loc ctxt mode tl v in\n      let unparse_r ctxt v = unparse_comparable_data ~loc ctxt mode tr v in\n      unparse_union ~loc unparse_l unparse_r ctxt v\n  | (Option_key (t, _), v) ->\n      let unparse_v ctxt v = unparse_comparable_data ~loc ctxt mode t v in\n      unparse_option ~loc unparse_v ctxt v\n  | (Never_key _, _) -> .\n\nlet pack_node unparsed ctxt =\n  Gas.consume ctxt (Script.strip_locations_cost unparsed) >>? fun ctxt ->\n  let bytes =\n    Data_encoding.Binary.to_bytes_exn\n      expr_encoding\n      (Micheline.strip_locations unparsed)\n  in\n  Gas.consume ctxt (Script.serialized_cost bytes) >|? fun ctxt ->\n  let bytes = Bytes.cat (Bytes.of_string \"\\005\") bytes in\n  (bytes, ctxt)\n\nlet pack_comparable_data ctxt typ data ~mode =\n  unparse_comparable_data ~loc:() ctxt mode typ data\n  >>=? fun (unparsed, ctxt) -> Lwt.return @@ pack_node unparsed ctxt\n\nlet hash_bytes ctxt bytes =\n  Gas.consume ctxt (Michelson_v1_gas.Cost_of.Interpreter.blake2b bytes)\n  >|? fun ctxt -> (Script_expr_hash.(hash_bytes [bytes]), ctxt)\n\nlet hash_comparable_data ctxt typ data =\n  pack_comparable_data ctxt typ data ~mode:Optimized_legacy\n  >>=? fun (bytes, ctxt) -> Lwt.return @@ hash_bytes ctxt bytes\n\n(* ---- Tickets ------------------------------------------------------------ *)\n\n(*\n   All comparable types are dupable, this function exists only to not forget\n   checking this property when adding new types.\n*)\nlet check_dupable_comparable_ty : type a. a comparable_ty -> unit = function\n  | Unit_key _ | Never_key _ | Int_key _ | Nat_key _ | Signature_key _\n  | String_key _ | Bytes_key _ | Mutez_key _ | Bool_key _ | Key_hash_key _\n  | Key_key _ | Timestamp_key _ | Chain_id_key _ | Address_key _ | Pair_key _\n  | Union_key _ | Option_key _ ->\n      ()\n\nlet rec check_dupable_ty :\n    type a. context -> location -> a ty -> context tzresult =\n fun ctxt loc ty ->\n  Gas.consume ctxt Typecheck_costs.check_dupable_cycle >>? fun ctxt ->\n  match ty with\n  | Unit_t _ -> ok ctxt\n  | Int_t _ -> ok ctxt\n  | Nat_t _ -> ok ctxt\n  | Signature_t _ -> ok ctxt\n  | String_t _ -> ok ctxt\n  | Bytes_t _ -> ok ctxt\n  | Mutez_t _ -> ok ctxt\n  | Key_hash_t _ -> ok ctxt\n  | Key_t _ -> ok ctxt\n  | Timestamp_t _ -> ok ctxt\n  | Address_t _ -> ok ctxt\n  | Bool_t _ -> ok ctxt\n  | Contract_t (_, _) -> ok ctxt\n  | Operation_t _ -> ok ctxt\n  | Chain_id_t _ -> ok ctxt\n  | Never_t _ -> ok ctxt\n  | Bls12_381_g1_t _ -> ok ctxt\n  | Bls12_381_g2_t _ -> ok ctxt\n  | Bls12_381_fr_t _ -> ok ctxt\n  | Sapling_state_t _ -> ok ctxt\n  | Sapling_transaction_t _ -> ok ctxt\n  | Chest_t _ -> ok ctxt\n  | Chest_key_t _ -> ok ctxt\n  | Ticket_t _ -> error (Unexpected_ticket loc)\n  | Pair_t ((ty_a, _, _), (ty_b, _, _), _) ->\n      check_dupable_ty ctxt loc ty_a >>? fun ctxt ->\n      check_dupable_ty ctxt loc ty_b\n  | Union_t ((ty_a, _), (ty_b, _), _) ->\n      check_dupable_ty ctxt loc ty_a >>? fun ctxt ->\n      check_dupable_ty ctxt loc ty_b\n  | Lambda_t (_, _, _) ->\n      (*\n        Lambda are dupable as long as:\n          - they don't contain non-dupable values, e.g. in `PUSH`\n            (mostly non-dupable values should probably be considered forged)\n          - they are not the result of a partial application on a non-dupable\n            value. `APPLY` rejects non-packable types (because of `PUSH`).\n            Hence non-dupable should imply non-packable.\n      *)\n      ok ctxt\n  | Option_t (ty, _) -> check_dupable_ty ctxt loc ty\n  | List_t (ty, _) -> check_dupable_ty ctxt loc ty\n  | Set_t (key_ty, _) ->\n      let () = check_dupable_comparable_ty key_ty in\n      ok ctxt\n  | Map_t (key_ty, val_ty, _) ->\n      let () = check_dupable_comparable_ty key_ty in\n      check_dupable_ty ctxt loc val_ty\n  | Big_map_t (key_ty, val_ty, _) ->\n      let () = check_dupable_comparable_ty key_ty in\n      check_dupable_ty ctxt loc val_ty\n\n(* ---- Equality witnesses --------------------------------------------------*)\n\ntype ('ta, 'tb) eq = Eq : ('same, 'same) eq\n\nlet record_inconsistent_types loc ta tb =\n  record_trace_eval (fun () ->\n      let ta = serialize_ty_for_error ta in\n      let tb = serialize_ty_for_error tb in\n      Inconsistent_types (Some loc, ta, tb))\n\nlet merge_type_metadata :\n    legacy:bool -> 'a ty_metadata -> 'b ty_metadata -> 'a ty_metadata tzresult =\n fun ~legacy {size = size_a; annot = annot_a} {size = size_b; annot = annot_b} ->\n  Type_size.merge size_a size_b >>? fun size ->\n  merge_type_annot ~legacy annot_a annot_b >|? fun annot -> {annot; size}\n\n(* Takes two comparable types and simultaneously merge their annotations and\n   check that they represent the same type.\n\n   The result contains:\n   - an equality witness between the types of the two inputs\n   - the merged type\n   - an updated context (for gas consumption)\n\n   The tzresult monad is used at two levels: the inner tzresult\n   is used for tracking merge errors (types of different shapes\n   or annotation mismatches), the outer tzresult is used only\n   for gas consumption. Separating these two error cases like\n   this allows to recover from a type comparison error without\n   reverting the gas consumption.\n *)\nlet rec merge_comparable_types :\n    type ta tb.\n    legacy:bool ->\n    ta comparable_ty ->\n    tb comparable_ty ->\n    ( (ta comparable_ty, tb comparable_ty) eq * ta comparable_ty,\n      error trace )\n    Gas_monad.t =\n  let open Gas_monad in\n  fun ~legacy ta tb ->\n    consume_gas Typecheck_costs.merge_cycle >>$ fun () ->\n    let merge_type_metadata ~legacy meta_a meta_b =\n      of_result @@ merge_type_metadata ~legacy meta_a meta_b\n    in\n    let merge_field_annot ~legacy annot_a annot_b =\n      of_result @@ merge_field_annot ~legacy annot_a annot_b\n    in\n    let return f eq annot_a annot_b :\n        ( (ta comparable_ty, tb comparable_ty) eq * ta comparable_ty,\n          error trace )\n        gas_monad =\n      merge_type_metadata ~legacy annot_a annot_b >>$ fun annot ->\n      return (eq, f annot)\n    in\n    match (ta, tb) with\n    | (Unit_key annot_a, Unit_key annot_b) ->\n        return (fun annot -> Unit_key annot) Eq annot_a annot_b\n    | (Never_key annot_a, Never_key annot_b) ->\n        return (fun annot -> Never_key annot) Eq annot_a annot_b\n    | (Int_key annot_a, Int_key annot_b) ->\n        return (fun annot -> Int_key annot) Eq annot_a annot_b\n    | (Nat_key annot_a, Nat_key annot_b) ->\n        return (fun annot -> Nat_key annot) Eq annot_a annot_b\n    | (Signature_key annot_a, Signature_key annot_b) ->\n        return (fun annot -> Signature_key annot) Eq annot_a annot_b\n    | (String_key annot_a, String_key annot_b) ->\n        return (fun annot -> String_key annot) Eq annot_a annot_b\n    | (Bytes_key annot_a, Bytes_key annot_b) ->\n        return (fun annot -> Bytes_key annot) Eq annot_a annot_b\n    | (Mutez_key annot_a, Mutez_key annot_b) ->\n        return (fun annot -> Mutez_key annot) Eq annot_a annot_b\n    | (Bool_key annot_a, Bool_key annot_b) ->\n        return (fun annot -> Bool_key annot) Eq annot_a annot_b\n    | (Key_hash_key annot_a, Key_hash_key annot_b) ->\n        return (fun annot -> Key_hash_key annot) Eq annot_a annot_b\n    | (Key_key annot_a, Key_key annot_b) ->\n        return (fun annot -> Key_key annot) Eq annot_a annot_b\n    | (Timestamp_key annot_a, Timestamp_key annot_b) ->\n        return (fun annot -> Timestamp_key annot) Eq annot_a annot_b\n    | (Chain_id_key annot_a, Chain_id_key annot_b) ->\n        return (fun annot -> Chain_id_key annot) Eq annot_a annot_b\n    | (Address_key annot_a, Address_key annot_b) ->\n        return (fun annot -> Address_key annot) Eq annot_a annot_b\n    | ( Pair_key ((left_a, annot_left_a), (right_a, annot_right_a), annot_a),\n        Pair_key ((left_b, annot_left_b), (right_b, annot_right_b), annot_b) )\n      ->\n        merge_type_metadata ~legacy annot_a annot_b >>$ fun annot ->\n        merge_field_annot ~legacy annot_left_a annot_left_b\n        >>$ fun annot_left ->\n        merge_field_annot ~legacy annot_right_a annot_right_b\n        >>$ fun annot_right ->\n        merge_comparable_types ~legacy left_a left_b >>$ fun (Eq, left) ->\n        merge_comparable_types ~legacy right_a right_b >|$ fun (Eq, right) ->\n        ( (Eq : (ta comparable_ty, tb comparable_ty) eq),\n          Pair_key ((left, annot_left), (right, annot_right), annot) )\n    | ( Union_key ((left_a, annot_left_a), (right_a, annot_right_a), annot_a),\n        Union_key ((left_b, annot_left_b), (right_b, annot_right_b), annot_b) )\n      ->\n        merge_type_metadata ~legacy annot_a annot_b >>$ fun annot ->\n        merge_field_annot ~legacy annot_left_a annot_left_b\n        >>$ fun annot_left ->\n        merge_field_annot ~legacy annot_right_a annot_right_b\n        >>$ fun annot_right ->\n        merge_comparable_types ~legacy left_a left_b >>$ fun (Eq, left) ->\n        merge_comparable_types ~legacy right_a right_b >|$ fun (Eq, right) ->\n        ( (Eq : (ta comparable_ty, tb comparable_ty) eq),\n          Union_key ((left, annot_left), (right, annot_right), annot) )\n    | (Option_key (ta, annot_a), Option_key (tb, annot_b)) ->\n        merge_type_metadata ~legacy annot_a annot_b >>$ fun annot ->\n        merge_comparable_types ~legacy ta tb >|$ fun (Eq, t) ->\n        ((Eq : (ta comparable_ty, tb comparable_ty) eq), Option_key (t, annot))\n    | (_, _) ->\n        let ta = serialize_ty_for_error (ty_of_comparable_ty ta) in\n        let tb = serialize_ty_for_error (ty_of_comparable_ty tb) in\n        of_result @@ error (Inconsistent_types (None, ta, tb))\n\n(* This function does not distinguish gas errors from merge errors. If you need\n   to recover from a type mismatch and consume the exact gas for the failed\n   comparison, use [merge_comparable_types] instead.\n*)\nlet comparable_ty_eq :\n    type ta tb.\n    context ->\n    ta comparable_ty ->\n    tb comparable_ty ->\n    ((ta comparable_ty, tb comparable_ty) eq * context) tzresult =\n fun ctxt ta tb ->\n  Gas_monad.run ctxt (merge_comparable_types ~legacy:true ta tb)\n  >>? fun (eq_ty, ctxt) ->\n  eq_ty >|? fun (eq, _ty) -> (eq, ctxt)\n\nlet merge_memo_sizes ms1 ms2 =\n  if Sapling.Memo_size.equal ms1 ms2 then ok ms1\n  else error (Inconsistent_memo_sizes (ms1, ms2))\n\ntype merge_type_error_flag = Default_merge_type_error | Fast_merge_type_error\n\nlet default_merge_type_error ty1 ty2 =\n  let ty1 = serialize_ty_for_error ty1 in\n  let ty2 = serialize_ty_for_error ty2 in\n  Inconsistent_types (None, ty1, ty2)\n\ntype error += Inconsistent_types_fast\n\nlet fast_merge_type_error _ty1 _ty2 = Inconsistent_types_fast\n\nlet merge_type_error ~merge_type_error_flag =\n  match merge_type_error_flag with\n  | Default_merge_type_error -> default_merge_type_error\n  | Fast_merge_type_error -> fast_merge_type_error\n\nlet record_inconsistent_carbonated ta tb =\n  Gas_monad.record_trace_eval (fun () ->\n      let ta = serialize_ty_for_error ta in\n      let tb = serialize_ty_for_error tb in\n      Inconsistent_types (None, ta, tb))\n\n(* Same as merge_comparable_types but for any types *)\nlet merge_types :\n    type a b.\n    legacy:bool ->\n    merge_type_error_flag:merge_type_error_flag ->\n    Script.location ->\n    a ty ->\n    b ty ->\n    ((a ty, b ty) eq * a ty, error trace) Gas_monad.t =\n  let open Gas_monad in\n  fun ~legacy ~merge_type_error_flag loc ty1 ty2 ->\n    let merge_type_metadata tn1 tn2 =\n      of_result\n        (merge_type_metadata ~legacy tn1 tn2\n        |> record_inconsistent_types loc ty1 ty2)\n    in\n    let merge_field_annot ~legacy tn1 tn2 =\n      of_result (merge_field_annot ~legacy tn1 tn2)\n    in\n    let merge_memo_sizes ms1 ms2 = of_result (merge_memo_sizes ms1 ms2) in\n    let rec help :\n        type ta tb.\n        ta ty -> tb ty -> ((ta ty, tb ty) eq * ta ty, error trace) gas_monad =\n     fun ty1 ty2 -> help0 ty1 ty2 |> record_inconsistent_carbonated ty1 ty2\n    and help0 :\n        type ta tb.\n        ta ty -> tb ty -> ((ta ty, tb ty) eq * ta ty, error trace) gas_monad =\n     fun ty1 ty2 ->\n      consume_gas Typecheck_costs.merge_cycle >>$ fun () ->\n      let return f eq annot_a annot_b :\n          ((ta ty, tb ty) eq * ta ty, error trace) gas_monad =\n        merge_type_metadata annot_a annot_b >>$ fun annot -> return (eq, f annot)\n      in\n      match (ty1, ty2) with\n      | (Unit_t tn1, Unit_t tn2) ->\n          return (fun tname -> Unit_t tname) Eq tn1 tn2\n      | (Int_t tn1, Int_t tn2) -> return (fun tname -> Int_t tname) Eq tn1 tn2\n      | (Nat_t tn1, Nat_t tn2) -> return (fun tname -> Nat_t tname) Eq tn1 tn2\n      | (Key_t tn1, Key_t tn2) -> return (fun tname -> Key_t tname) Eq tn1 tn2\n      | (Key_hash_t tn1, Key_hash_t tn2) ->\n          return (fun tname -> Key_hash_t tname) Eq tn1 tn2\n      | (String_t tn1, String_t tn2) ->\n          return (fun tname -> String_t tname) Eq tn1 tn2\n      | (Bytes_t tn1, Bytes_t tn2) ->\n          return (fun tname -> Bytes_t tname) Eq tn1 tn2\n      | (Signature_t tn1, Signature_t tn2) ->\n          return (fun tname -> Signature_t tname) Eq tn1 tn2\n      | (Mutez_t tn1, Mutez_t tn2) ->\n          return (fun tname -> Mutez_t tname) Eq tn1 tn2\n      | (Timestamp_t tn1, Timestamp_t tn2) ->\n          return (fun tname -> Timestamp_t tname) Eq tn1 tn2\n      | (Address_t tn1, Address_t tn2) ->\n          return (fun tname -> Address_t tname) Eq tn1 tn2\n      | (Bool_t tn1, Bool_t tn2) ->\n          return (fun tname -> Bool_t tname) Eq tn1 tn2\n      | (Chain_id_t tn1, Chain_id_t tn2) ->\n          return (fun tname -> Chain_id_t tname) Eq tn1 tn2\n      | (Never_t tn1, Never_t tn2) ->\n          return (fun tname -> Never_t tname) Eq tn1 tn2\n      | (Operation_t tn1, Operation_t tn2) ->\n          return (fun tname -> Operation_t tname) Eq tn1 tn2\n      | (Bls12_381_g1_t tn1, Bls12_381_g1_t tn2) ->\n          return (fun tname -> Bls12_381_g1_t tname) Eq tn1 tn2\n      | (Bls12_381_g2_t tn1, Bls12_381_g2_t tn2) ->\n          return (fun tname -> Bls12_381_g2_t tname) Eq tn1 tn2\n      | (Bls12_381_fr_t tn1, Bls12_381_fr_t tn2) ->\n          return (fun tname -> Bls12_381_fr_t tname) Eq tn1 tn2\n      | (Map_t (tal, tar, tn1), Map_t (tbl, tbr, tn2)) ->\n          merge_type_metadata tn1 tn2 >>$ fun tname ->\n          help tar tbr >>$ fun (Eq, value) ->\n          merge_comparable_types ~legacy tal tbl >|$ fun (Eq, tk) ->\n          ((Eq : (ta ty, tb ty) eq), Map_t (tk, value, tname))\n      | (Big_map_t (tal, tar, tn1), Big_map_t (tbl, tbr, tn2)) ->\n          merge_type_metadata tn1 tn2 >>$ fun tname ->\n          help tar tbr >>$ fun (Eq, value) ->\n          merge_comparable_types ~legacy tal tbl >|$ fun (Eq, tk) ->\n          ((Eq : (ta ty, tb ty) eq), Big_map_t (tk, value, tname))\n      | (Set_t (ea, tn1), Set_t (eb, tn2)) ->\n          merge_type_metadata tn1 tn2 >>$ fun tname ->\n          merge_comparable_types ~legacy ea eb >|$ fun (Eq, e) ->\n          ((Eq : (ta ty, tb ty) eq), Set_t (e, tname))\n      | (Ticket_t (ea, tn1), Ticket_t (eb, tn2)) ->\n          merge_type_metadata tn1 tn2 >>$ fun tname ->\n          merge_comparable_types ~legacy ea eb >|$ fun (Eq, e) ->\n          ((Eq : (ta ty, tb ty) eq), Ticket_t (e, tname))\n      | ( Pair_t ((tal, l_field1, l_var1), (tar, r_field1, r_var1), tn1),\n          Pair_t ((tbl, l_field2, l_var2), (tbr, r_field2, r_var2), tn2) ) ->\n          merge_type_metadata tn1 tn2 >>$ fun tname ->\n          merge_field_annot ~legacy l_field1 l_field2 >>$ fun l_field ->\n          merge_field_annot ~legacy r_field1 r_field2 >>$ fun r_field ->\n          let l_var = merge_var_annot l_var1 l_var2 in\n          let r_var = merge_var_annot r_var1 r_var2 in\n          help tal tbl >>$ fun (Eq, left_ty) ->\n          help tar tbr >|$ fun (Eq, right_ty) ->\n          ( (Eq : (ta ty, tb ty) eq),\n            Pair_t ((left_ty, l_field, l_var), (right_ty, r_field, r_var), tname)\n          )\n      | ( Union_t ((tal, tal_annot), (tar, tar_annot), tn1),\n          Union_t ((tbl, tbl_annot), (tbr, tbr_annot), tn2) ) ->\n          merge_type_metadata tn1 tn2 >>$ fun tname ->\n          merge_field_annot ~legacy tal_annot tbl_annot >>$ fun left_annot ->\n          merge_field_annot ~legacy tar_annot tbr_annot >>$ fun right_annot ->\n          help tal tbl >>$ fun (Eq, left_ty) ->\n          help tar tbr >|$ fun (Eq, right_ty) ->\n          ( (Eq : (ta ty, tb ty) eq),\n            Union_t ((left_ty, left_annot), (right_ty, right_annot), tname) )\n      | (Lambda_t (tal, tar, tn1), Lambda_t (tbl, tbr, tn2)) ->\n          merge_type_metadata tn1 tn2 >>$ fun tname ->\n          help tal tbl >>$ fun (Eq, left_ty) ->\n          help tar tbr >|$ fun (Eq, right_ty) ->\n          ((Eq : (ta ty, tb ty) eq), Lambda_t (left_ty, right_ty, tname))\n      | (Contract_t (tal, tn1), Contract_t (tbl, tn2)) ->\n          merge_type_metadata tn1 tn2 >>$ fun tname ->\n          help tal tbl >|$ fun (Eq, arg_ty) ->\n          ((Eq : (ta ty, tb ty) eq), Contract_t (arg_ty, tname))\n      | (Option_t (tva, tn1), Option_t (tvb, tn2)) ->\n          merge_type_metadata tn1 tn2 >>$ fun tname ->\n          help tva tvb >|$ fun (Eq, ty) ->\n          ((Eq : (ta ty, tb ty) eq), Option_t (ty, tname))\n      | (List_t (tva, tn1), List_t (tvb, tn2)) ->\n          merge_type_metadata tn1 tn2 >>$ fun tname ->\n          help tva tvb >|$ fun (Eq, ty) ->\n          ((Eq : (ta ty, tb ty) eq), List_t (ty, tname))\n      | (Sapling_state_t (ms1, tn1), Sapling_state_t (ms2, tn2)) ->\n          merge_type_metadata tn1 tn2 >>$ fun tname ->\n          merge_memo_sizes ms1 ms2 >|$ fun ms ->\n          (Eq, Sapling_state_t (ms, tname))\n      | (Sapling_transaction_t (ms1, tn1), Sapling_transaction_t (ms2, tn2)) ->\n          merge_type_metadata tn1 tn2 >>$ fun tname ->\n          merge_memo_sizes ms1 ms2 >|$ fun ms ->\n          (Eq, Sapling_transaction_t (ms, tname))\n      | (Chest_t tn1, Chest_t tn2) ->\n          return (fun tname -> Chest_t tname) Eq tn1 tn2\n      | (Chest_key_t tn1, Chest_key_t tn2) ->\n          return (fun tname -> Chest_key_t tname) Eq tn1 tn2\n      | (_, _) ->\n          of_result @@ error @@ merge_type_error ~merge_type_error_flag ty1 ty2\n    in\n    help ty1 ty2\n  [@@coq_axiom_with_reason \"non-top-level mutual recursion\"]\n\n(* This function does not distinguish gas errors from merge errors. If you need\n   to recover from a type mismatch and consume the exact gas for the failed\n   comparison, use [merge_types] instead.\n*)\nlet ty_eq :\n    type ta tb.\n    legacy:bool ->\n    context ->\n    Script.location ->\n    ta ty ->\n    tb ty ->\n    ((ta ty, tb ty) eq * context) tzresult =\n fun ~legacy ctxt loc ta tb ->\n  Gas_monad.run ctxt\n  @@ merge_types\n       ~merge_type_error_flag:Default_merge_type_error\n       ~legacy\n       loc\n       ta\n       tb\n  >>? fun (eq_ty, ctxt) ->\n  eq_ty >|? fun (eq, _ty) -> (eq, ctxt)\n\n(* Same as merge_comparable_types and merge_types but for stacks.\n   A single error monad is used here because there is no need to\n   recover from stack merging errors.  *)\nlet merge_stacks :\n    type ta tb ts tu.\n    legacy:bool ->\n    Script.location ->\n    context ->\n    int ->\n    (ta, ts) stack_ty ->\n    (tb, tu) stack_ty ->\n    (((ta, ts) stack_ty, (tb, tu) stack_ty) eq * (ta, ts) stack_ty * context)\n    tzresult =\n fun ~legacy loc ->\n  let rec help :\n      type ta tb ts tu.\n      context ->\n      int ->\n      (ta, ts) stack_ty ->\n      (tb, tu) stack_ty ->\n      (((ta, ts) stack_ty, (tb, tu) stack_ty) eq * (ta, ts) stack_ty * context)\n      tzresult =\n   fun ctxt lvl stack1 stack2 ->\n    match (stack1, stack2) with\n    | (Bot_t, Bot_t) -> ok (Eq, Bot_t, ctxt)\n    | (Item_t (ty1, rest1, annot1), Item_t (ty2, rest2, annot2)) ->\n        Gas_monad.run ctxt\n        @@ merge_types\n             ~merge_type_error_flag:Default_merge_type_error\n             ~legacy\n             loc\n             ty1\n             ty2\n        |> record_trace (Bad_stack_item lvl)\n        >>? fun (eq_ty, ctxt) ->\n        eq_ty >>? fun (Eq, ty) ->\n        help ctxt (lvl + 1) rest1 rest2 >|? fun (Eq, rest, ctxt) ->\n        let annot = merge_var_annot annot1 annot2 in\n        ( (Eq : ((ta, ts) stack_ty, (tb, tu) stack_ty) eq),\n          Item_t (ty, rest, annot),\n          ctxt )\n    | (_, _) -> error Bad_stack_length\n  in\n  help\n\n(* ---- Type checker results -------------------------------------------------*)\n\ntype ('a, 's) judgement =\n  | Typed : ('a, 's, 'b, 'u) descr -> ('a, 's) judgement\n  | Failed : {\n      descr : 'b 'u. ('b, 'u) stack_ty -> ('a, 's, 'b, 'u) descr;\n    }\n      -> ('a, 's) judgement\n\n(* ---- Type checker (Untyped expressions -> Typed IR) ----------------------*)\n\ntype ('a, 's, 'b, 'u, 'c, 'v) branch = {\n  branch :\n    'r 'f.\n    ('a, 's, 'r, 'f) descr -> ('b, 'u, 'r, 'f) descr -> ('c, 'v, 'r, 'f) descr;\n}\n[@@unboxed]\n\nlet merge_branches :\n    type a s b u c v.\n    legacy:bool ->\n    context ->\n    Script.location ->\n    (a, s) judgement ->\n    (b, u) judgement ->\n    (a, s, b, u, c, v) branch ->\n    ((c, v) judgement * context) tzresult =\n fun ~legacy ctxt loc btr bfr {branch} ->\n  match (btr, bfr) with\n  | (Typed ({aft = aftbt; _} as dbt), Typed ({aft = aftbf; _} as dbf)) ->\n      let unmatched_branches () =\n        let aftbt = serialize_stack_for_error ctxt aftbt in\n        let aftbf = serialize_stack_for_error ctxt aftbf in\n        Unmatched_branches (loc, aftbt, aftbf)\n      in\n      record_trace_eval\n        unmatched_branches\n        ( merge_stacks ~legacy loc ctxt 1 aftbt aftbf\n        >|? fun (Eq, merged_stack, ctxt) ->\n          ( Typed\n              (branch\n                 {dbt with aft = merged_stack}\n                 {dbf with aft = merged_stack}),\n            ctxt ) )\n  | (Failed {descr = descrt}, Failed {descr = descrf}) ->\n      let descr ret = branch (descrt ret) (descrf ret) in\n      ok (Failed {descr}, ctxt)\n  | (Typed dbt, Failed {descr = descrf}) ->\n      ok (Typed (branch dbt (descrf dbt.aft)), ctxt)\n  | (Failed {descr = descrt}, Typed dbf) ->\n      ok (Typed (branch (descrt dbf.aft) dbf), ctxt)\n\nlet parse_memo_size (n : (location, _) Micheline.node) :\n    Sapling.Memo_size.t tzresult =\n  match n with\n  | Int (_, z) -> (\n      match Sapling.Memo_size.parse_z z with\n      | Ok _ as ok_memo_size -> ok_memo_size [@coq_cast]\n      | Error msg ->\n          error\n          @@ Invalid_syntactic_constant (location n, strip_locations n, msg))\n  | _ -> error @@ Invalid_kind (location n, [Int_kind], kind n)\n\ntype ex_comparable_ty =\n  | Ex_comparable_ty : 'a comparable_ty -> ex_comparable_ty\n\nlet[@coq_struct \"ty\"] rec parse_comparable_ty :\n    stack_depth:int ->\n    context ->\n    Script.node ->\n    (ex_comparable_ty * context) tzresult =\n fun ~stack_depth ctxt ty ->\n  Gas.consume ctxt Typecheck_costs.parse_type_cycle >>? fun ctxt ->\n  if Compare.Int.(stack_depth > 10000) then\n    error Typechecking_too_many_recursive_calls\n  else\n    match ty with\n    | Prim (loc, T_unit, [], annot) ->\n        parse_type_annot loc annot >|? fun annot ->\n        (Ex_comparable_ty (unit_key ~annot), ctxt)\n    | Prim (loc, T_never, [], annot) ->\n        parse_type_annot loc annot >|? fun annot ->\n        (Ex_comparable_ty (never_key ~annot), ctxt)\n    | Prim (loc, T_int, [], annot) ->\n        parse_type_annot loc annot >|? fun annot ->\n        (Ex_comparable_ty (int_key ~annot), ctxt)\n    | Prim (loc, T_nat, [], annot) ->\n        parse_type_annot loc annot >|? fun annot ->\n        (Ex_comparable_ty (nat_key ~annot), ctxt)\n    | Prim (loc, T_signature, [], annot) ->\n        parse_type_annot loc annot >|? fun annot ->\n        (Ex_comparable_ty (signature_key ~annot), ctxt)\n    | Prim (loc, T_string, [], annot) ->\n        parse_type_annot loc annot >|? fun annot ->\n        (Ex_comparable_ty (string_key ~annot), ctxt)\n    | Prim (loc, T_bytes, [], annot) ->\n        parse_type_annot loc annot >|? fun annot ->\n        (Ex_comparable_ty (bytes_key ~annot), ctxt)\n    | Prim (loc, T_mutez, [], annot) ->\n        parse_type_annot loc annot >|? fun annot ->\n        (Ex_comparable_ty (mutez_key ~annot), ctxt)\n    | Prim (loc, T_bool, [], annot) ->\n        parse_type_annot loc annot >|? fun annot ->\n        (Ex_comparable_ty (bool_key ~annot), ctxt)\n    | Prim (loc, T_key_hash, [], annot) ->\n        parse_type_annot loc annot >|? fun annot ->\n        (Ex_comparable_ty (key_hash_key ~annot), ctxt)\n    | Prim (loc, T_key, [], annot) ->\n        parse_type_annot loc annot >|? fun annot ->\n        (Ex_comparable_ty (key_key ~annot), ctxt)\n    | Prim (loc, T_timestamp, [], annot) ->\n        parse_type_annot loc annot >|? fun annot ->\n        (Ex_comparable_ty (timestamp_key ~annot), ctxt)\n    | Prim (loc, T_chain_id, [], annot) ->\n        parse_type_annot loc annot >|? fun annot ->\n        (Ex_comparable_ty (chain_id_key ~annot), ctxt)\n    | Prim (loc, T_address, [], annot) ->\n        parse_type_annot loc annot >|? fun annot ->\n        (Ex_comparable_ty (address_key ~annot), ctxt)\n    | Prim\n        ( loc,\n          (( T_unit | T_never | T_int | T_nat | T_string | T_bytes | T_mutez\n           | T_bool | T_key_hash | T_timestamp | T_address | T_chain_id\n           | T_signature | T_key ) as prim),\n          l,\n          _ ) ->\n        error (Invalid_arity (loc, prim, 0, List.length l))\n    | Prim (loc, T_pair, left :: right, annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        extract_field_annot left >>? fun (left, left_annot) ->\n        (match right with\n        | [right] -> extract_field_annot right\n        | right ->\n            (* Unfold [pair t1 ... tn] as [pair t1 (... (pair tn-1 tn))] *)\n            ok (Prim (loc, T_pair, right, []), None))\n        >>? fun (right, right_annot) ->\n        parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt right\n        >>? fun (Ex_comparable_ty right, ctxt) ->\n        parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt left\n        >>? fun (Ex_comparable_ty left, ctxt) ->\n        pair_key loc (left, left_annot) (right, right_annot) ~annot\n        >|? fun ty -> (Ex_comparable_ty ty, ctxt)\n    | Prim (loc, T_or, [left; right], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        extract_field_annot left >>? fun (left, left_annot) ->\n        extract_field_annot right >>? fun (right, right_annot) ->\n        parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt right\n        >>? fun (Ex_comparable_ty right, ctxt) ->\n        parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt left\n        >>? fun (Ex_comparable_ty left, ctxt) ->\n        union_key loc (left, left_annot) (right, right_annot) ~annot\n        >|? fun ty -> (Ex_comparable_ty ty, ctxt)\n    | Prim (loc, ((T_pair | T_or) as prim), l, _) ->\n        error (Invalid_arity (loc, prim, 2, List.length l))\n    | Prim (loc, T_option, [t], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt t\n        >>? fun (Ex_comparable_ty t, ctxt) ->\n        option_key loc t ~annot >|? fun ty -> (Ex_comparable_ty ty, ctxt)\n    | Prim (loc, T_option, l, _) ->\n        error (Invalid_arity (loc, T_option, 1, List.length l))\n    | Prim\n        ( loc,\n          (T_set | T_map | T_list | T_lambda | T_contract | T_operation),\n          _,\n          _ ) ->\n        error (Comparable_type_expected (loc, Micheline.strip_locations ty))\n    | expr ->\n        error\n        @@ unexpected\n             expr\n             []\n             Type_namespace\n             [\n               T_unit;\n               T_never;\n               T_int;\n               T_nat;\n               T_string;\n               T_bytes;\n               T_mutez;\n               T_bool;\n               T_key_hash;\n               T_timestamp;\n               T_address;\n               T_pair;\n               T_or;\n               T_option;\n               T_chain_id;\n               T_signature;\n               T_key;\n             ]\n\ntype ex_ty = Ex_ty : 'a ty -> ex_ty\n\nlet[@coq_axiom_with_reason \"complex mutually recursive definition\"] rec parse_packable_ty\n    :\n    context ->\n    stack_depth:int ->\n    legacy:bool ->\n    Script.node ->\n    (ex_ty * context) tzresult =\n fun ctxt ~stack_depth ~legacy ->\n  (parse_ty [@tailcall])\n    ctxt\n    ~stack_depth\n    ~legacy\n    ~allow_lazy_storage:false\n    ~allow_operation:false\n    ~allow_contract:\n      legacy\n      (* type contract is forbidden in UNPACK because of\n         https://gitlab.com/tezos/tezos/-/issues/301 *)\n    ~allow_ticket:false\n\nand[@coq_axiom_with_reason \"complex mutually recursive definition\"] parse_parameter_ty\n    :\n    context ->\n    stack_depth:int ->\n    legacy:bool ->\n    Script.node ->\n    (ex_ty * context) tzresult =\n fun ctxt ~stack_depth ~legacy ->\n  (parse_ty [@tailcall])\n    ctxt\n    ~stack_depth\n    ~legacy\n    ~allow_lazy_storage:true\n    ~allow_operation:false\n    ~allow_contract:true\n    ~allow_ticket:true\n\nand parse_view_input_ty :\n    context ->\n    stack_depth:int ->\n    legacy:bool ->\n    Script.node ->\n    (ex_ty * context) tzresult =\n fun ctxt ~stack_depth ~legacy ->\n  (parse_ty [@tailcall])\n    ctxt\n    ~stack_depth\n    ~legacy\n    ~allow_lazy_storage:false\n    ~allow_operation:false\n    ~allow_contract:true\n    ~allow_ticket:false\n\nand parse_view_output_ty :\n    context ->\n    stack_depth:int ->\n    legacy:bool ->\n    Script.node ->\n    (ex_ty * context) tzresult =\n fun ctxt ~stack_depth ~legacy ->\n  (parse_ty [@tailcall])\n    ctxt\n    ~stack_depth\n    ~legacy\n    ~allow_lazy_storage:false\n    ~allow_operation:false\n    ~allow_contract:true\n    ~allow_ticket:false\n\nand[@coq_axiom_with_reason \"complex mutually recursive definition\"] parse_normal_storage_ty\n    :\n    context ->\n    stack_depth:int ->\n    legacy:bool ->\n    Script.node ->\n    (ex_ty * context) tzresult =\n fun ctxt ~stack_depth ~legacy ->\n  (parse_ty [@tailcall])\n    ctxt\n    ~stack_depth\n    ~legacy\n    ~allow_lazy_storage:true\n    ~allow_operation:false\n    ~allow_contract:legacy\n    ~allow_ticket:true\n\nand[@coq_axiom_with_reason \"complex mutually recursive definition\"] parse_any_ty\n    :\n    context ->\n    stack_depth:int ->\n    legacy:bool ->\n    Script.node ->\n    (ex_ty * context) tzresult =\n fun ctxt ~stack_depth ~legacy ->\n  (parse_ty [@tailcall])\n    ctxt\n    ~stack_depth\n    ~legacy\n    ~allow_lazy_storage:true\n    ~allow_operation:true\n    ~allow_contract:true\n    ~allow_ticket:true\n\nand[@coq_axiom_with_reason \"complex mutually recursive definition\"] parse_ty :\n    context ->\n    stack_depth:int ->\n    legacy:bool ->\n    allow_lazy_storage:bool ->\n    allow_operation:bool ->\n    allow_contract:bool ->\n    allow_ticket:bool ->\n    Script.node ->\n    (ex_ty * context) tzresult =\n fun ctxt\n     ~stack_depth\n     ~legacy\n     ~allow_lazy_storage\n     ~allow_operation\n     ~allow_contract\n     ~allow_ticket\n     node ->\n  Gas.consume ctxt Typecheck_costs.parse_type_cycle >>? fun ctxt ->\n  if Compare.Int.(stack_depth > 10000) then\n    error Typechecking_too_many_recursive_calls\n  else\n    match node with\n    | Prim (loc, T_unit, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (unit_t ~annot), ctxt)\n    | Prim (loc, T_int, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (int_t ~annot), ctxt)\n    | Prim (loc, T_nat, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (nat_t ~annot), ctxt)\n    | Prim (loc, T_string, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (string_t ~annot), ctxt)\n    | Prim (loc, T_bytes, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (bytes_t ~annot), ctxt)\n    | Prim (loc, T_mutez, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (mutez_t ~annot), ctxt)\n    | Prim (loc, T_bool, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (bool_t ~annot), ctxt)\n    | Prim (loc, T_key, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (key_t ~annot), ctxt)\n    | Prim (loc, T_key_hash, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (key_hash_t ~annot), ctxt)\n    | Prim (loc, T_chest_key, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (chest_key_t ~annot), ctxt)\n    | Prim (loc, T_chest, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (chest_t ~annot), ctxt)\n    | Prim (loc, T_timestamp, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (timestamp_t ~annot), ctxt)\n    | Prim (loc, T_address, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (address_t ~annot), ctxt)\n    | Prim (loc, T_signature, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (signature_t ~annot), ctxt)\n    | Prim (loc, T_operation, [], annot) ->\n        if allow_operation then\n          parse_type_annot loc annot >>? fun annot ->\n          ok (Ex_ty (operation_t ~annot), ctxt)\n        else error (Unexpected_operation loc)\n    | Prim (loc, T_chain_id, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (chain_id_t ~annot), ctxt)\n    | Prim (loc, T_never, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (never_t ~annot), ctxt)\n    | Prim (loc, T_bls12_381_g1, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (bls12_381_g1_t ~annot), ctxt)\n    | Prim (loc, T_bls12_381_g2, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (bls12_381_g2_t ~annot), ctxt)\n    | Prim (loc, T_bls12_381_fr, [], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        ok (Ex_ty (bls12_381_fr_t ~annot), ctxt)\n    | Prim (loc, T_contract, [utl], annot) ->\n        if allow_contract then\n          parse_parameter_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy utl\n          >>? fun (Ex_ty tl, ctxt) ->\n          parse_type_annot loc annot >>? fun annot ->\n          contract_t loc tl ~annot >|? fun ty -> (Ex_ty ty, ctxt)\n        else error (Unexpected_contract loc)\n    | Prim (loc, T_pair, utl :: utr, annot) ->\n        extract_field_annot utl >>? fun (utl, left_field) ->\n        parse_ty\n          ctxt\n          ~stack_depth:(stack_depth + 1)\n          ~legacy\n          ~allow_lazy_storage\n          ~allow_operation\n          ~allow_contract\n          ~allow_ticket\n          utl\n        >>? fun (Ex_ty tl, ctxt) ->\n        (match utr with\n        | [utr] -> extract_field_annot utr\n        | utr ->\n            (* Unfold [pair t1 ... tn] as [pair t1 (... (pair tn-1 tn))] *)\n            ok (Prim (loc, T_pair, utr, []), None))\n        >>? fun (utr, right_field) ->\n        parse_ty\n          ctxt\n          ~stack_depth:(stack_depth + 1)\n          ~legacy\n          ~allow_lazy_storage\n          ~allow_operation\n          ~allow_contract\n          ~allow_ticket\n          utr\n        >>? fun (Ex_ty tr, ctxt) ->\n        parse_type_annot loc annot >>? fun annot ->\n        pair_t loc (tl, left_field, None) (tr, right_field, None) ~annot\n        >|? fun ty -> (Ex_ty ty, ctxt)\n    | Prim (loc, T_or, [utl; utr], annot) ->\n        extract_field_annot utl >>? fun (utl, left_constr) ->\n        extract_field_annot utr >>? fun (utr, right_constr) ->\n        parse_ty\n          ctxt\n          ~stack_depth:(stack_depth + 1)\n          ~legacy\n          ~allow_lazy_storage\n          ~allow_operation\n          ~allow_contract\n          ~allow_ticket\n          utl\n        >>? fun (Ex_ty tl, ctxt) ->\n        parse_ty\n          ctxt\n          ~stack_depth:(stack_depth + 1)\n          ~legacy\n          ~allow_lazy_storage\n          ~allow_operation\n          ~allow_contract\n          ~allow_ticket\n          utr\n        >>? fun (Ex_ty tr, ctxt) ->\n        parse_type_annot loc annot >>? fun annot ->\n        union_t loc (tl, left_constr) (tr, right_constr) ~annot >|? fun ty ->\n        (Ex_ty ty, ctxt)\n    | Prim (loc, T_lambda, [uta; utr], annot) ->\n        parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy uta\n        >>? fun (Ex_ty ta, ctxt) ->\n        parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy utr\n        >>? fun (Ex_ty tr, ctxt) ->\n        parse_type_annot loc annot >>? fun annot ->\n        lambda_t loc ta tr ~annot >|? fun ty -> (Ex_ty ty, ctxt)\n    | Prim (loc, T_option, [ut], annot) ->\n        (if legacy then\n         (* legacy semantics with (broken) field annotations *)\n         extract_field_annot ut >>? fun (ut, _some_constr) ->\n         parse_composed_type_annot loc annot\n         >>? fun (ty_name, _none_constr, _) -> ok (ut, ty_name)\n        else parse_type_annot loc annot >>? fun annot -> ok (ut, annot))\n        >>? fun (ut, annot) ->\n        parse_ty\n          ctxt\n          ~stack_depth:(stack_depth + 1)\n          ~legacy\n          ~allow_lazy_storage\n          ~allow_operation\n          ~allow_contract\n          ~allow_ticket\n          ut\n        >>? fun (Ex_ty t, ctxt) ->\n        option_t loc t ~annot >|? fun ty -> (Ex_ty ty, ctxt)\n    | Prim (loc, T_list, [ut], annot) ->\n        parse_ty\n          ctxt\n          ~stack_depth:(stack_depth + 1)\n          ~legacy\n          ~allow_lazy_storage\n          ~allow_operation\n          ~allow_contract\n          ~allow_ticket\n          ut\n        >>? fun (Ex_ty t, ctxt) ->\n        parse_type_annot loc annot >>? fun annot ->\n        list_t loc t ~annot >|? fun ty -> (Ex_ty ty, ctxt)\n    | Prim (loc, T_ticket, [ut], annot) ->\n        if allow_ticket then\n          parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt ut\n          >>? fun (Ex_comparable_ty t, ctxt) ->\n          parse_type_annot loc annot >>? fun annot ->\n          ticket_t loc t ~annot >|? fun ty -> (Ex_ty ty, ctxt)\n        else error (Unexpected_ticket loc)\n    | Prim (loc, T_set, [ut], annot) ->\n        parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt ut\n        >>? fun (Ex_comparable_ty t, ctxt) ->\n        parse_type_annot loc annot >>? fun annot ->\n        set_t loc t ~annot >|? fun ty -> (Ex_ty ty, ctxt)\n    | Prim (loc, T_map, [uta; utr], annot) ->\n        parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt uta\n        >>? fun (Ex_comparable_ty ta, ctxt) ->\n        parse_ty\n          ctxt\n          ~stack_depth:(stack_depth + 1)\n          ~legacy\n          ~allow_lazy_storage\n          ~allow_operation\n          ~allow_contract\n          ~allow_ticket\n          utr\n        >>? fun (Ex_ty tr, ctxt) ->\n        parse_type_annot loc annot >>? fun annot ->\n        map_t loc ta tr ~annot >|? fun ty -> (Ex_ty ty, ctxt)\n    | Prim (loc, T_sapling_transaction, [memo_size], annot) ->\n        parse_type_annot loc annot >>? fun annot ->\n        parse_memo_size memo_size >|? fun memo_size ->\n        (Ex_ty (sapling_transaction_t ~memo_size ~annot), ctxt)\n    (*\n    /!\\ When adding new lazy storage kinds, be careful to use\n    [when allow_lazy_storage] /!\\\n    Lazy storage should not be packable to avoid stealing a lazy storage\n    from another contract with `PUSH t id` or `UNPACK`.\n  *)\n    | Prim (loc, T_big_map, args, annot) when allow_lazy_storage ->\n        (parse_big_map_ty [@tailcall]) ctxt ~stack_depth ~legacy loc args annot\n    | Prim (loc, T_sapling_state, [memo_size], annot) when allow_lazy_storage ->\n        parse_type_annot loc annot >>? fun annot ->\n        parse_memo_size memo_size >|? fun memo_size ->\n        (Ex_ty (sapling_state_t ~memo_size ~annot), ctxt)\n    | Prim (loc, (T_big_map | T_sapling_state), _, _) ->\n        error (Unexpected_lazy_storage loc)\n    | Prim\n        ( loc,\n          (( T_unit | T_signature | T_int | T_nat | T_string | T_bytes | T_mutez\n           | T_bool | T_key | T_key_hash | T_timestamp | T_address | T_chain_id\n           | T_operation | T_never ) as prim),\n          l,\n          _ ) ->\n        error (Invalid_arity (loc, prim, 0, List.length l))\n    | Prim\n        ( loc,\n          ((T_set | T_list | T_option | T_contract | T_ticket) as prim),\n          l,\n          _ ) ->\n        error (Invalid_arity (loc, prim, 1, List.length l))\n    | Prim (loc, ((T_pair | T_or | T_map | T_lambda) as prim), l, _) ->\n        error (Invalid_arity (loc, prim, 2, List.length l))\n    | expr ->\n        error\n        @@ unexpected\n             expr\n             []\n             Type_namespace\n             [\n               T_pair;\n               T_or;\n               T_set;\n               T_map;\n               T_list;\n               T_option;\n               T_lambda;\n               T_unit;\n               T_signature;\n               T_contract;\n               T_int;\n               T_nat;\n               T_operation;\n               T_string;\n               T_bytes;\n               T_mutez;\n               T_bool;\n               T_key;\n               T_key_hash;\n               T_timestamp;\n               T_chain_id;\n               T_never;\n               T_bls12_381_g1;\n               T_bls12_381_g2;\n               T_bls12_381_fr;\n               T_ticket;\n             ]\n\nand[@coq_axiom_with_reason \"complex mutually recursive definition\"] parse_big_map_ty\n    ctxt ~stack_depth ~legacy big_map_loc args map_annot =\n  Gas.consume ctxt Typecheck_costs.parse_type_cycle >>? fun ctxt ->\n  match args with\n  | [key_ty; value_ty] ->\n      parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt key_ty\n      >>? fun (Ex_comparable_ty key_ty, ctxt) ->\n      parse_big_map_value_ty\n        ctxt\n        ~stack_depth:(stack_depth + 1)\n        ~legacy\n        value_ty\n      >>? fun (Ex_ty value_ty, ctxt) ->\n      parse_type_annot big_map_loc map_annot >>? fun annot ->\n      big_map_t big_map_loc key_ty value_ty ~annot >|? fun big_map_ty ->\n      (Ex_ty big_map_ty, ctxt)\n  | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args)\n\nand[@coq_axiom_with_reason \"complex mutually recursive definition\"] parse_big_map_value_ty\n    ctxt ~stack_depth ~legacy value_ty =\n  (parse_ty [@tailcall])\n    ctxt\n    ~stack_depth\n    ~legacy\n    ~allow_lazy_storage:false\n    ~allow_operation:false\n    ~allow_contract:legacy\n    ~allow_ticket:true\n    value_ty\n\nlet parse_storage_ty :\n    context ->\n    stack_depth:int ->\n    legacy:bool ->\n    Script.node ->\n    (ex_ty * context) tzresult =\n fun ctxt ~stack_depth ~legacy node ->\n  match node with\n  | Prim\n      ( loc,\n        T_pair,\n        [Prim (big_map_loc, T_big_map, args, map_annot); remaining_storage],\n        storage_annot )\n    when legacy -> (\n      match storage_annot with\n      | [] ->\n          (parse_normal_storage_ty [@tailcall]) ctxt ~stack_depth ~legacy node\n      | [single]\n        when Compare.Int.(String.length single > 0)\n             && Compare.Char.(single.[0] = '%') ->\n          (parse_normal_storage_ty [@tailcall]) ctxt ~stack_depth ~legacy node\n      | _ ->\n          (* legacy semantics of big maps used the wrong annotation parser *)\n          Gas.consume ctxt Typecheck_costs.parse_type_cycle >>? fun ctxt ->\n          parse_big_map_ty\n            ctxt\n            ~stack_depth:(stack_depth + 1)\n            ~legacy\n            big_map_loc\n            args\n            map_annot\n          >>? fun (Ex_ty big_map_ty, ctxt) ->\n          parse_normal_storage_ty\n            ctxt\n            ~stack_depth:(stack_depth + 1)\n            ~legacy\n            remaining_storage\n          >>? fun (Ex_ty remaining_storage, ctxt) ->\n          parse_composed_type_annot loc storage_annot\n          >>? fun (annot, map_field, storage_field) ->\n          pair_t\n            loc\n            (big_map_ty, map_field, None)\n            (remaining_storage, storage_field, None)\n            ~annot\n          >|? fun ty -> (Ex_ty ty, ctxt))\n  | _ -> (parse_normal_storage_ty [@tailcall]) ctxt ~stack_depth ~legacy node\n\nlet check_packable ~legacy loc root =\n  let rec check : type t. t ty -> unit tzresult = function\n    (* /!\\ When adding new lazy storage kinds, be sure to return an error. /!\\\n       Lazy storage should not be packable. *)\n    | Big_map_t _ -> error (Unexpected_lazy_storage loc)\n    | Sapling_state_t _ -> error (Unexpected_lazy_storage loc)\n    | Operation_t _ -> error (Unexpected_operation loc)\n    | Unit_t _ -> Result.return_unit\n    | Int_t _ -> Result.return_unit\n    | Nat_t _ -> Result.return_unit\n    | Signature_t _ -> Result.return_unit\n    | String_t _ -> Result.return_unit\n    | Bytes_t _ -> Result.return_unit\n    | Mutez_t _ -> Result.return_unit\n    | Key_hash_t _ -> Result.return_unit\n    | Key_t _ -> Result.return_unit\n    | Timestamp_t _ -> Result.return_unit\n    | Address_t _ -> Result.return_unit\n    | Bool_t _ -> Result.return_unit\n    | Chain_id_t _ -> Result.return_unit\n    | Never_t _ -> Result.return_unit\n    | Set_t (_, _) -> Result.return_unit\n    | Ticket_t _ -> error (Unexpected_ticket loc)\n    | Lambda_t (_, _, _) -> Result.return_unit\n    | Bls12_381_g1_t _ -> Result.return_unit\n    | Bls12_381_g2_t _ -> Result.return_unit\n    | Bls12_381_fr_t _ -> Result.return_unit\n    | Pair_t ((l_ty, _, _), (r_ty, _, _), _) ->\n        check l_ty >>? fun () -> check r_ty\n    | Union_t ((l_ty, _), (r_ty, _), _) -> check l_ty >>? fun () -> check r_ty\n    | Option_t (v_ty, _) -> check v_ty\n    | List_t (elt_ty, _) -> check elt_ty\n    | Map_t (_, elt_ty, _) -> check elt_ty\n    | Contract_t (_, _) when legacy -> Result.return_unit\n    | Contract_t (_, _) -> error (Unexpected_contract loc)\n    | Sapling_transaction_t _ -> ok ()\n    | Chest_key_t _ -> Result.return_unit\n    | Chest_t _ -> Result.return_unit\n  in\n  check root\n\ntype toplevel = {\n  code_field : Script.node;\n  arg_type : Script.node;\n  storage_type : Script.node;\n  views : view SMap.t;\n  root_name : field_annot option;\n}\n\ntype ('arg, 'storage) code = {\n  code : (('arg, 'storage) pair, (operation boxed_list, 'storage) pair) lambda;\n  arg_type : 'arg ty;\n  storage_type : 'storage ty;\n  views : view SMap.t;\n  root_name : field_annot option;\n  code_size : Cache_memory_helpers.sint;\n}\n\ntype ex_script = Ex_script : ('a, 'c) script -> ex_script\n\ntype ex_code = Ex_code : ('a, 'c) code -> ex_code\n\ntype 'storage ex_view =\n  | Ex_view :\n      ('input * 'storage, 'output) Script_typed_ir.lambda\n      -> 'storage ex_view\n\ntype (_, _) dig_proof_argument =\n  | Dig_proof_argument :\n      ('x, 'a * 's, 'a, 's, 'b, 't, 'c, 'u) stack_prefix_preservation_witness\n      * 'x ty\n      * var_annot option\n      * ('c, 'u) stack_ty\n      -> ('b, 't) dig_proof_argument\n\ntype (_, _, _) dug_proof_argument =\n  | Dug_proof_argument :\n      (('a, 's, 'x, 'a * 's, 'b, 't, 'c, 'u) stack_prefix_preservation_witness\n      * ('c, 'u) stack_ty)\n      -> ('b, 't, 'x) dug_proof_argument\n\ntype (_, _) dipn_proof_argument =\n  | Dipn_proof_argument :\n      ('fa, 'fs, 'fb, 'fu, 'a, 's, 'b, 'u) stack_prefix_preservation_witness\n      * context\n      * ('fa, 'fs, 'fb, 'fu) descr\n      * ('b, 'u) stack_ty\n      -> ('a, 's) dipn_proof_argument\n\ntype (_, _) dropn_proof_argument =\n  | Dropn_proof_argument :\n      ('fa, 'fs, 'fa, 'fs, 'a, 's, 'a, 's) stack_prefix_preservation_witness\n      * ('fa, 'fs) stack_ty\n      -> ('a, 's) dropn_proof_argument\n\ntype 'before comb_proof_argument =\n  | Comb_proof_argument :\n      ('a * 's, 'b * 'u) comb_gadt_witness * ('b, 'u) stack_ty\n      -> ('a * 's) comb_proof_argument\n\ntype 'before uncomb_proof_argument =\n  | Uncomb_proof_argument :\n      ('a * 's, 'b * 'u) uncomb_gadt_witness * ('b, 'u) stack_ty\n      -> ('a * 's) uncomb_proof_argument\n\ntype 'before comb_get_proof_argument =\n  | Comb_get_proof_argument :\n      ('before, 'after) comb_get_gadt_witness * 'after ty\n      -> 'before comb_get_proof_argument\n\ntype ('rest, 'before) comb_set_proof_argument =\n  | Comb_set_proof_argument :\n      ('rest, 'before, 'after) comb_set_gadt_witness * 'after ty\n      -> ('rest, 'before) comb_set_proof_argument\n\ntype 'before dup_n_proof_argument =\n  | Dup_n_proof_argument :\n      ('before, 'a) dup_n_gadt_witness * 'a ty\n      -> 'before dup_n_proof_argument\n\nlet find_entrypoint (type full) (full : full ty) ~root_name entrypoint =\n  let annot_is_entrypoint entrypoint = function\n    | None -> false\n    | Some (Field_annot l) -> Compare.String.((l :> string) = entrypoint)\n  in\n  let loc = Micheline.dummy_location in\n  let rec find_entrypoint :\n      type t. t ty -> string -> ((Script.node -> Script.node) * ex_ty) option =\n   fun t entrypoint ->\n    match t with\n    | Union_t ((tl, al), (tr, ar), _) -> (\n        if annot_is_entrypoint entrypoint al then\n          Some ((fun e -> Prim (loc, D_Left, [e], [])), Ex_ty tl)\n        else if annot_is_entrypoint entrypoint ar then\n          Some ((fun e -> Prim (loc, D_Right, [e], [])), Ex_ty tr)\n        else\n          match find_entrypoint tl entrypoint with\n          | Some (f, t) -> Some ((fun e -> Prim (loc, D_Left, [f e], [])), t)\n          | None -> (\n              match find_entrypoint tr entrypoint with\n              | Some (f, t) ->\n                  Some ((fun e -> Prim (loc, D_Right, [f e], [])), t)\n              | None -> None))\n    | _ -> None\n  in\n  let entrypoint =\n    if Compare.String.(entrypoint = \"\") then \"default\" else entrypoint\n  in\n  if Compare.Int.(String.length entrypoint > 31) then\n    error (Entrypoint_name_too_long entrypoint)\n  else\n    match root_name with\n    | Some (Field_annot root_name)\n      when Compare.String.(entrypoint = (root_name :> string)) ->\n        ok ((fun e -> e), Ex_ty full)\n    | _ -> (\n        match find_entrypoint full entrypoint with\n        | Some result -> ok result\n        | None -> (\n            match entrypoint with\n            | \"default\" -> ok ((fun e -> e), Ex_ty full)\n            | _ -> error (No_such_entrypoint entrypoint)))\n\nlet find_entrypoint_for_type (type full exp) ~legacy ~merge_type_error_flag\n    ~(full : full ty) ~(expected : exp ty) ~root_name entrypoint loc :\n    (string * exp ty, error trace) Gas_monad.t =\n  let open Gas_monad in\n  match find_entrypoint full ~root_name entrypoint with\n  | Error _ as err -> of_result err\n  | Ok (_, Ex_ty ty) -> (\n      merge_types ~legacy ~merge_type_error_flag loc ty expected\n      >??$ fun eq_ty ->\n      match (entrypoint, root_name) with\n      | (\"default\", Some (Field_annot fa))\n        when Compare.String.((fa :> string) = \"root\") -> (\n          match eq_ty with\n          | Ok (Eq, ty) -> return (\"default\", (ty : exp ty))\n          | Error _ ->\n              merge_types ~legacy ~merge_type_error_flag loc full expected\n              >?$ fun (Eq, full) -> ok (\"root\", (full : exp ty)))\n      | _ -> of_result (eq_ty >|? fun (Eq, ty) -> (entrypoint, (ty : exp ty))))\n\nmodule Entrypoints = Set.Make (String)\n\nlet well_formed_entrypoints (type full) (full : full ty) ~root_name =\n  let merge path annot (type t) (ty : t ty) reachable\n      ((first_unreachable, all) as acc) =\n    match annot with\n    | None ->\n        ok\n          (if reachable then acc\n          else\n            match ty with\n            | Union_t _ -> acc\n            | _ -> (\n                match first_unreachable with\n                | None -> (Some (List.rev path), all)\n                | Some _ -> acc))\n    | Some (Field_annot name) ->\n        let name = (name :> string) in\n        if Compare.Int.(String.length name > 31) then\n          error (Entrypoint_name_too_long name)\n        else if Entrypoints.mem name all then error (Duplicate_entrypoint name)\n        else ok (first_unreachable, Entrypoints.add name all)\n  in\n  let rec check :\n      type t.\n      t ty ->\n      prim list ->\n      bool ->\n      prim list option * Entrypoints.t ->\n      (prim list option * Entrypoints.t) tzresult =\n   fun t path reachable acc ->\n    match t with\n    | Union_t ((tl, al), (tr, ar), _) ->\n        merge (D_Left :: path) al tl reachable acc >>? fun acc ->\n        merge (D_Right :: path) ar tr reachable acc >>? fun acc ->\n        check\n          tl\n          (D_Left :: path)\n          (match al with Some _ -> true | None -> reachable)\n          acc\n        >>? fun acc ->\n        check\n          tr\n          (D_Right :: path)\n          (match ar with Some _ -> true | None -> reachable)\n          acc\n    | _ -> ok acc\n  in\n  let (init, reachable) =\n    match root_name with\n    | None -> (Entrypoints.empty, false)\n    | Some (Field_annot name) -> (Entrypoints.singleton (name :> string), true)\n  in\n  check full [] reachable (None, init) >>? fun (first_unreachable, all) ->\n  if not (Entrypoints.mem \"default\" all) then Result.return_unit\n  else\n    match first_unreachable with\n    | None -> Result.return_unit\n    | Some path -> error (Unreachable_entrypoint path)\n\nlet parse_uint ~nb_bits =\n  assert (Compare.Int.(nb_bits >= 0 && nb_bits <= 30)) ;\n  let max_int = (1 lsl nb_bits) - 1 in\n  let max_z = Z.of_int max_int in\n  function\n  | Micheline.Int (_, n) when Compare.Z.(Z.zero <= n) && Compare.Z.(n <= max_z)\n    ->\n      ok (Z.to_int n)\n  | node ->\n      error\n      @@ Invalid_syntactic_constant\n           ( location node,\n             strip_locations node,\n             \"a positive \" ^ string_of_int nb_bits\n             ^ \"-bit integer (between 0 and \" ^ string_of_int max_int ^ \")\" )\n\nlet parse_uint10 = parse_uint ~nb_bits:10\n\nlet parse_uint11 = parse_uint ~nb_bits:11\n\n(* This type is used to:\n   - serialize and deserialize tickets when they are stored or transferred,\n   - type the READ_TICKET instruction. *)\nlet opened_ticket_type loc ty =\n  pair_3_key\n    loc\n    (address_key ~annot:None, None)\n    (ty, None)\n    (nat_key ~annot:None, None)\n\n(* -- parse data of primitive types -- *)\n\nlet parse_unit ctxt ~legacy = function\n  | Prim (loc, D_Unit, [], annot) ->\n      (if legacy then Result.return_unit else error_unexpected_annot loc annot)\n      >>? fun () ->\n      Gas.consume ctxt Typecheck_costs.unit >|? fun ctxt -> ((), ctxt)\n  | Prim (loc, D_Unit, l, _) ->\n      error @@ Invalid_arity (loc, D_Unit, 0, List.length l)\n  | expr -> error @@ unexpected expr [] Constant_namespace [D_Unit]\n\nlet parse_bool ctxt ~legacy = function\n  | Prim (loc, D_True, [], annot) ->\n      (if legacy then Result.return_unit else error_unexpected_annot loc annot)\n      >>? fun () ->\n      Gas.consume ctxt Typecheck_costs.bool >|? fun ctxt -> (true, ctxt)\n  | Prim (loc, D_False, [], annot) ->\n      (if legacy then Result.return_unit else error_unexpected_annot loc annot)\n      >>? fun () ->\n      Gas.consume ctxt Typecheck_costs.bool >|? fun ctxt -> (false, ctxt)\n  | Prim (loc, ((D_True | D_False) as c), l, _) ->\n      error @@ Invalid_arity (loc, c, 0, List.length l)\n  | expr -> error @@ unexpected expr [] Constant_namespace [D_True; D_False]\n\nlet parse_string ctxt : Script.node -> (Script_string.t * context) tzresult =\n  function\n  | String (loc, v) as expr ->\n      Gas.consume ctxt (Typecheck_costs.check_printable v) >>? fun ctxt ->\n      record_trace\n        (Invalid_syntactic_constant\n           (loc, strip_locations expr, \"a printable ascii string\"))\n        (Script_string.of_string v >|? fun s -> (s, ctxt))\n  | expr -> error @@ Invalid_kind (location expr, [String_kind], kind expr)\n\nlet parse_bytes ctxt = function\n  | Bytes (_, v) -> ok (v, ctxt)\n  | expr -> error @@ Invalid_kind (location expr, [Bytes_kind], kind expr)\n\nlet parse_int ctxt = function\n  | Int (_, v) -> ok (Script_int.of_zint v, ctxt)\n  | expr -> error @@ Invalid_kind (location expr, [Int_kind], kind expr)\n\nlet parse_nat ctxt :\n    Script.node -> (Script_int.n Script_int.num * context) tzresult = function\n  | Int (loc, v) as expr -> (\n      let v = Script_int.of_zint v in\n      match Script_int.is_nat v with\n      | Some nat -> ok (nat, ctxt)\n      | None ->\n          error\n          @@ Invalid_syntactic_constant\n               (loc, strip_locations expr, \"a non-negative integer\"))\n  | expr -> error @@ Invalid_kind (location expr, [Int_kind], kind expr)\n\nlet parse_mutez ctxt : Script.node -> (Tez.t * context) tzresult = function\n  | Int (loc, v) as expr -> (\n      match\n        let open Option in\n        bind (catch (fun () -> Z.to_int64 v)) Tez.of_mutez\n      with\n      | Some tez -> Ok (tez, ctxt)\n      | None ->\n          error\n          @@ Invalid_syntactic_constant\n               (loc, strip_locations expr, \"a valid mutez amount\"))\n  | expr -> error @@ Invalid_kind (location expr, [Int_kind], kind expr)\n\nlet parse_timestamp ctxt :\n    Script.node -> (Script_timestamp.t * context) tzresult = function\n  | Int (_, v) (* As unparsed with [Optimized] or out of bounds [Readable]. *)\n    ->\n      ok (Script_timestamp.of_zint v, ctxt)\n  | String (loc, s) as expr (* As unparsed with [Readable]. *) -> (\n      Gas.consume ctxt Typecheck_costs.timestamp_readable >>? fun ctxt ->\n      match Script_timestamp.of_string s with\n      | Some v -> ok (v, ctxt)\n      | None ->\n          error\n          @@ Invalid_syntactic_constant\n               (loc, strip_locations expr, \"a valid timestamp\"))\n  | expr ->\n      error @@ Invalid_kind (location expr, [String_kind; Int_kind], kind expr)\n\nlet parse_key ctxt : Script.node -> (public_key * context) tzresult = function\n  | Bytes (loc, bytes) as expr -> (\n      (* As unparsed with [Optimized]. *)\n      Gas.consume ctxt Typecheck_costs.public_key_optimized\n      >>? fun ctxt ->\n      match\n        Data_encoding.Binary.of_bytes_opt Signature.Public_key.encoding bytes\n      with\n      | Some k -> ok (k, ctxt)\n      | None ->\n          error\n          @@ Invalid_syntactic_constant\n               (loc, strip_locations expr, \"a valid public key\"))\n  | String (loc, s) as expr -> (\n      (* As unparsed with [Readable]. *)\n      Gas.consume ctxt Typecheck_costs.public_key_readable\n      >>? fun ctxt ->\n      match Signature.Public_key.of_b58check_opt s with\n      | Some k -> ok (k, ctxt)\n      | None ->\n          error\n          @@ Invalid_syntactic_constant\n               (loc, strip_locations expr, \"a valid public key\"))\n  | expr ->\n      error @@ Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)\n\nlet parse_key_hash ctxt : Script.node -> (public_key_hash * context) tzresult =\n  function\n  | Bytes (loc, bytes) as expr -> (\n      (* As unparsed with [Optimized]. *)\n      Gas.consume ctxt Typecheck_costs.key_hash_optimized\n      >>? fun ctxt ->\n      match\n        Data_encoding.Binary.of_bytes_opt\n          Signature.Public_key_hash.encoding\n          bytes\n      with\n      | Some k -> ok (k, ctxt)\n      | None ->\n          error\n          @@ Invalid_syntactic_constant\n               (loc, strip_locations expr, \"a valid key hash\"))\n  | String (loc, s) as expr (* As unparsed with [Readable]. *) -> (\n      Gas.consume ctxt Typecheck_costs.key_hash_readable >>? fun ctxt ->\n      match Signature.Public_key_hash.of_b58check_opt s with\n      | Some k -> ok (k, ctxt)\n      | None ->\n          error\n          @@ Invalid_syntactic_constant\n               (loc, strip_locations expr, \"a valid key hash\"))\n  | expr ->\n      error @@ Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)\n\nlet parse_signature ctxt : Script.node -> (signature * context) tzresult =\n  function\n  | Bytes (loc, bytes) as expr (* As unparsed with [Optimized]. *) -> (\n      Gas.consume ctxt Typecheck_costs.signature_optimized >>? fun ctxt ->\n      match Data_encoding.Binary.of_bytes_opt Signature.encoding bytes with\n      | Some k -> ok (k, ctxt)\n      | None ->\n          error\n          @@ Invalid_syntactic_constant\n               (loc, strip_locations expr, \"a valid signature\"))\n  | String (loc, s) as expr (* As unparsed with [Readable]. *) -> (\n      Gas.consume ctxt Typecheck_costs.signature_readable >>? fun ctxt ->\n      match Signature.of_b58check_opt s with\n      | Some s -> ok (s, ctxt)\n      | None ->\n          error\n          @@ Invalid_syntactic_constant\n               (loc, strip_locations expr, \"a valid signature\"))\n  | expr ->\n      error @@ Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)\n\nlet parse_chain_id ctxt : Script.node -> (Chain_id.t * context) tzresult =\n  function\n  | Bytes (loc, bytes) as expr -> (\n      Gas.consume ctxt Typecheck_costs.chain_id_optimized >>? fun ctxt ->\n      match Data_encoding.Binary.of_bytes_opt Chain_id.encoding bytes with\n      | Some k -> ok (k, ctxt)\n      | None ->\n          error\n          @@ Invalid_syntactic_constant\n               (loc, strip_locations expr, \"a valid chain id\"))\n  | String (loc, s) as expr -> (\n      Gas.consume ctxt Typecheck_costs.chain_id_readable >>? fun ctxt ->\n      match Chain_id.of_b58check_opt s with\n      | Some s -> ok (s, ctxt)\n      | None ->\n          error\n          @@ Invalid_syntactic_constant\n               (loc, strip_locations expr, \"a valid chain id\"))\n  | expr ->\n      error @@ Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)\n\nlet parse_address ctxt : Script.node -> (address * context) tzresult = function\n  | Bytes (loc, bytes) as expr (* As unparsed with [Optimized]. *) -> (\n      Gas.consume ctxt Typecheck_costs.contract >>? fun ctxt ->\n      match\n        Data_encoding.Binary.of_bytes_opt\n          Data_encoding.(tup2 Contract.encoding Variable.string)\n          bytes\n      with\n      | Some (c, entrypoint) -> (\n          if Compare.Int.(String.length entrypoint > 31) then\n            error (Entrypoint_name_too_long entrypoint)\n          else\n            match entrypoint with\n            | \"\" -> ok ((c, \"default\"), ctxt)\n            | \"default\" -> error (Unexpected_annotation loc)\n            | name -> ok ((c, name), ctxt))\n      | None ->\n          error\n          @@ Invalid_syntactic_constant\n               (loc, strip_locations expr, \"a valid address\"))\n  | String (loc, s) (* As unparsed with [Readable]. *) ->\n      Gas.consume ctxt Typecheck_costs.contract >>? fun ctxt ->\n      (match String.index_opt s '%' with\n      | None -> ok (s, \"default\")\n      | Some pos -> (\n          let len = String.length s - pos - 1 in\n          let name = String.sub s (pos + 1) len in\n          if Compare.Int.(len > 31) then error (Entrypoint_name_too_long name)\n          else\n            match (String.sub s 0 pos, name) with\n            | (addr, \"\") -> ok (addr, \"default\")\n            | (_, \"default\") -> error @@ Unexpected_annotation loc\n            | addr_and_name -> ok addr_and_name))\n      >>? fun (addr, entrypoint) ->\n      Contract.of_b58check addr >|? fun c -> ((c, entrypoint), ctxt)\n  | expr ->\n      error @@ Invalid_kind (location expr, [String_kind; Bytes_kind], kind expr)\n\nlet parse_never expr : (never * context) tzresult =\n  error @@ Invalid_never_expr (location expr)\n\n(* -- parse data of complex types -- *)\n\nlet parse_pair (type r) parse_l parse_r ctxt ~legacy\n    (r_comb_witness : (r, unit -> _) comb_witness) expr =\n  let parse_comb loc l rs =\n    parse_l ctxt l >>=? fun (l, ctxt) ->\n    (match (rs, r_comb_witness) with\n    | ([r], _) -> ok r\n    | ([], _) -> error @@ Invalid_arity (loc, D_Pair, 2, 1)\n    | (_ :: _, Comb_Pair _) ->\n        (* Unfold [Pair x1 ... xn] as [Pair x1 (Pair x2 ... xn-1 xn))]\n           for type [pair ta (pair tb1 tb2)] and n >= 3 only *)\n        ok (Prim (loc, D_Pair, rs, []))\n    | _ -> error @@ Invalid_arity (loc, D_Pair, 2, 1 + List.length rs))\n    >>?= fun r ->\n    parse_r ctxt r >|=? fun (r, ctxt) -> ((l, r), ctxt)\n  in\n  match expr with\n  | Prim (loc, D_Pair, l :: rs, annot) ->\n      (if legacy then Result.return_unit else error_unexpected_annot loc annot)\n      >>?= fun () -> parse_comb loc l rs\n  | Prim (loc, D_Pair, l, _) ->\n      fail @@ Invalid_arity (loc, D_Pair, 2, List.length l)\n  (* Unfold [{x1; ...; xn}] as [Pair x1 x2 ... xn-1 xn] for n >= 2 *)\n  | Seq (loc, l :: (_ :: _ as rs)) -> parse_comb loc l rs\n  | Seq (loc, l) -> fail @@ Invalid_seq_arity (loc, 2, List.length l)\n  | expr -> fail @@ unexpected expr [] Constant_namespace [D_Pair]\n\nlet parse_union parse_l parse_r ctxt ~legacy = function\n  | Prim (loc, D_Left, [v], annot) ->\n      (if legacy then Result.return_unit else error_unexpected_annot loc annot)\n      >>?= fun () ->\n      parse_l ctxt v >|=? fun (v, ctxt) -> (L v, ctxt)\n  | Prim (loc, D_Left, l, _) ->\n      fail @@ Invalid_arity (loc, D_Left, 1, List.length l)\n  | Prim (loc, D_Right, [v], annot) ->\n      (if legacy then Result.return_unit else error_unexpected_annot loc annot)\n      >>?= fun () ->\n      parse_r ctxt v >|=? fun (v, ctxt) -> (R v, ctxt)\n  | Prim (loc, D_Right, l, _) ->\n      fail @@ Invalid_arity (loc, D_Right, 1, List.length l)\n  | expr -> fail @@ unexpected expr [] Constant_namespace [D_Left; D_Right]\n\nlet parse_option parse_v ctxt ~legacy = function\n  | Prim (loc, D_Some, [v], annot) ->\n      (if legacy then Result.return_unit else error_unexpected_annot loc annot)\n      >>?= fun () ->\n      parse_v ctxt v >|=? fun (v, ctxt) -> (Some v, ctxt)\n  | Prim (loc, D_Some, l, _) ->\n      fail @@ Invalid_arity (loc, D_Some, 1, List.length l)\n  | Prim (loc, D_None, [], annot) ->\n      Lwt.return\n        ( (if legacy then Result.return_unit\n          else error_unexpected_annot loc annot)\n        >|? fun () -> (None, ctxt) )\n  | Prim (loc, D_None, l, _) ->\n      fail @@ Invalid_arity (loc, D_None, 0, List.length l)\n  | expr -> fail @@ unexpected expr [] Constant_namespace [D_Some; D_None]\n\n(* -- parse data of comparable types -- *)\n\nlet comparable_comb_witness1 :\n    type t. t comparable_ty -> (t, unit -> unit) comb_witness = function\n  | Pair_key _ -> Comb_Pair Comb_Any\n  | _ -> Comb_Any\n\nlet[@coq_axiom_with_reason \"gadt\"] rec parse_comparable_data :\n    type a.\n    ?type_logger:type_logger ->\n    context ->\n    a comparable_ty ->\n    Script.node ->\n    (a * context) tzresult Lwt.t =\n fun ?type_logger ctxt ty script_data ->\n  (* No need for stack_depth here. Unlike [parse_data],\n     [parse_comparable_data] doesn't call [parse_returning].\n     The stack depth is bounded by the type depth, bounded by 1024. *)\n  let parse_data_error () =\n    let ty = serialize_ty_for_error (ty_of_comparable_ty ty) in\n    Invalid_constant (location script_data, strip_locations script_data, ty)\n  in\n  let traced_no_lwt body = record_trace_eval parse_data_error body in\n  let traced body = trace_eval parse_data_error body in\n  Gas.consume ctxt Typecheck_costs.parse_data_cycle\n  (* We could have a smaller cost but let's keep it consistent with\n     [parse_data] for now. *)\n  >>?=\n  fun ctxt ->\n  let legacy = false in\n  match (ty, script_data) with\n  | (Unit_key _, expr) ->\n      Lwt.return @@ traced_no_lwt\n      @@ (parse_unit ctxt ~legacy expr : (a * context) tzresult)\n  | (Bool_key _, expr) ->\n      Lwt.return @@ traced_no_lwt @@ parse_bool ctxt ~legacy expr\n  | (String_key _, expr) ->\n      Lwt.return @@ traced_no_lwt @@ parse_string ctxt expr\n  | (Bytes_key _, expr) -> Lwt.return @@ traced_no_lwt @@ parse_bytes ctxt expr\n  | (Int_key _, expr) -> Lwt.return @@ traced_no_lwt @@ parse_int ctxt expr\n  | (Nat_key _, expr) -> Lwt.return @@ traced_no_lwt @@ parse_nat ctxt expr\n  | (Mutez_key _, expr) -> Lwt.return @@ traced_no_lwt @@ parse_mutez ctxt expr\n  | (Timestamp_key _, expr) ->\n      Lwt.return @@ traced_no_lwt @@ parse_timestamp ctxt expr\n  | (Key_key _, expr) -> Lwt.return @@ traced_no_lwt @@ parse_key ctxt expr\n  | (Key_hash_key _, expr) ->\n      Lwt.return @@ traced_no_lwt @@ parse_key_hash ctxt expr\n  | (Signature_key _, expr) ->\n      Lwt.return @@ traced_no_lwt @@ parse_signature ctxt expr\n  | (Chain_id_key _, expr) ->\n      Lwt.return @@ traced_no_lwt @@ parse_chain_id ctxt expr\n  | (Address_key _, expr) ->\n      Lwt.return @@ traced_no_lwt @@ parse_address ctxt expr\n  | (Pair_key ((tl, _), (tr, _), _), expr) ->\n      let r_witness = comparable_comb_witness1 tr in\n      let parse_l ctxt v = parse_comparable_data ?type_logger ctxt tl v in\n      let parse_r ctxt v = parse_comparable_data ?type_logger ctxt tr v in\n      traced @@ parse_pair parse_l parse_r ctxt ~legacy r_witness expr\n  | (Union_key ((tl, _), (tr, _), _), expr) ->\n      let parse_l ctxt v = parse_comparable_data ?type_logger ctxt tl v in\n      let parse_r ctxt v = parse_comparable_data ?type_logger ctxt tr v in\n      traced @@ parse_union parse_l parse_r ctxt ~legacy expr\n  | (Option_key (t, _), expr) ->\n      let parse_v ctxt v = parse_comparable_data ?type_logger ctxt t v in\n      traced @@ parse_option parse_v ctxt ~legacy expr\n  | (Never_key _, expr) -> Lwt.return @@ traced_no_lwt @@ parse_never expr\n\n(* -- parse data of any type -- *)\n\nlet comb_witness1 : type t. t ty -> (t, unit -> unit) comb_witness = function\n  | Pair_t _ -> Comb_Pair Comb_Any\n  | _ -> Comb_Any\n\n(*\n  Some values, such as operations, tickets, or big map ids, are used only\n  internally and are not allowed to be forged by users.\n  In [parse_data], [allow_forged] should be [false] for:\n  - PUSH\n  - UNPACK\n  - user-provided script parameters\n  - storage on origination\n  And [true] for:\n  - internal calls parameters\n  - storage after origination\n*)\n\nlet[@coq_axiom_with_reason \"gadt\"] rec parse_data :\n    type a.\n    ?type_logger:type_logger ->\n    stack_depth:int ->\n    context ->\n    legacy:bool ->\n    allow_forged:bool ->\n    a ty ->\n    Script.node ->\n    (a * context) tzresult Lwt.t =\n fun ?type_logger ~stack_depth ctxt ~legacy ~allow_forged ty script_data ->\n  Gas.consume ctxt Typecheck_costs.parse_data_cycle >>?= fun ctxt ->\n  let non_terminal_recursion ?type_logger ctxt ~legacy ty script_data =\n    if Compare.Int.(stack_depth > 10_000) then\n      fail Typechecking_too_many_recursive_calls\n    else\n      parse_data\n        ?type_logger\n        ~stack_depth:(stack_depth + 1)\n        ctxt\n        ~legacy\n        ~allow_forged\n        ty\n        script_data\n  in\n  let parse_data_error () =\n    let ty = serialize_ty_for_error ty in\n    Invalid_constant (location script_data, strip_locations script_data, ty)\n  in\n  let fail_parse_data () = fail (parse_data_error ()) in\n  let traced_no_lwt body = record_trace_eval parse_data_error body in\n  let traced body = trace_eval parse_data_error body in\n  let traced_fail err = Lwt.return @@ traced_no_lwt (error err) in\n  let parse_items ?type_logger ctxt expr key_type value_type items item_wrapper\n      =\n    List.fold_left_es\n      (fun (last_value, map, ctxt) item ->\n        match item with\n        | Prim (loc, D_Elt, [k; v], annot) ->\n            (if legacy then Result.return_unit\n            else error_unexpected_annot loc annot)\n            >>?= fun () ->\n            parse_comparable_data ?type_logger ctxt key_type k\n            >>=? fun (k, ctxt) ->\n            non_terminal_recursion ?type_logger ctxt ~legacy value_type v\n            >>=? fun (v, ctxt) ->\n            Lwt.return\n              ( (match last_value with\n                | Some value ->\n                    Gas.consume\n                      ctxt\n                      (Michelson_v1_gas.Cost_of.Interpreter.compare\n                         key_type\n                         value\n                         k)\n                    >>? fun ctxt ->\n                    let c =\n                      Script_comparable.compare_comparable key_type value k\n                    in\n                    if Compare.Int.(0 <= c) then\n                      if Compare.Int.(0 = c) then\n                        error (Duplicate_map_keys (loc, strip_locations expr))\n                      else\n                        error (Unordered_map_keys (loc, strip_locations expr))\n                    else ok ctxt\n                | None -> ok ctxt)\n              >>? fun ctxt ->\n                Gas.consume\n                  ctxt\n                  (Michelson_v1_gas.Cost_of.Interpreter.map_update k map)\n                >|? fun ctxt ->\n                (Some k, Script_map.update k (Some (item_wrapper v)) map, ctxt)\n              )\n        | Prim (loc, D_Elt, l, _) ->\n            fail @@ Invalid_arity (loc, D_Elt, 2, List.length l)\n        | Prim (loc, name, _, _) ->\n            fail @@ Invalid_primitive (loc, [D_Elt], name)\n        | Int _ | String _ | Bytes _ | Seq _ -> fail_parse_data ())\n      (None, Script_map.empty key_type, ctxt)\n      items\n    |> traced\n    >|=? fun (_, items, ctxt) -> (items, ctxt)\n  in\n  let parse_big_map_items (type t) ?type_logger ctxt expr\n      (key_type : t comparable_ty) value_type items item_wrapper =\n    List.fold_left_es\n      (fun (last_key, {map; size}, ctxt) item ->\n        match item with\n        | Prim (loc, D_Elt, [k; v], annot) ->\n            (if legacy then Result.return_unit\n            else error_unexpected_annot loc annot)\n            >>?= fun () ->\n            parse_comparable_data ?type_logger ctxt key_type k\n            >>=? fun (k, ctxt) ->\n            hash_comparable_data ctxt key_type k >>=? fun (key_hash, ctxt) ->\n            non_terminal_recursion ?type_logger ctxt ~legacy value_type v\n            >>=? fun (v, ctxt) ->\n            Lwt.return\n              ( (match last_key with\n                | Some last_key ->\n                    Gas.consume\n                      ctxt\n                      (Michelson_v1_gas.Cost_of.Interpreter.compare\n                         key_type\n                         last_key\n                         k)\n                    >>? fun ctxt ->\n                    let c =\n                      Script_comparable.compare_comparable key_type last_key k\n                    in\n                    if Compare.Int.(0 <= c) then\n                      if Compare.Int.(0 = c) then\n                        error (Duplicate_map_keys (loc, strip_locations expr))\n                      else\n                        error (Unordered_map_keys (loc, strip_locations expr))\n                    else ok ctxt\n                | None -> ok ctxt)\n              >>? fun ctxt ->\n                Gas.consume\n                  ctxt\n                  (Michelson_v1_gas.Cost_of.Interpreter.big_map_update\n                     {map; size})\n                >>? fun ctxt ->\n                if Big_map_overlay.mem key_hash map then\n                  error (Duplicate_map_keys (loc, strip_locations expr))\n                else\n                  ok\n                    ( Some k,\n                      {\n                        map =\n                          Big_map_overlay.add key_hash (k, item_wrapper v) map;\n                        size = size + 1;\n                      },\n                      ctxt ) )\n        | Prim (loc, D_Elt, l, _) ->\n            fail @@ Invalid_arity (loc, D_Elt, 2, List.length l)\n        | Prim (loc, name, _, _) ->\n            fail @@ Invalid_primitive (loc, [D_Elt], name)\n        | Int _ | String _ | Bytes _ | Seq _ -> fail_parse_data ())\n      (None, {map = Big_map_overlay.empty; size = 0}, ctxt)\n      items\n    |> traced\n    >|=? fun (_, map, ctxt) -> (map, ctxt)\n  in\n  match (ty, script_data) with\n  | (Unit_t _, expr) ->\n      Lwt.return @@ traced_no_lwt\n      @@ (parse_unit ctxt ~legacy expr : (a * context) tzresult)\n  | (Bool_t _, expr) ->\n      Lwt.return @@ traced_no_lwt @@ parse_bool ctxt ~legacy expr\n  | (String_t _, expr) -> Lwt.return @@ traced_no_lwt @@ parse_string ctxt expr\n  | (Bytes_t _, expr) -> Lwt.return @@ traced_no_lwt @@ parse_bytes ctxt expr\n  | (Int_t _, expr) -> Lwt.return @@ traced_no_lwt @@ parse_int ctxt expr\n  | (Nat_t _, expr) -> Lwt.return @@ traced_no_lwt @@ parse_nat ctxt expr\n  | (Mutez_t _, expr) -> Lwt.return @@ traced_no_lwt @@ parse_mutez ctxt expr\n  | (Timestamp_t _, expr) ->\n      Lwt.return @@ traced_no_lwt @@ parse_timestamp ctxt expr\n  | (Key_t _, expr) -> Lwt.return @@ traced_no_lwt @@ parse_key ctxt expr\n  | (Key_hash_t _, expr) ->\n      Lwt.return @@ traced_no_lwt @@ parse_key_hash ctxt expr\n  | (Signature_t _, expr) ->\n      Lwt.return @@ traced_no_lwt @@ parse_signature ctxt expr\n  | (Operation_t _, _) ->\n      (* operations cannot appear in parameters or storage,\n         the protocol should never parse the bytes of an operation *)\n      assert false\n  | (Chain_id_t _, expr) ->\n      Lwt.return @@ traced_no_lwt @@ parse_chain_id ctxt expr\n  | (Address_t _, expr) ->\n      Lwt.return @@ traced_no_lwt @@ parse_address ctxt expr\n  | (Contract_t (ty, _), expr) ->\n      traced\n        ( parse_address ctxt expr >>?= fun ((c, entrypoint), ctxt) ->\n          let loc = location expr in\n          parse_contract\n            ~stack_depth:(stack_depth + 1)\n            ~legacy\n            ctxt\n            loc\n            ty\n            c\n            ~entrypoint\n          >|=? fun (ctxt, _) -> ((ty, (c, entrypoint)), ctxt) )\n  (* Pairs *)\n  | (Pair_t ((tl, _, _), (tr, _, _), _), expr) ->\n      let r_witness = comb_witness1 tr in\n      let parse_l ctxt v =\n        non_terminal_recursion ?type_logger ctxt ~legacy tl v\n      in\n      let parse_r ctxt v =\n        non_terminal_recursion ?type_logger ctxt ~legacy tr v\n      in\n      traced @@ parse_pair parse_l parse_r ctxt ~legacy r_witness expr\n  (* Unions *)\n  | (Union_t ((tl, _), (tr, _), _), expr) ->\n      let parse_l ctxt v =\n        non_terminal_recursion ?type_logger ctxt ~legacy tl v\n      in\n      let parse_r ctxt v =\n        non_terminal_recursion ?type_logger ctxt ~legacy tr v\n      in\n      traced @@ parse_union parse_l parse_r ctxt ~legacy expr\n  (* Lambdas *)\n  | (Lambda_t (ta, tr, _ty_name), (Seq (_loc, _) as script_instr)) ->\n      traced\n      @@ parse_returning\n           Lambda\n           ?type_logger\n           ~stack_depth:(stack_depth + 1)\n           ctxt\n           ~legacy\n           (ta, lambda_arg_annot)\n           tr\n           script_instr\n  | (Lambda_t _, expr) ->\n      traced_fail (Invalid_kind (location expr, [Seq_kind], kind expr))\n  (* Options *)\n  | (Option_t (t, _), expr) ->\n      let parse_v ctxt v =\n        non_terminal_recursion ?type_logger ctxt ~legacy t v\n      in\n      traced @@ parse_option parse_v ctxt ~legacy expr\n  (* Lists *)\n  | (List_t (t, _ty_name), Seq (_loc, items)) ->\n      traced\n      @@ List.fold_right_es\n           (fun v (rest, ctxt) ->\n             non_terminal_recursion ?type_logger ctxt ~legacy t v\n             >|=? fun (v, ctxt) -> (Script_list.cons v rest, ctxt))\n           items\n           (Script_list.empty, ctxt)\n  | (List_t _, expr) ->\n      traced_fail (Invalid_kind (location expr, [Seq_kind], kind expr))\n  (* Tickets *)\n  | (Ticket_t (t, _ty_name), expr) ->\n      if allow_forged then\n        opened_ticket_type (location expr) t >>?= fun ty ->\n        parse_comparable_data ?type_logger ctxt ty expr\n        >|=? fun (((ticketer, _entrypoint), (contents, amount)), ctxt) ->\n        ({ticketer; contents; amount}, ctxt)\n      else traced_fail (Unexpected_forged_value (location expr))\n  (* Sets *)\n  | (Set_t (t, _ty_name), (Seq (loc, vs) as expr)) ->\n      traced\n      @@ List.fold_left_es\n           (fun (last_value, set, ctxt) v ->\n             parse_comparable_data ?type_logger ctxt t v >>=? fun (v, ctxt) ->\n             Lwt.return\n               ( (match last_value with\n                 | Some value ->\n                     Gas.consume\n                       ctxt\n                       (Michelson_v1_gas.Cost_of.Interpreter.compare t value v)\n                     >>? fun ctxt ->\n                     let c = Script_comparable.compare_comparable t value v in\n                     if Compare.Int.(0 <= c) then\n                       if Compare.Int.(0 = c) then\n                         error\n                           (Duplicate_set_values (loc, strip_locations expr))\n                       else\n                         error\n                           (Unordered_set_values (loc, strip_locations expr))\n                     else ok ctxt\n                 | None -> ok ctxt)\n               >>? fun ctxt ->\n                 Gas.consume\n                   ctxt\n                   (Michelson_v1_gas.Cost_of.Interpreter.set_update v set)\n                 >|? fun ctxt -> (Some v, Script_set.update v true set, ctxt) ))\n           (None, Script_set.empty t, ctxt)\n           vs\n      >|=? fun (_, set, ctxt) -> (set, ctxt)\n  | (Set_t _, expr) ->\n      traced_fail (Invalid_kind (location expr, [Seq_kind], kind expr))\n  (* Maps *)\n  | (Map_t (tk, tv, _ty_name), (Seq (_, vs) as expr)) ->\n      parse_items ?type_logger ctxt expr tk tv vs (fun x -> x)\n  | (Map_t _, expr) ->\n      traced_fail (Invalid_kind (location expr, [Seq_kind], kind expr))\n  | (Big_map_t (tk, tv, _ty_name), expr) ->\n      (match expr with\n      | Int (loc, id) ->\n          return (Some (id, loc), {map = Big_map_overlay.empty; size = 0}, ctxt)\n      | Seq (_, vs) ->\n          parse_big_map_items ?type_logger ctxt expr tk tv vs (fun x -> Some x)\n          >|=? fun (diff, ctxt) -> (None, diff, ctxt)\n      | Prim (loc, D_Pair, [Int (loc_id, id); Seq (_, vs)], annot) ->\n          error_unexpected_annot loc annot >>?= fun () ->\n          option_t loc tv ~annot:None >>?= fun tv_opt ->\n          parse_big_map_items ?type_logger ctxt expr tk tv_opt vs (fun x -> x)\n          >|=? fun (diff, ctxt) -> (Some (id, loc_id), diff, ctxt)\n      | Prim (_, D_Pair, [Int _; expr], _) ->\n          traced_fail (Invalid_kind (location expr, [Seq_kind], kind expr))\n      | Prim (_, D_Pair, [expr; _], _) ->\n          traced_fail (Invalid_kind (location expr, [Int_kind], kind expr))\n      | Prim (loc, D_Pair, l, _) ->\n          traced_fail @@ Invalid_arity (loc, D_Pair, 2, List.length l)\n      | _ ->\n          traced_fail\n            (unexpected expr [Seq_kind; Int_kind] Constant_namespace [D_Pair]))\n      >>=? fun (id_opt, diff, ctxt) ->\n      (match id_opt with\n      | None -> return @@ (None, ctxt)\n      | Some (id, loc) ->\n          if allow_forged then\n            let id = Big_map.Id.parse_z id in\n            Big_map.exists ctxt id >>=? function\n            | (_, None) -> traced_fail (Invalid_big_map (loc, id))\n            | (ctxt, Some (btk, btv)) ->\n                Lwt.return\n                  ( parse_comparable_ty\n                      ~stack_depth:(stack_depth + 1)\n                      ctxt\n                      (Micheline.root btk)\n                  >>? fun (Ex_comparable_ty btk, ctxt) ->\n                    parse_big_map_value_ty\n                      ctxt\n                      ~stack_depth:(stack_depth + 1)\n                      ~legacy\n                      (Micheline.root btv)\n                    >>? fun (Ex_ty btv, ctxt) ->\n                    comparable_ty_eq ctxt tk btk >>? fun (Eq, ctxt) ->\n                    ty_eq ~legacy:true ctxt loc tv btv >>? fun (Eq, ctxt) ->\n                    ok (Some id, ctxt) )\n          else traced_fail (Unexpected_forged_value loc))\n      >|=? fun (id, ctxt) -> ({id; diff; key_type = tk; value_type = tv}, ctxt)\n  | (Never_t _, expr) -> Lwt.return @@ traced_no_lwt @@ parse_never expr\n  (* Bls12_381 types *)\n  | (Bls12_381_g1_t _, Bytes (_, bs)) -> (\n      Gas.consume ctxt Typecheck_costs.bls12_381_g1 >>?= fun ctxt ->\n      match Bls12_381.G1.of_bytes_opt bs with\n      | Some pt -> return (pt, ctxt)\n      | None -> fail_parse_data ())\n  | (Bls12_381_g1_t _, expr) ->\n      traced_fail (Invalid_kind (location expr, [Bytes_kind], kind expr))\n  | (Bls12_381_g2_t _, Bytes (_, bs)) -> (\n      Gas.consume ctxt Typecheck_costs.bls12_381_g2 >>?= fun ctxt ->\n      match Bls12_381.G2.of_bytes_opt bs with\n      | Some pt -> return (pt, ctxt)\n      | None -> fail_parse_data ())\n  | (Bls12_381_g2_t _, expr) ->\n      traced_fail (Invalid_kind (location expr, [Bytes_kind], kind expr))\n  | (Bls12_381_fr_t _, Bytes (_, bs)) -> (\n      Gas.consume ctxt Typecheck_costs.bls12_381_fr >>?= fun ctxt ->\n      match Bls12_381.Fr.of_bytes_opt bs with\n      | Some pt -> return (pt, ctxt)\n      | None -> fail_parse_data ())\n  | (Bls12_381_fr_t _, Int (_, v)) ->\n      Gas.consume ctxt Typecheck_costs.bls12_381_fr >>?= fun ctxt ->\n      return (Bls12_381.Fr.of_z v, ctxt)\n  | (Bls12_381_fr_t _, expr) ->\n      traced_fail (Invalid_kind (location expr, [Bytes_kind], kind expr))\n  (*\n    /!\\ When adding new lazy storage kinds, you may want to guard the parsing\n    of identifiers with [allow_forged].\n  *)\n  (* Sapling *)\n  | (Sapling_transaction_t (memo_size, _), Bytes (_, bytes)) -> (\n      match\n        Data_encoding.Binary.of_bytes_opt Sapling.transaction_encoding bytes\n      with\n      | Some transaction -> (\n          match Sapling.transaction_get_memo_size transaction with\n          | None -> return (transaction, ctxt)\n          | Some transac_memo_size ->\n              Lwt.return\n                ( merge_memo_sizes memo_size transac_memo_size >|? fun _ms ->\n                  (transaction, ctxt) ))\n      | None -> fail_parse_data ())\n  | (Sapling_transaction_t _, expr) ->\n      traced_fail (Invalid_kind (location expr, [Bytes_kind], kind expr))\n  | (Sapling_state_t (memo_size, _), Int (loc, id)) ->\n      if allow_forged then\n        let id = Sapling.Id.parse_z id in\n        Sapling.state_from_id ctxt id >>=? fun (state, ctxt) ->\n        Lwt.return\n          ( traced_no_lwt @@ merge_memo_sizes memo_size state.Sapling.memo_size\n          >|? fun _memo_size -> (state, ctxt) )\n      else traced_fail (Unexpected_forged_value loc)\n  | (Sapling_state_t (memo_size, _), Seq (_, [])) ->\n      return (Sapling.empty_state ~memo_size (), ctxt)\n  | (Sapling_state_t _, expr) ->\n      (* Do not allow to input diffs as they are untrusted and may not be the\n         result of a verify_update. *)\n      traced_fail\n        (Invalid_kind (location expr, [Int_kind; Seq_kind], kind expr))\n  (* Time lock*)\n  | (Chest_key_t _, Bytes (_, bytes)) -> (\n      Gas.consume ctxt Typecheck_costs.chest_key >>?= fun ctxt ->\n      match\n        Data_encoding.Binary.of_bytes_opt Timelock.chest_key_encoding bytes\n      with\n      | Some chest_key -> return (chest_key, ctxt)\n      | None -> fail_parse_data ())\n  | (Chest_key_t _, expr) ->\n      traced_fail (Invalid_kind (location expr, [Bytes_kind], kind expr))\n  | (Chest_t _, Bytes (_, bytes)) -> (\n      Gas.consume ctxt (Typecheck_costs.chest ~bytes:(Bytes.length bytes))\n      >>?= fun ctxt ->\n      match Data_encoding.Binary.of_bytes_opt Timelock.chest_encoding bytes with\n      | Some chest -> return (chest, ctxt)\n      | None -> fail_parse_data ())\n  | (Chest_t _, expr) ->\n      traced_fail (Invalid_kind (location expr, [Bytes_kind], kind expr))\n\nand parse_view_returning :\n    type storage.\n    ?type_logger:type_logger ->\n    context ->\n    legacy:bool ->\n    storage ty ->\n    view ->\n    (storage ex_view * context) tzresult Lwt.t =\n fun ?type_logger ctxt ~legacy storage_type {input_ty; output_ty; view_code} ->\n  let input_ty_loc = location input_ty in\n  record_trace_eval\n    (fun () ->\n      Ill_formed_type\n        (Some \"arg of view\", strip_locations input_ty, input_ty_loc))\n    (parse_view_input_ty ctxt ~stack_depth:0 ~legacy input_ty)\n  >>?= fun (Ex_ty input_ty', ctxt) ->\n  let output_ty_loc = location output_ty in\n  record_trace_eval\n    (fun () ->\n      Ill_formed_type\n        (Some \"return of view\", strip_locations output_ty, output_ty_loc))\n    (parse_view_output_ty ctxt ~stack_depth:0 ~legacy output_ty)\n  >>?= fun (Ex_ty output_ty', ctxt) ->\n  pair_t\n    input_ty_loc\n    (input_ty', None, None)\n    (storage_type, None, None)\n    ~annot:None\n  >>?= fun pair_ty ->\n  parse_instr\n    ?type_logger\n    ~stack_depth:0\n    Lambda\n    ctxt\n    ~legacy\n    view_code\n    (Item_t (pair_ty, Bot_t, None))\n  >>=? fun (judgement, ctxt) ->\n  Lwt.return\n  @@\n  match judgement with\n  | Failed {descr} ->\n      let cur_view' =\n        Ex_view\n          (Lam\n             (close_descr (descr (Item_t (output_ty', Bot_t, None))), view_code))\n      in\n      ok (cur_view', ctxt)\n  | Typed ({loc; aft; _} as descr) -> (\n      let ill_type_view loc stack_ty () =\n        let actual = serialize_stack_for_error ctxt stack_ty in\n        let expected_stack = Item_t (output_ty', Bot_t, None) in\n        let expected = serialize_stack_for_error ctxt expected_stack in\n        Ill_typed_view {loc; actual; expected}\n      in\n      match aft with\n      | Item_t (ty, Bot_t, _) ->\n          record_trace_eval\n            (ill_type_view loc aft : unit -> _)\n            ( ty_eq ~legacy ctxt loc ty output_ty' >|? fun (Eq, ctxt) ->\n              let view' = Ex_view (Lam (close_descr descr, view_code)) in\n              (view', ctxt) )\n      | _ -> error (ill_type_view loc aft ()))\n\nand typecheck_views :\n    type storage.\n    ?type_logger:type_logger ->\n    context ->\n    legacy:bool ->\n    storage ty ->\n    view SMap.t ->\n    context tzresult Lwt.t =\n fun ?type_logger ctxt ~legacy storage_type views ->\n  let aux _name cur_view ctxt =\n    parse_view_returning ?type_logger ctxt ~legacy storage_type cur_view\n    >|=? fun (_parsed_view, ctxt) -> ctxt\n  in\n  SMap.fold_es aux views ctxt\n\nand[@coq_axiom_with_reason \"gadt\"] parse_returning :\n    type arg ret.\n    ?type_logger:type_logger ->\n    stack_depth:int ->\n    tc_context ->\n    context ->\n    legacy:bool ->\n    arg ty * var_annot option ->\n    ret ty ->\n    Script.node ->\n    ((arg, ret) lambda * context) tzresult Lwt.t =\n fun ?type_logger\n     ~stack_depth\n     tc_context\n     ctxt\n     ~legacy\n     (arg, arg_annot)\n     ret\n     script_instr ->\n  parse_instr\n    ?type_logger\n    tc_context\n    ctxt\n    ~legacy\n    ~stack_depth:(stack_depth + 1)\n    script_instr\n    (Item_t (arg, Bot_t, arg_annot))\n  >>=? function\n  | (Typed ({loc; aft = Item_t (ty, Bot_t, _) as stack_ty; _} as descr), ctxt)\n    ->\n      Lwt.return\n      @@ record_trace_eval\n           (fun () ->\n             let ret = serialize_ty_for_error ret in\n             let stack_ty = serialize_stack_for_error ctxt stack_ty in\n             Bad_return (loc, stack_ty, ret))\n           ( ty_eq ~legacy ctxt loc ty ret >|? fun (Eq, ctxt) ->\n             ((Lam (close_descr descr, script_instr) : (arg, ret) lambda), ctxt)\n           )\n  | (Typed {loc; aft = stack_ty; _}, ctxt) ->\n      let ret = serialize_ty_for_error ret in\n      let stack_ty = serialize_stack_for_error ctxt stack_ty in\n      fail @@ Bad_return (loc, stack_ty, ret)\n  | (Failed {descr}, ctxt) ->\n      return\n        ( (Lam (close_descr (descr (Item_t (ret, Bot_t, None))), script_instr)\n            : (arg, ret) lambda),\n          ctxt )\n\nand[@coq_axiom_with_reason \"gadt\"] parse_instr :\n    type a s.\n    ?type_logger:type_logger ->\n    stack_depth:int ->\n    tc_context ->\n    context ->\n    legacy:bool ->\n    Script.node ->\n    (a, s) stack_ty ->\n    ((a, s) judgement * context) tzresult Lwt.t =\n fun ?type_logger ~stack_depth tc_context ctxt ~legacy script_instr stack_ty ->\n  let check_item_ty (type a b) ctxt (exp : a ty) (got : b ty) loc name n m :\n      ((a, b) eq * a ty * context) tzresult =\n    record_trace_eval (fun () ->\n        let stack_ty = serialize_stack_for_error ctxt stack_ty in\n        Bad_stack (loc, name, m, stack_ty))\n    @@ record_trace\n         (Bad_stack_item n)\n         ( Gas_monad.run ctxt\n         @@ merge_types\n              ~legacy\n              ~merge_type_error_flag:Default_merge_type_error\n              loc\n              exp\n              got\n         >>? fun (eq_ty, ctxt) ->\n           eq_ty >|? fun (Eq, ty) -> ((Eq : (a, b) eq), (ty : a ty), ctxt) )\n  in\n  let log_stack loc stack_ty aft =\n    match (type_logger, script_instr) with\n    | (None, _) | (Some _, (Int _ | String _ | Bytes _)) -> ()\n    | (Some log, (Prim _ | Seq _)) ->\n        (* Unparsing for logging is not carbonated as this\n              is used only by the client and not the protocol *)\n        let stack_ty = unparse_stack_uncarbonated stack_ty in\n        let aft = unparse_stack_uncarbonated aft in\n        log loc stack_ty aft\n  in\n  let typed_no_lwt ctxt loc instr aft =\n    log_stack loc stack_ty aft ;\n    let j = Typed {loc; instr; bef = stack_ty; aft} in\n    Ok (j, ctxt)\n  in\n  let typed ctxt loc instr aft =\n    Lwt.return @@ typed_no_lwt ctxt loc instr aft\n  in\n  Gas.consume ctxt Typecheck_costs.parse_instr_cycle >>?= fun ctxt ->\n  let non_terminal_recursion ?type_logger tc_context ctxt ~legacy script_instr\n      stack_ty =\n    if Compare.Int.(stack_depth > 10000) then\n      fail Typechecking_too_many_recursive_calls\n    else\n      parse_instr\n        ?type_logger\n        tc_context\n        ctxt\n        ~stack_depth:(stack_depth + 1)\n        ~legacy\n        script_instr\n        stack_ty\n  in\n  match (script_instr, stack_ty) with\n  (* stack ops *)\n  | (Prim (loc, I_DROP, [], annot), Item_t (_, rest, _)) ->\n      (error_unexpected_annot loc annot >>?= fun () ->\n       typed ctxt loc {apply = (fun kinfo k -> IDrop (kinfo, k))} rest\n        : ((a, s) judgement * context) tzresult Lwt.t)\n  | (Prim (loc, I_DROP, [n], result_annot), whole_stack) ->\n      parse_uint10 n >>?= fun whole_n ->\n      Gas.consume ctxt (Typecheck_costs.proof_argument whole_n) >>?= fun ctxt ->\n      let rec make_proof_argument :\n          type a s.\n          int -> (a, s) stack_ty -> (a, s) dropn_proof_argument tzresult =\n       fun n stk ->\n        match (Compare.Int.(n = 0), stk) with\n        | (true, rest) -> ok @@ Dropn_proof_argument (KRest, rest)\n        | (false, Item_t (_, rest, _)) ->\n            make_proof_argument (n - 1) rest\n            >|? fun (Dropn_proof_argument (n', stack_after_drops)) ->\n            let kinfo = {iloc = loc; kstack_ty = rest} in\n            Dropn_proof_argument (KPrefix (kinfo, n'), stack_after_drops)\n        | (_, _) ->\n            let whole_stack = serialize_stack_for_error ctxt whole_stack in\n            error (Bad_stack (loc, I_DROP, whole_n, whole_stack))\n      in\n      error_unexpected_annot loc result_annot >>?= fun () ->\n      make_proof_argument whole_n whole_stack\n      >>?= fun (Dropn_proof_argument (n', stack_after_drops)) ->\n      let kdropn kinfo k = IDropn (kinfo, whole_n, n', k) in\n      typed ctxt loc {apply = kdropn} stack_after_drops\n  | (Prim (loc, I_DROP, (_ :: _ :: _ as l), _), _) ->\n      (* Technically, the arities 0 and 1 are allowed but the error only mentions 1.\n            However, DROP is equivalent to DROP 1 so hinting at an arity of 1 makes sense. *)\n      fail (Invalid_arity (loc, I_DROP, 1, List.length l))\n  | (Prim (loc, I_DUP, [], annot), Item_t (v, rest, stack_annot)) ->\n      parse_var_annot loc annot ~default:stack_annot >>?= fun annot ->\n      record_trace_eval\n        (fun () ->\n          let t = serialize_ty_for_error v in\n          Non_dupable_type (loc, t))\n        (check_dupable_ty ctxt loc v)\n      >>?= fun ctxt ->\n      let dup = {apply = (fun kinfo k -> IDup (kinfo, k))} in\n      typed ctxt loc dup (Item_t (v, Item_t (v, rest, stack_annot), annot))\n  | (Prim (loc, I_DUP, [n], v_annot), stack_ty) ->\n      parse_var_annot loc v_annot >>?= fun annot ->\n      let rec make_proof_argument :\n          type a s.\n          int -> (a, s) stack_ty -> (a * s) dup_n_proof_argument tzresult =\n       fun n (stack_ty : (a, s) stack_ty) ->\n        match (n, stack_ty) with\n        | (1, Item_t (hd_ty, _, _)) ->\n            ok @@ Dup_n_proof_argument (Dup_n_zero, hd_ty)\n        | (n, Item_t (_, tl_ty, _)) ->\n            make_proof_argument (n - 1) tl_ty\n            >|? fun (Dup_n_proof_argument (dup_n_witness, b_ty)) ->\n            Dup_n_proof_argument (Dup_n_succ dup_n_witness, b_ty)\n        | _ ->\n            let whole_stack = serialize_stack_for_error ctxt stack_ty in\n            error (Bad_stack (loc, I_DUP, 1, whole_stack))\n      in\n      parse_uint10 n >>?= fun n ->\n      Gas.consume ctxt (Typecheck_costs.proof_argument n) >>?= fun ctxt ->\n      error_unless (Compare.Int.( > ) n 0) (Dup_n_bad_argument loc)\n      >>?= fun () ->\n      record_trace (Dup_n_bad_stack loc) (make_proof_argument n stack_ty)\n      >>?= fun (Dup_n_proof_argument (witness, after_ty)) ->\n      record_trace_eval\n        (fun () ->\n          let t = serialize_ty_for_error after_ty in\n          Non_dupable_type (loc, t))\n        (check_dupable_ty ctxt loc after_ty)\n      >>?= fun ctxt ->\n      let dupn = {apply = (fun kinfo k -> IDup_n (kinfo, n, witness, k))} in\n      typed ctxt loc dupn (Item_t (after_ty, stack_ty, annot))\n  | (Prim (loc, I_DIG, [n], result_annot), stack) ->\n      let rec make_proof_argument :\n          type a s. int -> (a, s) stack_ty -> (a, s) dig_proof_argument tzresult\n          =\n       fun n stk ->\n        match (Compare.Int.(n = 0), stk) with\n        | (true, Item_t (v, rest, annot)) ->\n            ok @@ Dig_proof_argument (KRest, v, annot, rest)\n        | (false, Item_t (v, rest, annot)) ->\n            make_proof_argument (n - 1) rest\n            >|? fun (Dig_proof_argument (n', x, xv, aft')) ->\n            let kinfo = {iloc = loc; kstack_ty = aft'} in\n            Dig_proof_argument\n              (KPrefix (kinfo, n'), x, xv, Item_t (v, aft', annot))\n        | (_, _) ->\n            let whole_stack = serialize_stack_for_error ctxt stack in\n            error (Bad_stack (loc, I_DIG, 3, whole_stack))\n      in\n      parse_uint10 n >>?= fun n ->\n      Gas.consume ctxt (Typecheck_costs.proof_argument n) >>?= fun ctxt ->\n      error_unexpected_annot loc result_annot >>?= fun () ->\n      make_proof_argument n stack\n      >>?= fun (Dig_proof_argument (n', x, stack_annot, aft)) ->\n      let dig = {apply = (fun kinfo k -> IDig (kinfo, n, n', k))} in\n      typed ctxt loc dig (Item_t (x, aft, stack_annot))\n  | (Prim (loc, I_DIG, (([] | _ :: _ :: _) as l), _), _) ->\n      fail (Invalid_arity (loc, I_DIG, 1, List.length l))\n  | (Prim (loc, I_DUG, [n], result_annot), Item_t (x, whole_stack, stack_annot))\n    ->\n      parse_uint10 n >>?= fun whole_n ->\n      Gas.consume ctxt (Typecheck_costs.proof_argument whole_n) >>?= fun ctxt ->\n      let rec make_proof_argument :\n          type a s x.\n          int ->\n          x ty ->\n          var_annot option ->\n          (a, s) stack_ty ->\n          (a, s, x) dug_proof_argument tzresult =\n       fun n x stack_annot stk ->\n        match (Compare.Int.(n = 0), stk) with\n        | (true, rest) ->\n            ok @@ Dug_proof_argument (KRest, Item_t (x, rest, stack_annot))\n        | (false, Item_t (v, rest, annot)) ->\n            make_proof_argument (n - 1) x stack_annot rest\n            >|? fun (Dug_proof_argument (n', aft')) ->\n            let kinfo = {iloc = loc; kstack_ty = aft'} in\n            Dug_proof_argument (KPrefix (kinfo, n'), Item_t (v, aft', annot))\n        | (_, _) ->\n            let whole_stack = serialize_stack_for_error ctxt whole_stack in\n            error (Bad_stack (loc, I_DUG, whole_n, whole_stack))\n      in\n      error_unexpected_annot loc result_annot >>?= fun () ->\n      make_proof_argument whole_n x stack_annot whole_stack\n      >>?= fun (Dug_proof_argument (n', aft)) ->\n      let dug = {apply = (fun kinfo k -> IDug (kinfo, whole_n, n', k))} in\n      typed ctxt loc dug aft\n  | (Prim (loc, I_DUG, [_], result_annot), stack) ->\n      Lwt.return\n        ( error_unexpected_annot loc result_annot >>? fun () ->\n          let stack = serialize_stack_for_error ctxt stack in\n          error (Bad_stack (loc, I_DUG, 1, stack)) )\n  | (Prim (loc, I_DUG, (([] | _ :: _ :: _) as l), _), _) ->\n      fail (Invalid_arity (loc, I_DUG, 1, List.length l))\n  | ( Prim (loc, I_SWAP, [], annot),\n      Item_t (v, Item_t (w, rest, stack_annot), cur_top_annot) ) ->\n      error_unexpected_annot loc annot >>?= fun () ->\n      let swap = {apply = (fun kinfo k -> ISwap (kinfo, k))} in\n      let stack_ty = Item_t (w, Item_t (v, rest, cur_top_annot), stack_annot) in\n      typed ctxt loc swap stack_ty\n  | (Prim (loc, I_PUSH, [t; d], annot), stack) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      parse_packable_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy t\n      >>?= fun (Ex_ty t, ctxt) ->\n      parse_data\n        ?type_logger\n        ~stack_depth:(stack_depth + 1)\n        ctxt\n        ~legacy\n        ~allow_forged:false\n        t\n        d\n      >>=? fun (v, ctxt) ->\n      let const = {apply = (fun kinfo k -> IConst (kinfo, v, k))} in\n      typed ctxt loc const (Item_t (t, stack, annot))\n  | (Prim (loc, I_UNIT, [], annot), stack) ->\n      parse_var_type_annot loc annot >>?= fun (annot, ty_name) ->\n      let const = {apply = (fun kinfo k -> IConst (kinfo, (), k))} in\n      typed ctxt loc const (Item_t (unit_t ~annot:ty_name, stack, annot))\n  (* options *)\n  | (Prim (loc, I_SOME, [], annot), Item_t (t, rest, _)) ->\n      parse_var_type_annot loc annot >>?= fun (annot, ty_name) ->\n      let cons_some = {apply = (fun kinfo k -> ICons_some (kinfo, k))} in\n      option_t loc t ~annot:ty_name >>?= fun ty ->\n      typed ctxt loc cons_some (Item_t (ty, rest, annot))\n  | (Prim (loc, I_NONE, [t], annot), stack) ->\n      parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy t\n      >>?= fun (Ex_ty t, ctxt) ->\n      parse_var_type_annot loc annot >>?= fun (annot, ty_name) ->\n      let cons_none = {apply = (fun kinfo k -> ICons_none (kinfo, k))} in\n      option_t loc t ~annot:ty_name >>?= fun ty ->\n      let stack_ty = Item_t (ty, stack, annot) in\n      typed ctxt loc cons_none stack_ty\n  | (Prim (loc, I_MAP, [body], annot), Item_t (Option_t (t, _), rest, opt_annot))\n    -> (\n      check_kind [Seq_kind] body >>?= fun () ->\n      parse_var_type_annot loc annot >>?= fun (ret_annot, opt_ty_name) ->\n      let elt_annot = gen_access_annot opt_annot default_some_annot in\n      non_terminal_recursion\n        ?type_logger\n        ~legacy\n        tc_context\n        ctxt\n        body\n        (Item_t (t, rest, elt_annot))\n      >>=? fun (judgement, ctxt) ->\n      Lwt.return\n      @@\n      match judgement with\n      | Typed ({loc; aft = Item_t (ret, aft_rest, _aft_annot); _} as kibody) ->\n          let invalid_map_body () =\n            let aft = serialize_stack_for_error ctxt kibody.aft in\n            Invalid_map_body (loc, aft)\n          in\n          record_trace_eval\n            invalid_map_body\n            ( merge_stacks ~legacy loc ctxt 1 aft_rest rest\n            >>? fun (Eq, rest, ctxt) ->\n              option_t loc ret ~annot:opt_ty_name >>? fun opt_ty ->\n              let final_stack = Item_t (opt_ty, rest, ret_annot) in\n              let hinfo =\n                {iloc = loc; kstack_ty = Item_t (ret, aft_rest, ret_annot)}\n              in\n              let cinfo = kinfo_of_descr kibody in\n              let body = kibody.instr.apply cinfo (IHalt hinfo) in\n              let apply kinfo k = IOpt_map {kinfo; body; k} in\n              typed_no_lwt ctxt loc {apply} final_stack )\n      | Typed {aft = Bot_t; _} ->\n          let aft = serialize_stack_for_error ctxt Bot_t in\n          error (Invalid_map_body (loc, aft))\n      | Failed _ -> error (Invalid_map_block_fail loc))\n  | ( Prim (loc, I_IF_NONE, [bt; bf], annot),\n      (Item_t (Option_t (t, _), rest, option_annot) as bef) ) ->\n      check_kind [Seq_kind] bt >>?= fun () ->\n      check_kind [Seq_kind] bf >>?= fun () ->\n      error_unexpected_annot loc annot >>?= fun () ->\n      let annot = gen_access_annot option_annot default_some_annot in\n      non_terminal_recursion ?type_logger tc_context ctxt ~legacy bt rest\n      >>=? fun (btr, ctxt) ->\n      let stack_ty = Item_t (t, rest, annot) in\n      non_terminal_recursion ?type_logger tc_context ctxt ~legacy bf stack_ty\n      >>=? fun (bfr, ctxt) ->\n      let branch ibt ibf =\n        let ifnone =\n          {\n            apply =\n              (fun kinfo k ->\n                let hinfo = kinfo_of_kinstr k in\n                let btinfo = kinfo_of_descr ibt\n                and bfinfo = kinfo_of_descr ibf in\n                let branch_if_none = ibt.instr.apply btinfo (IHalt hinfo)\n                and branch_if_some = ibf.instr.apply bfinfo (IHalt hinfo) in\n                IIf_none {kinfo; branch_if_none; branch_if_some; k});\n          }\n        in\n        {loc; instr = ifnone; bef; aft = ibt.aft}\n      in\n      Lwt.return @@ merge_branches ~legacy ctxt loc btr bfr {branch}\n  (* pairs *)\n  | ( Prim (loc, I_PAIR, [], annot),\n      Item_t (a, Item_t (b, rest, snd_annot), fst_annot) ) ->\n      parse_constr_annot\n        loc\n        annot\n        ~if_special_first:(var_to_field_annot fst_annot)\n        ~if_special_second:(var_to_field_annot snd_annot)\n      >>?= fun (annot, ty_name, l_field, r_field) ->\n      pair_t loc (a, l_field, fst_annot) (b, r_field, snd_annot) ~annot:ty_name\n      >>?= fun ty ->\n      let stack_ty = Item_t (ty, rest, annot) in\n      let cons_pair = {apply = (fun kinfo k -> ICons_pair (kinfo, k))} in\n      typed ctxt loc cons_pair stack_ty\n  | (Prim (loc, I_PAIR, [n], annot), stack_ty) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let rec make_proof_argument :\n          type a s.\n          int -> (a, s) stack_ty -> (a * s) comb_proof_argument tzresult =\n       fun n stack_ty ->\n        match (n, stack_ty) with\n        | (1, Item_t (a_ty, tl_ty, _a_annot_opt)) ->\n            ok (Comb_proof_argument (Comb_one, Item_t (a_ty, tl_ty, annot)))\n        | (n, Item_t (a_ty, tl_ty, _prop_annot_opt)) ->\n            make_proof_argument (n - 1) tl_ty\n            >>? fun (Comb_proof_argument\n                      (comb_witness, Item_t (b_ty, tl_ty', annot))) ->\n            pair_t loc (a_ty, None, None) (b_ty, None, None) ~annot:None\n            >|? fun pair_t ->\n            Comb_proof_argument\n              (Comb_succ comb_witness, Item_t (pair_t, tl_ty', annot))\n        | _ ->\n            let whole_stack = serialize_stack_for_error ctxt stack_ty in\n            error (Bad_stack (loc, I_PAIR, 1, whole_stack))\n      in\n      parse_uint10 n >>?= fun n ->\n      Gas.consume ctxt (Typecheck_costs.proof_argument n) >>?= fun ctxt ->\n      error_unless (Compare.Int.( > ) n 1) (Pair_bad_argument loc)\n      >>?= fun () ->\n      make_proof_argument n stack_ty\n      >>?= fun (Comb_proof_argument (witness, after_ty)) ->\n      let comb = {apply = (fun kinfo k -> IComb (kinfo, n, witness, k))} in\n      typed ctxt loc comb after_ty\n  | (Prim (loc, I_UNPAIR, [n], annot), stack_ty) ->\n      error_unexpected_annot loc annot >>?= fun () ->\n      let rec make_proof_argument :\n          type a s.\n          int -> (a, s) stack_ty -> (a * s) uncomb_proof_argument tzresult =\n       fun n stack_ty ->\n        match (n, stack_ty) with\n        | (1, Item_t (a_ty, tl_ty, annot)) ->\n            ok @@ Uncomb_proof_argument (Uncomb_one, Item_t (a_ty, tl_ty, annot))\n        | ( n,\n            Item_t\n              ( Pair_t ((a_ty, field_opt, _), (b_ty, b_field_opt, _), _),\n                tl_ty,\n                _ ) ) ->\n            let b_annot = Script_ir_annot.field_to_var_annot b_field_opt in\n            make_proof_argument (n - 1) (Item_t (b_ty, tl_ty, b_annot))\n            >|? fun (Uncomb_proof_argument (uncomb_witness, after_ty)) ->\n            Uncomb_proof_argument\n              ( Uncomb_succ uncomb_witness,\n                Item_t\n                  (a_ty, after_ty, Script_ir_annot.field_to_var_annot field_opt)\n              )\n        | _ ->\n            let whole_stack = serialize_stack_for_error ctxt stack_ty in\n            error (Bad_stack (loc, I_UNPAIR, 1, whole_stack))\n      in\n      parse_uint10 n >>?= fun n ->\n      Gas.consume ctxt (Typecheck_costs.proof_argument n) >>?= fun ctxt ->\n      error_unless (Compare.Int.( > ) n 1) (Unpair_bad_argument loc)\n      >>?= fun () ->\n      make_proof_argument n stack_ty\n      >>?= fun (Uncomb_proof_argument (witness, after_ty)) ->\n      let uncomb = {apply = (fun kinfo k -> IUncomb (kinfo, n, witness, k))} in\n      typed ctxt loc uncomb after_ty\n  | (Prim (loc, I_GET, [n], annot), Item_t (comb_ty, rest_ty, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let rec make_proof_argument :\n          type b. int -> b ty -> b comb_get_proof_argument tzresult =\n       fun n ty ->\n        match (n, ty) with\n        | (0, value_ty) ->\n            ok @@ Comb_get_proof_argument (Comb_get_zero, value_ty)\n        | (1, Pair_t ((hd_ty, _at1, _at2), _, _annot)) ->\n            ok @@ Comb_get_proof_argument (Comb_get_one, hd_ty)\n        | (n, Pair_t (_, (tl_ty, _bt1, _bt2), _annot)) ->\n            make_proof_argument (n - 2) tl_ty\n            >|? fun (Comb_get_proof_argument (comb_get_left_witness, ty')) ->\n            Comb_get_proof_argument\n              (Comb_get_plus_two comb_get_left_witness, ty')\n        | _ ->\n            let whole_stack = serialize_stack_for_error ctxt stack_ty in\n            error (Bad_stack (loc, I_GET, 1, whole_stack))\n      in\n      parse_uint11 n >>?= fun n ->\n      Gas.consume ctxt (Typecheck_costs.proof_argument n) >>?= fun ctxt ->\n      make_proof_argument n comb_ty\n      >>?= fun (Comb_get_proof_argument (witness, ty')) ->\n      let after_stack_ty = Item_t (ty', rest_ty, annot) in\n      let comb_get =\n        {apply = (fun kinfo k -> IComb_get (kinfo, n, witness, k))}\n      in\n      typed ctxt loc comb_get after_stack_ty\n  | ( Prim (loc, I_UPDATE, [n], annot),\n      Item_t (value_ty, Item_t (comb_ty, rest_ty, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let rec make_proof_argument :\n          type value before.\n          int ->\n          value ty ->\n          before ty ->\n          (value, before) comb_set_proof_argument tzresult =\n       fun n value_ty ty ->\n        match (n, ty) with\n        | (0, _) -> ok @@ Comb_set_proof_argument (Comb_set_zero, value_ty)\n        | (1, Pair_t ((_hd_ty, at1, at2), (tl_ty, bt1, bt2), {annot; _})) ->\n            pair_t loc (value_ty, at1, at2) (tl_ty, bt1, bt2) ~annot\n            >|? fun after_ty -> Comb_set_proof_argument (Comb_set_one, after_ty)\n        | (n, Pair_t ((hd_ty, at1, at2), (tl_ty, bt1, bt2), {annot; _})) ->\n            make_proof_argument (n - 2) value_ty tl_ty\n            >>? fun (Comb_set_proof_argument (comb_set_left_witness, tl_ty')) ->\n            pair_t loc (hd_ty, at1, at2) (tl_ty', bt1, bt2) ~annot\n            >|? fun after_ty ->\n            Comb_set_proof_argument\n              (Comb_set_plus_two comb_set_left_witness, after_ty)\n        | _ ->\n            let whole_stack = serialize_stack_for_error ctxt stack_ty in\n            error (Bad_stack (loc, I_UPDATE, 2, whole_stack))\n      in\n      parse_uint11 n >>?= fun n ->\n      Gas.consume ctxt (Typecheck_costs.proof_argument n) >>?= fun ctxt ->\n      make_proof_argument n value_ty comb_ty\n      >>?= fun (Comb_set_proof_argument (witness, after_ty)) ->\n      let after_stack_ty = Item_t (after_ty, rest_ty, annot) in\n      let comb_set =\n        {apply = (fun kinfo k -> IComb_set (kinfo, n, witness, k))}\n      in\n      typed ctxt loc comb_set after_stack_ty\n  | ( Prim (loc, I_UNPAIR, [], annot),\n      Item_t\n        ( Pair_t\n            ( (a, expected_field_annot_a, a_annot),\n              (b, expected_field_annot_b, b_annot),\n              _ ),\n          rest,\n          pair_annot ) ) ->\n      parse_unpair_annot\n        loc\n        annot\n        ~pair_annot\n        ~value_annot_car:a_annot\n        ~value_annot_cdr:b_annot\n        ~field_name_car:expected_field_annot_a\n        ~field_name_cdr:expected_field_annot_b\n      >>?= fun (annot_a, annot_b, field_a, field_b) ->\n      check_correct_field field_a expected_field_annot_a >>?= fun () ->\n      check_correct_field field_b expected_field_annot_b >>?= fun () ->\n      let unpair = {apply = (fun kinfo k -> IUnpair (kinfo, k))} in\n      typed ctxt loc unpair (Item_t (a, Item_t (b, rest, annot_b), annot_a))\n  | ( Prim (loc, I_CAR, [], annot),\n      Item_t\n        (Pair_t ((a, expected_field_annot, a_annot), _, _), rest, pair_annot) )\n    ->\n      parse_destr_annot\n        loc\n        annot\n        ~pair_annot\n        ~value_annot:a_annot\n        ~field_name:expected_field_annot\n        ~default_accessor:default_car_annot\n      >>?= fun (annot, field_annot) ->\n      check_correct_field field_annot expected_field_annot >>?= fun () ->\n      let car = {apply = (fun kinfo k -> ICar (kinfo, k))} in\n      typed ctxt loc car (Item_t (a, rest, annot))\n  | ( Prim (loc, I_CDR, [], annot),\n      Item_t\n        (Pair_t (_, (b, expected_field_annot, b_annot), _), rest, pair_annot) )\n    ->\n      parse_destr_annot\n        loc\n        annot\n        ~pair_annot\n        ~value_annot:b_annot\n        ~field_name:expected_field_annot\n        ~default_accessor:default_cdr_annot\n      >>?= fun (annot, field_annot) ->\n      check_correct_field field_annot expected_field_annot >>?= fun () ->\n      let cdr = {apply = (fun kinfo k -> ICdr (kinfo, k))} in\n      typed ctxt loc cdr (Item_t (b, rest, annot))\n  (* unions *)\n  | (Prim (loc, I_LEFT, [tr], annot), Item_t (tl, rest, stack_annot)) ->\n      parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy tr\n      >>?= fun (Ex_ty tr, ctxt) ->\n      parse_constr_annot\n        loc\n        annot\n        ~if_special_first:(var_to_field_annot stack_annot)\n      >>?= fun (annot, tname, l_field, r_field) ->\n      let cons_left = {apply = (fun kinfo k -> ICons_left (kinfo, k))} in\n      union_t loc (tl, l_field) (tr, r_field) ~annot:tname >>?= fun ty ->\n      let stack_ty = Item_t (ty, rest, annot) in\n      typed ctxt loc cons_left stack_ty\n  | (Prim (loc, I_RIGHT, [tl], annot), Item_t (tr, rest, stack_annot)) ->\n      parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy tl\n      >>?= fun (Ex_ty tl, ctxt) ->\n      parse_constr_annot\n        loc\n        annot\n        ~if_special_second:(var_to_field_annot stack_annot)\n      >>?= fun (annot, tname, l_field, r_field) ->\n      let cons_right = {apply = (fun kinfo k -> ICons_right (kinfo, k))} in\n      union_t loc (tl, l_field) (tr, r_field) ~annot:tname >>?= fun ty ->\n      let stack_ty = Item_t (ty, rest, annot) in\n      typed ctxt loc cons_right stack_ty\n  | ( Prim (loc, I_IF_LEFT, [bt; bf], annot),\n      (Item_t (Union_t ((tl, l_field), (tr, r_field), _), rest, union_annot) as\n      bef) ) ->\n      check_kind [Seq_kind] bt >>?= fun () ->\n      check_kind [Seq_kind] bf >>?= fun () ->\n      error_unexpected_annot loc annot >>?= fun () ->\n      let left_annot =\n        gen_access_annot union_annot l_field ~default:default_left_annot\n      in\n      let right_annot =\n        gen_access_annot union_annot r_field ~default:default_right_annot\n      in\n      non_terminal_recursion\n        ?type_logger\n        tc_context\n        ctxt\n        ~legacy\n        bt\n        (Item_t (tl, rest, left_annot))\n      >>=? fun (btr, ctxt) ->\n      non_terminal_recursion\n        ?type_logger\n        tc_context\n        ctxt\n        ~legacy\n        bf\n        (Item_t (tr, rest, right_annot))\n      >>=? fun (bfr, ctxt) ->\n      let branch ibt ibf =\n        let infobt = kinfo_of_descr ibt and infobf = kinfo_of_descr ibf in\n        let instr =\n          {\n            apply =\n              (fun kinfo k ->\n                let hinfo = kinfo_of_kinstr k in\n                let branch_if_left = ibt.instr.apply infobt (IHalt hinfo)\n                and branch_if_right = ibf.instr.apply infobf (IHalt hinfo) in\n                IIf_left {kinfo; branch_if_left; branch_if_right; k});\n          }\n        in\n        {loc; instr; bef; aft = ibt.aft}\n      in\n      Lwt.return @@ merge_branches ~legacy ctxt loc btr bfr {branch}\n  (* lists *)\n  | (Prim (loc, I_NIL, [t], annot), stack) ->\n      parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy t\n      >>?= fun (Ex_ty t, ctxt) ->\n      parse_var_type_annot loc annot >>?= fun (annot, ty_name) ->\n      let nil = {apply = (fun kinfo k -> INil (kinfo, k))} in\n      list_t loc t ~annot:ty_name >>?= fun ty ->\n      typed ctxt loc nil (Item_t (ty, stack, annot))\n  | ( Prim (loc, I_CONS, [], annot),\n      Item_t (tv, Item_t (List_t (t, ty_name), rest, _), _) ) ->\n      check_item_ty ctxt tv t loc I_CONS 1 2 >>?= fun (Eq, t, ctxt) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let cons_list = {apply = (fun kinfo k -> ICons_list (kinfo, k))} in\n      (typed ctxt loc cons_list (Item_t (List_t (t, ty_name), rest, annot))\n        : ((a, s) judgement * context) tzresult Lwt.t)\n  | ( Prim (loc, I_IF_CONS, [bt; bf], annot),\n      (Item_t (List_t (t, ty_name), rest, list_annot) as bef) ) ->\n      check_kind [Seq_kind] bt >>?= fun () ->\n      check_kind [Seq_kind] bf >>?= fun () ->\n      error_unexpected_annot loc annot >>?= fun () ->\n      let hd_annot = gen_access_annot list_annot default_hd_annot in\n      let tl_annot = gen_access_annot list_annot default_tl_annot in\n      non_terminal_recursion\n        ?type_logger\n        tc_context\n        ctxt\n        ~legacy\n        bt\n        (Item_t (t, Item_t (List_t (t, ty_name), rest, tl_annot), hd_annot))\n      >>=? fun (btr, ctxt) ->\n      non_terminal_recursion ?type_logger tc_context ctxt ~legacy bf rest\n      >>=? fun (bfr, ctxt) ->\n      let branch ibt ibf =\n        let infobt = kinfo_of_descr ibt and infobf = kinfo_of_descr ibf in\n        let instr =\n          {\n            apply =\n              (fun kinfo k ->\n                let hinfo = kinfo_of_kinstr k in\n                let branch_if_cons = ibt.instr.apply infobt (IHalt hinfo)\n                and branch_if_nil = ibf.instr.apply infobf (IHalt hinfo) in\n                IIf_cons {kinfo; branch_if_nil; branch_if_cons; k});\n          }\n        in\n        {loc; instr; bef; aft = ibt.aft}\n      in\n      Lwt.return @@ merge_branches ~legacy ctxt loc btr bfr {branch}\n  | (Prim (loc, I_SIZE, [], annot), Item_t (List_t _, rest, _)) ->\n      parse_var_type_annot loc annot >>?= fun (annot, tname) ->\n      let list_size = {apply = (fun kinfo k -> IList_size (kinfo, k))} in\n      typed ctxt loc list_size (Item_t (nat_t ~annot:tname, rest, annot))\n  | ( Prim (loc, I_MAP, [body], annot),\n      Item_t (List_t (elt, _), starting_rest, list_annot) ) -> (\n      check_kind [Seq_kind] body >>?= fun () ->\n      parse_var_type_annot loc annot >>?= fun (ret_annot, list_ty_name) ->\n      let elt_annot = gen_access_annot list_annot default_elt_annot in\n      non_terminal_recursion\n        ?type_logger\n        tc_context\n        ctxt\n        ~legacy\n        body\n        (Item_t (elt, starting_rest, elt_annot))\n      >>=? fun (judgement, ctxt) ->\n      Lwt.return\n      @@\n      match judgement with\n      | Typed ({aft = Item_t (ret, rest, _); _} as kibody) ->\n          let invalid_map_body () =\n            let aft = serialize_stack_for_error ctxt kibody.aft in\n            Invalid_map_body (loc, aft)\n          in\n          record_trace_eval\n            invalid_map_body\n            ( merge_stacks ~legacy loc ctxt 1 rest starting_rest\n            >>? fun (Eq, rest, ctxt) ->\n              let binfo = kinfo_of_descr kibody in\n              let hinfo =\n                {iloc = loc; kstack_ty = Item_t (ret, rest, ret_annot)}\n              in\n              let ibody = kibody.instr.apply binfo (IHalt hinfo) in\n              let list_map =\n                {apply = (fun kinfo k -> IList_map (kinfo, ibody, k))}\n              in\n              list_t loc ret ~annot:list_ty_name >>? fun ty ->\n              let stack = Item_t (ty, rest, ret_annot) in\n              typed_no_lwt ctxt loc list_map stack )\n      | Typed {aft; _} ->\n          let aft = serialize_stack_for_error ctxt aft in\n          error (Invalid_map_body (loc, aft))\n      | Failed _ -> error (Invalid_map_block_fail loc))\n  | ( Prim (loc, I_ITER, [body], annot),\n      Item_t (List_t (elt, _), rest, list_annot) ) -> (\n      check_kind [Seq_kind] body >>?= fun () ->\n      error_unexpected_annot loc annot >>?= fun () ->\n      let elt_annot = gen_access_annot list_annot default_elt_annot in\n      non_terminal_recursion\n        ?type_logger\n        tc_context\n        ctxt\n        ~legacy\n        body\n        (Item_t (elt, rest, elt_annot))\n      >>=? fun (judgement, ctxt) ->\n      let mk_list_iter ibody =\n        {\n          apply =\n            (fun kinfo k ->\n              let hinfo = {iloc = loc; kstack_ty = rest} in\n              let binfo = kinfo_of_descr ibody in\n              let ibody = ibody.instr.apply binfo (IHalt hinfo) in\n              IList_iter (kinfo, ibody, k));\n        }\n      in\n      Lwt.return\n      @@\n      match judgement with\n      | Typed ({aft; _} as ibody) ->\n          let invalid_iter_body () =\n            let aft = serialize_stack_for_error ctxt ibody.aft in\n            let rest = serialize_stack_for_error ctxt rest in\n            Invalid_iter_body (loc, rest, aft)\n          in\n          record_trace_eval\n            invalid_iter_body\n            ( merge_stacks ~legacy loc ctxt 1 aft rest\n            >>? fun (Eq, rest, ctxt) : ((a, s) judgement * context) tzresult ->\n              typed_no_lwt ctxt loc (mk_list_iter ibody) rest )\n      | Failed {descr} -> typed_no_lwt ctxt loc (mk_list_iter (descr rest)) rest\n      )\n  (* sets *)\n  | (Prim (loc, I_EMPTY_SET, [t], annot), rest) ->\n      parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt t\n      >>?= fun (Ex_comparable_ty t, ctxt) ->\n      parse_var_type_annot loc annot >>?= fun (annot, tname) ->\n      let instr = {apply = (fun kinfo k -> IEmpty_set (kinfo, t, k))} in\n      set_t loc t ~annot:tname >>?= fun ty ->\n      typed ctxt loc instr (Item_t (ty, rest, annot))\n  | ( Prim (loc, I_ITER, [body], annot),\n      Item_t (Set_t (comp_elt, _), rest, set_annot) ) -> (\n      check_kind [Seq_kind] body >>?= fun () ->\n      error_unexpected_annot loc annot >>?= fun () ->\n      let elt_annot = gen_access_annot set_annot default_elt_annot in\n      let elt = ty_of_comparable_ty comp_elt in\n      non_terminal_recursion\n        ?type_logger\n        tc_context\n        ctxt\n        ~legacy\n        body\n        (Item_t (elt, rest, elt_annot))\n      >>=? fun (judgement, ctxt) ->\n      let mk_iset_iter ibody =\n        {\n          apply =\n            (fun kinfo k ->\n              let hinfo = {iloc = loc; kstack_ty = rest} in\n              let binfo = kinfo_of_descr ibody in\n              let ibody = ibody.instr.apply binfo (IHalt hinfo) in\n              ISet_iter (kinfo, ibody, k));\n        }\n      in\n      Lwt.return\n      @@\n      match judgement with\n      | Typed ({aft; _} as ibody) ->\n          let invalid_iter_body () =\n            let aft = serialize_stack_for_error ctxt ibody.aft in\n            let rest = serialize_stack_for_error ctxt rest in\n            Invalid_iter_body (loc, rest, aft)\n          in\n          record_trace_eval\n            invalid_iter_body\n            ( merge_stacks ~legacy loc ctxt 1 aft rest\n            >>? fun (Eq, rest, ctxt) : ((a, s) judgement * context) tzresult ->\n              typed_no_lwt ctxt loc (mk_iset_iter ibody) rest )\n      | Failed {descr} -> typed_no_lwt ctxt loc (mk_iset_iter (descr rest)) rest\n      )\n  | ( Prim (loc, I_MEM, [], annot),\n      Item_t (v, Item_t (Set_t (elt, _), rest, _), _) ) ->\n      let elt = ty_of_comparable_ty elt in\n      parse_var_type_annot loc annot >>?= fun (annot, tname) ->\n      check_item_ty ctxt elt v loc I_MEM 1 2 >>?= fun (Eq, _, ctxt) ->\n      let instr = {apply = (fun kinfo k -> ISet_mem (kinfo, k))} in\n      (typed ctxt loc instr (Item_t (bool_t ~annot:tname, rest, annot))\n        : ((a, s) judgement * context) tzresult Lwt.t)\n  | ( Prim (loc, I_UPDATE, [], annot),\n      Item_t\n        ( v,\n          Item_t (Bool_t _, Item_t (Set_t (elt, tname), rest, set_annot), _),\n          _ ) ) ->\n      check_item_ty ctxt (ty_of_comparable_ty elt) v loc I_UPDATE 1 3\n      >>?= fun (Eq, _, ctxt) ->\n      parse_var_annot loc annot ~default:set_annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ISet_update (kinfo, k))} in\n      (typed ctxt loc instr (Item_t (Set_t (elt, tname), rest, annot))\n        : ((a, s) judgement * context) tzresult Lwt.t)\n  | (Prim (loc, I_SIZE, [], annot), Item_t (Set_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ISet_size (kinfo, k))} in\n      typed ctxt loc instr (Item_t (nat_t ~annot:None, rest, annot))\n  (* maps *)\n  | (Prim (loc, I_EMPTY_MAP, [tk; tv], annot), stack) ->\n      parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt tk\n      >>?= fun (Ex_comparable_ty tk, ctxt) ->\n      parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy tv\n      >>?= fun (Ex_ty tv, ctxt) ->\n      parse_var_type_annot loc annot >>?= fun (annot, ty_name) ->\n      let instr = {apply = (fun kinfo k -> IEmpty_map (kinfo, tk, k))} in\n      map_t loc tk tv ~annot:ty_name >>?= fun ty ->\n      typed ctxt loc instr (Item_t (ty, stack, annot))\n  | ( Prim (loc, I_MAP, [body], annot),\n      Item_t (Map_t (ck, elt, _), starting_rest, _map_annot) ) -> (\n      let k = ty_of_comparable_ty ck in\n      check_kind [Seq_kind] body >>?= fun () ->\n      parse_var_type_annot loc annot >>?= fun (ret_annot, ty_name) ->\n      let k_name = field_to_var_annot default_key_annot in\n      let e_name = field_to_var_annot default_elt_annot in\n      pair_t loc (k, None, k_name) (elt, None, e_name) ~annot:None\n      >>?= fun ty ->\n      non_terminal_recursion\n        ?type_logger\n        tc_context\n        ctxt\n        ~legacy\n        body\n        (Item_t (ty, starting_rest, None))\n      >>=? fun (judgement, ctxt) ->\n      Lwt.return\n      @@\n      match judgement with\n      | Typed ({aft = Item_t (ret, rest, _); _} as ibody) ->\n          let invalid_map_body () =\n            let aft = serialize_stack_for_error ctxt ibody.aft in\n            Invalid_map_body (loc, aft)\n          in\n          record_trace_eval\n            invalid_map_body\n            ( merge_stacks ~legacy loc ctxt 1 rest starting_rest\n            >>? fun (Eq, rest, ctxt) ->\n              let instr =\n                {\n                  apply =\n                    (fun kinfo k ->\n                      let binfo = kinfo_of_descr ibody in\n                      let hinfo =\n                        {iloc = loc; kstack_ty = Item_t (ret, rest, ret_annot)}\n                      in\n                      let ibody = ibody.instr.apply binfo (IHalt hinfo) in\n                      IMap_map (kinfo, ibody, k));\n                }\n              in\n              map_t loc ck ret ~annot:ty_name >>? fun ty ->\n              let stack = Item_t (ty, rest, ret_annot) in\n              typed_no_lwt ctxt loc instr stack )\n      | Typed {aft; _} ->\n          let aft = serialize_stack_for_error ctxt aft in\n          error (Invalid_map_body (loc, aft))\n      | Failed _ -> error (Invalid_map_block_fail loc))\n  | ( Prim (loc, I_ITER, [body], annot),\n      Item_t (Map_t (comp_elt, element_ty, _), rest, _map_annot) ) -> (\n      check_kind [Seq_kind] body >>?= fun () ->\n      error_unexpected_annot loc annot >>?= fun () ->\n      let k_name = field_to_var_annot default_key_annot in\n      let e_name = field_to_var_annot default_elt_annot in\n      let key = ty_of_comparable_ty comp_elt in\n      pair_t loc (key, None, k_name) (element_ty, None, e_name) ~annot:None\n      >>?= fun ty ->\n      non_terminal_recursion\n        ?type_logger\n        tc_context\n        ctxt\n        ~legacy\n        body\n        (Item_t (ty, rest, None))\n      >>=? fun (judgement, ctxt) ->\n      let make_instr ibody =\n        {\n          apply =\n            (fun kinfo k ->\n              let hinfo = {iloc = loc; kstack_ty = rest} in\n              let binfo = kinfo_of_descr ibody in\n              let ibody = ibody.instr.apply binfo (IHalt hinfo) in\n              IMap_iter (kinfo, ibody, k));\n        }\n      in\n      Lwt.return\n      @@\n      match judgement with\n      | Typed ({aft; _} as ibody) ->\n          let invalid_iter_body () =\n            let aft = serialize_stack_for_error ctxt ibody.aft in\n            let rest = serialize_stack_for_error ctxt rest in\n            Invalid_iter_body (loc, rest, aft)\n          in\n          record_trace_eval\n            invalid_iter_body\n            ( merge_stacks ~legacy loc ctxt 1 aft rest\n            >>? fun (Eq, rest, ctxt) : ((a, s) judgement * context) tzresult ->\n              typed_no_lwt ctxt loc (make_instr ibody) rest )\n      | Failed {descr} -> typed_no_lwt ctxt loc (make_instr (descr rest)) rest)\n  | ( Prim (loc, I_MEM, [], annot),\n      Item_t (vk, Item_t (Map_t (ck, _, _), rest, _), _) ) ->\n      let k = ty_of_comparable_ty ck in\n      check_item_ty ctxt vk k loc I_MEM 1 2 >>?= fun (Eq, _, ctxt) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IMap_mem (kinfo, k))} in\n      (typed ctxt loc instr (Item_t (bool_t ~annot:None, rest, annot))\n        : ((a, s) judgement * context) tzresult Lwt.t)\n  | ( Prim (loc, I_GET, [], annot),\n      Item_t (vk, Item_t (Map_t (ck, elt, _), rest, _), _) ) ->\n      let k = ty_of_comparable_ty ck in\n      check_item_ty ctxt vk k loc I_GET 1 2 >>?= fun (Eq, _, ctxt) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IMap_get (kinfo, k))} in\n      option_t loc elt ~annot:None\n      >>?= fun ty : ((a, s) judgement * context) tzresult Lwt.t ->\n      typed ctxt loc instr (Item_t (ty, rest, annot))\n  | ( Prim (loc, I_UPDATE, [], annot),\n      Item_t\n        ( vk,\n          Item_t\n            ( Option_t (vv, _),\n              Item_t (Map_t (ck, v, map_name), rest, map_annot),\n              _ ),\n          _ ) ) ->\n      let k = ty_of_comparable_ty ck in\n      check_item_ty ctxt vk k loc I_UPDATE 1 3 >>?= fun (Eq, _, ctxt) ->\n      check_item_ty ctxt vv v loc I_UPDATE 2 3 >>?= fun (Eq, v, ctxt) ->\n      parse_var_annot loc annot ~default:map_annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IMap_update (kinfo, k))} in\n      (typed ctxt loc instr (Item_t (Map_t (ck, v, map_name), rest, annot))\n        : ((a, s) judgement * context) tzresult Lwt.t)\n  | ( Prim (loc, I_GET_AND_UPDATE, [], annot),\n      Item_t\n        ( vk,\n          Item_t\n            ( Option_t (vv, vname),\n              Item_t (Map_t (ck, v, map_name), rest, map_annot),\n              v_annot ),\n          _ ) ) ->\n      let k = ty_of_comparable_ty ck in\n      check_item_ty ctxt vk k loc I_GET_AND_UPDATE 1 3 >>?= fun (Eq, _, ctxt) ->\n      check_item_ty ctxt vv v loc I_GET_AND_UPDATE 2 3 >>?= fun (Eq, v, ctxt) ->\n      parse_var_annot loc annot ~default:map_annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IMap_get_and_update (kinfo, k))} in\n      let stack =\n        Item_t\n          ( Option_t (vv, vname),\n            Item_t (Map_t (ck, v, map_name), rest, annot),\n            v_annot )\n      in\n      (typed ctxt loc instr stack : ((a, s) judgement * context) tzresult Lwt.t)\n  | (Prim (loc, I_SIZE, [], annot), Item_t (Map_t (_, _, _), rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IMap_size (kinfo, k))} in\n      typed ctxt loc instr (Item_t (nat_t ~annot:None, rest, annot))\n  (* big_map *)\n  | (Prim (loc, I_EMPTY_BIG_MAP, [tk; tv], annot), stack) ->\n      parse_comparable_ty ~stack_depth:(stack_depth + 1) ctxt tk\n      >>?= fun (Ex_comparable_ty tk, ctxt) ->\n      parse_big_map_value_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy tv\n      >>?= fun (Ex_ty tv, ctxt) ->\n      parse_var_type_annot loc annot >>?= fun (annot, ty_name) ->\n      let instr =\n        {apply = (fun kinfo k -> IEmpty_big_map (kinfo, tk, tv, k))}\n      in\n      big_map_t loc tk tv ~annot:ty_name >>?= fun ty ->\n      let stack = Item_t (ty, stack, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_MEM, [], annot),\n      Item_t (set_key, Item_t (Big_map_t (map_key, _, _), rest, _), _) ) ->\n      let k = ty_of_comparable_ty map_key in\n      check_item_ty ctxt set_key k loc I_MEM 1 2 >>?= fun (Eq, _, ctxt) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IBig_map_mem (kinfo, k))} in\n      let stack = Item_t (bool_t ~annot:None, rest, annot) in\n      (typed ctxt loc instr stack : ((a, s) judgement * context) tzresult Lwt.t)\n  | ( Prim (loc, I_GET, [], annot),\n      Item_t (vk, Item_t (Big_map_t (ck, elt, _), rest, _), _) ) ->\n      let k = ty_of_comparable_ty ck in\n      check_item_ty ctxt vk k loc I_GET 1 2 >>?= fun (Eq, _, ctxt) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IBig_map_get (kinfo, k))} in\n      option_t loc elt ~annot:None >>?= fun ty ->\n      let stack = Item_t (ty, rest, annot) in\n      (typed ctxt loc instr stack : ((a, s) judgement * context) tzresult Lwt.t)\n  | ( Prim (loc, I_UPDATE, [], annot),\n      Item_t\n        ( set_key,\n          Item_t\n            ( Option_t (set_value, _),\n              Item_t (Big_map_t (map_key, map_value, map_name), rest, map_annot),\n              _ ),\n          _ ) ) ->\n      let k = ty_of_comparable_ty map_key in\n      check_item_ty ctxt set_key k loc I_UPDATE 1 3 >>?= fun (Eq, _, ctxt) ->\n      check_item_ty ctxt set_value map_value loc I_UPDATE 2 3\n      >>?= fun (Eq, map_value, ctxt) ->\n      parse_var_annot loc annot ~default:map_annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IBig_map_update (kinfo, k))} in\n      let stack =\n        Item_t (Big_map_t (map_key, map_value, map_name), rest, annot)\n      in\n      (typed ctxt loc instr stack : ((a, s) judgement * context) tzresult Lwt.t)\n  | ( Prim (loc, I_GET_AND_UPDATE, [], annot),\n      Item_t\n        ( vk,\n          Item_t\n            ( Option_t (vv, vname),\n              Item_t (Big_map_t (ck, v, map_name), rest, map_annot),\n              v_annot ),\n          _ ) ) ->\n      let k = ty_of_comparable_ty ck in\n      check_item_ty ctxt vk k loc I_GET_AND_UPDATE 1 3 >>?= fun (Eq, _, ctxt) ->\n      check_item_ty ctxt vv v loc I_GET_AND_UPDATE 2 3 >>?= fun (Eq, v, ctxt) ->\n      parse_var_annot loc annot ~default:map_annot >>?= fun annot ->\n      let instr =\n        {apply = (fun kinfo k -> IBig_map_get_and_update (kinfo, k))}\n      in\n      let stack =\n        Item_t\n          ( Option_t (vv, vname),\n            Item_t (Big_map_t (ck, v, map_name), rest, annot),\n            v_annot )\n      in\n      (typed ctxt loc instr stack : ((a, s) judgement * context) tzresult Lwt.t)\n  (* Sapling *)\n  | (Prim (loc, I_SAPLING_EMPTY_STATE, [memo_size], annot), rest) ->\n      parse_memo_size memo_size >>?= fun memo_size ->\n      parse_var_annot loc annot ~default:default_sapling_state_annot\n      >>?= fun annot ->\n      let instr =\n        {apply = (fun kinfo k -> ISapling_empty_state (kinfo, memo_size, k))}\n      in\n      let stack =\n        Item_t (sapling_state_t ~memo_size ~annot:None, rest, annot)\n      in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_SAPLING_VERIFY_UPDATE, [], _),\n      Item_t\n        ( Sapling_transaction_t (transaction_memo_size, _),\n          Item_t\n            ( (Sapling_state_t (state_memo_size, _) as state_ty),\n              rest,\n              stack_annot ),\n          _ ) ) ->\n      merge_memo_sizes state_memo_size transaction_memo_size\n      >>?= fun _memo_size ->\n      let instr =\n        {apply = (fun kinfo k -> ISapling_verify_update (kinfo, k))}\n      in\n      pair_t\n        loc\n        (int_t ~annot:None, None, default_sapling_balance_annot)\n        (state_ty, None, None)\n        ~annot:None\n      >>?= fun pair_ty ->\n      option_t loc pair_ty ~annot:None >>?= fun ty ->\n      let stack = Item_t (ty, rest, stack_annot) in\n      typed ctxt loc instr stack\n  (* control *)\n  | (Seq (loc, []), stack) ->\n      let instr = {apply = (fun _kinfo k -> k)} in\n      typed ctxt loc instr stack\n  | (Seq (_, [single]), stack) ->\n      non_terminal_recursion ?type_logger tc_context ctxt ~legacy single stack\n  | (Seq (loc, hd :: tl), stack) -> (\n      non_terminal_recursion ?type_logger tc_context ctxt ~legacy hd stack\n      >>=? fun (judgement, ctxt) ->\n      match judgement with\n      | Failed _ -> fail (Fail_not_in_tail_position (Micheline.location hd))\n      | Typed ({aft = middle; _} as ihd) ->\n          non_terminal_recursion\n            ?type_logger\n            tc_context\n            ctxt\n            ~legacy\n            (Seq (Micheline.dummy_location, tl))\n            middle\n          >|=? fun (judgement, ctxt) ->\n          let judgement =\n            match judgement with\n            | Failed {descr} ->\n                let descr ret = compose_descr loc ihd (descr ret) in\n                Failed {descr}\n            | Typed itl -> Typed (compose_descr loc ihd itl)\n          in\n          (judgement, ctxt))\n  | (Prim (loc, I_IF, [bt; bf], annot), (Item_t (Bool_t _, rest, _) as bef)) ->\n      check_kind [Seq_kind] bt >>?= fun () ->\n      check_kind [Seq_kind] bf >>?= fun () ->\n      error_unexpected_annot loc annot >>?= fun () ->\n      non_terminal_recursion ?type_logger tc_context ctxt ~legacy bt rest\n      >>=? fun (btr, ctxt) ->\n      non_terminal_recursion ?type_logger tc_context ctxt ~legacy bf rest\n      >>=? fun (bfr, ctxt) ->\n      let branch ibt ibf =\n        let infobt = kinfo_of_descr ibt and infobf = kinfo_of_descr ibf in\n        let instr =\n          {\n            apply =\n              (fun kinfo k ->\n                let hinfo = kinfo_of_kinstr k in\n                let branch_if_true = ibt.instr.apply infobt (IHalt hinfo)\n                and branch_if_false = ibf.instr.apply infobf (IHalt hinfo) in\n                IIf {kinfo; branch_if_true; branch_if_false; k});\n          }\n        in\n        {loc; instr; bef; aft = ibt.aft}\n      in\n      Lwt.return @@ merge_branches ~legacy ctxt loc btr bfr {branch}\n  | ( Prim (loc, I_LOOP, [body], annot),\n      (Item_t (Bool_t _, rest, _stack_annot) as stack) ) -> (\n      check_kind [Seq_kind] body >>?= fun () ->\n      error_unexpected_annot loc annot >>?= fun () ->\n      non_terminal_recursion ?type_logger tc_context ctxt ~legacy body rest\n      >>=? fun (judgement, ctxt) ->\n      Lwt.return\n      @@\n      match judgement with\n      | Typed ibody ->\n          let unmatched_branches () =\n            let aft = serialize_stack_for_error ctxt ibody.aft in\n            let stack = serialize_stack_for_error ctxt stack in\n            Unmatched_branches (loc, aft, stack)\n          in\n          record_trace_eval\n            unmatched_branches\n            ( merge_stacks ~legacy loc ctxt 1 ibody.aft stack\n            >>? fun (Eq, _stack, ctxt) ->\n              let instr =\n                {\n                  apply =\n                    (fun kinfo k ->\n                      let ibody =\n                        ibody.instr.apply (kinfo_of_descr ibody) (IHalt kinfo)\n                      in\n                      ILoop (kinfo, ibody, k));\n                }\n              in\n              typed_no_lwt ctxt loc instr rest )\n      | Failed {descr} ->\n          let instr =\n            {\n              apply =\n                (fun kinfo k ->\n                  let ibody = descr stack in\n                  let ibody =\n                    ibody.instr.apply (kinfo_of_descr ibody) (IHalt kinfo)\n                  in\n                  ILoop (kinfo, ibody, k));\n            }\n          in\n          typed_no_lwt ctxt loc instr rest)\n  | ( Prim (loc, I_LOOP_LEFT, [body], annot),\n      (Item_t (Union_t ((tl, l_field), (tr, _), _), rest, union_annot) as stack)\n    ) -> (\n      check_kind [Seq_kind] body >>?= fun () ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let l_annot =\n        gen_access_annot union_annot l_field ~default:default_left_annot\n      in\n      non_terminal_recursion\n        ?type_logger\n        tc_context\n        ctxt\n        ~legacy\n        body\n        (Item_t (tl, rest, l_annot))\n      >>=? fun (judgement, ctxt) ->\n      Lwt.return\n      @@\n      match judgement with\n      | Typed ibody ->\n          let unmatched_branches () =\n            let aft = serialize_stack_for_error ctxt ibody.aft in\n            let stack = serialize_stack_for_error ctxt stack in\n            Unmatched_branches (loc, aft, stack)\n          in\n          record_trace_eval\n            unmatched_branches\n            ( merge_stacks ~legacy loc ctxt 1 ibody.aft stack\n            >>? fun (Eq, _stack, ctxt) ->\n              let instr =\n                {\n                  apply =\n                    (fun kinfo k ->\n                      let ibody =\n                        ibody.instr.apply (kinfo_of_descr ibody) (IHalt kinfo)\n                      in\n                      ILoop_left (kinfo, ibody, k));\n                }\n              in\n              let stack = Item_t (tr, rest, annot) in\n              typed_no_lwt ctxt loc instr stack )\n      | Failed {descr} ->\n          let instr =\n            {\n              apply =\n                (fun kinfo k ->\n                  let ibody = descr stack in\n                  let ibody =\n                    ibody.instr.apply (kinfo_of_descr ibody) (IHalt kinfo)\n                  in\n                  ILoop_left (kinfo, ibody, k));\n            }\n          in\n          let stack = Item_t (tr, rest, annot) in\n          typed_no_lwt ctxt loc instr stack)\n  | (Prim (loc, I_LAMBDA, [arg; ret; code], annot), stack) ->\n      parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy arg\n      >>?= fun (Ex_ty arg, ctxt) ->\n      parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy ret\n      >>?= fun (Ex_ty ret, ctxt) ->\n      check_kind [Seq_kind] code >>?= fun () ->\n      parse_var_annot loc annot >>?= fun annot ->\n      parse_returning\n        Lambda\n        ?type_logger\n        ~stack_depth:(stack_depth + 1)\n        ctxt\n        ~legacy\n        (arg, default_arg_annot)\n        ret\n        code\n      >>=? fun (lambda, ctxt) ->\n      let instr = {apply = (fun kinfo k -> ILambda (kinfo, lambda, k))} in\n      lambda_t loc arg ret ~annot:None >>?= fun ty ->\n      let stack = Item_t (ty, stack, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_EXEC, [], annot),\n      Item_t (arg, Item_t (Lambda_t (param, ret, _), rest, _), _) ) ->\n      check_item_ty ctxt arg param loc I_EXEC 1 2 >>?= fun (Eq, _, ctxt) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IExec (kinfo, k))} in\n      let stack = Item_t (ret, rest, annot) in\n      (typed ctxt loc instr stack : ((a, s) judgement * context) tzresult Lwt.t)\n  | ( Prim (loc, I_APPLY, [], annot),\n      Item_t\n        ( capture,\n          Item_t\n            ( Lambda_t\n                ( Pair_t\n                    ((capture_ty, _, _), (arg_ty, _, _), {annot = lam_annot; _}),\n                  ret,\n                  _ ),\n              rest,\n              _ ),\n          _ ) ) ->\n      check_packable ~legacy:false loc capture_ty >>?= fun () ->\n      check_item_ty ctxt capture capture_ty loc I_APPLY 1 2\n      >>?= fun (Eq, capture_ty, ctxt) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IApply (kinfo, capture_ty, k))} in\n      lambda_t loc arg_ty ret ~annot:lam_annot\n      (* This cannot fail because the type [lambda 'arg 'ret] is always smaller than\n         the input type [lambda (pair 'arg 'capture) 'ret]. In an ideal world, there\n         would be a smart deconstructor to ensure this statically. *)\n      >>?=\n      fun res_ty ->\n      let stack = Item_t (res_ty, rest, annot) in\n      (typed ctxt loc instr stack : ((a, s) judgement * context) tzresult Lwt.t)\n  | (Prim (loc, I_DIP, [code], annot), Item_t (v, rest, stack_annot)) -> (\n      error_unexpected_annot loc annot >>?= fun () ->\n      check_kind [Seq_kind] code >>?= fun () ->\n      non_terminal_recursion\n        ?type_logger\n        (add_dip v stack_annot tc_context)\n        ctxt\n        ~legacy\n        code\n        rest\n      >>=? fun (judgement, ctxt) ->\n      match judgement with\n      | Typed descr ->\n          let instr =\n            {\n              apply =\n                (fun kinfo k ->\n                  let binfo = {iloc = descr.loc; kstack_ty = descr.bef} in\n                  let kinfoh = {iloc = descr.loc; kstack_ty = descr.aft} in\n                  let b = descr.instr.apply binfo (IHalt kinfoh) in\n                  IDip (kinfo, b, k));\n            }\n          in\n          let stack = Item_t (v, descr.aft, stack_annot) in\n          typed ctxt loc instr stack\n      | Failed _ -> fail (Fail_not_in_tail_position loc))\n  | (Prim (loc, I_DIP, [n; code], result_annot), stack) ->\n      parse_uint10 n >>?= fun n ->\n      Gas.consume ctxt (Typecheck_costs.proof_argument n) >>?= fun ctxt ->\n      let rec make_proof_argument :\n          type a s.\n          int ->\n          tc_context ->\n          (a, s) stack_ty ->\n          (a, s) dipn_proof_argument tzresult Lwt.t =\n       fun n inner_tc_context stk ->\n        match (Compare.Int.(n = 0), stk) with\n        | (true, rest) -> (\n            non_terminal_recursion\n              ?type_logger\n              inner_tc_context\n              ctxt\n              ~legacy\n              code\n              rest\n            >>=? fun (judgement, ctxt) ->\n            Lwt.return\n            @@\n            match judgement with\n            | Typed descr ->\n                ok\n                  (Dipn_proof_argument (KRest, ctxt, descr, descr.aft)\n                    : (a, s) dipn_proof_argument)\n            | Failed _ -> error (Fail_not_in_tail_position loc))\n        | (false, Item_t (v, rest, annot)) ->\n            make_proof_argument (n - 1) (add_dip v annot tc_context) rest\n            >|=? fun (Dipn_proof_argument (n', ctxt, descr, aft')) ->\n            let kinfo' = {iloc = loc; kstack_ty = aft'} in\n            let w = KPrefix (kinfo', n') in\n            Dipn_proof_argument (w, ctxt, descr, Item_t (v, aft', annot))\n        | (_, _) ->\n            Lwt.return\n              (let whole_stack = serialize_stack_for_error ctxt stack in\n               error (Bad_stack (loc, I_DIP, 1, whole_stack)))\n      in\n      error_unexpected_annot loc result_annot >>?= fun () ->\n      make_proof_argument n tc_context stack\n      >>=? fun (Dipn_proof_argument (n', ctxt, descr, aft)) ->\n      let kinfo = {iloc = descr.loc; kstack_ty = descr.bef} in\n      let kinfoh = {iloc = descr.loc; kstack_ty = descr.aft} in\n      let b = descr.instr.apply kinfo (IHalt kinfoh) in\n      let res = {apply = (fun kinfo k -> IDipn (kinfo, n, n', b, k))} in\n      typed ctxt loc res aft\n  | (Prim (loc, I_DIP, (([] | _ :: _ :: _ :: _) as l), _), _) ->\n      (* Technically, the arities 1 and 2 are allowed but the error only mentions 2.\n            However, DIP {code} is equivalent to DIP 1 {code} so hinting at an arity of 2 makes sense. *)\n      fail (Invalid_arity (loc, I_DIP, 2, List.length l))\n  | (Prim (loc, I_FAILWITH, [], annot), Item_t (v, _rest, _)) ->\n      Lwt.return\n        ( error_unexpected_annot loc annot >>? fun () ->\n          (if legacy then Result.return_unit\n          else check_packable ~legacy:false loc v)\n          >|? fun () ->\n          let instr = {apply = (fun kinfo _k -> IFailwith (kinfo, loc, v))} in\n          let descr aft = {loc; instr; bef = stack_ty; aft} in\n          log_stack loc stack_ty Bot_t ;\n          (Failed {descr}, ctxt) )\n  | (Prim (loc, I_NEVER, [], annot), Item_t (Never_t _, _rest, _)) ->\n      Lwt.return\n        ( error_unexpected_annot loc annot >|? fun () ->\n          let instr = {apply = (fun kinfo _k -> INever kinfo)} in\n          let descr aft = {loc; instr; bef = stack_ty; aft} in\n          log_stack loc stack_ty Bot_t ;\n          (Failed {descr}, ctxt) )\n  (* timestamp operations *)\n  | ( Prim (loc, I_ADD, [], annot),\n      Item_t (Timestamp_t tname, Item_t (Int_t _, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr =\n        {apply = (fun kinfo k -> IAdd_timestamp_to_seconds (kinfo, k))}\n      in\n      typed ctxt loc instr (Item_t (Timestamp_t tname, rest, annot))\n  | ( Prim (loc, I_ADD, [], annot),\n      Item_t (Int_t _, Item_t (Timestamp_t tname, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr =\n        {apply = (fun kinfo k -> IAdd_seconds_to_timestamp (kinfo, k))}\n      in\n      typed ctxt loc instr (Item_t (Timestamp_t tname, rest, annot))\n  | ( Prim (loc, I_SUB, [], annot),\n      Item_t (Timestamp_t tname, Item_t (Int_t _, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr =\n        {apply = (fun kinfo k -> ISub_timestamp_seconds (kinfo, k))}\n      in\n      let stack = Item_t (Timestamp_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_SUB, [], annot),\n      Item_t\n        ( Timestamp_t {annot = tn1; size = _},\n          Item_t (Timestamp_t {annot = tn2; size = _}, rest, _),\n          _ ) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_annot ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IDiff_timestamps (kinfo, k))} in\n      let stack = Item_t (int_t ~annot:tname, rest, annot) in\n      typed ctxt loc instr stack\n  (* string operations *)\n  | ( Prim (loc, I_CONCAT, [], annot),\n      Item_t (String_t tn1, Item_t (String_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IConcat_string_pair (kinfo, k))} in\n      typed ctxt loc instr (Item_t (String_t tname, rest, annot))\n  | ( Prim (loc, I_CONCAT, [], annot),\n      Item_t (List_t (String_t tname, _), rest, list_annot) ) ->\n      parse_var_annot ~default:list_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IConcat_string (kinfo, k))} in\n      typed ctxt loc instr (Item_t (String_t tname, rest, annot))\n  | ( Prim (loc, I_SLICE, [], annot),\n      Item_t\n        ( Nat_t _,\n          Item_t (Nat_t _, Item_t (String_t tname, rest, string_annot), _),\n          _ ) ) ->\n      parse_var_annot\n        ~default:(gen_access_annot string_annot default_slice_annot)\n        loc\n        annot\n      >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ISlice_string (kinfo, k))} in\n      let stack = Item_t (option_string'_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_SIZE, [], annot), Item_t (String_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IString_size (kinfo, k))} in\n      let stack = Item_t (nat_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  (* bytes operations *)\n  | ( Prim (loc, I_CONCAT, [], annot),\n      Item_t (Bytes_t tn1, Item_t (Bytes_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IConcat_bytes_pair (kinfo, k))} in\n      let stack = Item_t (Bytes_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_CONCAT, [], annot),\n      Item_t (List_t (Bytes_t tname, _), rest, list_annot) ) ->\n      parse_var_annot ~default:list_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IConcat_bytes (kinfo, k))} in\n      let stack = Item_t (Bytes_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_SLICE, [], annot),\n      Item_t\n        ( Nat_t _,\n          Item_t (Nat_t _, Item_t (Bytes_t tname, rest, bytes_annot), _),\n          _ ) ) ->\n      parse_var_annot\n        ~default:(gen_access_annot bytes_annot default_slice_annot)\n        loc\n        annot\n      >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ISlice_bytes (kinfo, k))} in\n      let stack = Item_t (option_bytes'_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_SIZE, [], annot), Item_t (Bytes_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IBytes_size (kinfo, k))} in\n      let stack = Item_t (nat_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  (* currency operations *)\n  | ( Prim (loc, I_ADD, [], annot),\n      Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IAdd_tez (kinfo, k))} in\n      let stack = Item_t (Mutez_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_SUB, [], annot),\n      Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ) ->\n      if legacy then\n        parse_var_annot loc annot >>?= fun annot ->\n        merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n        let instr = {apply = (fun kinfo k -> ISub_tez_legacy (kinfo, k))} in\n        let stack = Item_t (Mutez_t tname, rest, annot) in\n        typed ctxt loc instr stack\n      else fail (Deprecated_instruction I_SUB)\n  | ( Prim (loc, I_SUB_MUTEZ, [], annot),\n      Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> ISub_tez (kinfo, k))} in\n      let stack = Item_t (option_mutez'_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_MUL, [], annot),\n      Item_t (Mutez_t tname, Item_t (Nat_t _, rest, _), _) ) ->\n      (* no type name check *)\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IMul_teznat (kinfo, k))} in\n      let stack = Item_t (Mutez_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_MUL, [], annot),\n      Item_t (Nat_t _, Item_t (Mutez_t tname, rest, _), _) ) ->\n      (* no type name check *)\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IMul_nattez (kinfo, k))} in\n      let stack = Item_t (Mutez_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  (* boolean operations *)\n  | ( Prim (loc, I_OR, [], annot),\n      Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IOr (kinfo, k))} in\n      let stack = Item_t (Bool_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_AND, [], annot),\n      Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IAnd (kinfo, k))} in\n      let stack = Item_t (Bool_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_XOR, [], annot),\n      Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IXor (kinfo, k))} in\n      let stack = Item_t (Bool_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_NOT, [], annot), Item_t (Bool_t tname, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> INot (kinfo, k))} in\n      let stack = Item_t (Bool_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  (* integer operations *)\n  | (Prim (loc, I_ABS, [], annot), Item_t (Int_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IAbs_int (kinfo, k))} in\n      let stack = Item_t (nat_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_ISNAT, [], annot), Item_t (Int_t _, rest, int_annot)) ->\n      parse_var_annot loc annot ~default:int_annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IIs_nat (kinfo, k))} in\n      let stack = Item_t (option_nat_t, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_INT, [], annot), Item_t (Nat_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IInt_nat (kinfo, k))} in\n      let stack = Item_t (int_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_NEG, [], annot), Item_t (Int_t tname, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> INeg (kinfo, k))} in\n      let stack = Item_t (Int_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_NEG, [], annot), Item_t (Nat_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> INeg (kinfo, k))} in\n      let stack = Item_t (int_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_ADD, [], annot),\n      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IAdd_int (kinfo, k))} in\n      let stack = Item_t (Int_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_ADD, [], annot),\n      Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IAdd_int (kinfo, k))} in\n      let stack = Item_t (Int_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_ADD, [], annot),\n      Item_t (Nat_t _, Item_t (Int_t tname, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IAdd_int (kinfo, k))} in\n      let stack = Item_t (Int_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_ADD, [], annot),\n      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IAdd_nat (kinfo, k))} in\n      let stack = Item_t (Nat_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_SUB, [], annot),\n      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> ISub_int (kinfo, k))} in\n      let stack = Item_t (Int_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_SUB, [], annot),\n      Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ISub_int (kinfo, k))} in\n      let stack = Item_t (Int_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_SUB, [], annot),\n      Item_t (Nat_t _, Item_t (Int_t tname, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ISub_int (kinfo, k))} in\n      let stack = Item_t (Int_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_SUB, [], annot),\n      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun _tname ->\n      let instr = {apply = (fun kinfo k -> ISub_int (kinfo, k))} in\n      let stack = Item_t (int_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_MUL, [], annot),\n      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IMul_int (kinfo, k))} in\n      let stack = Item_t (Int_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_MUL, [], annot),\n      Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IMul_int (kinfo, k))} in\n      let stack = Item_t (Int_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_MUL, [], annot),\n      Item_t (Nat_t _, Item_t (Int_t tname, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IMul_nat (kinfo, k))} in\n      let stack = Item_t (Int_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_MUL, [], annot),\n      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IMul_nat (kinfo, k))} in\n      let stack = Item_t (Nat_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_EDIV, [], annot),\n      Item_t (Mutez_t tname, Item_t (Nat_t _, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IEdiv_teznat (kinfo, k))} in\n      let stack = Item_t (option_pair_mutez'_mutez'_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_EDIV, [], annot),\n      Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IEdiv_tez (kinfo, k))} in\n      let stack = Item_t (option_pair_nat_mutez'_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_EDIV, [], annot),\n      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IEdiv_int (kinfo, k))} in\n      let stack = Item_t (option_pair_int'_nat_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_EDIV, [], annot),\n      Item_t (Int_t tname, Item_t (Nat_t _, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IEdiv_int (kinfo, k))} in\n      let stack = Item_t (option_pair_int'_nat_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_EDIV, [], annot),\n      Item_t (Nat_t tname, Item_t (Int_t _, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IEdiv_nat (kinfo, k))} in\n      let stack = Item_t (option_pair_int_nat'_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_EDIV, [], annot),\n      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IEdiv_nat (kinfo, k))} in\n      let stack = Item_t (option_pair_nat'_nat'_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_LSL, [], annot),\n      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> ILsl_nat (kinfo, k))} in\n      let stack = Item_t (Nat_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_LSR, [], annot),\n      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> ILsr_nat (kinfo, k))} in\n      let stack = Item_t (Nat_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_OR, [], annot),\n      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IOr_nat (kinfo, k))} in\n      let stack = Item_t (Nat_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_AND, [], annot),\n      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IAnd_nat (kinfo, k))} in\n      let stack = Item_t (Nat_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_AND, [], annot),\n      Item_t (Int_t _, Item_t (Nat_t tname, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IAnd_int_nat (kinfo, k))} in\n      let stack = Item_t (Nat_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_XOR, [], annot),\n      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IXor_nat (kinfo, k))} in\n      let stack = Item_t (Nat_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_NOT, [], annot), Item_t (Int_t tname, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> INot_int (kinfo, k))} in\n      let stack = Item_t (Int_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_NOT, [], annot), Item_t (Nat_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> INot_int (kinfo, k))} in\n      let stack = Item_t (int_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  (* comparison *)\n  | (Prim (loc, I_COMPARE, [], annot), Item_t (t1, Item_t (t2, rest, _), _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      check_item_ty ctxt t1 t2 loc I_COMPARE 1 2 >>?= fun (Eq, t, ctxt) ->\n      comparable_ty_of_ty ctxt loc t >>?= fun (key, ctxt) ->\n      let instr = {apply = (fun kinfo k -> ICompare (kinfo, key, k))} in\n      let stack = Item_t (int_t ~annot:None, rest, annot) in\n      (typed ctxt loc instr stack : ((a, s) judgement * context) tzresult Lwt.t)\n  (* comparators *)\n  | (Prim (loc, I_EQ, [], annot), Item_t (Int_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IEq (kinfo, k))} in\n      let stack = Item_t (bool_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_NEQ, [], annot), Item_t (Int_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> INeq (kinfo, k))} in\n      let stack = Item_t (bool_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_LT, [], annot), Item_t (Int_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ILt (kinfo, k))} in\n      let stack = Item_t (bool_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_GT, [], annot), Item_t (Int_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IGt (kinfo, k))} in\n      let stack = Item_t (bool_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_LE, [], annot), Item_t (Int_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ILe (kinfo, k))} in\n      let stack = Item_t (bool_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_GE, [], annot), Item_t (Int_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IGe (kinfo, k))} in\n      let stack = Item_t (bool_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  (* annotations *)\n  | (Prim (loc, I_CAST, [cast_t], annot), Item_t (t, stack, item_annot)) ->\n      parse_var_annot loc annot ~default:item_annot >>?= fun annot ->\n      parse_any_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy cast_t\n      >>?= fun (Ex_ty cast_t, ctxt) ->\n      ty_eq ~legacy ctxt loc cast_t t >>?= fun (Eq, ctxt) ->\n      let instr = {apply = (fun _ k -> k)} in\n      let stack = Item_t (cast_t, stack, annot) in\n      (typed ctxt loc instr stack : ((a, s) judgement * context) tzresult Lwt.t)\n  | (Prim (loc, I_RENAME, [], annot), Item_t (t, stack, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      (* can erase annot *)\n      let instr = {apply = (fun _ k -> k)} in\n      let stack = Item_t (t, stack, annot) in\n      typed ctxt loc instr stack\n  (* packing *)\n  | (Prim (loc, I_PACK, [], annot), Item_t (t, rest, unpacked_annot)) ->\n      check_packable\n        ~legacy:true\n        (* allow to pack contracts for hash/signature checks *) loc\n        t\n      >>?= fun () ->\n      parse_var_annot\n        loc\n        annot\n        ~default:(gen_access_annot unpacked_annot default_pack_annot)\n      >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IPack (kinfo, t, k))} in\n      let stack = Item_t (bytes_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_UNPACK, [ty], annot), Item_t (Bytes_t _, rest, packed_annot))\n    ->\n      parse_packable_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy ty\n      >>?= fun (Ex_ty t, ctxt) ->\n      parse_var_type_annot loc annot >>?= fun (annot, ty_name) ->\n      option_t loc t ~annot:ty_name >>?= fun res_ty ->\n      let annot =\n        default_annot\n          annot\n          ~default:(gen_access_annot packed_annot default_unpack_annot)\n      in\n      let instr = {apply = (fun kinfo k -> IUnpack (kinfo, t, k))} in\n      let stack = Item_t (res_ty, rest, annot) in\n      typed ctxt loc instr stack\n  (* protocol *)\n  | ( Prim (loc, I_ADDRESS, [], annot),\n      Item_t (Contract_t _, rest, contract_annot) ) ->\n      parse_var_annot\n        loc\n        annot\n        ~default:(gen_access_annot contract_annot default_addr_annot)\n      >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IAddress (kinfo, k))} in\n      let stack = Item_t (address_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_CONTRACT, [ty], annot), Item_t (Address_t _, rest, addr_annot))\n    ->\n      parse_parameter_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy ty\n      >>?= fun (Ex_ty t, ctxt) ->\n      contract_t loc t ~annot:None >>?= fun contract_ty ->\n      option_t loc contract_ty ~annot:None >>?= fun res_ty ->\n      parse_entrypoint_annot\n        loc\n        annot\n        ~default:(gen_access_annot addr_annot default_contract_annot)\n      >>?= fun (annot, entrypoint) ->\n      (match entrypoint with\n      | None -> Ok \"default\"\n      | Some (Field_annot entrypoint) ->\n          let entrypoint = (entrypoint :> string) in\n          if Compare.String.(entrypoint = \"default\") then\n            error (Unexpected_annotation loc)\n          else if Compare.Int.(String.length entrypoint > 31) then\n            error (Entrypoint_name_too_long entrypoint)\n          else Ok entrypoint)\n      >>?= fun entrypoint ->\n      let instr =\n        {apply = (fun kinfo k -> IContract (kinfo, t, entrypoint, k))}\n      in\n      let stack = Item_t (res_ty, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_VIEW, [name; output_ty], annot),\n      Item_t (input_ty, Item_t (Address_t _, rest, addr_annot), _) ) ->\n      let output_ty_loc = location output_ty in\n      parse_view_name ctxt name >>?= fun (name, ctxt) ->\n      parse_view_output_ty ctxt ~stack_depth:0 ~legacy output_ty\n      >>?= fun (Ex_ty output_ty, ctxt) ->\n      option_t output_ty_loc output_ty ~annot:None >>?= fun res_ty ->\n      parse_var_annot\n        loc\n        annot\n        ~default:(gen_access_annot addr_annot default_contract_annot)\n      >>?= fun annot ->\n      let instr =\n        {\n          apply =\n            (fun kinfo k ->\n              IView (kinfo, View_signature {name; input_ty; output_ty}, k));\n        }\n      in\n      let stack = Item_t (res_ty, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_TRANSFER_TOKENS, [], annot),\n      Item_t (p, Item_t (Mutez_t _, Item_t (Contract_t (cp, _), rest, _), _), _)\n    ) ->\n      check_item_ty ctxt p cp loc I_TRANSFER_TOKENS 1 4\n      >>?= fun (Eq, _, ctxt) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ITransfer_tokens (kinfo, k))} in\n      let stack = Item_t (operation_t ~annot:None, rest, annot) in\n      (typed ctxt loc instr stack : ((a, s) judgement * context) tzresult Lwt.t)\n  | ( Prim (loc, I_SET_DELEGATE, [], annot),\n      Item_t (Option_t (Key_hash_t _, _), rest, _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ISet_delegate (kinfo, k))} in\n      let stack = Item_t (operation_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (_, I_CREATE_ACCOUNT, _, _), _) ->\n      fail (Deprecated_instruction I_CREATE_ACCOUNT)\n  | (Prim (loc, I_IMPLICIT_ACCOUNT, [], annot), Item_t (Key_hash_t _, rest, _))\n    ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IImplicit_account (kinfo, k))} in\n      let stack = Item_t (contract_unit_t, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_CREATE_CONTRACT, [(Seq _ as code)], annot),\n      Item_t\n        ( Option_t (Key_hash_t _, _),\n          Item_t (Mutez_t _, Item_t (ginit, rest, _), _),\n          _ ) ) ->\n      parse_two_var_annot loc annot >>?= fun (op_annot, addr_annot) ->\n      let canonical_code = Micheline.strip_locations code in\n      parse_toplevel ctxt ~legacy canonical_code\n      >>?= fun ({arg_type; storage_type; code_field; views; root_name}, ctxt) ->\n      record_trace\n        (Ill_formed_type (Some \"parameter\", canonical_code, location arg_type))\n        (parse_parameter_ty\n           ctxt\n           ~stack_depth:(stack_depth + 1)\n           ~legacy\n           arg_type)\n      >>?= fun (Ex_ty arg_type, ctxt) ->\n      (if legacy then Result.return_unit\n      else well_formed_entrypoints ~root_name arg_type)\n      >>?= fun () ->\n      record_trace\n        (Ill_formed_type (Some \"storage\", canonical_code, location storage_type))\n        (parse_storage_ty\n           ctxt\n           ~stack_depth:(stack_depth + 1)\n           ~legacy\n           storage_type)\n      >>?= fun (Ex_ty storage_type, ctxt) ->\n      let arg_annot =\n        default_annot\n          (type_to_var_annot (name_of_ty arg_type))\n          ~default:default_param_annot\n      in\n      let storage_annot =\n        default_annot\n          (type_to_var_annot (name_of_ty storage_type))\n          ~default:default_storage_annot\n      in\n      pair_t\n        loc\n        (arg_type, None, arg_annot)\n        (storage_type, None, storage_annot)\n        ~annot:None\n      >>?= fun arg_type_full ->\n      pair_t\n        loc\n        (list_operation_t, None, None)\n        (storage_type, None, None)\n        ~annot:None\n      >>?= fun ret_type_full ->\n      trace\n        (Ill_typed_contract (canonical_code, []))\n        (parse_returning\n           (Toplevel {storage_type; param_type = arg_type; root_name})\n           ctxt\n           ~legacy\n           ?type_logger\n           ~stack_depth:(stack_depth + 1)\n           (arg_type_full, None)\n           ret_type_full\n           code_field)\n      >>=? fun ( (Lam\n                    ( {\n                        kbef = Item_t (arg, Bot_t, _);\n                        kaft = Item_t (ret, Bot_t, _);\n                        _;\n                      },\n                      _ ) as lambda),\n                 ctxt ) ->\n      let views_result =\n        typecheck_views ctxt ?type_logger ~legacy storage_type views\n      in\n      trace (Ill_typed_contract (canonical_code, [])) views_result\n      >>=? fun ctxt ->\n      ty_eq ~legacy ctxt loc arg arg_type_full >>?= fun (Eq, ctxt) ->\n      ty_eq ~legacy ctxt loc ret ret_type_full >>?= fun (Eq, ctxt) ->\n      ty_eq ~legacy ctxt loc storage_type ginit >>?= fun (Eq, ctxt) ->\n      let instr =\n        {\n          apply =\n            (fun kinfo k ->\n              ICreate_contract\n                {kinfo; storage_type; arg_type; lambda; views; root_name; k});\n        }\n      in\n      let stack =\n        Item_t\n          ( operation_t ~annot:None,\n            Item_t (address_t ~annot:None, rest, addr_annot),\n            op_annot )\n      in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_NOW, [], annot), stack) ->\n      parse_var_annot loc annot ~default:default_now_annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> INow (kinfo, k))} in\n      let stack = Item_t (timestamp_t ~annot:None, stack, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_AMOUNT, [], annot), stack) ->\n      parse_var_annot loc annot ~default:default_amount_annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IAmount (kinfo, k))} in\n      let stack = Item_t (mutez_t ~annot:None, stack, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_CHAIN_ID, [], annot), stack) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IChainId (kinfo, k))} in\n      let stack = Item_t (chain_id_t ~annot:None, stack, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_BALANCE, [], annot), stack) ->\n      parse_var_annot loc annot ~default:default_balance_annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IBalance (kinfo, k))} in\n      let stack = Item_t (mutez_t ~annot:None, stack, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_LEVEL, [], annot), stack) ->\n      parse_var_annot loc annot ~default:default_level_annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ILevel (kinfo, k))} in\n      let stack = Item_t (nat_t ~annot:None, stack, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_VOTING_POWER, [], annot), Item_t (Key_hash_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IVoting_power (kinfo, k))} in\n      let stack = Item_t (nat_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_TOTAL_VOTING_POWER, [], annot), stack) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ITotal_voting_power (kinfo, k))} in\n      let stack = Item_t (nat_t ~annot:None, stack, annot) in\n      typed ctxt loc instr stack\n  | (Prim (_, I_STEPS_TO_QUOTA, _, _), _) ->\n      fail (Deprecated_instruction I_STEPS_TO_QUOTA)\n  | (Prim (loc, I_SOURCE, [], annot), stack) ->\n      parse_var_annot loc annot ~default:default_source_annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ISource (kinfo, k))} in\n      let stack = Item_t (address_t ~annot:None, stack, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_SENDER, [], annot), stack) ->\n      parse_var_annot loc annot ~default:default_sender_annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ISender (kinfo, k))} in\n      let stack = Item_t (address_t ~annot:None, stack, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_SELF, [], annot), stack) ->\n      Lwt.return\n        ( parse_entrypoint_annot loc annot ~default:default_self_annot\n        >>? fun (annot, entrypoint) ->\n          let entrypoint =\n            Option.fold\n              ~some:(fun (Field_annot annot) -> (annot :> string))\n              ~none:\"default\"\n              entrypoint\n          in\n          let rec get_toplevel_type :\n              tc_context -> ((a, s) judgement * context) tzresult = function\n            | Lambda -> error (Self_in_lambda loc)\n            | Dip (_, prev) -> get_toplevel_type prev\n            | Toplevel {param_type; root_name; storage_type = _} ->\n                find_entrypoint param_type ~root_name entrypoint\n                >>? fun (_, Ex_ty param_type) ->\n                contract_t loc param_type ~annot:None >>? fun res_ty ->\n                let instr =\n                  {\n                    apply =\n                      (fun kinfo k -> ISelf (kinfo, param_type, entrypoint, k));\n                  }\n                in\n                let stack = Item_t (res_ty, stack, annot) in\n                typed_no_lwt ctxt loc instr stack\n          in\n          get_toplevel_type tc_context )\n  | (Prim (loc, I_SELF_ADDRESS, [], annot), stack) ->\n      parse_var_annot loc annot ~default:default_self_annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ISelf_address (kinfo, k))} in\n      let stack = Item_t (address_t ~annot:None, stack, annot) in\n      typed ctxt loc instr stack\n  (* cryptography *)\n  | (Prim (loc, I_HASH_KEY, [], annot), Item_t (Key_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IHash_key (kinfo, k))} in\n      let stack = Item_t (key_hash_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_CHECK_SIGNATURE, [], annot),\n      Item_t (Key_t _, Item_t (Signature_t _, Item_t (Bytes_t _, rest, _), _), _)\n    ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ICheck_signature (kinfo, k))} in\n      let stack = Item_t (bool_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_BLAKE2B, [], annot), Item_t (Bytes_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IBlake2b (kinfo, k))} in\n      let stack = Item_t (bytes_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_SHA256, [], annot), Item_t (Bytes_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ISha256 (kinfo, k))} in\n      let stack = Item_t (bytes_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_SHA512, [], annot), Item_t (Bytes_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ISha512 (kinfo, k))} in\n      let stack = Item_t (bytes_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_KECCAK, [], annot), Item_t (Bytes_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IKeccak (kinfo, k))} in\n      let stack = Item_t (bytes_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_SHA3, [], annot), Item_t (Bytes_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> ISha3 (kinfo, k))} in\n      let stack = Item_t (bytes_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_ADD, [], annot),\n      Item_t (Bls12_381_g1_t tn1, Item_t (Bls12_381_g1_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IAdd_bls12_381_g1 (kinfo, k))} in\n      let stack = Item_t (Bls12_381_g1_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_ADD, [], annot),\n      Item_t (Bls12_381_g2_t tn1, Item_t (Bls12_381_g2_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IAdd_bls12_381_g2 (kinfo, k))} in\n      let stack = Item_t (Bls12_381_g2_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_ADD, [], annot),\n      Item_t (Bls12_381_fr_t tn1, Item_t (Bls12_381_fr_t tn2, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      merge_type_metadata ~legacy tn1 tn2 >>?= fun tname ->\n      let instr = {apply = (fun kinfo k -> IAdd_bls12_381_fr (kinfo, k))} in\n      let stack = Item_t (Bls12_381_fr_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_MUL, [], annot),\n      Item_t (Bls12_381_g1_t tname, Item_t (Bls12_381_fr_t _, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IMul_bls12_381_g1 (kinfo, k))} in\n      let stack = Item_t (Bls12_381_g1_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_MUL, [], annot),\n      Item_t (Bls12_381_g2_t tname, Item_t (Bls12_381_fr_t _, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IMul_bls12_381_g2 (kinfo, k))} in\n      let stack = Item_t (Bls12_381_g2_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_MUL, [], annot),\n      Item_t (Bls12_381_fr_t tname, Item_t (Bls12_381_fr_t _, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IMul_bls12_381_fr (kinfo, k))} in\n      let stack = Item_t (Bls12_381_fr_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_MUL, [], annot),\n      Item_t (Nat_t {annot = tname; _}, Item_t (Bls12_381_fr_t _, rest, _), _)\n    ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IMul_bls12_381_fr_z (kinfo, k))} in\n      let stack = Item_t (bls12_381_fr_t ~annot:tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_MUL, [], annot),\n      Item_t (Int_t {annot = tname; _}, Item_t (Bls12_381_fr_t _, rest, _), _)\n    ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IMul_bls12_381_fr_z (kinfo, k))} in\n      let stack = Item_t (bls12_381_fr_t ~annot:tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_MUL, [], annot),\n      Item_t (Bls12_381_fr_t tname, Item_t (Int_t _, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IMul_bls12_381_z_fr (kinfo, k))} in\n      let stack = Item_t (Bls12_381_fr_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_MUL, [], annot),\n      Item_t (Bls12_381_fr_t tname, Item_t (Nat_t _, rest, _), _) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IMul_bls12_381_z_fr (kinfo, k))} in\n      let stack = Item_t (Bls12_381_fr_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_INT, [], annot), Item_t (Bls12_381_fr_t _, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> IInt_bls12_381_fr (kinfo, k))} in\n      let stack = Item_t (int_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_NEG, [], annot), Item_t (Bls12_381_g1_t tname, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> INeg_bls12_381_g1 (kinfo, k))} in\n      let stack = Item_t (Bls12_381_g1_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_NEG, [], annot), Item_t (Bls12_381_g2_t tname, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> INeg_bls12_381_g2 (kinfo, k))} in\n      let stack = Item_t (Bls12_381_g2_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | (Prim (loc, I_NEG, [], annot), Item_t (Bls12_381_fr_t tname, rest, _)) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr = {apply = (fun kinfo k -> INeg_bls12_381_fr (kinfo, k))} in\n      let stack = Item_t (Bls12_381_fr_t tname, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_PAIRING_CHECK, [], annot),\n      Item_t\n        ( List_t\n            (Pair_t ((Bls12_381_g1_t _, _, _), (Bls12_381_g2_t _, _, _), _), _),\n          rest,\n          _ ) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let instr =\n        {apply = (fun kinfo k -> IPairing_check_bls12_381 (kinfo, k))}\n      in\n      let stack = Item_t (bool_t ~annot:None, rest, annot) in\n      typed ctxt loc instr stack\n  (* Tickets *)\n  | (Prim (loc, I_TICKET, [], annot), Item_t (t, Item_t (Nat_t _, rest, _), _))\n    ->\n      parse_var_annot loc annot >>?= fun annot ->\n      comparable_ty_of_ty ctxt loc t >>?= fun (ty, ctxt) ->\n      ticket_t loc ty ~annot:None >>?= fun res_ty ->\n      let instr = {apply = (fun kinfo k -> ITicket (kinfo, k))} in\n      let stack = Item_t (res_ty, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_READ_TICKET, [], annot),\n      (Item_t (Ticket_t (t, _), _, _) as full_stack) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let () = check_dupable_comparable_ty t in\n      opened_ticket_type loc t >>?= fun opened_ticket_ty ->\n      let result = ty_of_comparable_ty opened_ticket_ty in\n      let instr = {apply = (fun kinfo k -> IRead_ticket (kinfo, k))} in\n      let stack = Item_t (result, full_stack, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_SPLIT_TICKET, [], annot),\n      Item_t\n        ( (Ticket_t (t, _) as ticket_t),\n          Item_t\n            (Pair_t ((Nat_t _, fa_a, a_a), (Nat_t _, fa_b, a_b), _), rest, _),\n          _ ) ) ->\n      parse_var_annot loc annot >>?= fun annot ->\n      let () = check_dupable_comparable_ty t in\n      pair_t loc (ticket_t, fa_a, a_a) (ticket_t, fa_b, a_b) ~annot:None\n      >>?= fun pair_tickets_ty ->\n      option_t loc pair_tickets_ty ~annot:None >>?= fun res_ty ->\n      let instr = {apply = (fun kinfo k -> ISplit_ticket (kinfo, k))} in\n      let stack = Item_t (res_ty, rest, annot) in\n      typed ctxt loc instr stack\n  | ( Prim (loc, I_JOIN_TICKETS, [], annot),\n      Item_t\n        ( Pair_t (((Ticket_t _ as ty_a), _, _), ((Ticket_t _ as ty_b), _, _), _),\n          rest,\n          _ ) ) -> (\n      parse_var_annot loc annot >>?= fun annot ->\n      Gas_monad.run ctxt\n      @@ merge_types\n           ~legacy\n           ~merge_type_error_flag:Default_merge_type_error\n           loc\n           ty_a\n           ty_b\n      >>?= fun (eq_ty, ctxt) ->\n      eq_ty >>?= fun (Eq, ty) ->\n      match ty with\n      | Ticket_t (contents_ty, _) ->\n          option_t loc ty ~annot:None >>?= fun res_ty ->\n          let instr =\n            {apply = (fun kinfo k -> IJoin_tickets (kinfo, contents_ty, k))}\n          in\n          let stack = Item_t (res_ty, rest, annot) in\n          typed ctxt loc instr stack\n      | _ ->\n          (* TODO: https://gitlab.com/tezos/tezos/-/issues/1962\n             fix injectivity of types *)\n          assert false)\n  (* Timelocks *)\n  | ( Prim (loc, I_OPEN_CHEST, [], _),\n      Item_t (Chest_key_t _, Item_t (Chest_t _, Item_t (Nat_t _, rest, _), _), _)\n    ) ->\n      let instr = {apply = (fun kinfo k -> IOpen_chest (kinfo, k))} in\n      typed ctxt loc instr (Item_t (union_bytes_bool_t, rest, None))\n  (* Primitive parsing errors *)\n  | ( Prim\n        ( loc,\n          (( I_DUP | I_SWAP | I_SOME | I_UNIT | I_PAIR | I_UNPAIR | I_CAR\n           | I_CDR | I_CONS | I_CONCAT | I_SLICE | I_MEM | I_UPDATE | I_GET\n           | I_EXEC | I_FAILWITH | I_SIZE | I_ADD | I_SUB | I_SUB_MUTEZ | I_MUL\n           | I_EDIV | I_OR | I_AND | I_XOR | I_NOT | I_ABS | I_NEG | I_LSL\n           | I_LSR | I_COMPARE | I_EQ | I_NEQ | I_LT | I_GT | I_LE | I_GE\n           | I_TRANSFER_TOKENS | I_SET_DELEGATE | I_NOW | I_IMPLICIT_ACCOUNT\n           | I_AMOUNT | I_BALANCE | I_LEVEL | I_CHECK_SIGNATURE | I_HASH_KEY\n           | I_SOURCE | I_SENDER | I_BLAKE2B | I_SHA256 | I_SHA512 | I_ADDRESS\n           | I_RENAME | I_PACK | I_ISNAT | I_INT | I_SELF | I_CHAIN_ID | I_NEVER\n           | I_VOTING_POWER | I_TOTAL_VOTING_POWER | I_KECCAK | I_SHA3\n           | I_PAIRING_CHECK | I_TICKET | I_READ_TICKET | I_SPLIT_TICKET\n           | I_JOIN_TICKETS | I_OPEN_CHEST ) as name),\n          (_ :: _ as l),\n          _ ),\n      _ ) ->\n      fail (Invalid_arity (loc, name, 0, List.length l))\n  | ( Prim\n        ( loc,\n          (( I_NONE | I_LEFT | I_RIGHT | I_NIL | I_MAP | I_ITER | I_EMPTY_SET\n           | I_LOOP | I_LOOP_LEFT | I_CONTRACT | I_CAST | I_UNPACK\n           | I_CREATE_CONTRACT ) as name),\n          (([] | _ :: _ :: _) as l),\n          _ ),\n      _ ) ->\n      fail (Invalid_arity (loc, name, 1, List.length l))\n  | ( Prim\n        ( loc,\n          (( I_PUSH | I_VIEW | I_IF_NONE | I_IF_LEFT | I_IF_CONS | I_EMPTY_MAP\n           | I_EMPTY_BIG_MAP | I_IF ) as name),\n          (([] | [_] | _ :: _ :: _ :: _) as l),\n          _ ),\n      _ ) ->\n      fail (Invalid_arity (loc, name, 2, List.length l))\n  | ( Prim (loc, I_LAMBDA, (([] | [_] | [_; _] | _ :: _ :: _ :: _ :: _) as l), _),\n      _ ) ->\n      fail (Invalid_arity (loc, I_LAMBDA, 3, List.length l))\n  (* Stack errors *)\n  | ( Prim\n        ( loc,\n          (( I_ADD | I_SUB | I_SUB_MUTEZ | I_MUL | I_EDIV | I_AND | I_OR | I_XOR\n           | I_LSL | I_LSR | I_CONCAT | I_PAIRING_CHECK ) as name),\n          [],\n          _ ),\n      Item_t (ta, Item_t (tb, _, _), _) ) ->\n      let ta = serialize_ty_for_error ta in\n      let tb = serialize_ty_for_error tb in\n      fail (Undefined_binop (loc, name, ta, tb))\n  | ( Prim\n        ( loc,\n          (( I_NEG | I_ABS | I_NOT | I_SIZE | I_EQ | I_NEQ | I_LT | I_GT | I_LE\n           | I_GE\n           (* CONCAT is both unary and binary; this case can only be triggered\n               on a singleton stack *)\n           | I_CONCAT ) as name),\n          [],\n          _ ),\n      Item_t (t, _, _) ) ->\n      let t = serialize_ty_for_error t in\n      fail (Undefined_unop (loc, name, t))\n  | (Prim (loc, ((I_UPDATE | I_SLICE | I_OPEN_CHEST) as name), [], _), stack) ->\n      Lwt.return\n        (let stack = serialize_stack_for_error ctxt stack in\n         error (Bad_stack (loc, name, 3, stack)))\n  | (Prim (loc, I_CREATE_CONTRACT, _, _), stack) ->\n      let stack = serialize_stack_for_error ctxt stack in\n      fail (Bad_stack (loc, I_CREATE_CONTRACT, 7, stack))\n  | (Prim (loc, I_TRANSFER_TOKENS, [], _), stack) ->\n      Lwt.return\n        (let stack = serialize_stack_for_error ctxt stack in\n         error (Bad_stack (loc, I_TRANSFER_TOKENS, 4, stack)))\n  | ( Prim\n        ( loc,\n          (( I_DROP | I_DUP | I_CAR | I_CDR | I_UNPAIR | I_SOME | I_BLAKE2B\n           | I_SHA256 | I_SHA512 | I_DIP | I_IF_NONE | I_LEFT | I_RIGHT\n           | I_IF_LEFT | I_IF | I_LOOP | I_IF_CONS | I_IMPLICIT_ACCOUNT | I_NEG\n           | I_ABS | I_INT | I_NOT | I_HASH_KEY | I_EQ | I_NEQ | I_LT | I_GT\n           | I_LE | I_GE | I_SIZE | I_FAILWITH | I_RENAME | I_PACK | I_ISNAT\n           | I_ADDRESS | I_SET_DELEGATE | I_CAST | I_MAP | I_ITER | I_LOOP_LEFT\n           | I_UNPACK | I_CONTRACT | I_NEVER | I_KECCAK | I_SHA3 | I_READ_TICKET\n           | I_JOIN_TICKETS ) as name),\n          _,\n          _ ),\n      stack ) ->\n      Lwt.return\n        (let stack = serialize_stack_for_error ctxt stack in\n         error (Bad_stack (loc, name, 1, stack)))\n  | ( Prim\n        ( loc,\n          (( I_SWAP | I_PAIR | I_CONS | I_GET | I_MEM | I_EXEC\n           | I_CHECK_SIGNATURE | I_ADD | I_SUB | I_SUB_MUTEZ | I_MUL | I_EDIV\n           | I_AND | I_OR | I_XOR | I_LSL | I_LSR | I_COMPARE | I_PAIRING_CHECK\n           | I_TICKET | I_SPLIT_TICKET ) as name),\n          _,\n          _ ),\n      stack ) ->\n      Lwt.return\n        (let stack = serialize_stack_for_error ctxt stack in\n         error (Bad_stack (loc, name, 2, stack)))\n  (* Generic parsing errors *)\n  | (expr, _) ->\n      fail\n      @@ unexpected\n           expr\n           [Seq_kind]\n           Instr_namespace\n           [\n             I_DROP;\n             I_DUP;\n             I_DIG;\n             I_DUG;\n             I_VIEW;\n             I_SWAP;\n             I_SOME;\n             I_UNIT;\n             I_PAIR;\n             I_UNPAIR;\n             I_CAR;\n             I_CDR;\n             I_CONS;\n             I_MEM;\n             I_UPDATE;\n             I_MAP;\n             I_ITER;\n             I_GET;\n             I_GET_AND_UPDATE;\n             I_EXEC;\n             I_FAILWITH;\n             I_SIZE;\n             I_CONCAT;\n             I_ADD;\n             I_SUB;\n             I_SUB_MUTEZ;\n             I_MUL;\n             I_EDIV;\n             I_OR;\n             I_AND;\n             I_XOR;\n             I_NOT;\n             I_ABS;\n             I_INT;\n             I_NEG;\n             I_LSL;\n             I_LSR;\n             I_COMPARE;\n             I_EQ;\n             I_NEQ;\n             I_LT;\n             I_GT;\n             I_LE;\n             I_GE;\n             I_TRANSFER_TOKENS;\n             I_CREATE_CONTRACT;\n             I_NOW;\n             I_AMOUNT;\n             I_BALANCE;\n             I_LEVEL;\n             I_IMPLICIT_ACCOUNT;\n             I_CHECK_SIGNATURE;\n             I_BLAKE2B;\n             I_SHA256;\n             I_SHA512;\n             I_HASH_KEY;\n             I_PUSH;\n             I_NONE;\n             I_LEFT;\n             I_RIGHT;\n             I_NIL;\n             I_EMPTY_SET;\n             I_DIP;\n             I_LOOP;\n             I_IF_NONE;\n             I_IF_LEFT;\n             I_IF_CONS;\n             I_EMPTY_MAP;\n             I_EMPTY_BIG_MAP;\n             I_IF;\n             I_SOURCE;\n             I_SENDER;\n             I_SELF;\n             I_SELF_ADDRESS;\n             I_LAMBDA;\n             I_NEVER;\n             I_VOTING_POWER;\n             I_TOTAL_VOTING_POWER;\n             I_KECCAK;\n             I_SHA3;\n             I_PAIRING_CHECK;\n             I_SAPLING_EMPTY_STATE;\n             I_SAPLING_VERIFY_UPDATE;\n             I_TICKET;\n             I_READ_TICKET;\n             I_SPLIT_TICKET;\n             I_JOIN_TICKETS;\n             I_OPEN_CHEST;\n           ]\n\nand[@coq_axiom_with_reason \"complex mutually recursive definition\"] parse_contract :\n    type arg.\n    stack_depth:int ->\n    legacy:bool ->\n    context ->\n    Script.location ->\n    arg ty ->\n    Contract.t ->\n    entrypoint:string ->\n    (context * arg typed_contract) tzresult Lwt.t =\n fun ~stack_depth ~legacy ctxt loc arg contract ~entrypoint ->\n  match Contract.is_implicit contract with\n  | Some _ -> (\n      match entrypoint with\n      | \"default\" ->\n          (* An implicit account on the \"default\" entrypoint always exists and has type unit. *)\n          Lwt.return\n            ( ty_eq ~legacy:true ctxt loc arg (unit_t ~annot:None)\n            >|? fun (Eq, ctxt) ->\n              let contract : arg typed_contract =\n                (arg, (contract, entrypoint))\n              in\n              (ctxt, contract) )\n      | _ -> fail (No_such_entrypoint entrypoint))\n  | None -> (\n      (* Originated account *)\n      trace (Invalid_contract (loc, contract))\n      @@ Contract.get_script_code ctxt contract\n      >>=? fun (ctxt, code) ->\n      match code with\n      | None -> fail (Invalid_contract (loc, contract))\n      | Some code ->\n          Lwt.return\n            ( Script.force_decode_in_context\n                ~consume_deserialization_gas:When_needed\n                ctxt\n                code\n            >>? fun (code, ctxt) ->\n              (* can only fail because of gas *)\n              parse_toplevel ctxt ~legacy:true code\n              >>? fun ({arg_type; root_name; _}, ctxt) ->\n              parse_parameter_ty\n                ctxt\n                ~stack_depth:(stack_depth + 1)\n                ~legacy:true\n                arg_type\n              >>? fun (Ex_ty targ, ctxt) ->\n              (* we don't check targ size here because it's a legacy contract code *)\n              Gas_monad.run ctxt\n              @@ find_entrypoint_for_type\n                   ~legacy\n                   ~merge_type_error_flag:Default_merge_type_error\n                   ~full:targ\n                   ~expected:arg\n                   ~root_name\n                   entrypoint\n                   loc\n              >>? fun (entrypoint_arg, ctxt) ->\n              entrypoint_arg >|? fun (entrypoint, arg) ->\n              let contract : arg typed_contract =\n                (arg, (contract, entrypoint))\n              in\n              (ctxt, contract) ))\n\nand parse_view_name ctxt : Script.node -> (Script_string.t * context) tzresult =\n  function\n  | String (loc, v) as expr ->\n      (* The limitation of length of string is same as entrypoint *)\n      if Compare.Int.(String.length v > 31) then error (View_name_too_long v)\n      else\n        let rec check_char i =\n          if Compare.Int.(i < 0) then ok v\n          else if Script_ir_annot.is_allowed_char v.[i] then check_char (i - 1)\n          else error (Bad_view_name loc)\n        in\n        Gas.consume ctxt (Typecheck_costs.check_printable v) >>? fun ctxt ->\n        record_trace\n          (Invalid_syntactic_constant\n             ( loc,\n               strip_locations expr,\n               \"string [a-zA-Z0-9_.%@] and the maximum string length of 31 \\\n                characters\" ))\n          ( check_char (String.length v - 1) >>? fun v ->\n            Script_string.of_string v >|? fun s -> (s, ctxt) )\n  | expr -> error @@ Invalid_kind (location expr, [String_kind], kind expr)\n\nand parse_toplevel :\n    context -> legacy:bool -> Script.expr -> (toplevel * context) tzresult =\n fun ctxt ~legacy toplevel ->\n  record_trace (Ill_typed_contract (toplevel, []))\n  @@\n  match root toplevel with\n  | Int (loc, _) -> error (Invalid_kind (loc, [Seq_kind], Int_kind))\n  | String (loc, _) -> error (Invalid_kind (loc, [Seq_kind], String_kind))\n  | Bytes (loc, _) -> error (Invalid_kind (loc, [Seq_kind], Bytes_kind))\n  | Prim (loc, _, _, _) -> error (Invalid_kind (loc, [Seq_kind], Prim_kind))\n  | Seq (_, fields) -> (\n      let rec find_fields ctxt p s c views fields =\n        match fields with\n        | [] -> ok (ctxt, (p, s, c, views))\n        | Int (loc, _) :: _ -> error (Invalid_kind (loc, [Prim_kind], Int_kind))\n        | String (loc, _) :: _ ->\n            error (Invalid_kind (loc, [Prim_kind], String_kind))\n        | Bytes (loc, _) :: _ ->\n            error (Invalid_kind (loc, [Prim_kind], Bytes_kind))\n        | Seq (loc, _) :: _ -> error (Invalid_kind (loc, [Prim_kind], Seq_kind))\n        | Prim (loc, K_parameter, [arg], annot) :: rest -> (\n            match p with\n            | None -> find_fields ctxt (Some (arg, loc, annot)) s c views rest\n            | Some _ -> error (Duplicate_field (loc, K_parameter)))\n        | Prim (loc, K_storage, [arg], annot) :: rest -> (\n            match s with\n            | None -> find_fields ctxt p (Some (arg, loc, annot)) c views rest\n            | Some _ -> error (Duplicate_field (loc, K_storage)))\n        | Prim (loc, K_code, [arg], annot) :: rest -> (\n            match c with\n            | None -> find_fields ctxt p s (Some (arg, loc, annot)) views rest\n            | Some _ -> error (Duplicate_field (loc, K_code)))\n        | Prim (loc, ((K_parameter | K_storage | K_code) as name), args, _) :: _\n          ->\n            error (Invalid_arity (loc, name, 1, List.length args))\n        | Prim (loc, K_view, [name; input_ty; output_ty; view_code], _) :: rest\n          ->\n            parse_view_name ctxt name >>? fun (str, ctxt) ->\n            Gas.consume\n              ctxt\n              (Michelson_v1_gas.Cost_of.Interpreter.view_update str views)\n            >>? fun ctxt ->\n            if SMap.mem str views then error (Duplicated_view_name loc)\n            else\n              let views' =\n                SMap.add str {input_ty; output_ty; view_code} views\n              in\n              find_fields ctxt p s c views' rest\n        | Prim (loc, K_view, args, _) :: _ ->\n            error (Invalid_arity (loc, K_view, 4, List.length args))\n        | Prim (loc, name, _, _) :: _ ->\n            let allowed = [K_parameter; K_storage; K_code; K_view] in\n            error (Invalid_primitive (loc, allowed, name))\n      in\n      find_fields ctxt None None None SMap.empty fields\n      >>? fun (ctxt, toplevel) ->\n      match toplevel with\n      | (None, _, _, _) -> error (Missing_field K_parameter)\n      | (Some _, None, _, _) -> error (Missing_field K_storage)\n      | (Some _, Some _, None, _) -> error (Missing_field K_code)\n      | ( Some (p, ploc, pannot),\n          Some (s, sloc, sannot),\n          Some (c, cloc, carrot),\n          views ) ->\n          let maybe_root_name =\n            (* root name can be attached to either the parameter\n                 primitive or the toplevel constructor *)\n            Script_ir_annot.extract_field_annot p >>? fun (p, root_name) ->\n            match root_name with\n            | Some _ -> ok (p, pannot, root_name)\n            | None -> (\n                match pannot with\n                | [single]\n                  when Compare.Int.(String.length single > 0)\n                       && Compare.Char.(single.[0] = '%') ->\n                    parse_field_annot ploc [single] >>? fun pannot ->\n                    ok (p, [], pannot)\n                | _ -> ok (p, pannot, None))\n          in\n          (if legacy then\n           (* legacy semantics ignores spurious annotations *)\n           match maybe_root_name with\n           | Ok (p, _, root_name) -> ok (p, root_name)\n           | Error _ -> ok (p, None)\n          else\n            (* only one field annot is allowed to set the root entrypoint name *)\n            maybe_root_name >>? fun (p, pannot, root_name) ->\n            Script_ir_annot.error_unexpected_annot ploc pannot >>? fun () ->\n            Script_ir_annot.error_unexpected_annot cloc carrot >>? fun () ->\n            Script_ir_annot.error_unexpected_annot sloc sannot >|? fun () ->\n            (p, root_name))\n          >|? fun (arg_type, root_name) ->\n          ({code_field = c; arg_type; root_name; views; storage_type = s}, ctxt)\n      )\n\n(* Same as [parse_contract], but does not fail when the contact is missing or\n   if the expected type doesn't match the actual one. In that case None is\n   returned and some overapproximation of the typechecking gas is consumed.\n   This can still fail on gas exhaustion. *)\nlet parse_contract_for_script :\n    type arg.\n    context ->\n    Script.location ->\n    arg ty ->\n    Contract.t ->\n    entrypoint:string ->\n    (context * arg typed_contract option) tzresult Lwt.t =\n fun ctxt loc arg contract ~entrypoint ->\n  match Contract.is_implicit contract with\n  | Some _ -> (\n      match entrypoint with\n      | \"default\" ->\n          (* An implicit account on the \"default\" entrypoint always exists and has type unit. *)\n          Lwt.return\n            ( Gas_monad.run ctxt\n            @@ merge_types\n                 ~legacy:true\n                 ~merge_type_error_flag:Fast_merge_type_error\n                 loc\n                 arg\n                 (unit_t ~annot:None)\n            >|? fun (eq_ty, ctxt) ->\n              match eq_ty with\n              | Ok (Eq, _ty) ->\n                  let contract : arg typed_contract =\n                    (arg, (contract, entrypoint))\n                  in\n                  (ctxt, Some contract)\n              | Error _ -> (ctxt, None) )\n      | _ ->\n          Lwt.return\n            ( Gas.consume ctxt Typecheck_costs.parse_instr_cycle >|? fun ctxt ->\n              (* An implicit account on any other entrypoint is not a valid contract. *)\n              (ctxt, None) ))\n  | None -> (\n      (* Originated account *)\n      trace (Invalid_contract (loc, contract))\n      @@ Contract.get_script_code ctxt contract\n      >>=? fun (ctxt, code) ->\n      match code with\n      | None -> return (ctxt, None)\n      | Some code ->\n          Lwt.return\n            ( Script.force_decode_in_context\n                ~consume_deserialization_gas:When_needed\n                ctxt\n                code\n            >>? fun (code, ctxt) ->\n              (* can only fail because of gas *)\n              match parse_toplevel ctxt ~legacy:true code with\n              | Error _ -> error (Invalid_contract (loc, contract))\n              | Ok ({arg_type; root_name; _}, ctxt) -> (\n                  match\n                    parse_parameter_ty ctxt ~stack_depth:0 ~legacy:true arg_type\n                  with\n                  | Error _ -> error (Invalid_contract (loc, contract))\n                  | Ok (Ex_ty targ, ctxt) -> (\n                      (* we don't check targ size here because it's a legacy contract code *)\n                      Gas_monad.run ctxt\n                      @@ find_entrypoint_for_type\n                           ~legacy:false\n                           ~merge_type_error_flag:Fast_merge_type_error\n                           ~full:targ\n                           ~expected:arg\n                           ~root_name\n                           entrypoint\n                           loc\n                      >|? fun (entrypoint_arg, ctxt) ->\n                      match entrypoint_arg with\n                      | Ok (entrypoint, arg) ->\n                          let contract : arg typed_contract =\n                            (arg, (contract, entrypoint))\n                          in\n                          (ctxt, Some contract)\n                      | Error _ -> (ctxt, None))) ))\n\nlet parse_code :\n    ?type_logger:type_logger ->\n    context ->\n    legacy:bool ->\n    code:lazy_expr ->\n    (ex_code * context) tzresult Lwt.t =\n fun ?type_logger ctxt ~legacy ~code ->\n  Script.force_decode_in_context\n    ~consume_deserialization_gas:When_needed\n    ctxt\n    code\n  >>?= fun (code, ctxt) ->\n  Global_constants_storage.expand ctxt code >>=? fun (ctxt, code) ->\n  parse_toplevel ctxt ~legacy code\n  >>?= fun ({arg_type; storage_type; code_field; views; root_name}, ctxt) ->\n  let arg_type_loc = location arg_type in\n  record_trace\n    (Ill_formed_type (Some \"parameter\", code, arg_type_loc))\n    (parse_parameter_ty ctxt ~stack_depth:0 ~legacy arg_type)\n  >>?= fun (Ex_ty arg_type, ctxt) ->\n  (if legacy then Result.return_unit\n  else well_formed_entrypoints ~root_name arg_type)\n  >>?= fun () ->\n  let storage_type_loc = location storage_type in\n  record_trace\n    (Ill_formed_type (Some \"storage\", code, storage_type_loc))\n    (parse_storage_ty ctxt ~stack_depth:0 ~legacy storage_type)\n  >>?= fun (Ex_ty storage_type, ctxt) ->\n  let arg_annot =\n    default_annot\n      (type_to_var_annot (name_of_ty arg_type))\n      ~default:default_param_annot\n  in\n  let storage_annot =\n    default_annot\n      (type_to_var_annot (name_of_ty storage_type))\n      ~default:default_storage_annot\n  in\n\n  pair_t\n    storage_type_loc\n    (arg_type, None, arg_annot)\n    (storage_type, None, storage_annot)\n    ~annot:None\n  >>?= fun arg_type_full ->\n  pair_t\n    storage_type_loc\n    (list_operation_t, None, None)\n    (storage_type, None, None)\n    ~annot:None\n  >>?= fun ret_type_full ->\n  trace\n    (Ill_typed_contract (code, []))\n    (parse_returning\n       (Toplevel {storage_type; param_type = arg_type; root_name})\n       ctxt\n       ~legacy\n       ~stack_depth:0\n       ?type_logger\n       (arg_type_full, None)\n       ret_type_full\n       code_field)\n  >>=? fun (code, ctxt) ->\n  Lwt.return\n    (let open Script_typed_ir_size in\n    let view_size view =\n      node_size view.view_code ++ node_size view.input_ty\n      ++ node_size view.output_ty\n    in\n    let views_size = SMap.fold (fun _ v s -> view_size v ++ s) views zero in\n    (* The size of the storage_type and the arg_type is counted by\n       [lambda_size]. *)\n    let ir_size = lambda_size code in\n    let (nodes, code_size) = views_size ++ ir_size in\n    (* We consume gas after the fact in order to not have to instrument\n       [node_size] (for efficiency).\n       This is safe, as we already pay gas proportional to [views_size]\n       and [ir_size] during their typechecking. *)\n    Gas.consume ctxt (Script_typed_ir_size_costs.nodes_cost ~nodes)\n    >>? fun ctxt ->\n    ok\n      (Ex_code {code; arg_type; storage_type; views; root_name; code_size}, ctxt))\n\nlet parse_storage :\n    ?type_logger:type_logger ->\n    context ->\n    legacy:bool ->\n    allow_forged:bool ->\n    'storage ty ->\n    storage:lazy_expr ->\n    ('storage * context) tzresult Lwt.t =\n fun ?type_logger ctxt ~legacy ~allow_forged storage_type ~storage ->\n  Script.force_decode_in_context\n    ~consume_deserialization_gas:When_needed\n    ctxt\n    storage\n  >>?= fun (storage, ctxt) ->\n  trace_eval\n    (fun () ->\n      let storage_type = serialize_ty_for_error storage_type in\n      Ill_typed_data (None, storage, storage_type))\n    (parse_data\n       ?type_logger\n       ~stack_depth:0\n       ctxt\n       ~legacy\n       ~allow_forged\n       storage_type\n       (root storage))\n\nlet[@coq_axiom_with_reason \"gadt\"] parse_script :\n    ?type_logger:type_logger ->\n    context ->\n    legacy:bool ->\n    allow_forged_in_storage:bool ->\n    Script.t ->\n    (ex_script * context) tzresult Lwt.t =\n fun ?type_logger ctxt ~legacy ~allow_forged_in_storage {code; storage} ->\n  parse_code ~legacy ctxt ?type_logger ~code\n  >>=? fun ( Ex_code {code; arg_type; storage_type; views; root_name; code_size},\n             ctxt ) ->\n  parse_storage\n    ?type_logger\n    ctxt\n    ~legacy\n    ~allow_forged:allow_forged_in_storage\n    storage_type\n    ~storage\n  >|=? fun (storage, ctxt) ->\n  ( Ex_script\n      {code_size; code; arg_type; storage; storage_type; views; root_name},\n    ctxt )\n\nlet typecheck_code :\n    legacy:bool ->\n    show_types:bool ->\n    context ->\n    Script.expr ->\n    (type_map * context) tzresult Lwt.t =\n fun ~legacy ~show_types ctxt code ->\n  (* Constants need to be expanded or [parse_toplevel] may fail. *)\n  Global_constants_storage.expand ctxt code >>=? fun (ctxt, code) ->\n  parse_toplevel ctxt ~legacy code\n  >>?= fun ({arg_type; storage_type; code_field; views; root_name}, ctxt) ->\n  let type_map = ref [] in\n  let arg_type_loc = location arg_type in\n  record_trace\n    (Ill_formed_type (Some \"parameter\", code, arg_type_loc))\n    (parse_parameter_ty ctxt ~stack_depth:0 ~legacy arg_type)\n  >>?= fun (Ex_ty arg_type, ctxt) ->\n  (if legacy then Result.return_unit\n  else well_formed_entrypoints ~root_name arg_type)\n  >>?= fun () ->\n  let storage_type_loc = location storage_type in\n  record_trace\n    (Ill_formed_type (Some \"storage\", code, storage_type_loc))\n    (parse_storage_ty ctxt ~stack_depth:0 ~legacy storage_type)\n  >>?= fun (Ex_ty storage_type, ctxt) ->\n  let arg_annot =\n    default_annot\n      (type_to_var_annot (name_of_ty arg_type))\n      ~default:default_param_annot\n  in\n  let storage_annot =\n    default_annot\n      (type_to_var_annot (name_of_ty storage_type))\n      ~default:default_storage_annot\n  in\n  pair_t\n    storage_type_loc\n    (arg_type, None, arg_annot)\n    (storage_type, None, storage_annot)\n    ~annot:None\n  >>?= fun arg_type_full ->\n  pair_t\n    storage_type_loc\n    (list_operation_t, None, None)\n    (storage_type, None, None)\n    ~annot:None\n  >>?= fun ret_type_full ->\n  let type_logger loc bef aft = type_map := (loc, (bef, aft)) :: !type_map in\n  let type_logger = if show_types then Some type_logger else None in\n  let result =\n    parse_returning\n      (Toplevel {storage_type; param_type = arg_type; root_name})\n      ctxt\n      ~legacy\n      ~stack_depth:0\n      ?type_logger\n      (arg_type_full, None)\n      ret_type_full\n      code_field\n  in\n  trace (Ill_typed_contract (code, !type_map)) result >>=? fun (Lam _, ctxt) ->\n  let views_result =\n    typecheck_views\n      ctxt\n      ~type_logger:(fun loc bef aft ->\n        type_map := (loc, (bef, aft)) :: !type_map)\n      ~legacy\n      storage_type\n      views\n  in\n  trace (Ill_typed_contract (code, !type_map)) views_result >|=? fun ctxt ->\n  (!type_map, ctxt)\n\nmodule Entrypoints_map = Map.Make (String)\n\nlet list_entrypoints (type full) (full : full ty) ctxt ~root_name =\n  let merge path annot (type t) (ty : t ty) reachable\n      ((unreachables, all) as acc) =\n    match annot with\n    | None -> (\n        ok\n        @@\n        if reachable then acc\n        else\n          match ty with\n          | Union_t _ -> acc\n          | _ -> (List.rev path :: unreachables, all))\n    | Some (Field_annot name) ->\n        let name = (name :> string) in\n        if Compare.Int.(String.length name > 31) then\n          ok (List.rev path :: unreachables, all)\n        else if Entrypoints_map.mem name all then\n          ok (List.rev path :: unreachables, all)\n        else\n          unparse_ty ~loc:() ctxt ty >>? fun (unparsed_ty, _) ->\n          ok\n            ( unreachables,\n              Entrypoints_map.add name (List.rev path, unparsed_ty) all )\n  in\n  let rec fold_tree :\n      type t.\n      t ty ->\n      prim list ->\n      bool ->\n      prim list list\n      * (prim list * Script.unlocated_michelson_node) Entrypoints_map.t ->\n      (prim list list\n      * (prim list * Script.unlocated_michelson_node) Entrypoints_map.t)\n      tzresult =\n   fun t path reachable acc ->\n    match t with\n    | Union_t ((tl, al), (tr, ar), _) ->\n        merge (D_Left :: path) al tl reachable acc >>? fun acc ->\n        merge (D_Right :: path) ar tr reachable acc >>? fun acc ->\n        fold_tree\n          tl\n          (D_Left :: path)\n          (match al with Some _ -> true | None -> reachable)\n          acc\n        >>? fun acc ->\n        fold_tree\n          tr\n          (D_Right :: path)\n          (match ar with Some _ -> true | None -> reachable)\n          acc\n    | _ -> ok acc\n  in\n  unparse_ty ~loc:() ctxt full >>? fun (unparsed_full, _) ->\n  let (init, reachable) =\n    match root_name with\n    | None -> (Entrypoints_map.empty, false)\n    | Some (Field_annot name) ->\n        (Entrypoints_map.singleton (name :> string) ([], unparsed_full), true)\n  in\n  fold_tree full [] reachable ([], init)\n  [@@coq_axiom_with_reason \"unsupported syntax\"]\n\n(* ---- Unparsing (Typed IR -> Untyped expressions) --------------------------*)\n\n(* -- Unparsing data of any type -- *)\n\nlet comb_witness2 : type t. t ty -> (t, unit -> unit -> unit) comb_witness =\n  function\n  | Pair_t (_, (Pair_t _, _, _), _) -> Comb_Pair (Comb_Pair Comb_Any)\n  | Pair_t _ -> Comb_Pair Comb_Any\n  | _ -> Comb_Any\n\nlet[@coq_axiom_with_reason \"gadt\"] rec unparse_data :\n    type a.\n    context ->\n    stack_depth:int ->\n    unparsing_mode ->\n    a ty ->\n    a ->\n    (Script.node * context) tzresult Lwt.t =\n fun ctxt ~stack_depth mode ty a ->\n  Gas.consume ctxt Unparse_costs.unparse_data_cycle >>?= fun ctxt ->\n  let non_terminal_recursion ctxt mode ty a =\n    if Compare.Int.(stack_depth > 10_000) then\n      fail Unparsing_too_many_recursive_calls\n    else unparse_data ctxt ~stack_depth:(stack_depth + 1) mode ty a\n  in\n  let loc = Micheline.dummy_location in\n  match (ty, a) with\n  | (Unit_t _, v) -> Lwt.return @@ unparse_unit ~loc ctxt v\n  | (Int_t _, v) -> Lwt.return @@ unparse_int ~loc ctxt v\n  | (Nat_t _, v) -> Lwt.return @@ unparse_nat ~loc ctxt v\n  | (String_t _, s) -> Lwt.return @@ unparse_string ~loc ctxt s\n  | (Bytes_t _, s) -> Lwt.return @@ unparse_bytes ~loc ctxt s\n  | (Bool_t _, b) -> Lwt.return @@ unparse_bool ~loc ctxt b\n  | (Timestamp_t _, t) -> Lwt.return @@ unparse_timestamp ~loc ctxt mode t\n  | (Address_t _, address) ->\n      Lwt.return @@ unparse_address ~loc ctxt mode address\n  | (Contract_t _, contract) ->\n      Lwt.return @@ unparse_contract ~loc ctxt mode contract\n  | (Signature_t _, s) -> Lwt.return @@ unparse_signature ~loc ctxt mode s\n  | (Mutez_t _, v) -> Lwt.return @@ unparse_mutez ~loc ctxt v\n  | (Key_t _, k) -> Lwt.return @@ unparse_key ~loc ctxt mode k\n  | (Key_hash_t _, k) -> Lwt.return @@ unparse_key_hash ~loc ctxt mode k\n  | (Operation_t _, operation) ->\n      Lwt.return @@ unparse_operation ~loc ctxt operation\n  | (Chain_id_t _, chain_id) ->\n      Lwt.return @@ unparse_chain_id ~loc ctxt mode chain_id\n  | (Bls12_381_g1_t _, x) -> Lwt.return @@ unparse_bls12_381_g1 ~loc ctxt x\n  | (Bls12_381_g2_t _, x) -> Lwt.return @@ unparse_bls12_381_g2 ~loc ctxt x\n  | (Bls12_381_fr_t _, x) -> Lwt.return @@ unparse_bls12_381_fr ~loc ctxt x\n  | (Pair_t ((tl, _, _), (tr, _, _), _), pair) ->\n      let r_witness = comb_witness2 tr in\n      let unparse_l ctxt v = non_terminal_recursion ctxt mode tl v in\n      let unparse_r ctxt v = non_terminal_recursion ctxt mode tr v in\n      unparse_pair ~loc unparse_l unparse_r ctxt mode r_witness pair\n  | (Union_t ((tl, _), (tr, _), _), v) ->\n      let unparse_l ctxt v = non_terminal_recursion ctxt mode tl v in\n      let unparse_r ctxt v = non_terminal_recursion ctxt mode tr v in\n      unparse_union ~loc unparse_l unparse_r ctxt v\n  | (Option_t (t, _), v) ->\n      let unparse_v ctxt v = non_terminal_recursion ctxt mode t v in\n      unparse_option ~loc unparse_v ctxt v\n  | (List_t (t, _), items) ->\n      List.fold_left_es\n        (fun (l, ctxt) element ->\n          non_terminal_recursion ctxt mode t element\n          >|=? fun (unparsed, ctxt) -> (unparsed :: l, ctxt))\n        ([], ctxt)\n        items.elements\n      >|=? fun (items, ctxt) -> (Micheline.Seq (loc, List.rev items), ctxt)\n  | (Ticket_t (t, _), {ticketer; contents; amount}) ->\n      (* ideally we would like to allow a little overhead here because it is only used for unparsing *)\n      opened_ticket_type loc t >>?= fun opened_ticket_ty ->\n      let t = ty_of_comparable_ty opened_ticket_ty in\n      (unparse_data [@tailcall])\n        ctxt\n        ~stack_depth\n        mode\n        t\n        ((ticketer, \"default\"), (contents, amount))\n  | (Set_t (t, _), set) ->\n      List.fold_left_es\n        (fun (l, ctxt) item ->\n          unparse_comparable_data ~loc ctxt mode t item >|=? fun (item, ctxt) ->\n          (item :: l, ctxt))\n        ([], ctxt)\n        (Script_set.fold (fun e acc -> e :: acc) set [])\n      >|=? fun (items, ctxt) -> (Micheline.Seq (loc, items), ctxt)\n  | (Map_t (kt, vt, _), map) ->\n      let items = Script_map.fold (fun k v acc -> (k, v) :: acc) map [] in\n      unparse_items ctxt ~stack_depth:(stack_depth + 1) mode kt vt items\n      >|=? fun (items, ctxt) -> (Micheline.Seq (loc, items), ctxt)\n  | (Big_map_t (_kt, _vt, _), {id = Some id; diff = {size; _}; _})\n    when Compare.Int.( = ) size 0 ->\n      return (Micheline.Int (loc, Big_map.Id.unparse_to_z id), ctxt)\n  | (Big_map_t (kt, vt, _), {id = Some id; diff = {map; _}; _}) ->\n      let items =\n        Big_map_overlay.fold (fun _ (k, v) acc -> (k, v) :: acc) map []\n      in\n      let items =\n        (* Sort the items in Michelson comparison order and not in key\n           hash order. This code path is only exercised for tracing,\n           so we don't bother carbonating this sort operation\n           precisely. Also, the sort uses a reverse compare because\n           [unparse_items] will reverse the result. *)\n        List.sort\n          (fun (a, _) (b, _) -> Script_comparable.compare_comparable kt b a)\n          items\n      in\n      (* this can't fail if the original type is well-formed\n         because [option vt] is always strictly smaller than [big_map kt vt] *)\n      option_t loc vt ~annot:None >>?= fun vt ->\n      unparse_items ctxt ~stack_depth:(stack_depth + 1) mode kt vt items\n      >|=? fun (items, ctxt) ->\n      ( Micheline.Prim\n          ( loc,\n            D_Pair,\n            [Int (loc, Big_map.Id.unparse_to_z id); Seq (loc, items)],\n            [] ),\n        ctxt )\n  | (Big_map_t (kt, vt, _), {id = None; diff = {map; _}; _}) ->\n      let items =\n        Big_map_overlay.fold\n          (fun _ (k, v) acc ->\n            match v with None -> acc | Some v -> (k, v) :: acc)\n          map\n          []\n      in\n      let items =\n        (* See note above. *)\n        List.sort\n          (fun (a, _) (b, _) -> Script_comparable.compare_comparable kt b a)\n          items\n      in\n      unparse_items ctxt ~stack_depth:(stack_depth + 1) mode kt vt items\n      >|=? fun (items, ctxt) -> (Micheline.Seq (loc, items), ctxt)\n  | (Lambda_t _, Lam (_, original_code)) ->\n      unparse_code ctxt ~stack_depth:(stack_depth + 1) mode original_code\n  | (Never_t _, _) -> .\n  | (Sapling_transaction_t _, s) ->\n      Lwt.return\n        ( Gas.consume ctxt (Unparse_costs.sapling_transaction s) >|? fun ctxt ->\n          let bytes =\n            Data_encoding.Binary.to_bytes_exn Sapling.transaction_encoding s\n          in\n          (Bytes (loc, bytes), ctxt) )\n  | (Sapling_state_t _, {id; diff; _}) ->\n      Lwt.return\n        ( Gas.consume ctxt (Unparse_costs.sapling_diff diff) >|? fun ctxt ->\n          ( (match diff with\n            | {commitments_and_ciphertexts = []; nullifiers = []} -> (\n                match id with\n                | None -> Micheline.Seq (loc, [])\n                | Some id ->\n                    let id = Sapling.Id.unparse_to_z id in\n                    Micheline.Int (loc, id))\n            | diff -> (\n                let diff_bytes =\n                  Data_encoding.Binary.to_bytes_exn Sapling.diff_encoding diff\n                in\n                let unparsed_diff = Bytes (loc, diff_bytes) in\n                match id with\n                | None -> unparsed_diff\n                | Some id ->\n                    let id = Sapling.Id.unparse_to_z id in\n                    Micheline.Prim\n                      (loc, D_Pair, [Int (loc, id); unparsed_diff], []))),\n            ctxt ) )\n  | (Chest_key_t _, s) ->\n      unparse_with_data_encoding\n        ~loc\n        ctxt\n        s\n        Unparse_costs.chest_key\n        Timelock.chest_key_encoding\n  | (Chest_t _, s) ->\n      unparse_with_data_encoding\n        ~loc\n        ctxt\n        s\n        (Unparse_costs.chest ~plaintext_size:(Timelock.get_plaintext_size s))\n        Timelock.chest_encoding\n\nand unparse_items :\n    type k v.\n    context ->\n    stack_depth:int ->\n    unparsing_mode ->\n    k comparable_ty ->\n    v ty ->\n    (k * v) list ->\n    (Script.node list * context) tzresult Lwt.t =\n fun ctxt ~stack_depth mode kt vt items ->\n  List.fold_left_es\n    (fun (l, ctxt) (k, v) ->\n      let loc = Micheline.dummy_location in\n      unparse_comparable_data ~loc ctxt mode kt k >>=? fun (key, ctxt) ->\n      unparse_data ctxt ~stack_depth:(stack_depth + 1) mode vt v\n      >|=? fun (value, ctxt) -> (Prim (loc, D_Elt, [key; value], []) :: l, ctxt))\n    ([], ctxt)\n    items\n\nand[@coq_axiom_with_reason \"gadt\"] unparse_code ctxt ~stack_depth mode code =\n  let legacy = true in\n  Gas.consume ctxt Unparse_costs.unparse_instr_cycle >>?= fun ctxt ->\n  let non_terminal_recursion ctxt mode code =\n    if Compare.Int.(stack_depth > 10_000) then\n      fail Unparsing_too_many_recursive_calls\n    else unparse_code ctxt ~stack_depth:(stack_depth + 1) mode code\n  in\n  match code with\n  | Prim (loc, I_PUSH, [ty; data], annot) ->\n      parse_packable_ty ctxt ~stack_depth:(stack_depth + 1) ~legacy ty\n      >>?= fun (Ex_ty t, ctxt) ->\n      let allow_forged =\n        false\n        (* Forgeable in PUSH data are already forbidden at parsing,\n           the only case for which this matters is storing a lambda resulting\n           from APPLYing a non-forgeable but this cannot happen either as long\n           as all packable values are also forgeable. *)\n      in\n      parse_data\n        ctxt\n        ~stack_depth:(stack_depth + 1)\n        ~legacy\n        ~allow_forged\n        t\n        data\n      >>=? fun (data, ctxt) ->\n      unparse_data ctxt ~stack_depth:(stack_depth + 1) mode t data\n      >>=? fun (data, ctxt) ->\n      return (Prim (loc, I_PUSH, [ty; data], annot), ctxt)\n  | Seq (loc, items) ->\n      List.fold_left_es\n        (fun (l, ctxt) item ->\n          non_terminal_recursion ctxt mode item >|=? fun (item, ctxt) ->\n          (item :: l, ctxt))\n        ([], ctxt)\n        items\n      >>=? fun (items, ctxt) ->\n      return (Micheline.Seq (loc, List.rev items), ctxt)\n  | Prim (loc, prim, items, annot) ->\n      List.fold_left_es\n        (fun (l, ctxt) item ->\n          non_terminal_recursion ctxt mode item >|=? fun (item, ctxt) ->\n          (item :: l, ctxt))\n        ([], ctxt)\n        items\n      >>=? fun (items, ctxt) ->\n      return (Prim (loc, prim, List.rev items, annot), ctxt)\n  | (Int _ | String _ | Bytes _) as atom -> return (atom, ctxt)\n\n(* Gas accounting may not be perfect in this function, as it is only called by RPCs. *)\n(* TODO: https://gitlab.com/tezos/tezos/-/issues/1688\n   Refactor the sharing part of unparse_script and create_contract *)\nlet unparse_script ctxt mode\n    {code; arg_type; storage; storage_type; root_name; views; _} =\n  let (Lam (_, original_code)) = code in\n  unparse_code ctxt ~stack_depth:0 mode original_code >>=? fun (code, ctxt) ->\n  unparse_data ctxt ~stack_depth:0 mode storage_type storage\n  >>=? fun (storage, ctxt) ->\n  Lwt.return\n    (let loc = Micheline.dummy_location in\n     unparse_ty ~loc ctxt arg_type >>? fun (arg_type, ctxt) ->\n     unparse_ty ~loc ctxt storage_type >>? fun (storage_type, ctxt) ->\n     let arg_type = add_field_annot root_name None arg_type in\n     let open Micheline in\n     let view name {input_ty; output_ty; view_code} views =\n       Prim\n         ( loc,\n           K_view,\n           [\n             String (loc, Script_string.to_string name);\n             input_ty;\n             output_ty;\n             view_code;\n           ],\n           [] )\n       :: views\n     in\n     let views = SMap.fold view views [] |> List.rev in\n     let code =\n       Seq\n         ( loc,\n           [\n             Prim (loc, K_parameter, [arg_type], []);\n             Prim (loc, K_storage, [storage_type], []);\n             Prim (loc, K_code, [code], []);\n           ]\n           @ views )\n     in\n     Gas.consume ctxt Unparse_costs.unparse_instr_cycle >>? fun ctxt ->\n     Gas.consume ctxt Unparse_costs.unparse_instr_cycle >>? fun ctxt ->\n     Gas.consume ctxt Unparse_costs.unparse_instr_cycle >>? fun ctxt ->\n     Gas.consume ctxt Unparse_costs.unparse_instr_cycle >>? fun ctxt ->\n     Gas.consume ctxt (Script.strip_locations_cost code) >>? fun ctxt ->\n     Gas.consume ctxt (Script.strip_locations_cost storage) >|? fun ctxt ->\n     ( {\n         code = lazy_expr (strip_locations code);\n         storage = lazy_expr (strip_locations storage);\n       },\n       ctxt ))\n\nlet pack_data_with_mode ctxt typ data ~mode =\n  unparse_data ~stack_depth:0 ctxt mode typ data >>=? fun (unparsed, ctxt) ->\n  Lwt.return @@ pack_node unparsed ctxt\n\nlet hash_data ctxt typ data =\n  pack_data_with_mode ctxt typ data ~mode:Optimized_legacy\n  >>=? fun (bytes, ctxt) -> Lwt.return @@ hash_bytes ctxt bytes\n\nlet pack_data ctxt typ data =\n  pack_data_with_mode ctxt typ data ~mode:Optimized_legacy\n\n(* ---------------- Big map -------------------------------------------------*)\n\nlet empty_big_map key_type value_type =\n  {\n    id = None;\n    diff = {map = Big_map_overlay.empty; size = 0};\n    key_type;\n    value_type;\n  }\n\nlet big_map_mem ctxt key {id; diff; key_type; _} =\n  hash_comparable_data ctxt key_type key >>=? fun (key, ctxt) ->\n  match (Big_map_overlay.find key diff.map, id) with\n  | (None, None) -> return (false, ctxt)\n  | (None, Some id) ->\n      Alpha_context.Big_map.mem ctxt id key >|=? fun (ctxt, res) -> (res, ctxt)\n  | (Some (_, None), _) -> return (false, ctxt)\n  | (Some (_, Some _), _) -> return (true, ctxt)\n\nlet big_map_get_by_hash ctxt key {id; diff; value_type; _} =\n  match (Big_map_overlay.find key diff.map, id) with\n  | (Some (_, x), _) -> return (x, ctxt)\n  | (None, None) -> return (None, ctxt)\n  | (None, Some id) -> (\n      Alpha_context.Big_map.get_opt ctxt id key >>=? function\n      | (ctxt, None) -> return (None, ctxt)\n      | (ctxt, Some value) ->\n          parse_data\n            ~stack_depth:0\n            ctxt\n            ~legacy:true\n            ~allow_forged:true\n            value_type\n            (Micheline.root value)\n          >|=? fun (x, ctxt) -> (Some x, ctxt))\n\nlet big_map_get ctxt key map =\n  hash_comparable_data ctxt map.key_type key >>=? fun (key_hash, ctxt) ->\n  big_map_get_by_hash ctxt key_hash map\n\nlet big_map_update_by_hash ctxt key_hash key value map =\n  let contains = Big_map_overlay.mem key_hash map.diff.map in\n  return\n    ( {\n        map with\n        diff =\n          {\n            map = Big_map_overlay.add key_hash (key, value) map.diff.map;\n            size = (if contains then map.diff.size else map.diff.size + 1);\n          };\n      },\n      ctxt )\n\nlet big_map_update ctxt key value map =\n  hash_comparable_data ctxt map.key_type key >>=? fun (key_hash, ctxt) ->\n  big_map_update_by_hash ctxt key_hash key value map\n\nlet big_map_get_and_update ctxt key value map =\n  hash_comparable_data ctxt map.key_type key >>=? fun (key_hash, ctxt) ->\n  big_map_update_by_hash ctxt key_hash key value map >>=? fun (map', ctxt) ->\n  big_map_get_by_hash ctxt key_hash map >>=? fun (old_value, ctxt) ->\n  return ((old_value, map'), ctxt)\n\n(* ---------------- Lazy storage---------------------------------------------*)\n\ntype lazy_storage_ids = Lazy_storage.IdSet.t\n\nlet no_lazy_storage_id = Lazy_storage.IdSet.empty\n\nlet diff_of_big_map ctxt mode ~temporary ~ids_to_copy\n    {id; key_type; value_type; diff} =\n  (match id with\n  | Some id ->\n      if Lazy_storage.IdSet.mem Big_map id ids_to_copy then\n        Big_map.fresh ~temporary ctxt >|=? fun (ctxt, duplicate) ->\n        (ctxt, Lazy_storage.Copy {src = id}, duplicate)\n      else\n        (* The first occurrence encountered of a big_map reuses the\n             ID. This way, the payer is only charged for the diff.\n             For this to work, this diff has to be put at the end of\n             the global diff, otherwise the duplicates will use the\n             updated version as a base. This is true because we add\n             this diff first in the accumulator of\n             `extract_lazy_storage_updates`, and this accumulator is not\n             reversed. *)\n        return (ctxt, Lazy_storage.Existing, id)\n  | None ->\n      Big_map.fresh ~temporary ctxt >>=? fun (ctxt, id) ->\n      Lwt.return\n        (let kt = unparse_comparable_ty_uncarbonated ~loc:() key_type in\n         Gas.consume ctxt (Script.strip_locations_cost kt) >>? fun ctxt ->\n         unparse_ty ~loc:() ctxt value_type >>? fun (kv, ctxt) ->\n         Gas.consume ctxt (Script.strip_locations_cost kv) >|? fun ctxt ->\n         let key_type = Micheline.strip_locations kt in\n         let value_type = Micheline.strip_locations kv in\n         (ctxt, Lazy_storage.(Alloc Big_map.{key_type; value_type}), id)))\n  >>=? fun (ctxt, init, id) ->\n  let pairs =\n    Big_map_overlay.fold\n      (fun key_hash (key, value) acc -> (key_hash, key, value) :: acc)\n      diff.map\n      []\n  in\n  List.fold_left_es\n    (fun (acc, ctxt) (key_hash, key, value) ->\n      Gas.consume ctxt Typecheck_costs.parse_instr_cycle >>?= fun ctxt ->\n      unparse_comparable_data ~loc:() ctxt mode key_type key\n      >>=? fun (key_node, ctxt) ->\n      Gas.consume ctxt (Script.strip_locations_cost key_node) >>?= fun ctxt ->\n      let key = Micheline.strip_locations key_node in\n      (match value with\n      | None -> return (None, ctxt)\n      | Some x ->\n          unparse_data ~stack_depth:0 ctxt mode value_type x\n          >>=? fun (node, ctxt) ->\n          Lwt.return\n            ( Gas.consume ctxt (Script.strip_locations_cost node) >|? fun ctxt ->\n              (Some (Micheline.strip_locations node), ctxt) ))\n      >|=? fun (value, ctxt) ->\n      let diff_item = Big_map.{key; key_hash; value} in\n      (diff_item :: acc, ctxt))\n    ([], ctxt)\n    (List.rev pairs)\n  >|=? fun (updates, ctxt) -> (Lazy_storage.Update {init; updates}, id, ctxt)\n\nlet diff_of_sapling_state ctxt ~temporary ~ids_to_copy\n    ({id; diff; memo_size} : Sapling.state) =\n  (match id with\n  | Some id ->\n      if Lazy_storage.IdSet.mem Sapling_state id ids_to_copy then\n        Sapling.fresh ~temporary ctxt >|=? fun (ctxt, duplicate) ->\n        (ctxt, Lazy_storage.Copy {src = id}, duplicate)\n      else return (ctxt, Lazy_storage.Existing, id)\n  | None ->\n      Sapling.fresh ~temporary ctxt >|=? fun (ctxt, id) ->\n      (ctxt, Lazy_storage.Alloc Sapling.{memo_size}, id))\n  >|=? fun (ctxt, init, id) ->\n  (Lazy_storage.Update {init; updates = diff}, id, ctxt)\n\n(**\n    Witness flag for whether a type can be populated by a value containing a\n    lazy storage.\n    [False_f] must be used only when a value of the type cannot contain a lazy\n    storage.\n\n    This flag is built in [has_lazy_storage] and used only in\n    [extract_lazy_storage_updates] and [collect_lazy_storage].\n\n    This flag is necessary to avoid these two functions to have a quadratic\n    complexity in the size of the type.\n\n    Add new lazy storage kinds here.\n\n    Please keep the usage of this GADT local.\n*)\ntype 'ty has_lazy_storage =\n  | True_f : _ has_lazy_storage\n  | False_f : _ has_lazy_storage\n  | Pair_f :\n      'a has_lazy_storage * 'b has_lazy_storage\n      -> ('a, 'b) pair has_lazy_storage\n  | Union_f :\n      'a has_lazy_storage * 'b has_lazy_storage\n      -> ('a, 'b) union has_lazy_storage\n  | Option_f : 'a has_lazy_storage -> 'a option has_lazy_storage\n  | List_f : 'a has_lazy_storage -> 'a boxed_list has_lazy_storage\n  | Map_f : 'v has_lazy_storage -> (_, 'v) map has_lazy_storage\n\n(**\n    This function is called only on storage and parameter types of contracts,\n    once per typechecked contract. It has a complexity linear in the size of\n    the types, which happen to be literally written types, so the gas for them\n    has already been paid.\n*)\nlet rec has_lazy_storage : type t. t ty -> t has_lazy_storage =\n fun ty ->\n  let aux1 cons t =\n    match has_lazy_storage t with False_f -> False_f | h -> cons h\n  in\n  let aux2 cons t1 t2 =\n    match (has_lazy_storage t1, has_lazy_storage t2) with\n    | (False_f, False_f) -> False_f\n    | (h1, h2) -> cons h1 h2\n  in\n  match ty with\n  | Big_map_t (_, _, _) -> True_f\n  | Sapling_state_t _ -> True_f\n  | Unit_t _ -> False_f\n  | Int_t _ -> False_f\n  | Nat_t _ -> False_f\n  | Signature_t _ -> False_f\n  | String_t _ -> False_f\n  | Bytes_t _ -> False_f\n  | Mutez_t _ -> False_f\n  | Key_hash_t _ -> False_f\n  | Key_t _ -> False_f\n  | Timestamp_t _ -> False_f\n  | Address_t _ -> False_f\n  | Bool_t _ -> False_f\n  | Lambda_t (_, _, _) -> False_f\n  | Set_t (_, _) -> False_f\n  | Contract_t (_, _) -> False_f\n  | Operation_t _ -> False_f\n  | Chain_id_t _ -> False_f\n  | Never_t _ -> False_f\n  | Bls12_381_g1_t _ -> False_f\n  | Bls12_381_g2_t _ -> False_f\n  | Bls12_381_fr_t _ -> False_f\n  | Sapling_transaction_t _ -> False_f\n  | Ticket_t _ -> False_f\n  | Chest_key_t _ -> False_f\n  | Chest_t _ -> False_f\n  | Pair_t ((l, _, _), (r, _, _), _) -> aux2 (fun l r -> Pair_f (l, r)) l r\n  | Union_t ((l, _), (r, _), _) -> aux2 (fun l r -> Union_f (l, r)) l r\n  | Option_t (t, _) -> aux1 (fun h -> Option_f h) t\n  | List_t (t, _) -> aux1 (fun h -> List_f h) t\n  | Map_t (_, t, _) -> aux1 (fun h -> Map_f h) t\n\n(**\n  Transforms a value potentially containing lazy storage in an intermediary\n  state to a value containing lazy storage only represented by identifiers.\n\n  Returns the updated value, the updated set of ids to copy, and the lazy\n  storage diff to show on the receipt and apply on the storage.\n\n*)\nlet[@coq_axiom_with_reason \"gadt\"] extract_lazy_storage_updates ctxt mode\n    ~temporary ids_to_copy acc ty x =\n  let rec aux :\n      type a.\n      context ->\n      unparsing_mode ->\n      temporary:bool ->\n      Lazy_storage.IdSet.t ->\n      Lazy_storage.diffs ->\n      a ty ->\n      a ->\n      has_lazy_storage:a has_lazy_storage ->\n      (context * a * Lazy_storage.IdSet.t * Lazy_storage.diffs) tzresult Lwt.t =\n   fun ctxt mode ~temporary ids_to_copy acc ty x ~has_lazy_storage ->\n    Gas.consume ctxt Typecheck_costs.parse_instr_cycle >>?= fun ctxt ->\n    match (has_lazy_storage, ty, x) with\n    | (False_f, _, _) -> return (ctxt, x, ids_to_copy, acc)\n    | (_, Big_map_t (_, _, _), map) ->\n        diff_of_big_map ctxt mode ~temporary ~ids_to_copy map\n        >|=? fun (diff, id, ctxt) ->\n        let map =\n          {\n            map with\n            diff = {map = Big_map_overlay.empty; size = 0};\n            id = Some id;\n          }\n        in\n        let diff = Lazy_storage.make Big_map id diff in\n        let ids_to_copy = Lazy_storage.IdSet.add Big_map id ids_to_copy in\n        (ctxt, map, ids_to_copy, diff :: acc)\n    | (_, Sapling_state_t _, sapling_state) ->\n        diff_of_sapling_state ctxt ~temporary ~ids_to_copy sapling_state\n        >|=? fun (diff, id, ctxt) ->\n        let sapling_state =\n          Sapling.empty_state ~id ~memo_size:sapling_state.memo_size ()\n        in\n        let diff = Lazy_storage.make Sapling_state id diff in\n        let ids_to_copy = Lazy_storage.IdSet.add Sapling_state id ids_to_copy in\n        (ctxt, sapling_state, ids_to_copy, diff :: acc)\n    | (Pair_f (hl, hr), Pair_t ((tyl, _, _), (tyr, _, _), _), (xl, xr)) ->\n        aux ctxt mode ~temporary ids_to_copy acc tyl xl ~has_lazy_storage:hl\n        >>=? fun (ctxt, xl, ids_to_copy, acc) ->\n        aux ctxt mode ~temporary ids_to_copy acc tyr xr ~has_lazy_storage:hr\n        >|=? fun (ctxt, xr, ids_to_copy, acc) ->\n        (ctxt, (xl, xr), ids_to_copy, acc)\n    | (Union_f (has_lazy_storage, _), Union_t ((ty, _), (_, _), _), L x) ->\n        aux ctxt mode ~temporary ids_to_copy acc ty x ~has_lazy_storage\n        >|=? fun (ctxt, x, ids_to_copy, acc) -> (ctxt, L x, ids_to_copy, acc)\n    | (Union_f (_, has_lazy_storage), Union_t ((_, _), (ty, _), _), R x) ->\n        aux ctxt mode ~temporary ids_to_copy acc ty x ~has_lazy_storage\n        >|=? fun (ctxt, x, ids_to_copy, acc) -> (ctxt, R x, ids_to_copy, acc)\n    | (Option_f has_lazy_storage, Option_t (ty, _), Some x) ->\n        aux ctxt mode ~temporary ids_to_copy acc ty x ~has_lazy_storage\n        >|=? fun (ctxt, x, ids_to_copy, acc) -> (ctxt, Some x, ids_to_copy, acc)\n    | (List_f has_lazy_storage, List_t (ty, _), l) ->\n        List.fold_left_es\n          (fun (ctxt, l, ids_to_copy, acc) x ->\n            aux ctxt mode ~temporary ids_to_copy acc ty x ~has_lazy_storage\n            >|=? fun (ctxt, x, ids_to_copy, acc) ->\n            (ctxt, Script_list.cons x l, ids_to_copy, acc))\n          (ctxt, Script_list.empty, ids_to_copy, acc)\n          l.elements\n        >|=? fun (ctxt, l, ids_to_copy, acc) ->\n        let reversed = {length = l.length; elements = List.rev l.elements} in\n        (ctxt, reversed, ids_to_copy, acc)\n    | (Map_f has_lazy_storage, Map_t (_, ty, _), (module M)) ->\n        let bindings m = M.OPS.fold (fun k v bs -> (k, v) :: bs) m [] in\n        List.fold_left_es\n          (fun (ctxt, m, ids_to_copy, acc) (k, x) ->\n            aux ctxt mode ~temporary ids_to_copy acc ty x ~has_lazy_storage\n            >|=? fun (ctxt, x, ids_to_copy, acc) ->\n            (ctxt, M.OPS.add k x m, ids_to_copy, acc))\n          (ctxt, M.OPS.empty, ids_to_copy, acc)\n          (bindings M.boxed)\n        >|=? fun (ctxt, m, ids_to_copy, acc) ->\n        let module M = struct\n          module OPS = M.OPS\n\n          type key = M.key\n\n          type value = M.value\n\n          let key_ty = M.key_ty\n\n          let boxed = m\n\n          let size = M.size\n        end in\n        ( ctxt,\n          (module M : Boxed_map with type key = M.key and type value = M.value),\n          ids_to_copy,\n          acc )\n    | (_, Option_t (_, _), None) -> return (ctxt, None, ids_to_copy, acc)\n    | _ ->\n        (* TODO: https://gitlab.com/tezos/tezos/-/issues/1962\n           fix injectivity of types *)\n        assert false\n  in\n  let has_lazy_storage = has_lazy_storage ty in\n  aux ctxt mode ~temporary ids_to_copy acc ty x ~has_lazy_storage\n\n(** We namespace an error type for [fold_lazy_storage]. The error case is only\n    available when the ['error] parameter is equal to unit. *)\nmodule Fold_lazy_storage = struct\n  type ('acc, 'error) result =\n    | Ok : 'acc -> ('acc, 'error) result\n    | Error : ('acc, unit) result\nend\n\n(** Prematurely abort if [f] generates an error. Use this function without the\n    [unit] type for [error] if you are in a case where errors are impossible.\n*)\nlet[@coq_axiom_with_reason \"gadt\"] rec fold_lazy_storage :\n    type a error.\n    f:('acc, error) Fold_lazy_storage.result Lazy_storage.IdSet.fold_f ->\n    init:'acc ->\n    context ->\n    a ty ->\n    a ->\n    has_lazy_storage:a has_lazy_storage ->\n    (('acc, error) Fold_lazy_storage.result * context) tzresult =\n fun ~f ~init ctxt ty x ~has_lazy_storage ->\n  Gas.consume ctxt Typecheck_costs.parse_instr_cycle >>? fun ctxt ->\n  match (has_lazy_storage, ty, x) with\n  | (_, Big_map_t (_, _, _), {id = Some id; _}) ->\n      Gas.consume ctxt Typecheck_costs.parse_instr_cycle >>? fun ctxt ->\n      ok (f.f Big_map id (Fold_lazy_storage.Ok init), ctxt)\n  | (_, Sapling_state_t _, {id = Some id; _}) ->\n      Gas.consume ctxt Typecheck_costs.parse_instr_cycle >>? fun ctxt ->\n      ok (f.f Sapling_state id (Fold_lazy_storage.Ok init), ctxt)\n  | (False_f, _, _) -> ok (Fold_lazy_storage.Ok init, ctxt)\n  | (_, Big_map_t (_, _, _), {id = None; _}) ->\n      ok (Fold_lazy_storage.Ok init, ctxt)\n  | (_, Sapling_state_t _, {id = None; _}) ->\n      ok (Fold_lazy_storage.Ok init, ctxt)\n  | (Pair_f (hl, hr), Pair_t ((tyl, _, _), (tyr, _, _), _), (xl, xr)) -> (\n      fold_lazy_storage ~f ~init ctxt tyl xl ~has_lazy_storage:hl\n      >>? fun (init, ctxt) ->\n      match init with\n      | Fold_lazy_storage.Ok init ->\n          fold_lazy_storage ~f ~init ctxt tyr xr ~has_lazy_storage:hr\n      | Fold_lazy_storage.Error -> ok (init, ctxt))\n  | (Union_f (has_lazy_storage, _), Union_t ((ty, _), (_, _), _), L x) ->\n      fold_lazy_storage ~f ~init ctxt ty x ~has_lazy_storage\n  | (Union_f (_, has_lazy_storage), Union_t ((_, _), (ty, _), _), R x) ->\n      fold_lazy_storage ~f ~init ctxt ty x ~has_lazy_storage\n  | (_, Option_t (_, _), None) -> ok (Fold_lazy_storage.Ok init, ctxt)\n  | (Option_f has_lazy_storage, Option_t (ty, _), Some x) ->\n      fold_lazy_storage ~f ~init ctxt ty x ~has_lazy_storage\n  | (List_f has_lazy_storage, List_t (ty, _), l) ->\n      List.fold_left\n        (fun (acc : (('acc, error) Fold_lazy_storage.result * context) tzresult)\n             x ->\n          acc >>? fun (init, ctxt) ->\n          match init with\n          | Fold_lazy_storage.Ok init ->\n              fold_lazy_storage ~f ~init ctxt ty x ~has_lazy_storage\n          | Fold_lazy_storage.Error -> ok (init, ctxt))\n        (ok (Fold_lazy_storage.Ok init, ctxt))\n        l.elements\n  | (Map_f has_lazy_storage, Map_t (_, ty, _), m) ->\n      Script_map.fold\n        (fun _\n             v\n             (acc : (('acc, error) Fold_lazy_storage.result * context) tzresult) ->\n          acc >>? fun (init, ctxt) ->\n          match init with\n          | Fold_lazy_storage.Ok init ->\n              fold_lazy_storage ~f ~init ctxt ty v ~has_lazy_storage\n          | Fold_lazy_storage.Error -> ok (init, ctxt))\n        m\n        (ok (Fold_lazy_storage.Ok init, ctxt))\n  | _ ->\n      (* TODO: https://gitlab.com/tezos/tezos/-/issues/1962\n         fix injectivity of types *)\n      assert false\n\nlet[@coq_axiom_with_reason \"gadt\"] collect_lazy_storage ctxt ty x =\n  let has_lazy_storage = has_lazy_storage ty in\n  let f kind id (acc : (_, never) Fold_lazy_storage.result) =\n    let acc = match acc with Fold_lazy_storage.Ok acc -> acc in\n    Fold_lazy_storage.Ok (Lazy_storage.IdSet.add kind id acc)\n  in\n  fold_lazy_storage ~f:{f} ~init:no_lazy_storage_id ctxt ty x ~has_lazy_storage\n  >>? fun (ids, ctxt) ->\n  match ids with Fold_lazy_storage.Ok ids -> ok (ids, ctxt)\n\nlet[@coq_axiom_with_reason \"gadt\"] extract_lazy_storage_diff ctxt mode\n    ~temporary ~to_duplicate ~to_update ty v =\n  (*\n    Basically [to_duplicate] are ids from the argument and [to_update] are ids\n    from the storage before execution (i.e. it is safe to reuse them since they\n    will be owned by the same contract).\n  *)\n  let to_duplicate = Lazy_storage.IdSet.diff to_duplicate to_update in\n  extract_lazy_storage_updates ctxt mode ~temporary to_duplicate [] ty v\n  >|=? fun (ctxt, v, alive, diffs) ->\n  let diffs =\n    if temporary then diffs\n    else\n      let dead = Lazy_storage.IdSet.diff to_update alive in\n      Lazy_storage.IdSet.fold_all\n        {f = (fun kind id acc -> Lazy_storage.make kind id Remove :: acc)}\n        dead\n        diffs\n  in\n  match diffs with\n  | [] -> (v, None, ctxt)\n  | diffs -> (v, Some diffs (* do not reverse *), ctxt)\n\nlet list_of_big_map_ids ids =\n  Lazy_storage.IdSet.fold Big_map (fun id acc -> id :: acc) ids []\n\nlet parse_data = parse_data ~stack_depth:0\n\nlet parse_instr :\n    type a s.\n    ?type_logger:type_logger ->\n    tc_context ->\n    context ->\n    legacy:bool ->\n    Script.node ->\n    (a, s) stack_ty ->\n    ((a, s) judgement * context) tzresult Lwt.t =\n fun ?type_logger tc_context ctxt ~legacy script_instr stack_ty ->\n  parse_instr\n    ~stack_depth:0\n    ?type_logger\n    tc_context\n    ctxt\n    ~legacy\n    script_instr\n    stack_ty\n\nlet unparse_data = unparse_data ~stack_depth:0\n\nlet unparse_code ctxt mode code =\n  (* Constants need to be expanded or [unparse_code] may fail. *)\n  Global_constants_storage.expand ctxt (strip_locations code)\n  >>=? fun (ctxt, code) -> unparse_code ~stack_depth:0 ctxt mode (root code)\n\nlet parse_contract ~legacy context loc arg_ty contract ~entrypoint =\n  parse_contract ~stack_depth:0 ~legacy context loc arg_ty contract ~entrypoint\n\nlet parse_toplevel ctxt ~legacy toplevel =\n  Global_constants_storage.expand ctxt toplevel >>=? fun (ctxt, toplevel) ->\n  Lwt.return @@ parse_toplevel ctxt ~legacy toplevel\n\nlet parse_comparable_ty = parse_comparable_ty ~stack_depth:0\n\nlet parse_big_map_value_ty = parse_big_map_value_ty ~stack_depth:0\n\nlet parse_packable_ty = parse_packable_ty ~stack_depth:0\n\nlet parse_parameter_ty = parse_parameter_ty ~stack_depth:0\n\nlet parse_any_ty = parse_any_ty ~stack_depth:0\n\nlet parse_ty = parse_ty ~stack_depth:0\n\nlet ty_eq ctxt = ty_eq ~legacy:true ctxt\n\nlet[@coq_axiom_with_reason \"gadt\"] get_single_sapling_state ctxt ty x =\n  let has_lazy_storage = has_lazy_storage ty in\n  let f (type i a u) (kind : (i, a, u) Lazy_storage.Kind.t) (id : i)\n      single_id_opt : (Sapling.Id.t option, unit) Fold_lazy_storage.result =\n    match kind with\n    | Lazy_storage.Kind.Sapling_state -> (\n        match single_id_opt with\n        | Fold_lazy_storage.Ok None -> Fold_lazy_storage.Ok (Some id)\n        | Fold_lazy_storage.Ok (Some _) ->\n            Fold_lazy_storage.Error (* more than one *)\n        | Fold_lazy_storage.Error -> single_id_opt)\n    | _ -> single_id_opt\n  in\n  fold_lazy_storage ~f:{f} ~init:None ctxt ty x ~has_lazy_storage\n  >>? fun (id, ctxt) ->\n  match id with\n  | Fold_lazy_storage.Ok (Some id) -> ok (Some id, ctxt)\n  | Fold_lazy_storage.Ok None | Fold_lazy_storage.Error -> ok (None, ctxt)\n\n(*\n\n   {!Script_cache} needs a measure of the script size in memory.\n   Determining this size is not easy in OCaml because of sharing.\n\n   Indeed, many values present in the script share the same memory\n   area. This is especially true for types and stack types: they are\n   heavily shared in every typed IR internal representation. As a\n   consequence, computing the size of the typed IR without taking\n   sharing into account leads to a size which is sometimes two order\n   of magnitude bigger than the actual size.\n\n   We could track down this sharing. Unfortunately, sharing is not\n   part of OCaml semantics: for this reason, a compiler can optimize\n   memory representation by adding more sharing.  If two nodes use\n   different optimization flags or compilers, such a precise\n   computation of the memory footprint of scripts would lead to two\n   distinct sizes. As these sizes occur in the blockchain context,\n   this situation would lead to a fork.\n\n   For this reason, we introduce a *size model* for the script size.\n   This model provides an overapproximation of the actual size in\n   memory. The risk is to be too far from the actual size: the cache\n   would then be wrongly marked as full. This situation would make the\n   cache less useful but should present no security risk .\n\n*)\nlet script_size\n    (Ex_script\n      {\n        code_size;\n        code = _;\n        arg_type = _;\n        storage;\n        storage_type;\n        root_name = _;\n        views = _;\n      }) =\n  let (nodes, storage_size) =\n    Script_typed_ir_size.value_size storage_type storage\n  in\n  let cost = Script_typed_ir_size_costs.nodes_cost ~nodes in\n  (Saturation_repr.(add code_size storage_size |> to_int), cost)\n" ;
                } ;
                { name = "Script_cache" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** This module manages the cache for smart contracts.\n\n    This cache must be consistent with the on-disk representation\n    of the smart contracts. In particular, [update] must be called\n    each time a contract storage is updated.\n\n*)\n\nopen Alpha_context\n\n(** Each cached script has a unique identifier in the cache. *)\ntype identifier\n\n(** The cache holds the unparsed and the internal representation of\n   the contract. *)\ntype cached_contract = Script.t * Script_ir_translator.ex_script\n\n(** [find ctxt contract] returns [(ctxt', identifier, script)] where:\n   - [ctxt'] is [ctxt] with less gas;\n   - [identifier] is the identifier identifying the [contract] in the cache;\n   - [script = None] if there is no such contract in [ctxt];\n   - [script = Some (unparsed_script, ir_script)] where\n     - [unparsed_script] is the contract source code and storage;\n     - [script_ir] is a typed internal representation of the contract, i.e.,\n       the abstract syntax tree of its code as well as its storage.\n\n   This function consumes gas depending on the cache. If the contract is not\n   in the cache, then the function also consumes the gas of [Contract.get_script]\n   and [Script_ir_translator.parse_script]. *)\nval find :\n  context ->\n  Contract.t ->\n  (context * identifier * cached_contract option) tzresult Lwt.t\n\n(** [update ctxt identifier unparsed_script ir_script size] refreshes the\n   cached contract identified by [identifier] with a new [unparsed_script],\n   a new [ir_script], and a new size. *)\nval update : context -> identifier -> cached_contract -> int -> context tzresult\n\n(** [entries ctxt] returns the contracts in the cache as well as their\n   respective size. The list is sorted by date of last modification:\n   the least recently updated entry comes first. *)\nval entries : context -> (Contract.t * int) list tzresult\n\n(** [contract_rank ctxt contract] returns the number of contracts\n    older than [contract] in the cache of [ctxt]. This function\n    returns [None] if [contract] does not exist in the cache of\n    [ctxt]. *)\nval contract_rank : context -> Contract.t -> int option\n\n(** [size ctxt] is an overapproximation of the cache size in\n   memory (in bytes). *)\nval size : context -> int\n\n(** [size_limit ctxt] is the maximal size of the cache (in bytes). *)\nval size_limit : context -> int\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\ntype identifier = string\n\nlet identifier_of_contract addr = Contract.to_b58check addr\n\nlet contract_of_identifier identifier = Contract.of_b58check identifier\n\ntype cached_contract = Script.t * Script_ir_translator.ex_script\n\nlet load_and_elaborate ctxt addr =\n  Contract.get_script ctxt addr >>=? fun (ctxt, script) ->\n  match script with\n  | None -> return (ctxt, None)\n  | Some script ->\n      Script_ir_translator.(\n        parse_script ctxt script ~legacy:true ~allow_forged_in_storage:true\n        >>=? fun (ex_script, ctxt) ->\n        (* We consume gas after the fact in order to not have to instrument\n           [script_size] (for efficiency).\n           This is safe, as we already pay gas proportional to storage size\n           in [parse_script] beforehand. *)\n        let (size, cost) = script_size ex_script in\n        Gas.consume ctxt cost >>?= fun ctxt ->\n        return (ctxt, Some (script, ex_script, size)))\n\nmodule Client = struct\n  type cached_value = cached_contract\n\n  let namespace = Cache.create_namespace \"contract\"\n\n  let cache_index = 0\n\n  let value_of_identifier ctxt identifier =\n    (*\n\n       I/O, deserialization, and elaboration of contracts scripts\n       are cached.\n\n    *)\n    contract_of_identifier identifier >>?= fun addr ->\n    load_and_elaborate ctxt addr >>=? function\n    | (_, None) ->\n        (* [value_of_identifier ctxt k] is applied to identifiers stored\n           in the cache. Only script-based contracts that have been\n           executed are in the cache. Hence, [get_script] always\n           succeeds for these identifiers if [ctxt] and the [cache] are\n           properly synchronized by the shell. *)\n        failwith \"Script_cache: Inconsistent script cache.\"\n    | (_, Some (unparsed_script, ir_script, _)) ->\n        return (unparsed_script, ir_script)\nend\n\nmodule Cache = (val Cache.register_exn (module Client))\n\nlet find ctxt addr =\n  let identifier = identifier_of_contract addr in\n  Cache.find ctxt identifier >>=? function\n  | Some (unparsed_script, ex_script) ->\n      return (ctxt, identifier, Some (unparsed_script, ex_script))\n  | None -> (\n      load_and_elaborate ctxt addr >>=? function\n      | (ctxt, None) -> return (ctxt, identifier, None)\n      | (ctxt, Some (unparsed_script, script_ir, size)) ->\n          let cached_value = (unparsed_script, script_ir) in\n          Lwt.return\n            ( Cache.update ctxt identifier (Some (cached_value, size))\n            >>? fun ctxt ->\n              ok (ctxt, identifier, Some (unparsed_script, script_ir)) ))\n\nlet update ctxt identifier updated_script approx_size =\n  Cache.update ctxt identifier (Some (updated_script, approx_size))\n\nlet entries ctxt =\n  Cache.list_identifiers ctxt\n  |> List.map_e @@ fun (identifier, age) ->\n     contract_of_identifier identifier >|? fun contract -> (contract, age)\n\nlet contract_rank ctxt addr =\n  Cache.identifier_rank ctxt (identifier_of_contract addr)\n\nlet size = Cache.size\n\nlet size_limit = Cache.size_limit\n" ;
                } ;
                { name = "Script_tc_errors_registration" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020-2021 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\nopen Script\n\nval type_map_enc :\n  (location * ((expr * string list) list * (expr * string list) list)) list\n  Data_encoding.encoding\n\nval stack_ty_enc : (expr * string list) list Data_encoding.encoding\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\nopen Script\nopen Script_tc_errors\n\n(* Helpers for encoding *)\nlet type_map_enc =\n  let open Data_encoding in\n  let stack_enc = list (tup2 Script.expr_encoding (list string)) in\n  list\n    (conv\n       (fun (loc, (bef, aft)) -> (loc, bef, aft))\n       (fun (loc, bef, aft) -> (loc, (bef, aft)))\n       (obj3\n          (req \"location\" Script.location_encoding)\n          (req \"stack_before\" stack_enc)\n          (req \"stack_after\" stack_enc)))\n\nlet stack_ty_enc =\n  let open Data_encoding in\n  list (obj2 (req \"type\" Script.expr_encoding) (dft \"annots\" (list string) []))\n\n(* main registration *)\nlet () =\n  let open Data_encoding in\n  let located enc =\n    merge_objs (obj1 (req \"location\" Script.location_encoding)) enc\n  in\n  let arity_enc = int8 in\n  let namespace_enc =\n    def\n      \"primitiveNamespace\"\n      ~title:\"Primitive namespace\"\n      ~description:\n        \"One of the five possible namespaces of primitive (data constructor, \\\n         type name, instruction, keyword, or constant hash).\"\n    @@ string_enum\n         [\n           (\"type\", Michelson_v1_primitives.Type_namespace);\n           (\"constant\", Constant_namespace);\n           (\"instruction\", Instr_namespace);\n           (\"keyword\", Keyword_namespace);\n           (\"constant_hash\", Constant_hash_namespace);\n         ]\n  in\n  let kind_enc =\n    def\n      \"expressionKind\"\n      ~title:\"Expression kind\"\n      ~description:\n        \"One of the four possible kinds of expression (integer, string, \\\n         primitive application or sequence).\"\n    @@ string_enum\n         [\n           (\"integer\", Int_kind);\n           (\"string\", String_kind);\n           (\"bytes\", Bytes_kind);\n           (\"primitiveApplication\", Prim_kind);\n           (\"sequence\", Seq_kind);\n         ]\n  in\n  (* -- Structure errors ---------------------- *)\n  (* Invalid arity *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.invalid_arity\"\n    ~title:\"Invalid arity\"\n    ~description:\n      \"In a script or data expression, a primitive was applied to an \\\n       unsupported number of arguments.\"\n    (located\n       (obj3\n          (req \"primitive_name\" Script.prim_encoding)\n          (req \"expected_arity\" arity_enc)\n          (req \"wrong_arity\" arity_enc)))\n    (function\n      | Invalid_arity (loc, name, exp, got) -> Some (loc, (name, exp, got))\n      | _ -> None)\n    (fun (loc, (name, exp, got)) -> Invalid_arity (loc, name, exp, got)) ;\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.invalid_seq_arity\"\n    ~title:\"Invalid sequence arity\"\n    ~description:\n      \"In a script or data expression, a sequence was used with a number of \\\n       elements too small.\"\n    (located\n       (obj2\n          (req \"minimal_expected_arity\" arity_enc)\n          (req \"wrong_arity\" arity_enc)))\n    (function\n      | Invalid_seq_arity (loc, exp, got) -> Some (loc, (exp, got)) | _ -> None)\n    (fun (loc, (exp, got)) -> Invalid_seq_arity (loc, exp, got)) ;\n  (* Missing field *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.missing_script_field\"\n    ~title:\"Script is missing a field (parse error)\"\n    ~description:\"When parsing script, a field was expected, but not provided\"\n    (obj1 (req \"prim\" prim_encoding))\n    (function Missing_field prim -> Some prim | _ -> None)\n    (fun prim -> Missing_field prim) ;\n  (* Invalid primitive *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.invalid_primitive\"\n    ~title:\"Invalid primitive\"\n    ~description:\"In a script or data expression, a primitive was unknown.\"\n    (located\n       (obj2\n          (dft \"expected_primitive_names\" (list prim_encoding) [])\n          (req \"wrong_primitive_name\" prim_encoding)))\n    (function\n      | Invalid_primitive (loc, exp, got) -> Some (loc, (exp, got)) | _ -> None)\n    (fun (loc, (exp, got)) -> Invalid_primitive (loc, exp, got)) ;\n  (* Invalid kind *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.invalid_expression_kind\"\n    ~title:\"Invalid expression kind\"\n    ~description:\n      \"In a script or data expression, an expression was of the wrong kind \\\n       (for instance a string where only a primitive applications can appear).\"\n    (located\n       (obj2 (req \"expected_kinds\" (list kind_enc)) (req \"wrong_kind\" kind_enc)))\n    (function\n      | Invalid_kind (loc, exp, got) -> Some (loc, (exp, got)) | _ -> None)\n    (fun (loc, (exp, got)) -> Invalid_kind (loc, exp, got)) ;\n  (* Invalid namespace *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.invalid_primitive_namespace\"\n    ~title:\"Invalid primitive namespace\"\n    ~description:\n      \"In a script or data expression, a primitive was of the wrong namespace.\"\n    (located\n       (obj3\n          (req \"primitive_name\" prim_encoding)\n          (req \"expected_namespace\" namespace_enc)\n          (req \"wrong_namespace\" namespace_enc)))\n    (function\n      | Invalid_namespace (loc, name, exp, got) -> Some (loc, (name, exp, got))\n      | _ -> None)\n    (fun (loc, (name, exp, got)) -> Invalid_namespace (loc, name, exp, got)) ;\n  (* Invalid literal for type never *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.invalid_never_expr\"\n    ~title:\"Invalid expression for type never\"\n    ~description:\n      \"In a script or data expression, an expression was provided but a value \\\n       of type never was expected. No expression can have type never.\"\n    (located unit)\n    (function Invalid_never_expr loc -> Some (loc, ()) | _ -> None)\n    (fun (loc, ()) -> Invalid_never_expr loc) ;\n  (* Duplicate field *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.duplicate_script_field\"\n    ~title:\"Script has a duplicated field (parse error)\"\n    ~description:\"When parsing script, a field was found more than once\"\n    (obj2 (req \"loc\" location_encoding) (req \"prim\" prim_encoding))\n    (function Duplicate_field (loc, prim) -> Some (loc, prim) | _ -> None)\n    (fun (loc, prim) -> Duplicate_field (loc, prim)) ;\n  (* Unexpected big_map *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.unexpected_lazy_storage\"\n    ~title:\"Lazy storage in unauthorized position (type error)\"\n    ~description:\n      \"When parsing script, a big_map or sapling_state type was found in a \\\n       position where it could end up stored inside a big_map, which is \\\n       forbidden for now.\"\n    (obj1 (req \"loc\" location_encoding))\n    (function Unexpected_lazy_storage loc -> Some loc | _ -> None)\n    (fun loc -> Unexpected_lazy_storage loc) ;\n  (* Unexpected operation *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.unexpected_operation\"\n    ~title:\"Operation in unauthorized position (type error)\"\n    ~description:\n      \"When parsing script, an operation type was found in the storage or \\\n       parameter field.\"\n    (obj1 (req \"loc\" location_encoding))\n    (function Unexpected_operation loc -> Some loc | _ -> None)\n    (fun loc -> Unexpected_operation loc) ;\n  (* No such entrypoint *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.no_such_entrypoint\"\n    ~title:\"No such entrypoint (type error)\"\n    ~description:\"An entrypoint was not found when calling a contract.\"\n    (obj1 (req \"entrypoint\" string))\n    (function No_such_entrypoint entrypoint -> Some entrypoint | _ -> None)\n    (fun entrypoint -> No_such_entrypoint entrypoint) ;\n  (* Unreachable entrypoint *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.unreachable_entrypoint\"\n    ~title:\"Unreachable entrypoint (type error)\"\n    ~description:\"An entrypoint in the contract is not reachable.\"\n    (obj1 (req \"path\" (list prim_encoding)))\n    (function Unreachable_entrypoint path -> Some path | _ -> None)\n    (fun path -> Unreachable_entrypoint path) ;\n  (* Duplicate entrypoint *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.duplicate_entrypoint\"\n    ~title:\"Duplicate entrypoint (type error)\"\n    ~description:\"Two entrypoints have the same name.\"\n    (obj1 (req \"path\" string))\n    (function Duplicate_entrypoint entrypoint -> Some entrypoint | _ -> None)\n    (fun entrypoint -> Duplicate_entrypoint entrypoint) ;\n  (* Entrypoint name too long *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.entrypoint_name_too_long\"\n    ~title:\"Entrypoint name too long (type error)\"\n    ~description:\n      \"An entrypoint name exceeds the maximum length of 31 characters.\"\n    (obj1 (req \"name\" string))\n    (function\n      | Entrypoint_name_too_long entrypoint -> Some entrypoint | _ -> None)\n    (fun entrypoint -> Entrypoint_name_too_long entrypoint) ;\n  (* Unexpected contract *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.unexpected_contract\"\n    ~title:\"Contract in unauthorized position (type error)\"\n    ~description:\n      \"When parsing script, a contract type was found in the storage or \\\n       parameter field.\"\n    (obj1 (req \"loc\" location_encoding))\n    (function Unexpected_contract loc -> Some loc | _ -> None)\n    (fun loc -> Unexpected_contract loc) ;\n  (* -- Value typing errors ---------------------- *)\n  (* Unordered map keys *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.unordered_map_literal\"\n    ~title:\"Invalid map key order\"\n    ~description:\"Map keys must be in strictly increasing order\"\n    (obj2\n       (req \"location\" Script.location_encoding)\n       (req \"item\" Script.expr_encoding))\n    (function Unordered_map_keys (loc, expr) -> Some (loc, expr) | _ -> None)\n    (fun (loc, expr) -> Unordered_map_keys (loc, expr)) ;\n  (* Duplicate map keys *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.duplicate_map_keys\"\n    ~title:\"Duplicate map keys\"\n    ~description:\"Map literals cannot contain duplicated keys\"\n    (obj2\n       (req \"location\" Script.location_encoding)\n       (req \"item\" Script.expr_encoding))\n    (function Duplicate_map_keys (loc, expr) -> Some (loc, expr) | _ -> None)\n    (fun (loc, expr) -> Duplicate_map_keys (loc, expr)) ;\n  (* Unordered set values *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.unordered_set_literal\"\n    ~title:\"Invalid set value order\"\n    ~description:\"Set values must be in strictly increasing order\"\n    (obj2\n       (req \"location\" Script.location_encoding)\n       (req \"value\" Script.expr_encoding))\n    (function\n      | Unordered_set_values (loc, expr) -> Some (loc, expr) | _ -> None)\n    (fun (loc, expr) -> Unordered_set_values (loc, expr)) ;\n  (* Duplicate set values *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.duplicate_set_values_in_literal\"\n    ~title:\"Sets literals cannot contain duplicate elements\"\n    ~description:\n      \"Set literals cannot contain duplicate elements, but a duplicate was \\\n       found while parsing.\"\n    (obj2\n       (req \"location\" Script.location_encoding)\n       (req \"value\" Script.expr_encoding))\n    (function\n      | Duplicate_set_values (loc, expr) -> Some (loc, expr) | _ -> None)\n    (fun (loc, expr) -> Duplicate_set_values (loc, expr)) ;\n  (* -- Instruction typing errors ------------- *)\n  (* Fail not in tail position *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.fail_not_in_tail_position\"\n    ~title:\"FAIL not in tail position\"\n    ~description:\"There is non trivial garbage code after a FAIL instruction.\"\n    (located empty)\n    (function Fail_not_in_tail_position loc -> Some (loc, ()) | _ -> None)\n    (fun (loc, ()) -> Fail_not_in_tail_position loc) ;\n  (* Undefined binary operation *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.undefined_binop\"\n    ~title:\"Undefined binop\"\n    ~description:\n      \"A binary operation is called on operands of types over which it is not \\\n       defined.\"\n    (located\n       (obj3\n          (req \"operator_name\" prim_encoding)\n          (req \"wrong_left_operand_type\" Script.expr_encoding)\n          (req \"wrong_right_operand_type\" Script.expr_encoding)))\n    (function\n      | Undefined_binop (loc, n, tyl, tyr) -> Some (loc, (n, tyl, tyr))\n      | _ -> None)\n    (fun (loc, (n, tyl, tyr)) -> Undefined_binop (loc, n, tyl, tyr)) ;\n  (* Undefined unary operation *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.undefined_unop\"\n    ~title:\"Undefined unop\"\n    ~description:\n      \"A unary operation is called on an operand of type over which it is not \\\n       defined.\"\n    (located\n       (obj2\n          (req \"operator_name\" prim_encoding)\n          (req \"wrong_operand_type\" Script.expr_encoding)))\n    (function Undefined_unop (loc, n, ty) -> Some (loc, (n, ty)) | _ -> None)\n    (fun (loc, (n, ty)) -> Undefined_unop (loc, n, ty)) ;\n  (* Bad return *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.bad_return\"\n    ~title:\"Bad return\"\n    ~description:\"Unexpected stack at the end of a lambda or script.\"\n    (located\n       (obj2\n          (req \"expected_return_type\" Script.expr_encoding)\n          (req \"wrong_stack_type\" stack_ty_enc)))\n    (function Bad_return (loc, sty, ty) -> Some (loc, (ty, sty)) | _ -> None)\n    (fun (loc, (ty, sty)) -> Bad_return (loc, sty, ty)) ;\n  (* Bad stack *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.bad_stack\"\n    ~title:\"Bad stack\"\n    ~description:\"The stack has an unexpected length or contents.\"\n    (located\n       (obj3\n          (req \"primitive_name\" prim_encoding)\n          (req \"relevant_stack_portion\" int16)\n          (req \"wrong_stack_type\" stack_ty_enc)))\n    (function\n      | Bad_stack (loc, name, s, sty) -> Some (loc, (name, s, sty)) | _ -> None)\n    (fun (loc, (name, s, sty)) -> Bad_stack (loc, name, s, sty)) ;\n  (* Inconsistent annotations *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.inconsistent_annotations\"\n    ~title:\"Annotations inconsistent between branches\"\n    ~description:\"The annotations on two types could not be merged\"\n    (obj2 (req \"annot1\" string) (req \"annot2\" string))\n    (function\n      | Inconsistent_annotations (annot1, annot2) -> Some (annot1, annot2)\n      | _ -> None)\n    (fun (annot1, annot2) -> Inconsistent_annotations (annot1, annot2)) ;\n  (* Inconsistent field annotations *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.inconsistent_field_annotations\"\n    ~title:\"Annotations for field accesses is inconsistent\"\n    ~description:\n      \"The specified field does not match the field annotation in the type\"\n    (obj2 (req \"annot1\" string) (req \"annot2\" string))\n    (function\n      | Inconsistent_field_annotations (annot1, annot2) -> Some (annot1, annot2)\n      | _ -> None)\n    (fun (annot1, annot2) -> Inconsistent_field_annotations (annot1, annot2)) ;\n  (* Inconsistent type annotations *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.inconsistent_type_annotations\"\n    ~title:\"Types contain inconsistent annotations\"\n    ~description:\"The two types contain annotations that do not match\"\n    (located\n       (obj2\n          (req \"type1\" Script.expr_encoding)\n          (req \"type2\" Script.expr_encoding)))\n    (function\n      | Inconsistent_type_annotations (loc, ty1, ty2) -> Some (loc, (ty1, ty2))\n      | _ -> None)\n    (fun (loc, (ty1, ty2)) -> Inconsistent_type_annotations (loc, ty1, ty2)) ;\n  (* Unexpected annotation *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.unexpected_annotation\"\n    ~title:\"An annotation was encountered where no annotation is expected\"\n    ~description:\"A node in the syntax tree was improperly annotated\"\n    (located empty)\n    (function Unexpected_annotation loc -> Some (loc, ()) | _ -> None)\n    (fun (loc, ()) -> Unexpected_annotation loc) ;\n  (* Ungrouped annotations *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.ungrouped_annotations\"\n    ~title:\"Annotations of the same kind were found spread apart\"\n    ~description:\"Annotations of the same kind must be grouped\"\n    (located empty)\n    (function Ungrouped_annotations loc -> Some (loc, ()) | _ -> None)\n    (fun (loc, ()) -> Ungrouped_annotations loc) ;\n  (* Unmatched branches *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.unmatched_branches\"\n    ~title:\"Unmatched branches\"\n    ~description:\n      \"At the join point at the end of two code branches the stacks have \\\n       inconsistent lengths or contents.\"\n    (located\n       (obj2\n          (req \"first_stack_type\" stack_ty_enc)\n          (req \"other_stack_type\" stack_ty_enc)))\n    (function\n      | Unmatched_branches (loc, stya, styb) -> Some (loc, (stya, styb))\n      | _ -> None)\n    (fun (loc, (stya, styb)) -> Unmatched_branches (loc, stya, styb)) ;\n  (* Bad stack item *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.bad_stack_item\"\n    ~title:\"Bad stack item\"\n    ~description:\n      \"The type of a stack item is unexpected (this error is always \\\n       accompanied by a more precise one).\"\n    (obj1 (req \"item_level\" int16))\n    (function Bad_stack_item n -> Some n | _ -> None)\n    (fun n -> Bad_stack_item n) ;\n  (* SELF in lambda *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.self_in_lambda\"\n    ~title:\"SELF instruction in lambda\"\n    ~description:\"A SELF instruction was encountered in a lambda expression.\"\n    (located empty)\n    (function Self_in_lambda loc -> Some (loc, ()) | _ -> None)\n    (fun (loc, ()) -> Self_in_lambda loc) ;\n  (* Bad stack length *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.inconsistent_stack_lengths\"\n    ~title:\"Inconsistent stack lengths\"\n    ~description:\n      \"A stack was of an unexpected length (this error is always in the \\\n       context of a located error).\"\n    empty\n    (function Bad_stack_length -> Some () | _ -> None)\n    (fun () -> Bad_stack_length) ;\n  (* -- Value typing errors ------------------- *)\n  (* Invalid constant *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.invalid_constant\"\n    ~title:\"Invalid constant\"\n    ~description:\"A data expression was invalid for its expected type.\"\n    (located\n       (obj2\n          (req \"expected_type\" Script.expr_encoding)\n          (req \"wrong_expression\" Script.expr_encoding)))\n    (function\n      | Invalid_constant (loc, expr, ty) -> Some (loc, (ty, expr)) | _ -> None)\n    (fun (loc, (ty, expr)) -> Invalid_constant (loc, expr, ty)) ;\n  (* View name too long *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.view_name_too_long\"\n    ~title:\"View name too long (type error)\"\n    ~description:\"A view name exceeds the maximum length of 31 characters.\"\n    (obj1 (req \"name\" string))\n    (function View_name_too_long name -> Some name | _ -> None)\n    (fun name -> View_name_too_long name) ;\n  (* Duplicated view name *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.duplicated_view_name\"\n    ~title:\"Duplicated view name\"\n    ~description:\"The name of view in toplevel should be unique.\"\n    (obj1 (req \"location\" Script.location_encoding))\n    (function Duplicated_view_name loc -> Some loc | _ -> None)\n    (fun loc -> Duplicated_view_name loc) ;\n  (* Invalid syntactic constant *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.invalid_syntactic_constant\"\n    ~title:\"Invalid constant (parse error)\"\n    ~description:\"A compile-time constant was invalid for its expected form.\"\n    (located\n       (obj2\n          (req \"expected_form\" string)\n          (req \"wrong_expression\" Script.expr_encoding)))\n    (function\n      | Invalid_syntactic_constant (loc, expr, expected) ->\n          Some (loc, (expected, expr))\n      | _ -> None)\n    (fun (loc, (expected, expr)) ->\n      Invalid_syntactic_constant (loc, expr, expected)) ;\n  (* Invalid contract *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.invalid_contract\"\n    ~title:\"Invalid contract\"\n    ~description:\n      \"A script or data expression references a contract that does not exist \\\n       or assumes a wrong type for an existing contract.\"\n    (located (obj1 (req \"contract\" Contract.encoding)))\n    (function Invalid_contract (loc, c) -> Some (loc, c) | _ -> None)\n    (fun (loc, c) -> Invalid_contract (loc, c)) ;\n  (* Invalid big_map *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.invalid_big_map\"\n    ~title:\"Invalid big_map\"\n    ~description:\n      \"A script or data expression references a big_map that does not exist or \\\n       assumes a wrong type for an existing big_map.\"\n    (located (obj1 (req \"big_map\" Big_map.Id.encoding)))\n    (function Invalid_big_map (loc, c) -> Some (loc, c) | _ -> None)\n    (fun (loc, c) -> Invalid_big_map (loc, c)) ;\n  (* Comparable type expected *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.comparable_type_expected\"\n    ~title:\"Comparable type expected\"\n    ~description:\n      \"A non comparable type was used in a place where only comparable types \\\n       are accepted.\"\n    (located (obj1 (req \"wrong_type\" Script.expr_encoding)))\n    (function\n      | Comparable_type_expected (loc, ty) -> Some (loc, ty) | _ -> None)\n    (fun (loc, ty) -> Comparable_type_expected (loc, ty)) ;\n  (* Inconsistent type sizes *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.inconsistent_type_sizes\"\n    ~title:\"Inconsistent type sizes\"\n    ~description:\n      \"Two types were expected to be equal but they have different sizes.\"\n    (obj2 (req \"first_type_size\" int31) (req \"other_type_size\" int31))\n    (function\n      | Inconsistent_type_sizes (tya, tyb) -> Some (tya, tyb) | _ -> None)\n    (fun (tya, tyb) -> Inconsistent_type_sizes (tya, tyb)) ;\n  (* Inconsistent types *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.inconsistent_types\"\n    ~title:\"Inconsistent types\"\n    ~description:\n      \"This is the basic type clash error, that appears in several places \\\n       where the equality of two types have to be proven, it is always \\\n       accompanied with another error that provides more context.\"\n    (obj3\n       (opt \"loc\" Script.location_encoding)\n       (req \"first_type\" Script.expr_encoding)\n       (req \"other_type\" Script.expr_encoding))\n    (function\n      | Inconsistent_types (loc, tya, tyb) -> Some (loc, tya, tyb) | _ -> None)\n    (fun (loc, tya, tyb) -> Inconsistent_types (loc, tya, tyb)) ;\n  (* Inconsistent memo_sizes *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.inconsistent_memo_sizes\"\n    ~title:\"Inconsistent memo sizes\"\n    ~description:\"Memo sizes of two sapling states or transactions do not match\"\n    (obj2\n       (req \"first_memo_size\" Sapling.Memo_size.encoding)\n       (req \"other_memo_size\" Sapling.Memo_size.encoding))\n    (function\n      | Inconsistent_memo_sizes (msa, msb) -> Some (msa, msb) | _ -> None)\n    (fun (msa, msb) -> Inconsistent_memo_sizes (msa, msb)) ;\n  (* -- Instruction typing errors ------------------- *)\n  (* Bad view name *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.bad_view_name\"\n    ~title:\"Bad view name\"\n    ~description:\"In a view declaration, the view name must be a string\"\n    (obj1 (req \"loc\" Script.location_encoding))\n    (function Bad_view_name loc -> Some loc | _ -> None)\n    (fun loc -> Bad_view_name loc) ;\n  (* Invalid view body *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.ill_typed_view\"\n    ~title:\"Ill typed view\"\n    ~description:\"The return of a view block did not match the expected type\"\n    (obj3\n       (req \"loc\" Script.location_encoding)\n       (req \"resulted_view_stack\" stack_ty_enc)\n       (req \"expected_view_stack\" stack_ty_enc))\n    (function\n      | Ill_typed_view {loc; actual; expected} -> Some (loc, actual, expected)\n      | _ -> None)\n    (fun (loc, actual, expected) -> Ill_typed_view {loc; actual; expected}) ;\n  (* Invalid map body *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.invalid_map_body\"\n    ~title:\"Invalid map body\"\n    ~description:\"The body of a map block did not match the expected type\"\n    (obj2 (req \"loc\" Script.location_encoding) (req \"body_type\" stack_ty_enc))\n    (function Invalid_map_body (loc, stack) -> Some (loc, stack) | _ -> None)\n    (fun (loc, stack) -> Invalid_map_body (loc, stack)) ;\n  (* Invalid map block FAIL *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.invalid_map_block_fail\"\n    ~title:\"FAIL instruction occurred as body of map block\"\n    ~description:\n      \"FAIL cannot be the only instruction in the body. The proper type of the \\\n       return list cannot be inferred.\"\n    (obj1 (req \"loc\" Script.location_encoding))\n    (function Invalid_map_block_fail loc -> Some loc | _ -> None)\n    (fun loc -> Invalid_map_block_fail loc) ;\n  (* Invalid ITER body *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.invalid_iter_body\"\n    ~title:\"ITER body returned wrong stack type\"\n    ~description:\n      \"The body of an ITER instruction must result in the same stack type as \\\n       before the ITER.\"\n    (obj3\n       (req \"loc\" Script.location_encoding)\n       (req \"bef_stack\" stack_ty_enc)\n       (req \"aft_stack\" stack_ty_enc))\n    (function\n      | Invalid_iter_body (loc, bef, aft) -> Some (loc, bef, aft) | _ -> None)\n    (fun (loc, bef, aft) -> Invalid_iter_body (loc, bef, aft)) ;\n  (* Type too large *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.type_too_large\"\n    ~title:\"Stack item type too large\"\n    ~description:\"An instruction generated a type larger than the limit.\"\n    (obj2 (req \"loc\" Script.location_encoding) (req \"maximum_type_size\" uint16))\n    (function Type_too_large (loc, maxts) -> Some (loc, maxts) | _ -> None)\n    (fun (loc, maxts) -> Type_too_large (loc, maxts)) ;\n  (* Bad PAIR argument *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.bad_pair_argument\"\n    ~title:\"0 or 1 passed to PAIR\"\n    ~description:\"PAIR expects an argument of at least 2\"\n    (obj1 (req \"loc\" Script.location_encoding))\n    (function Pair_bad_argument loc -> Some loc | _ -> None)\n    (fun loc -> Pair_bad_argument loc) ;\n  (* Bad UNPAIR argument *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.bad_unpair_argument\"\n    ~title:\"0 or 1 passed to UNPAIR\"\n    ~description:\"UNPAIR expects an argument of at least 2\"\n    (obj1 (req \"loc\" Script.location_encoding))\n    (function Unpair_bad_argument loc -> Some loc | _ -> None)\n    (fun loc -> Unpair_bad_argument loc) ;\n  (* Bad dup_n argument *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.bad_dupn_argument\"\n    ~title:\"0 passed to DUP n\"\n    ~description:\"DUP expects an argument of at least 1 (passed 0)\"\n    (obj1 (req \"loc\" Script.location_encoding))\n    (function Dup_n_bad_argument loc -> Some loc | _ -> None)\n    (fun loc -> Dup_n_bad_argument loc) ;\n  (* Bad dup_n stack *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.bad_dupn_stack\"\n    ~title:\"Stack too short when typing DUP n\"\n    ~description:\"Stack present when typing DUP n was too short\"\n    (obj1 (req \"loc\" Script.location_encoding))\n    (function Dup_n_bad_stack x -> Some x | _ -> None)\n    (fun x -> Dup_n_bad_stack x) ;\n  (* -- Toplevel errors ------------------- *)\n  (* Ill typed data *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.ill_typed_data\"\n    ~title:\"Ill typed data\"\n    ~description:\n      \"The toplevel error thrown when trying to typecheck a data expression \\\n       against a given type (always followed by more precise errors).\"\n    (obj3\n       (opt \"identifier\" string)\n       (req \"expected_type\" Script.expr_encoding)\n       (req \"ill_typed_expression\" Script.expr_encoding))\n    (function\n      | Ill_typed_data (name, expr, ty) -> Some (name, ty, expr) | _ -> None)\n    (fun (name, ty, expr) -> Ill_typed_data (name, expr, ty)) ;\n  (* Ill formed type *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.ill_formed_type\"\n    ~title:\"Ill formed type\"\n    ~description:\n      \"The toplevel error thrown when trying to parse a type expression \\\n       (always followed by more precise errors).\"\n    (obj3\n       (opt \"identifier\" string)\n       (req \"ill_formed_expression\" Script.expr_encoding)\n       (req \"location\" Script.location_encoding))\n    (function\n      | Ill_formed_type (name, expr, loc) -> Some (name, expr, loc) | _ -> None)\n    (fun (name, expr, loc) -> Ill_formed_type (name, expr, loc)) ;\n  (* Ill typed contract *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.ill_typed_contract\"\n    ~title:\"Ill typed contract\"\n    ~description:\n      \"The toplevel error thrown when trying to typecheck a contract code \\\n       against given input, output and storage types (always followed by more \\\n       precise errors).\"\n    (obj2\n       (req \"ill_typed_code\" Script.expr_encoding)\n       (req \"type_map\" type_map_enc))\n    (function\n      | Ill_typed_contract (expr, type_map) -> Some (expr, type_map) | _ -> None)\n    (fun (expr, type_map) -> Ill_typed_contract (expr, type_map)) ;\n  (* Deprecated instruction *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.deprecated_instruction\"\n    ~title:\"Script is using a deprecated instruction\"\n    ~description:\n      \"A deprecated instruction usage is disallowed in newly created contracts\"\n    (obj1 (req \"prim\" prim_encoding))\n    (function Deprecated_instruction prim -> Some prim | _ -> None)\n    (fun prim -> Deprecated_instruction prim) ;\n  (* Typechecking stack overflow *)\n  register_error_kind\n    `Temporary\n    ~id:\"michelson_v1.typechecking_too_many_recursive_calls\"\n    ~title:\"Too many recursive calls during typechecking\"\n    ~description:\"Too many recursive calls were needed for typechecking\"\n    Data_encoding.empty\n    (function Typechecking_too_many_recursive_calls -> Some () | _ -> None)\n    (fun () -> Typechecking_too_many_recursive_calls) ;\n  (* Unparsing stack overflow *)\n  register_error_kind\n    `Temporary\n    ~id:\"michelson_v1.unparsing_stack_overflow\"\n    ~title:\"Too many recursive calls during unparsing\"\n    ~description:\"Too many recursive calls were needed for unparsing\"\n    Data_encoding.empty\n    (function Unparsing_too_many_recursive_calls -> Some () | _ -> None)\n    (fun () -> Unparsing_too_many_recursive_calls) ;\n  (* Unexpected forged value *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.unexpected_forged_value\"\n    ~title:\"Unexpected forged value\"\n    ~description:\n      \"A forged value was encountered but disallowed for that position.\"\n    (obj1 (req \"location\" Script.location_encoding))\n    (function Unexpected_forged_value loc -> Some loc | _ -> None)\n    (fun loc -> Unexpected_forged_value loc) ;\n  (* Unexpected ticket *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.unexpected_ticket\"\n    ~title:\"Ticket in unauthorized position (type error)\"\n    ~description:\"A ticket type has been found\"\n    (obj1 (req \"loc\" location_encoding))\n    (function Unexpected_ticket loc -> Some loc | _ -> None)\n    (fun loc -> Unexpected_ticket loc) ;\n  (* Attempt to duplicate a non-dupable type *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.non_dupable_type\"\n    ~title:\"Non-dupable type duplication attempt\"\n    ~description:\"DUP was used on a non-dupable type (e.g. tickets).\"\n    (obj2 (req \"loc\" location_encoding) (req \"type\" Script.expr_encoding))\n    (function Non_dupable_type (loc, ty) -> Some (loc, ty) | _ -> None)\n    (fun (loc, ty) -> Non_dupable_type (loc, ty))\n" ;
                } ;
                { name = "Ticket_costs" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Trili Tech, <contact@trili.tech>                       *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** This module contains constants and utility functions for gas metering\n    functions used for extracting and handling tickets for the global ticket\n    balance table. *)\n\nmodule Constants : sig\n  val cost_contains_tickets_step : Alpha_context.Gas.cost\n\n  val cost_collect_tickets_step : Alpha_context.Gas.cost\nend\n\n(** [consume_gas_steps ctxt ~num_steps] consumes gas corresponding to\n    a given [num_steps] and [step_cost]. It's useful for paying for gas\n    upfront where the number of steps can be determined.\n\n    This function is generic and should probably be moved. See issue\n    https://gitlab.com/tezos/tezos/-/issues/1950.\n\n  *)\nval consume_gas_steps :\n  Alpha_context.t ->\n  step_cost:Alpha_context.Gas.cost ->\n  num_steps:int ->\n  Alpha_context.t tzresult\n\n(** [has_tickets_of_ty_cost ty] returns the cost of producing a [has_tickets],\n    used internally in the [Ticket_scanner] module. *)\nval has_tickets_of_ty_cost :\n  'a Script_typed_ir.ty -> Saturation_repr.may_saturate Saturation_repr.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Trili Tech, <contact@trili.tech>                       *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\nmodule Constants = struct\n  module S = Saturation_repr\n\n  (* TODO: Fill in real benchmarked values *)\n  let cost_contains_tickets_step = S.safe_int 28\n\n  (* TODO: Fill in real benchmarked values *)\n  let cost_collect_tickets_step = S.safe_int 360\n\n  (* TODO: Fill in real benchmarked values *)\n  let cost_has_tickets_of_ty type_size = S.mul (S.safe_int 20) type_size\nend\n\nlet consume_gas_steps ctxt ~step_cost ~num_steps =\n  let ( * ) = Saturation_repr.mul in\n  if Compare.Int.(num_steps <= 0) then Ok ctxt\n  else\n    let gas =\n      Gas.atomic_step_cost (step_cost * Saturation_repr.safe_int num_steps)\n    in\n    Gas.consume ctxt gas\n\nlet has_tickets_of_ty_cost ty =\n  Constants.cost_has_tickets_of_ty\n    Script_typed_ir.(ty_size ty |> Type_size.to_int)\n" ;
                } ;
                { name = "Ticket_scanner" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Trili Tech, <contact@trili.tech>                       *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** This module provides an API for extracting tickets of arbitrary types\n    from an OCaml values, given a type-witness. *)\n\n(** A type for representing existentially quantified tickets (tickets with\n    different types of payloads). An [ex_ticket] value consists of:\n     - A type-witness representing the type of the content of the ticket.\n     - A ticket value of the particular content type.\n *)\ntype ex_ticket =\n  | Ex_ticket :\n      'a Script_typed_ir.comparable_ty * 'a Script_typed_ir.ticket\n      -> ex_ticket\n\n(** [tickets_of_value ctxt ~include_lazy ty value] extracts all tickets from the\n    given shape [ty] and value [value]. The [include_lazy] flag determines whether\n    or not to traverse lazy structures (values from the context).\n    In case the [include_lazy] flag is [true], any big-map contained in the value\n    must have an empty overlay or else an error of type\n    [Unsupported_non_empty_overlay] is returned. The reason for this restriction\n    is that we assume that all lazy big-map diffs should be applied before\n    calling this function. Dealing with non-empty overlays would be possible\n    in theory, but practically difficult. The challenge is to distinguish\n    between overlapping keys between the context and the overlay.\n   *)\nval tickets_of_value :\n  Alpha_context.context ->\n  include_lazy:bool ->\n  'a Script_typed_ir.ty ->\n  'a ->\n  (ex_ticket list * Alpha_context.context) tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Trili Tech, <contact@trili.tech>                       *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\n(* Impossible error *)\ntype error += Unsupported_type_invariant_violated\n\ntype error += Unsupported_non_empty_overlay | Unsupported_type_operation\n\nlet () =\n  register_error_kind\n    `Branch\n    ~id:\"Unsupported_non_empty_overlay\"\n    ~title:\"Unsupported non empty overlay\"\n    ~description:\"Unsupported big-map value with non-empty overlay\"\n    ~pp:(fun ppf () ->\n      Format.fprintf ppf \"Unsupported big-map value with non-empty overlay\")\n    Data_encoding.empty\n    (function Unsupported_non_empty_overlay -> Some () | _ -> None)\n    (fun () -> Unsupported_non_empty_overlay) ;\n  register_error_kind\n    `Branch\n    ~id:\"Unsupported_type_operation\"\n    ~title:\"Unsupported type operation\"\n    ~description:\"Types embedding operations are not supported\"\n    ~pp:(fun ppf () ->\n      Format.fprintf ppf \"Types embedding operations are not supported\")\n    Data_encoding.empty\n    (function Unsupported_type_operation -> Some () | _ -> None)\n    (fun () -> Unsupported_type_operation)\n\ntype ex_ticket =\n  | Ex_ticket :\n      'a Script_typed_ir.comparable_ty * 'a Script_typed_ir.ticket\n      -> ex_ticket\n\nmodule Ticket_inspection = struct\n  (* TODO: 1951\n     Replace with use of meta-data for ['a ty] type.\n     Once ['a ty] values can be extended with custom meta data, this type\n     can be removed.\n  *)\n  (**\n      Witness flag for whether a type can be populated by a value containing a\n      ticket. [False_ht] must be used only when a value of the type cannot\n      contain a ticket.\n\n      This flag is necessary for avoiding ticket collection (see below) to have\n      quadratic complexity in the order of: size-of-the-type * size-of-value.\n\n      This type is local to the [Ticket_scanner] module and should not be\n      exported.\n\n  *)\n  type 'a has_tickets =\n    | True_ht : _ Script_typed_ir.ticket has_tickets\n    | False_ht : _ has_tickets\n    | Pair_ht :\n        'a has_tickets * 'b has_tickets\n        -> ('a, 'b) Script_typed_ir.pair has_tickets\n    | Union_ht :\n        'a has_tickets * 'b has_tickets\n        -> ('a, 'b) Script_typed_ir.union has_tickets\n    | Option_ht : 'a has_tickets -> 'a option has_tickets\n    | List_ht : 'a has_tickets -> 'a Script_typed_ir.boxed_list has_tickets\n    | Set_ht : 'k has_tickets -> 'k Script_typed_ir.set has_tickets\n    | Map_ht :\n        'k has_tickets * 'v has_tickets\n        -> ('k, 'v) Script_typed_ir.map has_tickets\n    | Big_map_ht :\n        'k has_tickets * 'v has_tickets\n        -> ('k, 'v) Script_typed_ir.big_map has_tickets\n\n  (* Returns whether or not a comparable type embeds tickets. Currently\n     this function returns [false] for all input.\n\n     The only reason we keep this code is so that in the future, if tickets were\n     ever to be comparable, the compiler would detect a missing pattern match\n     case.\n\n     Note that in case tickets are made comparable, this function needs to change\n     so that constructors like [Union_key] and [Pair_key] are traversed\n     recursively.\n  *)\n  let has_tickets_of_comparable :\n      type a ret.\n      a Script_typed_ir.comparable_ty -> (a has_tickets -> ret) -> ret =\n   fun key_ty k ->\n    let open Script_typed_ir in\n    match key_ty with\n    | Unit_key _ -> (k [@ocaml.tailcall]) False_ht\n    | Never_key _ -> (k [@ocaml.tailcall]) False_ht\n    | Int_key _ -> (k [@ocaml.tailcall]) False_ht\n    | Nat_key _ -> (k [@ocaml.tailcall]) False_ht\n    | Signature_key _ -> (k [@ocaml.tailcall]) False_ht\n    | String_key _ -> (k [@ocaml.tailcall]) False_ht\n    | Bytes_key _ -> (k [@ocaml.tailcall]) False_ht\n    | Mutez_key _ -> (k [@ocaml.tailcall]) False_ht\n    | Bool_key _ -> (k [@ocaml.tailcall]) False_ht\n    | Key_hash_key _ -> (k [@ocaml.tailcall]) False_ht\n    | Key_key _ -> (k [@ocaml.tailcall]) False_ht\n    | Timestamp_key _ -> (k [@ocaml.tailcall]) False_ht\n    | Chain_id_key _ -> (k [@ocaml.tailcall]) False_ht\n    | Address_key _ -> (k [@ocaml.tailcall]) False_ht\n    | Pair_key ((_, _), (_, _), _) -> (k [@ocaml.tailcall]) False_ht\n    | Union_key (_, (_, _), _) -> (k [@ocaml.tailcall]) False_ht\n    | Option_key (_, _) -> (k [@ocaml.tailcall]) False_ht\n\n  (* Short circuit pairing of two [has_tickets] values.\n     If neither left nor right branch contains a ticket, [False_ht] is\n     returned. *)\n  let pair_has_tickets pair ht1 ht2 =\n    match (ht1, ht2) with (False_ht, False_ht) -> False_ht | _ -> pair ht1 ht2\n\n  let map_has_tickets map ht =\n    match ht with False_ht -> False_ht | _ -> map ht\n\n  type ('a, 'r) continuation = 'a has_tickets -> 'r tzresult\n\n  (* Creates a [has_tickets] type-witness value from the given ['a ty].\n     The returned value matches the given shape of the [ty] value, except\n     it collapses whole branches where no types embed tickets to [False_ht].\n  *)\n  let rec has_tickets_of_ty :\n      type a ret. a Script_typed_ir.ty -> (a, ret) continuation -> ret tzresult\n      =\n   fun ty k ->\n    let open Script_typed_ir in\n    match ty with\n    | Ticket_t _ -> (k [@ocaml.tailcall]) True_ht\n    | Unit_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Int_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Nat_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Signature_t _ -> (k [@ocaml.tailcall]) False_ht\n    | String_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Bytes_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Mutez_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Key_hash_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Key_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Timestamp_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Address_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Bool_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Pair_t ((ty1, _, _), (ty2, _, _), _) ->\n        (has_tickets_of_pair [@ocaml.tailcall])\n          ty1\n          ty2\n          ~pair:(fun ht1 ht2 -> Pair_ht (ht1, ht2))\n          k\n    | Union_t ((ty1, _), (ty2, _), _) ->\n        (has_tickets_of_pair [@ocaml.tailcall])\n          ty1\n          ty2\n          ~pair:(fun ht1 ht2 -> Union_ht (ht1, ht2))\n          k\n    | Lambda_t (_, _, _) ->\n        (* As of H, closures cannot contain tickets because APPLY requires\n           a packable type and tickets are not packable. *)\n        (k [@ocaml.tailcall]) False_ht\n    | Option_t (ty, _) ->\n        (has_tickets_of_ty [@ocaml.tailcall]) ty (fun ht ->\n            let opt_hty = map_has_tickets (fun ht -> Option_ht ht) ht in\n            (k [@ocaml.tailcall]) opt_hty)\n    | List_t (ty, _) ->\n        (has_tickets_of_ty [@ocaml.tailcall]) ty (fun ht ->\n            let list_hty = map_has_tickets (fun ht -> List_ht ht) ht in\n            (k [@ocaml.tailcall]) list_hty)\n    | Set_t (key_ty, _) ->\n        (has_tickets_of_comparable [@ocaml.tailcall]) key_ty (fun ht ->\n            let set_hty = map_has_tickets (fun ht -> Set_ht ht) ht in\n            (k [@ocaml.tailcall]) set_hty)\n    | Map_t (key_ty, val_ty, _) ->\n        (has_tickets_of_key_and_value [@ocaml.tailcall])\n          key_ty\n          val_ty\n          ~pair:(fun ht1 ht2 -> Map_ht (ht1, ht2))\n          k\n    | Big_map_t (key_ty, val_ty, _) ->\n        (has_tickets_of_key_and_value [@ocaml.tailcall])\n          key_ty\n          val_ty\n          ~pair:(fun ht1 ht2 -> Big_map_ht (ht1, ht2))\n          k\n    | Contract_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Sapling_transaction_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Sapling_state_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Operation_t _ ->\n        (* Operations may contain tickets but they should never be passed\n           why we fail in this case. *)\n        error Unsupported_type_operation\n    | Chain_id_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Never_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Bls12_381_g1_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Bls12_381_g2_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Bls12_381_fr_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Chest_t _ -> (k [@ocaml.tailcall]) False_ht\n    | Chest_key_t _ -> (k [@ocaml.tailcall]) False_ht\n\n  and has_tickets_of_pair :\n      type a b c ret.\n      a Script_typed_ir.ty ->\n      b Script_typed_ir.ty ->\n      pair:(a has_tickets -> b has_tickets -> c has_tickets) ->\n      (c, ret) continuation ->\n      ret tzresult =\n   fun ty1 ty2 ~pair k ->\n    (has_tickets_of_ty [@ocaml.tailcall]) ty1 (fun ht1 ->\n        (has_tickets_of_ty [@ocaml.tailcall]) ty2 (fun ht2 ->\n            (k [@ocaml.tailcall]) (pair_has_tickets pair ht1 ht2)))\n\n  and has_tickets_of_key_and_value :\n      type k v t ret.\n      k Script_typed_ir.comparable_ty ->\n      v Script_typed_ir.ty ->\n      pair:(k has_tickets -> v has_tickets -> t has_tickets) ->\n      (t, ret) continuation ->\n      ret tzresult =\n   fun key_ty val_ty ~pair k ->\n    (has_tickets_of_comparable [@ocaml.tailcall]) key_ty (fun ht1 ->\n        (has_tickets_of_ty [@ocaml.tailcall]) val_ty (fun ht2 ->\n            (k [@ocaml.tailcall]) (pair_has_tickets pair ht1 ht2)))\n\n  let has_tickets_of_ty ctxt ty =\n    Gas.consume ctxt (Ticket_costs.has_tickets_of_ty_cost ty) >>? fun ctxt ->\n    has_tickets_of_ty ty ok >|? fun ht -> (ht, ctxt)\nend\n\nmodule Ticket_collection = struct\n  let consume_gas_steps =\n    Ticket_costs.consume_gas_steps\n      ~step_cost:Ticket_costs.Constants.cost_collect_tickets_step\n\n  type accumulator = ex_ticket list\n\n  type 'a continuation =\n    Alpha_context.context -> accumulator -> 'a tzresult Lwt.t\n\n  (* Currently this always returns the original list.\n\n     If comparables are ever extended to support tickets, this function\n     needs to be modified. In particular constructors like [Option] and [Pair]\n     would have to recurse on their arguments. *)\n\n  let tickets_of_comparable :\n      type a ret.\n      Alpha_context.context ->\n      a Script_typed_ir.comparable_ty ->\n      accumulator ->\n      ret continuation ->\n      ret tzresult Lwt.t =\n   fun ctxt comp_ty acc k ->\n    let open Script_typed_ir in\n    match comp_ty with\n    | Unit_key _ -> (k [@ocaml.tailcall]) ctxt acc\n    | Never_key _ -> (k [@ocaml.tailcall]) ctxt acc\n    | Int_key _ -> (k [@ocaml.tailcall]) ctxt acc\n    | Nat_key _ -> (k [@ocaml.tailcall]) ctxt acc\n    | Signature_key _ -> (k [@ocaml.tailcall]) ctxt acc\n    | String_key _ -> (k [@ocaml.tailcall]) ctxt acc\n    | Bytes_key _ -> (k [@ocaml.tailcall]) ctxt acc\n    | Mutez_key _ -> (k [@ocaml.tailcall]) ctxt acc\n    | Bool_key _ -> (k [@ocaml.tailcall]) ctxt acc\n    | Key_hash_key _ -> (k [@ocaml.tailcall]) ctxt acc\n    | Key_key _ -> (k [@ocaml.tailcall]) ctxt acc\n    | Timestamp_key _ -> (k [@ocaml.tailcall]) ctxt acc\n    | Chain_id_key _ -> (k [@ocaml.tailcall]) ctxt acc\n    | Address_key _ -> (k [@ocaml.tailcall]) ctxt acc\n    | Pair_key ((_, _), (_, _), _) -> (k [@ocaml.tailcall]) ctxt acc\n    | Union_key ((_, _), (_, _), _) -> (k [@ocaml.tailcall]) ctxt acc\n    | Option_key (_, _) -> (k [@ocaml.tailcall]) ctxt acc\n\n  let tickets_of_set :\n      type a ret.\n      Alpha_context.context ->\n      a Script_typed_ir.comparable_ty ->\n      a Script_typed_ir.set ->\n      accumulator ->\n      ret continuation ->\n      ret tzresult Lwt.t =\n   fun ctxt key_ty _set acc k ->\n    consume_gas_steps ctxt ~num_steps:1 >>?= fun ctxt ->\n    (* This is only invoked to support any future extensions making tickets\n       comparable. *)\n    (tickets_of_comparable [@ocaml.tailcall]) ctxt key_ty acc k\n\n  let rec tickets_of_value :\n      type a ret.\n      include_lazy:bool ->\n      Alpha_context.context ->\n      a Ticket_inspection.has_tickets ->\n      a Script_typed_ir.ty ->\n      a ->\n      accumulator ->\n      ret continuation ->\n      ret tzresult Lwt.t =\n   fun ~include_lazy ctxt hty ty x acc k ->\n    let open Script_typed_ir in\n    consume_gas_steps ctxt ~num_steps:1 >>?= fun ctxt ->\n    match (hty, ty) with\n    | (False_ht, _) -> (k [@ocaml.tailcall]) ctxt acc\n    | (Pair_ht (hty1, hty2), Pair_t ((ty1, _, _), (ty2, _, _), _)) ->\n        let (l, r) = x in\n        (tickets_of_value [@ocaml.tailcall])\n          ~include_lazy\n          ctxt\n          hty1\n          ty1\n          l\n          acc\n          (fun ctxt acc ->\n            (tickets_of_value [@ocaml.tailcall])\n              ~include_lazy\n              ctxt\n              hty2\n              ty2\n              r\n              acc\n              k)\n    | (Union_ht (htyl, htyr), Union_t ((tyl, _), (tyr, _), _)) -> (\n        match x with\n        | L v ->\n            (tickets_of_value [@ocaml.tailcall])\n              ~include_lazy\n              ctxt\n              htyl\n              tyl\n              v\n              acc\n              k\n        | R v ->\n            (tickets_of_value [@ocaml.tailcall])\n              ~include_lazy\n              ctxt\n              htyr\n              tyr\n              v\n              acc\n              k)\n    | (Option_ht el_hty, Option_t (el_ty, _)) -> (\n        match x with\n        | Some x ->\n            (tickets_of_value [@ocaml.tailcall])\n              ~include_lazy\n              ctxt\n              el_hty\n              el_ty\n              x\n              acc\n              k\n        | None -> (k [@ocaml.tailcall]) ctxt acc)\n    | (List_ht el_hty, List_t (el_ty, _)) ->\n        let {elements; _} = x in\n        (tickets_of_list [@ocaml.tailcall])\n          ctxt\n          ~include_lazy\n          el_hty\n          el_ty\n          elements\n          acc\n          k\n    | (Set_ht _, Set_t (key_ty, _)) ->\n        (tickets_of_set [@ocaml.tailcall]) ctxt key_ty x acc k\n    | (Map_ht (_, val_hty), Map_t (key_ty, val_ty, _)) ->\n        (tickets_of_comparable [@ocaml.tailcall])\n          ctxt\n          key_ty\n          acc\n          (fun ctxt acc ->\n            (tickets_of_map [@ocaml.tailcall])\n              ctxt\n              ~include_lazy\n              val_hty\n              val_ty\n              x\n              acc\n              k)\n    | (Big_map_ht (_, val_hty), Big_map_t (key_ty, _, _)) ->\n        if include_lazy then\n          (tickets_of_big_map [@ocaml.tailcall]) ctxt val_hty key_ty x acc k\n        else (k [@ocaml.tailcall]) ctxt acc\n    | (True_ht, Ticket_t (comp_ty, _)) ->\n        (k [@ocaml.tailcall]) ctxt (Ex_ticket (comp_ty, x) :: acc)\n    | _ -> fail Unsupported_type_invariant_violated\n\n  and tickets_of_list :\n      type a ret.\n      Alpha_context.context ->\n      include_lazy:bool ->\n      a Ticket_inspection.has_tickets ->\n      a Script_typed_ir.ty ->\n      a list ->\n      accumulator ->\n      ret continuation ->\n      ret tzresult Lwt.t =\n   fun ctxt ~include_lazy el_hty el_ty elements acc k ->\n    consume_gas_steps ctxt ~num_steps:1 >>?= fun ctxt ->\n    match elements with\n    | elem :: elems ->\n        (tickets_of_value [@ocaml.tailcall])\n          ~include_lazy\n          ctxt\n          el_hty\n          el_ty\n          elem\n          acc\n          (fun ctxt acc ->\n            (tickets_of_list [@ocaml.tailcall])\n              ~include_lazy\n              ctxt\n              el_hty\n              el_ty\n              elems\n              acc\n              k)\n    | [] -> (k [@ocaml.tailcall]) ctxt acc\n\n  and tickets_of_map :\n      type k v ret.\n      include_lazy:bool ->\n      Alpha_context.context ->\n      v Ticket_inspection.has_tickets ->\n      v Script_typed_ir.ty ->\n      (k, v) Script_typed_ir.map ->\n      accumulator ->\n      ret continuation ->\n      ret tzresult Lwt.t =\n   fun ~include_lazy ctxt val_hty val_ty (module M) acc k ->\n    consume_gas_steps ctxt ~num_steps:1 >>?= fun ctxt ->\n    (* Pay gas for folding over the values *)\n    consume_gas_steps ctxt ~num_steps:M.size >>?= fun ctxt ->\n    let values = M.OPS.fold (fun _ v vs -> v :: vs) M.boxed [] in\n    (tickets_of_list [@ocaml.tailcall])\n      ~include_lazy\n      ctxt\n      val_hty\n      val_ty\n      values\n      acc\n      k\n\n  and tickets_of_big_map :\n      type k v ret.\n      Alpha_context.context ->\n      v Ticket_inspection.has_tickets ->\n      k Script_typed_ir.comparable_ty ->\n      (k, v) Script_typed_ir.big_map ->\n      accumulator ->\n      ret continuation ->\n      ret tzresult Lwt.t =\n   fun ctxt\n       val_hty\n       key_ty\n       {Script_typed_ir.id; diff = {map = _; size}; key_type = _; value_type}\n       acc\n       k ->\n    consume_gas_steps ctxt ~num_steps:1 >>?= fun ctxt ->\n    (* Require empty overlay *)\n    if Compare.Int.(size > 0) then fail Unsupported_non_empty_overlay\n    else\n      (* Traverse the keys for tickets, although currently keys should never\n         contain any tickets. *)\n      (tickets_of_comparable [@ocaml.tailcall]) ctxt key_ty acc (fun ctxt acc ->\n          (* Accumulate tickets from values of the big-map stored in the context *)\n          match id with\n          | Some id ->\n              let accum (values, ctxt) exp =\n                Script_ir_translator.parse_data\n                  ~legacy:true\n                  ctxt\n                  ~allow_forged:true\n                  value_type\n                  (Micheline.root exp)\n                >|=? fun (v, ctxt) -> (v :: values, ctxt)\n              in\n              Big_map.list_values ctxt id >>=? fun (ctxt, exps) ->\n              List.fold_left_es accum ([], ctxt) exps >>=? fun (values, ctxt) ->\n              (tickets_of_list [@ocaml.tailcall])\n                ~include_lazy:true\n                ctxt\n                val_hty\n                value_type\n                values\n                acc\n                k\n          | None -> (k [@ocaml.tailcall]) ctxt acc)\n\n  let tickets_of_value ctxt ~include_lazy ty x =\n    Ticket_inspection.has_tickets_of_ty ctxt ty >>?= fun (ht, ctxt) ->\n    tickets_of_value ctxt ~include_lazy ht ty x [] (fun ctxt ex_tickets ->\n        return (ex_tickets, ctxt))\nend\n\nlet tickets_of_value ctxt = Ticket_collection.tickets_of_value ctxt\n" ;
                } ;
                { name = "Ticket_balance_key" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Trili Tech, <contact@trili.tech>                       *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** This module exposes a function for generating a ticket-balance key-hash\n    and an amount, given an owner and a ticket. The key-hash and the amount is\n    used for populating the global ticket-balance table that tracks ownership\n    of different types of tickets.\n *)\n\n(** [ticket_balance_key_and_amount ctxt ~owner ex_ticket] returns the [key_hash]\n    of the given [owner] and [ex_ticket], as well as the amount of the\n    ticket. *)\nval ticket_balance_key_and_amount :\n  Alpha_context.context ->\n  owner:Alpha_context.Contract.t ->\n  Ticket_scanner.ex_ticket ->\n  (Alpha_context.Ticket_balance.key_hash * Z.t * Alpha_context.context) tzresult\n  Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Trili Tech, <contact@trili.tech>                       *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\n(* This function extracts nodes of:\n    - Ticketer\n    - Type of content\n    - Content\n    - Owner\n   to generate at ticket-balance key-hash.\n*)\nlet ticket_balance_key_and_amount ctxt ~owner\n    (Ticket_scanner.Ex_ticket\n      (comp_ty, Script_typed_ir.{ticketer; contents; amount})) =\n  let loc = Micheline.dummy_location in\n  Script_ir_translator.unparse_comparable_ty ~loc ctxt comp_ty\n  >>?= fun (cont_ty_unstripped, ctxt) ->\n  (* We strip the annotations from the content type in order to map\n     tickets with the same content type, but with different annotations, to the\n     same hash. *)\n  Gas.consume ctxt (Script.strip_annotations_cost cont_ty_unstripped)\n  >>?= fun ctxt ->\n  let typ = Script.strip_annotations cont_ty_unstripped in\n  let ticketer_address = (ticketer, \"default\") in\n  let owner_address = (owner, \"default\") in\n  let address_t = Script_typed_ir.address_t ~annot:None in\n  Script_ir_translator.unparse_data\n    ctxt\n    Script_ir_translator.Optimized_legacy\n    address_t\n    ticketer_address\n  >>=? fun (ticketer, ctxt) ->\n  Script_ir_translator.unparse_comparable_data\n    ~loc\n    ctxt\n    Script_ir_translator.Optimized_legacy\n    comp_ty\n    contents\n  >>=? fun (contents, ctxt) ->\n  Script_ir_translator.unparse_data\n    ctxt\n    Script_ir_translator.Optimized_legacy\n    address_t\n    owner_address\n  >>=? fun (owner, ctxt) ->\n  Ticket_balance.make_key_hash ctxt ~ticketer ~typ ~contents ~owner\n  >>?= fun (hash, ctxt) -> return (hash, Script_int.to_zint amount, ctxt)\n" ;
                } ;
                { name = "Script_interpreter_defs" ;
                  interface = None ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(*\n\n   This module provides auxiliary definitions used in the interpreter.\n\n   These are internal private definitions. Do not rely on them outside\n   the interpreter.\n\n*)\n\nopen Alpha_context\nopen Script\nopen Script_typed_ir\nopen Script_ir_translator\nopen Local_gas_counter\n\n(*\n\n   Computing the cost of Michelson instructions\n   ============================================\n\n   The function [cost_of_instr] provides a cost model for Michelson\n   instructions. It is used by the interpreter to track the\n   consumption of gas. This consumption may depend on the values\n   on the stack.\n\n *)\n\nmodule Interp_costs = Michelson_v1_gas.Cost_of.Interpreter\n\nlet cost_of_instr : type a s r f. (a, s, r, f) kinstr -> a -> s -> Gas.cost =\n fun i accu stack ->\n  match i with\n  | IList_map _ ->\n      let list = accu in\n      Interp_costs.list_map list\n  | IList_iter _ ->\n      let list = accu in\n      Interp_costs.list_iter list\n  | ISet_iter _ ->\n      let set = accu in\n      Interp_costs.set_iter set\n  | ISet_mem _ ->\n      let v = accu and (set, _) = stack in\n      Interp_costs.set_mem v set\n  | ISet_update _ ->\n      let v = accu and (_, (set, _)) = stack in\n      Interp_costs.set_update v set\n  | IMap_map _ ->\n      let map = accu in\n      Interp_costs.map_map map\n  | IMap_iter _ ->\n      let map = accu in\n      Interp_costs.map_iter map\n  | IMap_mem _ ->\n      let v = accu and (map, _) = stack in\n      Interp_costs.map_mem v map\n  | IMap_get _ ->\n      let v = accu and (map, _) = stack in\n      Interp_costs.map_get v map\n  | IMap_update _ ->\n      let k = accu and (_, (map, _)) = stack in\n      Interp_costs.map_update k map\n  | IMap_get_and_update _ ->\n      let k = accu and (_, (map, _)) = stack in\n      Interp_costs.map_get_and_update k map\n  | IBig_map_mem _ ->\n      let (map, _) = stack in\n      Interp_costs.big_map_mem map.diff\n  | IBig_map_get _ ->\n      let (map, _) = stack in\n      Interp_costs.big_map_get map.diff\n  | IBig_map_update _ ->\n      let (_, (map, _)) = stack in\n      Interp_costs.big_map_update map.diff\n  | IBig_map_get_and_update _ ->\n      let (_, (map, _)) = stack in\n      Interp_costs.big_map_get_and_update map.diff\n  | IAdd_seconds_to_timestamp _ ->\n      let n = accu and (t, _) = stack in\n      Interp_costs.add_seconds_timestamp n t\n  | IAdd_timestamp_to_seconds _ ->\n      let t = accu and (n, _) = stack in\n      Interp_costs.add_timestamp_seconds t n\n  | ISub_timestamp_seconds _ ->\n      let t = accu and (n, _) = stack in\n      Interp_costs.sub_timestamp_seconds t n\n  | IDiff_timestamps _ ->\n      let t1 = accu and (t2, _) = stack in\n      Interp_costs.diff_timestamps t1 t2\n  | IConcat_string_pair _ ->\n      let x = accu and (y, _) = stack in\n      Interp_costs.concat_string_pair x y\n  | IConcat_string _ ->\n      let ss = accu in\n      Interp_costs.concat_string_precheck ss\n  | ISlice_string _ ->\n      let _offset = accu in\n      let (_length, (s, _)) = stack in\n      Interp_costs.slice_string s\n  | IConcat_bytes_pair _ ->\n      let x = accu and (y, _) = stack in\n      Interp_costs.concat_bytes_pair x y\n  | IConcat_bytes _ ->\n      let ss = accu in\n      Interp_costs.concat_string_precheck ss\n  | ISlice_bytes _ ->\n      let (_, (s, _)) = stack in\n      Interp_costs.slice_bytes s\n  | IMul_teznat _ -> Interp_costs.mul_teznat\n  | IMul_nattez _ -> Interp_costs.mul_nattez\n  | IAbs_int _ ->\n      let x = accu in\n      Interp_costs.abs_int x\n  | INeg _ ->\n      let x = accu in\n      Interp_costs.neg x\n  | IAdd_int _ ->\n      let x = accu and (y, _) = stack in\n      Interp_costs.add_int x y\n  | IAdd_nat _ ->\n      let x = accu and (y, _) = stack in\n      Interp_costs.add_nat x y\n  | ISub_int _ ->\n      let x = accu and (y, _) = stack in\n      Interp_costs.sub_int x y\n  | IMul_int _ ->\n      let x = accu and (y, _) = stack in\n      Interp_costs.mul_int x y\n  | IMul_nat _ ->\n      let x = accu and (y, _) = stack in\n      Interp_costs.mul_nat x y\n  | IEdiv_teznat _ ->\n      let x = accu and (y, _) = stack in\n      Interp_costs.ediv_teznat x y\n  | IEdiv_int _ ->\n      let x = accu and (y, _) = stack in\n      Interp_costs.ediv_int x y\n  | IEdiv_nat _ ->\n      let x = accu and (y, _) = stack in\n      Interp_costs.ediv_nat x y\n  | ILsl_nat _ ->\n      let x = accu in\n      Interp_costs.lsl_nat x\n  | ILsr_nat _ ->\n      let x = accu in\n      Interp_costs.lsr_nat x\n  | IOr_nat _ ->\n      let x = accu and (y, _) = stack in\n      Interp_costs.or_nat x y\n  | IAnd_nat _ ->\n      let x = accu and (y, _) = stack in\n      Interp_costs.and_nat x y\n  | IAnd_int_nat _ ->\n      let x = accu and (y, _) = stack in\n      Interp_costs.and_int_nat x y\n  | IXor_nat _ ->\n      let x = accu and (y, _) = stack in\n      Interp_costs.xor_nat x y\n  | INot_int _ ->\n      let x = accu in\n      Interp_costs.not_int x\n  | ICompare (_, ty, _) ->\n      let a = accu and (b, _) = stack in\n      Interp_costs.compare ty a b\n  | ICheck_signature _ ->\n      let key = accu and (_, (message, _)) = stack in\n      Interp_costs.check_signature key message\n  | IHash_key _ ->\n      let pk = accu in\n      Interp_costs.hash_key pk\n  | IBlake2b _ ->\n      let bytes = accu in\n      Interp_costs.blake2b bytes\n  | ISha256 _ ->\n      let bytes = accu in\n      Interp_costs.sha256 bytes\n  | ISha512 _ ->\n      let bytes = accu in\n      Interp_costs.sha512 bytes\n  | IKeccak _ ->\n      let bytes = accu in\n      Interp_costs.keccak bytes\n  | ISha3 _ ->\n      let bytes = accu in\n      Interp_costs.sha3 bytes\n  | IPairing_check_bls12_381 _ ->\n      let pairs = accu in\n      Interp_costs.pairing_check_bls12_381 pairs\n  | ISapling_verify_update _ ->\n      let tx = accu in\n      let inputs = List.length tx.inputs in\n      let outputs = List.length tx.outputs in\n      Interp_costs.sapling_verify_update ~inputs ~outputs\n  | ISplit_ticket _ ->\n      let ticket = accu and ((amount_a, amount_b), _) = stack in\n      Interp_costs.split_ticket ticket.amount amount_a amount_b\n  | IJoin_tickets (_, ty, _) ->\n      let (ticket_a, ticket_b) = accu in\n      Interp_costs.join_tickets ty ticket_a ticket_b\n  | IHalt _ -> Interp_costs.halt\n  | IDrop _ -> Interp_costs.drop\n  | IDup _ -> Interp_costs.dup\n  | ISwap _ -> Interp_costs.swap\n  | IConst _ -> Interp_costs.const\n  | ICons_some _ -> Interp_costs.cons_some\n  | ICons_none _ -> Interp_costs.cons_none\n  | IIf_none _ -> Interp_costs.if_none\n  | IOpt_map _ -> Interp_costs.opt_map\n  | ICons_pair _ -> Interp_costs.cons_pair\n  | IUnpair _ -> Interp_costs.unpair\n  | ICar _ -> Interp_costs.car\n  | ICdr _ -> Interp_costs.cdr\n  | ICons_left _ -> Interp_costs.cons_left\n  | ICons_right _ -> Interp_costs.cons_right\n  | IIf_left _ -> Interp_costs.if_left\n  | ICons_list _ -> Interp_costs.cons_list\n  | INil _ -> Interp_costs.nil\n  | IIf_cons _ -> Interp_costs.if_cons\n  | IList_size _ -> Interp_costs.list_size\n  | IEmpty_set _ -> Interp_costs.empty_set\n  | ISet_size _ -> Interp_costs.set_size\n  | IEmpty_map _ -> Interp_costs.empty_map\n  | IMap_size _ -> Interp_costs.map_size\n  | IEmpty_big_map _ -> Interp_costs.empty_big_map\n  | IString_size _ -> Interp_costs.string_size\n  | IBytes_size _ -> Interp_costs.bytes_size\n  | IAdd_tez _ -> Interp_costs.add_tez\n  | ISub_tez _ -> Interp_costs.sub_tez\n  | ISub_tez_legacy _ -> Interp_costs.sub_tez_legacy\n  | IOr _ -> Interp_costs.bool_or\n  | IAnd _ -> Interp_costs.bool_and\n  | IXor _ -> Interp_costs.bool_xor\n  | INot _ -> Interp_costs.bool_not\n  | IIs_nat _ -> Interp_costs.is_nat\n  | IInt_nat _ -> Interp_costs.int_nat\n  | IInt_bls12_381_fr _ -> Interp_costs.int_bls12_381_fr\n  | IEdiv_tez _ -> Interp_costs.ediv_tez\n  | IIf _ -> Interp_costs.if_\n  | ILoop _ -> Interp_costs.loop\n  | ILoop_left _ -> Interp_costs.loop_left\n  | IDip _ -> Interp_costs.dip\n  | IExec _ -> Interp_costs.exec\n  | IApply _ -> Interp_costs.apply\n  | ILambda _ -> Interp_costs.lambda\n  | IFailwith _ -> Gas.free\n  | IEq _ -> Interp_costs.eq\n  | INeq _ -> Interp_costs.neq\n  | ILt _ -> Interp_costs.lt\n  | ILe _ -> Interp_costs.le\n  | IGt _ -> Interp_costs.gt\n  | IGe _ -> Interp_costs.ge\n  | IPack _ -> Gas.free\n  | IUnpack _ ->\n      let b = accu in\n      Interp_costs.unpack b\n  | IAddress _ -> Interp_costs.address\n  | IContract _ -> Interp_costs.contract\n  | ITransfer_tokens _ -> Interp_costs.transfer_tokens\n  | IView _ -> Interp_costs.view\n  | IImplicit_account _ -> Interp_costs.implicit_account\n  | ISet_delegate _ -> Interp_costs.set_delegate\n  | IBalance _ -> Interp_costs.balance\n  | ILevel _ -> Interp_costs.level\n  | INow _ -> Interp_costs.now\n  | ISapling_empty_state _ -> Interp_costs.sapling_empty_state\n  | ISource _ -> Interp_costs.source\n  | ISender _ -> Interp_costs.sender\n  | ISelf _ -> Interp_costs.self\n  | ISelf_address _ -> Interp_costs.self_address\n  | IAmount _ -> Interp_costs.amount\n  | IDig (_, n, _, _) -> Interp_costs.dign n\n  | IDug (_, n, _, _) -> Interp_costs.dugn n\n  | IDipn (_, n, _, _, _) -> Interp_costs.dipn n\n  | IDropn (_, n, _, _) -> Interp_costs.dropn n\n  | IChainId _ -> Interp_costs.chain_id\n  | ICreate_contract _ -> Interp_costs.create_contract\n  | INever _ -> ( match accu with _ -> .)\n  | IVoting_power _ -> Interp_costs.voting_power\n  | ITotal_voting_power _ -> Interp_costs.total_voting_power\n  | IAdd_bls12_381_g1 _ -> Interp_costs.add_bls12_381_g1\n  | IAdd_bls12_381_g2 _ -> Interp_costs.add_bls12_381_g2\n  | IAdd_bls12_381_fr _ -> Interp_costs.add_bls12_381_fr\n  | IMul_bls12_381_g1 _ -> Interp_costs.mul_bls12_381_g1\n  | IMul_bls12_381_g2 _ -> Interp_costs.mul_bls12_381_g2\n  | IMul_bls12_381_fr _ -> Interp_costs.mul_bls12_381_fr\n  | INeg_bls12_381_g1 _ -> Interp_costs.neg_bls12_381_g1\n  | INeg_bls12_381_g2 _ -> Interp_costs.neg_bls12_381_g2\n  | INeg_bls12_381_fr _ -> Interp_costs.neg_bls12_381_fr\n  | IMul_bls12_381_fr_z _ ->\n      let z = accu in\n      Interp_costs.mul_bls12_381_fr_z z\n  | IMul_bls12_381_z_fr _ ->\n      let (z, _) = stack in\n      Interp_costs.mul_bls12_381_z_fr z\n  | IDup_n (_, n, _, _) -> Interp_costs.dupn n\n  | IComb (_, n, _, _) -> Interp_costs.comb n\n  | IUncomb (_, n, _, _) -> Interp_costs.uncomb n\n  | IComb_get (_, n, _, _) -> Interp_costs.comb_get n\n  | IComb_set (_, n, _, _) -> Interp_costs.comb_set n\n  | ITicket _ -> Interp_costs.ticket\n  | IRead_ticket _ -> Interp_costs.read_ticket\n  | IOpen_chest _ ->\n      let _chest_key = accu and (chest, (time, _)) = stack in\n      Interp_costs.open_chest\n        ~chest\n        ~time:(Alpha_context.Script_int.to_zint time)\n  | ILog _ -> Gas.free\n [@@ocaml.inline always]\n [@@coq_axiom_with_reason \"unreachable expression `.` not handled\"]\n\nlet cost_of_control : type a s r f. (a, s, r, f) continuation -> Gas.cost =\n fun ks ->\n  match ks with\n  | KLog _ -> Gas.free\n  | KNil -> Interp_costs.Control.nil\n  | KCons (_, _) -> Interp_costs.Control.cons\n  | KReturn _ -> Interp_costs.Control.return\n  | KMap_head (_, _) -> Interp_costs.Control.map_head\n  | KUndip (_, _) -> Interp_costs.Control.undip\n  | KLoop_in (_, _) -> Interp_costs.Control.loop_in\n  | KLoop_in_left (_, _) -> Interp_costs.Control.loop_in_left\n  | KIter (_, _, _) -> Interp_costs.Control.iter\n  | KList_enter_body (_, xs, _, len, _) ->\n      Interp_costs.Control.list_enter_body xs len\n  | KList_exit_body (_, _, _, _, _) -> Interp_costs.Control.list_exit_body\n  | KMap_enter_body (_, _, _, _) -> Interp_costs.Control.map_enter_body\n  | KMap_exit_body (_, _, map, key, _) ->\n      Interp_costs.Control.map_exit_body key map\n  | KView_exit (_, _) -> Interp_costs.Control.view_exit\n\n(*\n\n   [step] calls [consume_instr] at the beginning of each execution step.\n\n   [Local_gas_counter.consume] is used in the implementation of\n   [IConcat_string] and [IConcat_bytes] because in that special cases, the\n   cost is expressed with respect to a non-constant-time computation on the\n   inputs.\n\n*)\n\nlet consume_instr local_gas_counter k accu stack =\n  let cost = cost_of_instr k accu stack in\n  update_and_check local_gas_counter cost\n  [@@ocaml.inline always]\n\nlet consume_control local_gas_counter ks =\n  let cost = cost_of_control ks in\n  update_and_check local_gas_counter cost\n  [@@ocaml.inline always]\n\n(*\n\n   Auxiliary functions used by the instrumentation\n   ===============================================\n\n*)\n\nlet log_entry logger ctxt gas k accu stack =\n  let kinfo = kinfo_of_kinstr k in\n  let ctxt = update_context gas ctxt in\n  logger.log_entry k ctxt kinfo.iloc kinfo.kstack_ty (accu, stack)\n\nlet log_exit logger ctxt gas kinfo_prev k accu stack =\n  let kinfo = kinfo_of_kinstr k in\n  let ctxt = update_context gas ctxt in\n  logger.log_exit k ctxt kinfo_prev.iloc kinfo.kstack_ty (accu, stack)\n\nlet log_control logger ks = logger.log_control ks\n\nlet get_log = function\n  | None -> Lwt.return (Ok None)\n  | Some logger -> logger.get_log ()\n  [@@ocaml.inline always]\n\n(* [log_kinstr logger i] emits an instruction to instrument the\n   execution of [i] with [logger]. *)\nlet log_kinstr logger i = ILog (kinfo_of_kinstr i, LogEntry, logger, i)\n\n(* [log_next_kinstr logger i] instruments the next instruction of [i]\n   with the [logger].\n\n   Notice that the instrumentation breaks the sharing of continuations\n   that is normally enforced between branches of conditionals. This\n   has a performance cost. Anyway, the instrumentation allocates many\n   new [ILog] instructions and [KLog] continuations which makes\n   the execution of instrumented code significantly slower than\n   non-instrumented code. \"Zero-cost logging\" means that the normal\n   non-instrumented execution is not impacted by the ability to\n   instrument it, not that the logging itself has no cost.\n\n*)\nlet log_next_kinstr logger i =\n  let apply k =\n    ILog\n      ( kinfo_of_kinstr k,\n        LogExit (kinfo_of_kinstr i),\n        logger,\n        log_kinstr logger k )\n  in\n  kinstr_rewritek i {apply}\n\n(* We pass the identity function when no instrumentation is needed. *)\nlet id x = x [@@inline]\n\n(*\n\n   Auxiliary functions used by the interpretation loop\n   ===================================================\n\n*)\n\n(* The following function pops n elements from the stack\n   and push their reintroduction in the continuations stack. *)\nlet rec kundip :\n    type a s e z c u d w b t.\n    (a, s, e, z, c, u, d, w) stack_prefix_preservation_witness ->\n    c ->\n    u ->\n    (d, w, b, t) kinstr ->\n    a * s * (e, z, b, t) kinstr =\n fun w accu stack k ->\n  match w with\n  | KPrefix (kinfo, w) ->\n      let k = IConst (kinfo, accu, k) in\n      let (accu, stack) = stack in\n      kundip w accu stack k\n  | KRest -> (accu, stack, k)\n\n(* [apply ctxt gas ty v lam] specializes [lam] by fixing its first\n   formal argument to [v]. The type of [v] is represented by [ty]. *)\nlet apply ctxt gas capture_ty capture lam =\n  let (Lam (descr, expr)) = lam in\n  let (Item_t (full_arg_ty, _, _)) = descr.kbef in\n  let ctxt = update_context gas ctxt in\n  unparse_data ctxt Optimized capture_ty capture >>=? fun (const_expr, ctxt) ->\n  let loc = Micheline.dummy_location in\n  unparse_ty ~loc ctxt capture_ty >>?= fun (ty_expr, ctxt) ->\n  match full_arg_ty with\n  | Pair_t ((capture_ty, _, _), (arg_ty, _, _), _) ->\n      let arg_stack_ty = Item_t (arg_ty, Bot_t, None) in\n      let full_descr =\n        {\n          kloc = descr.kloc;\n          kbef = arg_stack_ty;\n          kaft = descr.kaft;\n          kinstr =\n            (let kinfo_const = {iloc = descr.kloc; kstack_ty = arg_stack_ty} in\n             let kinfo_pair =\n               {\n                 iloc = descr.kloc;\n                 kstack_ty = Item_t (capture_ty, arg_stack_ty, None);\n               }\n             in\n             IConst (kinfo_const, capture, ICons_pair (kinfo_pair, descr.kinstr)));\n        }\n      in\n      let full_expr =\n        Micheline.Seq\n          ( loc,\n            [\n              Prim (loc, I_PUSH, [ty_expr; const_expr], []);\n              Prim (loc, I_PAIR, [], []);\n              expr;\n            ] )\n      in\n      let lam' = Lam (full_descr, full_expr) in\n      let gas = update_local_gas_counter ctxt in\n      return (lam', outdated ctxt, gas)\n  | _ -> assert false\n\n(* [transfer (ctxt, sc) gas tez tp p destination entrypoint]\n   creates an operation that transfers an amount of [tez] to\n   a contract determined by [(destination, entrypoint)]\n   instantiated with argument [p] of type [tp]. *)\nlet transfer (ctxt, sc) gas amount tp p destination entrypoint =\n  let ctxt = update_context gas ctxt in\n  collect_lazy_storage ctxt tp p >>?= fun (to_duplicate, ctxt) ->\n  let to_update = no_lazy_storage_id in\n  extract_lazy_storage_diff\n    ctxt\n    Optimized\n    tp\n    p\n    ~to_duplicate\n    ~to_update\n    ~temporary:true\n  >>=? fun (p, lazy_storage_diff, ctxt) ->\n  unparse_data ctxt Optimized tp p >>=? fun (p, ctxt) ->\n  Gas.consume ctxt (Script.strip_locations_cost p) >>?= fun ctxt ->\n  let operation =\n    Transaction\n      {\n        amount;\n        destination;\n        entrypoint;\n        parameters = Script.lazy_expr (Micheline.strip_locations p);\n      }\n  in\n  fresh_internal_nonce ctxt >>?= fun (ctxt, nonce) ->\n  let iop = {source = sc.self; operation; nonce} in\n  let res = (Internal_operation iop, lazy_storage_diff) in\n  let gas = update_local_gas_counter ctxt in\n  let ctxt = outdated ctxt in\n  return (res, ctxt, gas)\n\n(* [create_contract (ctxt, sc) gas storage_ty param_ty code root_name\n   delegate credit init] creates an origination operation for a\n   contract represented by [code], with some [root_name], some initial\n   [credit] (taken to contract being executed), and an initial storage\n   [init] of type [storage_ty]. The type of the new contract argument\n   is [param_ty]. *)\n\n(* TODO: https://gitlab.com/tezos/tezos/-/issues/1688\n   Refactor the sharing part of unparse_script and create_contract *)\nlet create_contract (ctxt, sc) gas storage_type param_type code views root_name\n    delegate credit init =\n  let ctxt = update_context gas ctxt in\n  let loc = Micheline.dummy_location in\n  unparse_ty ~loc ctxt param_type >>?= fun (unparsed_param_type, ctxt) ->\n  let unparsed_param_type =\n    Script_ir_translator.add_field_annot root_name None unparsed_param_type\n  in\n  unparse_ty ~loc ctxt storage_type >>?= fun (unparsed_storage_type, ctxt) ->\n  let open Micheline in\n  let view name {input_ty; output_ty; view_code} views =\n    Prim\n      ( loc,\n        K_view,\n        [\n          String (loc, Script_string.to_string name);\n          input_ty;\n          output_ty;\n          view_code;\n        ],\n        [] )\n    :: views\n  in\n  let views = SMap.fold view views [] |> List.rev in\n  let code =\n    strip_locations\n      (Seq\n         ( loc,\n           [\n             Prim (loc, K_parameter, [unparsed_param_type], []);\n             Prim (loc, K_storage, [unparsed_storage_type], []);\n             Prim (loc, K_code, [code], []);\n           ]\n           @ views ))\n  in\n  collect_lazy_storage ctxt storage_type init >>?= fun (to_duplicate, ctxt) ->\n  let to_update = no_lazy_storage_id in\n  extract_lazy_storage_diff\n    ctxt\n    Optimized\n    storage_type\n    init\n    ~to_duplicate\n    ~to_update\n    ~temporary:true\n  >>=? fun (init, lazy_storage_diff, ctxt) ->\n  unparse_data ctxt Optimized storage_type init >>=? fun (storage, ctxt) ->\n  Gas.consume ctxt (Script.strip_locations_cost storage) >>?= fun ctxt ->\n  let storage = strip_locations storage in\n  Contract.fresh_contract_from_current_nonce ctxt >>?= fun (ctxt, contract) ->\n  let operation =\n    Origination\n      {\n        credit;\n        delegate;\n        preorigination = Some contract;\n        script =\n          {code = Script.lazy_expr code; storage = Script.lazy_expr storage};\n      }\n  in\n  fresh_internal_nonce ctxt >>?= fun (ctxt, nonce) ->\n  let res =\n    (Internal_operation {source = sc.self; operation; nonce}, lazy_storage_diff)\n  in\n  let gas = update_local_gas_counter ctxt in\n  let ctxt = outdated ctxt in\n  return (res, contract, ctxt, gas)\n\n(* [unpack ctxt ty bytes] deserialize [bytes] into a value of type [ty]. *)\nlet unpack ctxt ~ty ~bytes =\n  Gas.consume\n    ctxt\n    (Script.deserialization_cost_estimated_from_bytes (Bytes.length bytes))\n  >>?= fun ctxt ->\n  if\n    Compare.Int.(Bytes.length bytes >= 1)\n    && Compare.Int.(TzEndian.get_uint8 bytes 0 = 0x05)\n  then\n    let str = Bytes.sub_string bytes 1 (Bytes.length bytes - 1) in\n    match Data_encoding.Binary.of_string_opt Script.expr_encoding str with\n    | None ->\n        Lwt.return\n          ( Gas.consume ctxt (Interp_costs.unpack_failed str) >|? fun ctxt ->\n            (None, ctxt) )\n    | Some expr -> (\n        parse_data\n          ctxt\n          ~legacy:false\n          ~allow_forged:false\n          ty\n          (Micheline.root expr)\n        >|= function\n        | Ok (value, ctxt) -> ok (Some value, ctxt)\n        | Error _ignored ->\n            Gas.consume ctxt (Interp_costs.unpack_failed str) >|? fun ctxt ->\n            (None, ctxt))\n  else return (None, ctxt)\n\n(* [interp_stack_prefix_preserving_operation f w accu stack] applies\n   a well-typed operation [f] under some prefix of the A-stack\n   exploiting [w] to justify that the shape of the stack is\n   preserved. *)\nlet rec interp_stack_prefix_preserving_operation :\n    type a s b t c u d w result.\n    (a -> s -> (b * t) * result) ->\n    (a, s, b, t, c, u, d, w) stack_prefix_preservation_witness ->\n    c ->\n    u ->\n    (d * w) * result =\n fun f n accu stk ->\n  match (n, stk) with\n  | (KPrefix (_, n), rest) ->\n      interp_stack_prefix_preserving_operation f n (fst rest) (snd rest)\n      |> fun ((v, rest'), result) -> ((accu, (v, rest')), result)\n  | (KRest, v) -> f accu v\n\n(*\n\n   Some auxiliary functions have complex types and must be annotated\n   because of GADTs and polymorphic recursion.\n\n   To improve readibility, we introduce their types as abbreviations:\n\n*)\n\ntype ('a, 's, 'b, 't, 'r, 'f) step_type =\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  ('a, 's, 'b, 't) kinstr ->\n  ('b, 't, 'r, 'f) continuation ->\n  'a ->\n  's ->\n  ('r * 'f * outdated_context * local_gas_counter) tzresult Lwt.t\n\ntype ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'm, 'n, 'o) kmap_exit_type =\n  (('c, 'd, 'e, 'f) continuation -> ('a, 'b, 'g, 'h) continuation) ->\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  ('m * 'n, 'c * 'd, 'o, 'c * 'd) kinstr * ('m * 'n) list * ('m, 'o) map * 'm ->\n  (('m, 'o) map, 'c * 'd, 'e, 'f) continuation ->\n  'o ->\n  'a * 'b ->\n  ('g * 'h * outdated_context * local_gas_counter) tzresult Lwt.t\n\ntype ('a, 'b, 'c, 'd, 'e, 'j, 'k) kmap_enter_type =\n  (('a, 'b * 'c, 'd, 'e) continuation -> ('a, 'b * 'c, 'd, 'e) continuation) ->\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  ('j * 'k, 'b * 'c, 'a, 'b * 'c) kinstr * ('j * 'k) list * ('j, 'a) map ->\n  (('j, 'a) map, 'b * 'c, 'd, 'e) continuation ->\n  'b ->\n  'c ->\n  ('d * 'e * outdated_context * local_gas_counter) tzresult Lwt.t\n\ntype ('a, 'b, 'c, 'd, 'i, 'j) klist_exit_type =\n  (('a, 'b, 'c, 'd) continuation -> ('a, 'b, 'c, 'd) continuation) ->\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  ('i, 'a * 'b, 'j, 'a * 'b) kinstr * 'i list * 'j list * local_gas_counter ->\n  ('j boxed_list, 'a * 'b, 'c, 'd) continuation ->\n  'j ->\n  'a * 'b ->\n  ('c * 'd * outdated_context * local_gas_counter) tzresult Lwt.t\n\ntype ('a, 'b, 'c, 'd, 'e, 'j) klist_enter_type =\n  (('b, 'a * 'c, 'd, 'e) continuation -> ('b, 'a * 'c, 'd, 'e) continuation) ->\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  ('j, 'a * 'c, 'b, 'a * 'c) kinstr * 'j list * 'b list * local_gas_counter ->\n  ('b boxed_list, 'a * 'c, 'd, 'e) continuation ->\n  'a ->\n  'c ->\n  ('d * 'e * outdated_context * local_gas_counter) tzresult Lwt.t\n\ntype ('a, 'b, 'c, 'd, 'e, 'f, 'g) kloop_in_left_type =\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  ('c, 'd, 'e, 'f) continuation ->\n  ('a, 'g, 'c, 'd) kinstr ->\n  ('b, 'g, 'e, 'f) continuation ->\n  ('a, 'b) union ->\n  'g ->\n  ('e * 'f * outdated_context * local_gas_counter) tzresult Lwt.t\n\ntype ('a, 'b, 'c, 'r, 'f, 's) kloop_in_type =\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  ('b, 'c, 'r, 'f) continuation ->\n  ('a, 's, 'b, 'c) kinstr ->\n  ('a, 's, 'r, 'f) continuation ->\n  bool ->\n  'a * 's ->\n  ('r * 'f * outdated_context * local_gas_counter) tzresult Lwt.t\n\ntype ('a, 'b, 's, 'r, 'f) kiter_type =\n  (('a, 's, 'r, 'f) continuation -> ('a, 's, 'r, 'f) continuation) ->\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  ('b, 'a * 's, 'a, 's) kinstr * 'b list ->\n  ('a, 's, 'r, 'f) continuation ->\n  'a ->\n  's ->\n  ('r * 'f * outdated_context * local_gas_counter) tzresult Lwt.t\n\ntype ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) ilist_map_type =\n  (('a, 'b, 'c, 'd) continuation -> ('a, 'b, 'c, 'd) continuation) ->\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  ('e, 'a * 'b, 'f, 'a * 'b) kinstr * ('f boxed_list, 'a * 'b, 'g, 'h) kinstr ->\n  ('g, 'h, 'c, 'd) continuation ->\n  'e boxed_list ->\n  'a * 'b ->\n  ('c * 'd * outdated_context * local_gas_counter) tzresult Lwt.t\n\ntype ('a, 'b, 'c, 'd, 'e, 'f, 'g) ilist_iter_type =\n  (('a, 'b, 'c, 'd) continuation -> ('a, 'b, 'c, 'd) continuation) ->\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  ('e, 'a * 'b, 'a, 'b) kinstr * ('a, 'b, 'f, 'g) kinstr ->\n  ('f, 'g, 'c, 'd) continuation ->\n  'e boxed_list ->\n  'a * 'b ->\n  ('c * 'd * outdated_context * local_gas_counter) tzresult Lwt.t\n\ntype ('a, 'b, 'c, 'd, 'e, 'f, 'g) iset_iter_type =\n  (('a, 'b, 'c, 'd) continuation -> ('a, 'b, 'c, 'd) continuation) ->\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  ('e, 'a * 'b, 'a, 'b) kinstr * ('a, 'b, 'f, 'g) kinstr ->\n  ('f, 'g, 'c, 'd) continuation ->\n  'e set ->\n  'a * 'b ->\n  ('c * 'd * outdated_context * local_gas_counter) tzresult Lwt.t\n\ntype ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h, 'i) imap_map_type =\n  (('a, 'b, 'c, 'd) continuation -> ('a, 'b, 'c, 'd) continuation) ->\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  ('e * 'f, 'a * 'b, 'g, 'a * 'b) kinstr\n  * (('e, 'g) map, 'a * 'b, 'h, 'i) kinstr ->\n  ('h, 'i, 'c, 'd) continuation ->\n  ('e, 'f) map ->\n  'a * 'b ->\n  ('c * 'd * outdated_context * local_gas_counter) tzresult Lwt.t\n\ntype ('a, 'b, 'c, 'd, 'e, 'f, 'g, 'h) imap_iter_type =\n  (('a, 'b, 'c, 'd) continuation -> ('a, 'b, 'c, 'd) continuation) ->\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  ('e * 'f, 'a * 'b, 'a, 'b) kinstr * ('a, 'b, 'g, 'h) kinstr ->\n  ('g, 'h, 'c, 'd) continuation ->\n  ('e, 'f) map ->\n  'a * 'b ->\n  ('c * 'd * outdated_context * local_gas_counter) tzresult Lwt.t\n\ntype ('a, 'b, 'c, 'd, 'e, 'f) imul_teznat_type =\n  logger option ->\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  (Tez.t, 'a) kinfo * (Tez.t, 'b, 'c, 'd) kinstr ->\n  ('c, 'd, 'e, 'f) continuation ->\n  Tez.t ->\n  Script_int.n Script_int.num * 'b ->\n  ('e * 'f * outdated_context * local_gas_counter, error trace) result Lwt.t\n\ntype ('a, 'b, 'c, 'd, 'e, 'f) imul_nattez_type =\n  logger option ->\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  (Script_int.n Script_int.num, 'a) kinfo * (Tez.t, 'b, 'c, 'd) kinstr ->\n  ('c, 'd, 'e, 'f) continuation ->\n  Script_int.n Script_int.num ->\n  Tez.t * 'b ->\n  ('e * 'f * outdated_context * local_gas_counter, error trace) result Lwt.t\n\ntype ('a, 'b, 'c, 'd, 'e, 'f) ilsl_nat_type =\n  logger option ->\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  (Script_int.n Script_int.num, 'a) kinfo\n  * (Script_int.n Script_int.num, 'b, 'c, 'd) kinstr ->\n  ('c, 'd, 'e, 'f) continuation ->\n  Script_int.n Script_int.num ->\n  Script_int.n Script_int.num * 'b ->\n  ('e * 'f * outdated_context * local_gas_counter, error trace) result Lwt.t\n\ntype ('a, 'b, 'c, 'd, 'e, 'f) ilsr_nat_type =\n  logger option ->\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  (Script_int.n Script_int.num, 'a) kinfo\n  * (Script_int.n Script_int.num, 'b, 'c, 'd) kinstr ->\n  ('c, 'd, 'e, 'f) continuation ->\n  Script_int.n Script_int.num ->\n  Script_int.n Script_int.num * 'b ->\n  ('e * 'f * outdated_context * local_gas_counter, error trace) result Lwt.t\n\ntype ('a, 'b) ifailwith_type =\n  logger option ->\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  Script.location ->\n  'a ty ->\n  'a ->\n  ('b, error trace) result Lwt.t\n\ntype ('a, 'b, 'c, 'd, 'e, 'f, 'g) iexec_type =\n  logger option ->\n  outdated_context * step_constants ->\n  local_gas_counter ->\n  ('a, 'b, 'c, 'd) kinstr ->\n  ('c, 'd, 'e, 'f) continuation ->\n  'g ->\n  ('g, 'a) lambda * 'b ->\n  ('e * 'f * outdated_context * local_gas_counter) tzresult Lwt.t\n" ;
                } ;
                { name = "Script_interpreter" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** This is the Michelson interpreter.\n\n    This module offers a way to execute either a Michelson script or a\n    Michelson instruction.\n\n    Implementation details are documented in the .ml file.\n\n*)\n\nopen Alpha_context\nopen Script_typed_ir\n\ntype error += Reject of Script.location * Script.expr * execution_trace option\n\ntype error += Overflow of Script.location * execution_trace option\n\ntype error += Runtime_contract_error of Contract.t\n\ntype error += Bad_contract_parameter of Contract.t (* `Permanent *)\n\ntype error += Cannot_serialize_failure\n\ntype error += Cannot_serialize_storage\n\ntype error += Michelson_too_many_recursive_calls\n\ntype execution_result = {\n  ctxt : context;\n  storage : Script.expr;\n  lazy_storage_diff : Lazy_storage.diffs option;\n  operations : packed_internal_operation list;\n}\n\ntype step_constants = Script_typed_ir.step_constants = {\n  source : Contract.t;\n  payer : Contract.t;\n  self : Contract.t;\n  amount : Tez.t;\n  chain_id : Chain_id.t;\n  now : Script_timestamp.t;\n  level : Script_int.n Script_int.num;\n}\n\nval step :\n  logger option ->\n  context ->\n  Script_typed_ir.step_constants ->\n  ('a, 's, 'r, 'f) Script_typed_ir.kdescr ->\n  'a ->\n  's ->\n  ('r * 'f * context) tzresult Lwt.t\n\n(** [execute ?logger ctxt ~cached_script mode step_constant ~script\n   ~entrypoint ~parameter ~internal] interprets the [script]'s\n   [entrypoint] for a given [parameter].\n\n   This will update the local storage of the contract\n   [step_constants.self]. Other pieces of contextual information\n   ([source], [payer], [amount], and [chaind_id]) are also passed in\n   [step_constant].\n\n   [internal] is [true] if and only if the execution happens within an\n   internal operation.\n\n   [mode] is the unparsing mode, as declared by\n   {!Script_ir_translator}.\n\n   [cached_script] is the cached elaboration of [script], that is the\n   well typed abstract syntax tree produced by the type elaboration of\n   [script] during a previous execution and stored in the in-memory\n   cache.\n\n*)\nval execute :\n  ?logger:logger ->\n  Alpha_context.t ->\n  cached_script:Script_ir_translator.ex_script option ->\n  Script_ir_translator.unparsing_mode ->\n  step_constants ->\n  script:Script.t ->\n  entrypoint:string ->\n  parameter:Script.expr ->\n  internal:bool ->\n  (execution_result * (Script_ir_translator.ex_script * int)) tzresult Lwt.t\n\n(** [kstep logger ctxt step_constants kinstr accu stack] interprets the\n    script represented by [kinstr] under the context [ctxt]. This will\n    turn a stack whose topmost element is [accu] and remaining elements\n    [stack] into a new accumulator and a new stack. This function also\n    returns an updated context. If [logger] is given, [kstep] calls back\n    its functions at specific points of the execution. The execution is\n    parameterized by some [step_constants]. *)\nval kstep :\n  logger option ->\n  context ->\n  step_constants ->\n  ('a, 's, 'r, 'f) Script_typed_ir.kinstr ->\n  'a ->\n  's ->\n  ('r * 'f * context) tzresult Lwt.t\n\n(** Internal interpretation loop\n    ============================\n\n    The following types and the following functions are exposed\n    in the interface to allow the inference of a gas model in\n    snoop.\n\n    Strictly speaking, they should not be considered as part of\n    the interface since they expose implementation details that\n    may change in the future.\n\n*)\n\nmodule Internals : sig\n  (** Internally, the interpretation loop uses a local gas counter. *)\n  type local_gas_counter = int\n\n  (** During the evaluation, the gas level in the context is outdated.\n      See comments in the implementation file for more details. *)\n  type outdated_context = OutDatedContext of context [@@unboxed]\n\n  (** [next logger (ctxt, step_constants) local_gas_counter ks accu\n      stack] is an internal function which interprets the continuation\n      [ks] to execute the interpreter on the current A-stack. *)\n  val next :\n    logger option ->\n    outdated_context * step_constants ->\n    local_gas_counter ->\n    ('a, 's, 'r, 'f) continuation ->\n    'a ->\n    's ->\n    ('r * 'f * outdated_context * local_gas_counter) tzresult Lwt.t\n\n  val step :\n    outdated_context * step_constants ->\n    local_gas_counter ->\n    ('a, 's, 'r, 'f) Script_typed_ir.kinstr ->\n    'a ->\n    's ->\n    ('r * 'f * outdated_context * local_gas_counter) tzresult Lwt.t\nend\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(*\n\n  This module implements an interpreter for Michelson. It takes the\n  form of a [step] function that interprets script instructions in a\n  dedicated abstract machine.\n\n  The interpreter is written in a small-step style: an execution\n  [step] only interprets a single instruction by updating the\n  configuration of a dedicated abstract machine.\n\n  This abstract machine has two components:\n\n  - a stack to control which instructions must be executed ; and\n\n  - a stack of values where instructions get their inputs and put\n   their outputs.\n\n  In addition, the machine has access to effectful primitives to\n  interact with the execution environment (e.g. the Tezos\n  node). These primitives live in the [Lwt+State+Error] monad. Hence,\n  this interpreter produces a computation in the [Lwt+State+Error]\n  monad.\n\n  This interpreter enjoys the following properties:\n\n  - The interpreter is tail-recursive, hence it is robust to stack\n    overflow. This property is checked by the compiler thanks to the\n    [@ocaml.tailcall] annotation of each recursive call.\n\n  - The interpreter is type-preserving. Thanks to GADTs, the typing\n    rules of Michelson are statically checked by the OCaml typechecker:\n    a Michelson program cannot go wrong.\n\n  - The interpreter is tagless. Thanks to GADTs, the exact shape of\n    the stack is known statically so the interpreter does not have to\n    check that the input stack has the shape expected by the\n    instruction to be executed.\n\n  Outline\n  =======\n\n  This file is organized as follows:\n\n  1. Definition of runtime errors.\n\n  2. Interpretation loop: This is the main functionality of this\n   module, aka the [step] function.\n\n  3. Interface functions: This part of the module builds high-level\n   functions on top of the more basic [step] function.\n\n  Auxiliary definitions can be found in {!Script_interpreter_defs}.\n\n  Implementation details are explained along the file.\n\n*)\n\nopen Alpha_context\nopen Script_typed_ir\nopen Script_ir_translator\nopen Local_gas_counter\nopen Script_interpreter_defs\nmodule S = Saturation_repr\n\ntype step_constants = Script_typed_ir.step_constants = {\n  source : Contract.t;\n  payer : Contract.t;\n  self : Contract.t;\n  amount : Tez.t;\n  chain_id : Chain_id.t;\n  now : Script_timestamp.t;\n  level : Script_int.n Script_int.num;\n}\n\n(* ---- Run-time errors -----------------------------------------------------*)\n\ntype error += Reject of Script.location * Script.expr * execution_trace option\n\ntype error += Overflow of Script.location * execution_trace option\n\ntype error += Runtime_contract_error of Contract.t\n\ntype error += Bad_contract_parameter of Contract.t (* `Permanent *)\n\ntype error += Cannot_serialize_failure\n\ntype error += Cannot_serialize_storage\n\ntype error += Michelson_too_many_recursive_calls\n\nlet () =\n  let open Data_encoding in\n  let trace_encoding =\n    list\n    @@ obj3\n         (req \"location\" Script.location_encoding)\n         (req \"gas\" Gas.encoding)\n         (req\n            \"stack\"\n            (list (obj2 (req \"item\" Script.expr_encoding) (opt \"annot\" string))))\n  in\n  (* Reject *)\n  register_error_kind\n    `Temporary\n    ~id:\"michelson_v1.script_rejected\"\n    ~title:\"Script failed\"\n    ~description:\"A FAILWITH instruction was reached\"\n    (obj3\n       (req \"location\" Script.location_encoding)\n       (req \"with\" Script.expr_encoding)\n       (opt \"trace\" trace_encoding))\n    (function Reject (loc, v, trace) -> Some (loc, v, trace) | _ -> None)\n    (fun (loc, v, trace) -> Reject (loc, v, trace)) ;\n  (* Overflow *)\n  register_error_kind\n    `Temporary\n    ~id:\"michelson_v1.script_overflow\"\n    ~title:\"Script failed (overflow error)\"\n    ~description:\n      \"A FAIL instruction was reached due to the detection of an overflow\"\n    (obj2\n       (req \"location\" Script.location_encoding)\n       (opt \"trace\" trace_encoding))\n    (function Overflow (loc, trace) -> Some (loc, trace) | _ -> None)\n    (fun (loc, trace) -> Overflow (loc, trace)) ;\n  (* Runtime contract error *)\n  register_error_kind\n    `Temporary\n    ~id:\"michelson_v1.runtime_error\"\n    ~title:\"Script runtime error\"\n    ~description:\"Toplevel error for all runtime script errors\"\n    (obj2\n       (req \"contract_handle\" Contract.encoding)\n       (req \"contract_code\" (constant \"Deprecated\")))\n    (function\n      | Runtime_contract_error contract -> Some (contract, ()) | _ -> None)\n    (fun (contract, ()) -> Runtime_contract_error contract) ;\n  (* Bad contract parameter *)\n  register_error_kind\n    `Permanent\n    ~id:\"michelson_v1.bad_contract_parameter\"\n    ~title:\"Contract supplied an invalid parameter\"\n    ~description:\n      \"Either no parameter was supplied to a contract with a non-unit \\\n       parameter type, a non-unit parameter was passed to an account, or a \\\n       parameter was supplied of the wrong type\"\n    Data_encoding.(obj1 (req \"contract\" Contract.encoding))\n    (function Bad_contract_parameter c -> Some c | _ -> None)\n    (fun c -> Bad_contract_parameter c) ;\n  (* Cannot serialize failure *)\n  register_error_kind\n    `Temporary\n    ~id:\"michelson_v1.cannot_serialize_failure\"\n    ~title:\"Not enough gas to serialize argument of FAILWITH\"\n    ~description:\n      \"Argument of FAILWITH was too big to be serialized with the provided gas\"\n    Data_encoding.empty\n    (function Cannot_serialize_failure -> Some () | _ -> None)\n    (fun () -> Cannot_serialize_failure) ;\n  (* Cannot serialize storage *)\n  register_error_kind\n    `Temporary\n    ~id:\"michelson_v1.cannot_serialize_storage\"\n    ~title:\"Not enough gas to serialize execution storage\"\n    ~description:\n      \"The returned storage was too big to be serialized with the provided gas\"\n    Data_encoding.empty\n    (function Cannot_serialize_storage -> Some () | _ -> None)\n    (fun () -> Cannot_serialize_storage)\n\n(*\n\n  Interpretation loop\n  ===================\n\n*)\n\n(*\n\n   As announced earlier, the [step] function produces a computation in\n   the [Lwt+State+Error] monad. The [State] monad is implemented by\n   having the [context] passed as input and returned updated as\n   output. The [Error] monad is represented by the [tzresult] type\n   constructor.\n\n   The [step] function is actually defined as an internal\n   tail-recursive routine of the toplevel [step]. It monitors the gas\n   level before executing the instruction under focus, once this is\n   done, it recursively calls itself on the continuation held by the\n   current instruction.\n\n   For each pure instruction (i.e. that is not monadic), the\n   interpretation simply updates the input arguments of the [step]\n   function. Since these arguments are (most likely) stored in\n   hardware registers and since the tail-recursive calls are compiled\n   into direct jumps, this interpretation technique offers good\n   performances while saving safety thanks to a rich typing.\n\n   For each impure instruction, the interpreter makes use of monadic\n   bindings to compose monadic primitives with the [step] function.\n   Again, we make sure that the recursive calls to [step] are tail\n   calls by annotating them with [@ocaml.tailcall].\n\n   The [step] function is actually based on several mutually\n   recursive functions that can be separated in two groups: the first\n   group focuses on the evaluation of continuations while the second\n   group is about evaluating the instructions.\n\n*)\n\n(*\n\n    Evaluation of continuations\n    ===========================\n\n    As explained in [Script_typed_ir], there are several kinds of\n    continuations, each having a specific evaluation rules. The\n    following group of functions starts with a list of evaluation\n    rules for continuations that generate fresh continuations. This\n    group ends with the definition of [next], which dispatches\n    evaluation rules depending on the continuation at stake.\n\n *)\nlet rec kmap_exit :\n    type a b c d e f g h m n o. (a, b, c, d, e, f, g, h, m, n, o) kmap_exit_type\n    =\n fun mk g gas (body, xs, ys, yk) ks accu stack ->\n  let ys = Script_map.update yk (Some accu) ys in\n  let ks = mk (KMap_enter_body (body, xs, ys, ks)) in\n  let (accu, stack) = stack in\n  (next [@ocaml.tailcall]) g gas ks accu stack\n [@@inline]\n\nand kmap_enter : type a b c d i j k. (a, b, c, d, i, j, k) kmap_enter_type =\n fun mk g gas (body, xs, ys) ks accu stack ->\n  match xs with\n  | [] -> (next [@ocaml.tailcall]) g gas ks ys (accu, stack)\n  | (xk, xv) :: xs ->\n      let ks = mk (KMap_exit_body (body, xs, ys, xk, ks)) in\n      let res = (xk, xv) in\n      let stack = (accu, stack) in\n      (step [@ocaml.tailcall]) g gas body ks res stack\n [@@inline]\n\nand klist_exit : type a b c d i j. (a, b, c, d, i, j) klist_exit_type =\n fun mk g gas (body, xs, ys, len) ks accu stack ->\n  let ks = mk (KList_enter_body (body, xs, accu :: ys, len, ks)) in\n  let (accu, stack) = stack in\n  (next [@ocaml.tailcall]) g gas ks accu stack\n [@@inline]\n\nand klist_enter : type a b c d e j. (a, b, c, d, e, j) klist_enter_type =\n fun mk g gas (body, xs, ys, len) ks' accu stack ->\n  match xs with\n  | [] ->\n      let ys = {elements = List.rev ys; length = len} in\n      (next [@ocaml.tailcall]) g gas ks' ys (accu, stack)\n  | x :: xs ->\n      let ks = mk (KList_exit_body (body, xs, ys, len, ks')) in\n      (step [@ocaml.tailcall]) g gas body ks x (accu, stack)\n [@@inline]\n\nand kloop_in_left : type a b c d e f g. (a, b, c, d, e, f, g) kloop_in_left_type\n    =\n fun g gas ks0 ki ks' accu stack ->\n  match accu with\n  | L v -> (step [@ocaml.tailcall]) g gas ki ks0 v stack\n  | R v -> (next [@ocaml.tailcall]) g gas ks' v stack\n [@@inline]\n\nand kloop_in : type a b c r f s. (a, b, c, r, f, s) kloop_in_type =\n fun g gas ks0 ki ks' accu stack ->\n  let (accu', stack') = stack in\n  if accu then (step [@ocaml.tailcall]) g gas ki ks0 accu' stack'\n  else (next [@ocaml.tailcall]) g gas ks' accu' stack'\n [@@inline]\n\nand kiter : type a b s r f. (a, b, s, r, f) kiter_type =\n fun mk g gas (body, xs) ks accu stack ->\n  match xs with\n  | [] -> (next [@ocaml.tailcall]) g gas ks accu stack\n  | x :: xs ->\n      let ks = mk (KIter (body, xs, ks)) in\n      (step [@ocaml.tailcall]) g gas body ks x (accu, stack)\n [@@inline]\n\nand next :\n    type a s r f.\n    outdated_context * step_constants ->\n    local_gas_counter ->\n    (a, s, r, f) continuation ->\n    a ->\n    s ->\n    (r * f * outdated_context * local_gas_counter) tzresult Lwt.t =\n fun ((ctxt, _) as g) gas ks0 accu stack ->\n  match consume_control gas ks0 with\n  | None -> fail Gas.Operation_quota_exceeded\n  | Some gas -> (\n      match ks0 with\n      | KLog (ks, logger) ->\n          (klog [@ocaml.tailcall]) logger g gas ks0 ks accu stack\n      | KNil -> Lwt.return (Ok (accu, stack, ctxt, gas))\n      | KCons (k, ks) -> (step [@ocaml.tailcall]) g gas k ks accu stack\n      | KLoop_in (ki, ks') ->\n          (kloop_in [@ocaml.tailcall]) g gas ks0 ki ks' accu stack\n      | KReturn (stack', ks) -> (next [@ocaml.tailcall]) g gas ks accu stack'\n      | KMap_head (f, ks) -> (next [@ocaml.tailcall]) g gas ks (f accu) stack\n      | KLoop_in_left (ki, ks') ->\n          (kloop_in_left [@ocaml.tailcall]) g gas ks0 ki ks' accu stack\n      | KUndip (x, ks) -> (next [@ocaml.tailcall]) g gas ks x (accu, stack)\n      | KIter (body, xs, ks) ->\n          let extra = (body, xs) in\n          (kiter [@ocaml.tailcall]) id g gas extra ks accu stack\n      | KList_enter_body (body, xs, ys, len, ks) ->\n          let extra = (body, xs, ys, len) in\n          (klist_enter [@ocaml.tailcall]) id g gas extra ks accu stack\n      | KList_exit_body (body, xs, ys, len, ks) ->\n          let extra = (body, xs, ys, len) in\n          (klist_exit [@ocaml.tailcall]) id g gas extra ks accu stack\n      | KMap_enter_body (body, xs, ys, ks) ->\n          let extra = (body, xs, ys) in\n          (kmap_enter [@ocaml.tailcall]) id g gas extra ks accu stack\n      | KMap_exit_body (body, xs, ys, yk, ks) ->\n          let extra = (body, xs, ys, yk) in\n          (kmap_exit [@ocaml.tailcall]) id g gas extra ks accu stack\n      | KView_exit (orig_step_constants, ks) ->\n          let g = (fst g, orig_step_constants) in\n          (next [@ocaml.tailcall]) g gas ks accu stack)\n\n(*\n\n   Evaluation of instructions\n   ==========================\n\n   The following functions define evaluation rules for instructions that\n   generate fresh continuations. As such, they expect a constructor\n   [log_if_needed] which inserts a [KLog] if the evaluation is logged.\n\n   The [step] function is taking care of the evaluation of the other\n   instructions.\n\n*)\nand ilist_map : type a b c d e f g h. (a, b, c, d, e, f, g, h) ilist_map_type =\n fun log_if_needed g gas (body, k) ks accu stack ->\n  let xs = accu.elements in\n  let ys = [] in\n  let len = accu.length in\n  let ks =\n    log_if_needed (KList_enter_body (body, xs, ys, len, KCons (k, ks)))\n  in\n  let (accu, stack) = stack in\n  (next [@ocaml.tailcall]) g gas ks accu stack\n [@@inline]\n\nand ilist_iter : type a b c d e f g. (a, b, c, d, e, f, g) ilist_iter_type =\n fun log_if_needed g gas (body, k) ks accu stack ->\n  let xs = accu.elements in\n  let ks = log_if_needed (KIter (body, xs, KCons (k, ks))) in\n  let (accu, stack) = stack in\n  (next [@ocaml.tailcall]) g gas ks accu stack\n [@@inline]\n\nand iset_iter : type a b c d e f g. (a, b, c, d, e, f, g) iset_iter_type =\n fun log_if_needed g gas (body, k) ks accu stack ->\n  let set = accu in\n  let l = List.rev (Script_set.fold (fun e acc -> e :: acc) set []) in\n  let ks = log_if_needed (KIter (body, l, KCons (k, ks))) in\n  let (accu, stack) = stack in\n  (next [@ocaml.tailcall]) g gas ks accu stack\n [@@inline]\n\nand imap_map : type a b c d e f g h i. (a, b, c, d, e, f, g, h, i) imap_map_type\n    =\n fun log_if_needed g gas (body, k) ks accu stack ->\n  let map = accu in\n  let xs = List.rev (Script_map.fold (fun k v a -> (k, v) :: a) map []) in\n  let ys = Script_map.(empty @@ key_ty map) in\n  let ks = log_if_needed (KMap_enter_body (body, xs, ys, KCons (k, ks))) in\n  let (accu, stack) = stack in\n  (next [@ocaml.tailcall]) g gas ks accu stack\n [@@inline]\n\nand imap_iter : type a b c d e f g h. (a, b, c, d, e, f, g, h) imap_iter_type =\n fun log_if_needed g gas (body, k) ks accu stack ->\n  let map = accu in\n  let l = List.rev (Script_map.fold (fun k v a -> (k, v) :: a) map []) in\n  let ks = log_if_needed (KIter (body, l, KCons (k, ks))) in\n  let (accu, stack) = stack in\n  (next [@ocaml.tailcall]) g gas ks accu stack\n [@@inline]\n\nand imul_teznat : type a b c d e f. (a, b, c, d, e, f) imul_teznat_type =\n fun logger g gas (kinfo, k) ks accu stack ->\n  let x = accu in\n  let (y, stack) = stack in\n  match Script_int.to_int64 y with\n  | None -> get_log logger >>=? fun log -> fail (Overflow (kinfo.iloc, log))\n  | Some y ->\n      Tez.(x *? y) >>?= fun res -> (step [@ocaml.tailcall]) g gas k ks res stack\n\nand imul_nattez : type a b c d e f. (a, b, c, d, e, f) imul_nattez_type =\n fun logger g gas (kinfo, k) ks accu stack ->\n  let y = accu in\n  let (x, stack) = stack in\n  match Script_int.to_int64 y with\n  | None -> get_log logger >>=? fun log -> fail (Overflow (kinfo.iloc, log))\n  | Some y ->\n      Tez.(x *? y) >>?= fun res -> (step [@ocaml.tailcall]) g gas k ks res stack\n\nand ilsl_nat : type a b c d e f. (a, b, c, d, e, f) ilsl_nat_type =\n fun logger g gas (kinfo, k) ks accu stack ->\n  let x = accu and (y, stack) = stack in\n  match Script_int.shift_left_n x y with\n  | None -> get_log logger >>=? fun log -> fail (Overflow (kinfo.iloc, log))\n  | Some x -> (step [@ocaml.tailcall]) g gas k ks x stack\n\nand ilsr_nat : type a b c d e f. (a, b, c, d, e, f) ilsr_nat_type =\n fun logger g gas (kinfo, k) ks accu stack ->\n  let x = accu and (y, stack) = stack in\n  match Script_int.shift_right_n x y with\n  | None -> get_log logger >>=? fun log -> fail (Overflow (kinfo.iloc, log))\n  | Some r -> (step [@ocaml.tailcall]) g gas k ks r stack\n\nand ifailwith : type a b. (a, b) ifailwith_type =\n fun logger (ctxt, _) gas kloc tv accu ->\n  let v = accu in\n  let ctxt = update_context gas ctxt in\n  trace Cannot_serialize_failure (unparse_data ctxt Optimized tv v)\n  >>=? fun (v, _ctxt) ->\n  let v = Micheline.strip_locations v in\n  get_log logger >>=? fun log -> fail (Reject (kloc, v, log))\n\nand iexec : type a b c d e f g. (a, b, c, d, e, f, g) iexec_type =\n fun logger g gas k ks accu stack ->\n  let arg = accu and (code, stack) = stack in\n  let (Lam (code, _)) = code in\n  let code =\n    match logger with\n    | None -> code.kinstr\n    | Some logger -> log_kinstr logger code.kinstr\n  in\n  let ks = KReturn (stack, KCons (k, ks)) in\n  (step [@ocaml.tailcall]) g gas code ks arg (EmptyCell, EmptyCell)\n\nand step : type a s b t r f. (a, s, b, t, r, f) step_type =\n fun ((ctxt, sc) as g) gas i ks accu stack ->\n  match consume_instr gas i accu stack with\n  | None -> fail Gas.Operation_quota_exceeded\n  | Some gas -> (\n      match i with\n      | ILog (_, event, logger, k) ->\n          (log [@ocaml.tailcall]) (logger, event) g gas k ks accu stack\n      | IHalt _ -> (next [@ocaml.tailcall]) g gas ks accu stack\n      (* stack ops *)\n      | IDrop (_, k) ->\n          let (accu, stack) = stack in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | IDup (_, k) -> (step [@ocaml.tailcall]) g gas k ks accu (accu, stack)\n      | ISwap (_, k) ->\n          let (top, stack) = stack in\n          (step [@ocaml.tailcall]) g gas k ks top (accu, stack)\n      | IConst (_, v, k) -> (step [@ocaml.tailcall]) g gas k ks v (accu, stack)\n      (* options *)\n      | ICons_some (_, k) ->\n          (step [@ocaml.tailcall]) g gas k ks (Some accu) stack\n      | ICons_none (_, k) ->\n          (step [@ocaml.tailcall]) g gas k ks None (accu, stack)\n      | IIf_none {branch_if_none; branch_if_some; k; _} -> (\n          match accu with\n          | None ->\n              let (accu, stack) = stack in\n              (step [@ocaml.tailcall])\n                g\n                gas\n                branch_if_none\n                (KCons (k, ks))\n                accu\n                stack\n          | Some v ->\n              (step [@ocaml.tailcall])\n                g\n                gas\n                branch_if_some\n                (KCons (k, ks))\n                v\n                stack)\n      | IOpt_map {body; k; kinfo = _} -> (\n          match accu with\n          | None -> (step [@ocaml.tailcall]) g gas k ks None stack\n          | Some v ->\n              let ks' = KMap_head (Option.some, KCons (k, ks)) in\n              (step [@ocaml.tailcall]) g gas body ks' v stack)\n      (* pairs *)\n      | ICons_pair (_, k) ->\n          let (b, stack) = stack in\n          (step [@ocaml.tailcall]) g gas k ks (accu, b) stack\n      | IUnpair (_, k) ->\n          let (a, b) = accu in\n          (step [@ocaml.tailcall]) g gas k ks a (b, stack)\n      | ICar (_, k) ->\n          let (a, _) = accu in\n          (step [@ocaml.tailcall]) g gas k ks a stack\n      | ICdr (_, k) ->\n          let (_, b) = accu in\n          (step [@ocaml.tailcall]) g gas k ks b stack\n      (* unions *)\n      | ICons_left (_, k) -> (step [@ocaml.tailcall]) g gas k ks (L accu) stack\n      | ICons_right (_, k) -> (step [@ocaml.tailcall]) g gas k ks (R accu) stack\n      | IIf_left {branch_if_left; branch_if_right; k; _} -> (\n          match accu with\n          | L v ->\n              (step [@ocaml.tailcall])\n                g\n                gas\n                branch_if_left\n                (KCons (k, ks))\n                v\n                stack\n          | R v ->\n              (step [@ocaml.tailcall])\n                g\n                gas\n                branch_if_right\n                (KCons (k, ks))\n                v\n                stack)\n      (* lists *)\n      | ICons_list (_, k) ->\n          let (tl, stack) = stack in\n          let accu = Script_list.cons accu tl in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | INil (_, k) ->\n          let stack = (accu, stack) in\n          let accu = Script_list.empty in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | IIf_cons {branch_if_cons; branch_if_nil; k; _} -> (\n          match accu.elements with\n          | [] ->\n              let (accu, stack) = stack in\n              (step [@ocaml.tailcall])\n                g\n                gas\n                branch_if_nil\n                (KCons (k, ks))\n                accu\n                stack\n          | hd :: tl ->\n              let tl = {elements = tl; length = accu.length - 1} in\n              (step [@ocaml.tailcall])\n                g\n                gas\n                branch_if_cons\n                (KCons (k, ks))\n                hd\n                (tl, stack))\n      | IList_map (_, body, k) ->\n          (ilist_map [@ocaml.tailcall]) id g gas (body, k) ks accu stack\n      | IList_size (_, k) ->\n          let list = accu in\n          let len = Script_int.(abs (of_int list.length)) in\n          (step [@ocaml.tailcall]) g gas k ks len stack\n      | IList_iter (_, body, k) ->\n          (ilist_iter [@ocaml.tailcall]) id g gas (body, k) ks accu stack\n      (* sets *)\n      | IEmpty_set (_, ty, k) ->\n          let res = Script_set.empty ty in\n          let stack = (accu, stack) in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | ISet_iter (_, body, k) ->\n          (iset_iter [@ocaml.tailcall]) id g gas (body, k) ks accu stack\n      | ISet_mem (_, k) ->\n          let (set, stack) = stack in\n          let res = Script_set.mem accu set in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | ISet_update (_, k) ->\n          let (presence, (set, stack)) = stack in\n          let res = Script_set.update accu presence set in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | ISet_size (_, k) ->\n          let res = Script_set.size accu in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      (* maps *)\n      | IEmpty_map (_, ty, k) ->\n          let res = Script_map.empty ty and stack = (accu, stack) in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IMap_map (_, body, k) ->\n          (imap_map [@ocaml.tailcall]) id g gas (body, k) ks accu stack\n      | IMap_iter (_, body, k) ->\n          (imap_iter [@ocaml.tailcall]) id g gas (body, k) ks accu stack\n      | IMap_mem (_, k) ->\n          let (map, stack) = stack in\n          let res = Script_map.mem accu map in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IMap_get (_, k) ->\n          let (map, stack) = stack in\n          let res = Script_map.get accu map in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IMap_update (_, k) ->\n          let (v, (map, stack)) = stack in\n          let key = accu in\n          let res = Script_map.update key v map in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IMap_get_and_update (_, k) ->\n          let key = accu in\n          let (v, (map, rest)) = stack in\n          let map' = Script_map.update key v map in\n          let v' = Script_map.get key map in\n          (step [@ocaml.tailcall]) g gas k ks v' (map', rest)\n      | IMap_size (_, k) ->\n          let res = Script_map.size accu in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      (* Big map operations *)\n      | IEmpty_big_map (_, tk, tv, k) ->\n          let ebm = Script_ir_translator.empty_big_map tk tv in\n          (step [@ocaml.tailcall]) g gas k ks ebm (accu, stack)\n      | IBig_map_mem (_, k) ->\n          let (map, stack) = stack in\n          let key = accu in\n          ( use_gas_counter_in_ctxt ctxt gas @@ fun ctxt ->\n            Script_ir_translator.big_map_mem ctxt key map )\n          >>=? fun (res, ctxt, gas) ->\n          (step [@ocaml.tailcall]) (ctxt, sc) gas k ks res stack\n      | IBig_map_get (_, k) ->\n          let (map, stack) = stack in\n          let key = accu in\n          ( use_gas_counter_in_ctxt ctxt gas @@ fun ctxt ->\n            Script_ir_translator.big_map_get ctxt key map )\n          >>=? fun (res, ctxt, gas) ->\n          (step [@ocaml.tailcall]) (ctxt, sc) gas k ks res stack\n      | IBig_map_update (_, k) ->\n          let key = accu in\n          let (maybe_value, (map, stack)) = stack in\n          ( use_gas_counter_in_ctxt ctxt gas @@ fun ctxt ->\n            Script_ir_translator.big_map_update ctxt key maybe_value map )\n          >>=? fun (big_map, ctxt, gas) ->\n          (step [@ocaml.tailcall]) (ctxt, sc) gas k ks big_map stack\n      | IBig_map_get_and_update (_, k) ->\n          let key = accu in\n          let (v, (map, stack)) = stack in\n          ( use_gas_counter_in_ctxt ctxt gas @@ fun ctxt ->\n            Script_ir_translator.big_map_get_and_update ctxt key v map )\n          >>=? fun ((v', map'), ctxt, gas) ->\n          (step [@ocaml.tailcall]) (ctxt, sc) gas k ks v' (map', stack)\n      (* timestamp operations *)\n      | IAdd_seconds_to_timestamp (_, k) ->\n          let n = accu in\n          let (t, stack) = stack in\n          let result = Script_timestamp.add_delta t n in\n          (step [@ocaml.tailcall]) g gas k ks result stack\n      | IAdd_timestamp_to_seconds (_, k) ->\n          let t = accu in\n          let (n, stack) = stack in\n          let result = Script_timestamp.add_delta t n in\n          (step [@ocaml.tailcall]) g gas k ks result stack\n      | ISub_timestamp_seconds (_, k) ->\n          let t = accu in\n          let (s, stack) = stack in\n          let result = Script_timestamp.sub_delta t s in\n          (step [@ocaml.tailcall]) g gas k ks result stack\n      | IDiff_timestamps (_, k) ->\n          let t1 = accu in\n          let (t2, stack) = stack in\n          let result = Script_timestamp.diff t1 t2 in\n          (step [@ocaml.tailcall]) g gas k ks result stack\n      (* string operations *)\n      | IConcat_string_pair (_, k) ->\n          let x = accu in\n          let (y, stack) = stack in\n          let s = Script_string.concat_pair x y in\n          (step [@ocaml.tailcall]) g gas k ks s stack\n      | IConcat_string (_, k) ->\n          let ss = accu in\n          (* The cost for this fold_left has been paid upfront *)\n          let total_length =\n            List.fold_left\n              (fun acc s -> S.add acc (S.safe_int (Script_string.length s)))\n              S.zero\n              ss.elements\n          in\n          consume gas (Interp_costs.concat_string total_length) >>?= fun gas ->\n          let s = Script_string.concat ss.elements in\n          (step [@ocaml.tailcall]) g gas k ks s stack\n      | ISlice_string (_, k) ->\n          let offset = accu and (length, (s, stack)) = stack in\n          let s_length = Z.of_int (Script_string.length s) in\n          let offset = Script_int.to_zint offset in\n          let length = Script_int.to_zint length in\n          if Compare.Z.(offset < s_length && Z.add offset length <= s_length)\n          then\n            let s = Script_string.sub s (Z.to_int offset) (Z.to_int length) in\n            (step [@ocaml.tailcall]) g gas k ks (Some s) stack\n          else (step [@ocaml.tailcall]) g gas k ks None stack\n      | IString_size (_, k) ->\n          let s = accu in\n          let result = Script_int.(abs (of_int (Script_string.length s))) in\n          (step [@ocaml.tailcall]) g gas k ks result stack\n      (* bytes operations *)\n      | IConcat_bytes_pair (_, k) ->\n          let x = accu in\n          let (y, stack) = stack in\n          let s = Bytes.cat x y in\n          (step [@ocaml.tailcall]) g gas k ks s stack\n      | IConcat_bytes (_, k) ->\n          let ss = accu in\n          (* The cost for this fold_left has been paid upfront *)\n          let total_length =\n            List.fold_left\n              (fun acc s -> S.add acc (S.safe_int (Bytes.length s)))\n              S.zero\n              ss.elements\n          in\n          consume gas (Interp_costs.concat_string total_length) >>?= fun gas ->\n          let s = Bytes.concat Bytes.empty ss.elements in\n          (step [@ocaml.tailcall]) g gas k ks s stack\n      | ISlice_bytes (_, k) ->\n          let offset = accu and (length, (s, stack)) = stack in\n          let s_length = Z.of_int (Bytes.length s) in\n          let offset = Script_int.to_zint offset in\n          let length = Script_int.to_zint length in\n          if Compare.Z.(offset < s_length && Z.add offset length <= s_length)\n          then\n            let s = Bytes.sub s (Z.to_int offset) (Z.to_int length) in\n            (step [@ocaml.tailcall]) g gas k ks (Some s) stack\n          else (step [@ocaml.tailcall]) g gas k ks None stack\n      | IBytes_size (_, k) ->\n          let s = accu in\n          let result = Script_int.(abs (of_int (Bytes.length s))) in\n          (step [@ocaml.tailcall]) g gas k ks result stack\n      (* currency operations *)\n      | IAdd_tez (_, k) ->\n          let x = accu in\n          let (y, stack) = stack in\n          Tez.(x +? y) >>?= fun res ->\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | ISub_tez (_, k) ->\n          let x = accu in\n          let (y, stack) = stack in\n          let res = Tez.sub_opt x y in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | ISub_tez_legacy (_, k) ->\n          let x = accu in\n          let (y, stack) = stack in\n          Tez.(x -? y) >>?= fun res ->\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IMul_teznat (kinfo, k) ->\n          imul_teznat None g gas (kinfo, k) ks accu stack\n      | IMul_nattez (kinfo, k) ->\n          imul_nattez None g gas (kinfo, k) ks accu stack\n      (* boolean operations *)\n      | IOr (_, k) ->\n          let x = accu in\n          let (y, stack) = stack in\n          (step [@ocaml.tailcall]) g gas k ks (x || y) stack\n      | IAnd (_, k) ->\n          let x = accu in\n          let (y, stack) = stack in\n          (step [@ocaml.tailcall]) g gas k ks (x && y) stack\n      | IXor (_, k) ->\n          let x = accu in\n          let (y, stack) = stack in\n          let res = Compare.Bool.(x <> y) in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | INot (_, k) ->\n          let x = accu in\n          (step [@ocaml.tailcall]) g gas k ks (not x) stack\n      (* integer operations *)\n      | IIs_nat (_, k) ->\n          let x = accu in\n          let res = Script_int.is_nat x in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IAbs_int (_, k) ->\n          let x = accu in\n          let res = Script_int.abs x in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IInt_nat (_, k) ->\n          let x = accu in\n          let res = Script_int.int x in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | INeg (_, k) ->\n          let x = accu in\n          let res = Script_int.neg x in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IAdd_int (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let res = Script_int.add x y in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IAdd_nat (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let res = Script_int.add_n x y in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | ISub_int (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let res = Script_int.sub x y in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IMul_int (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let res = Script_int.mul x y in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IMul_nat (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let res = Script_int.mul_n x y in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IEdiv_teznat (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let x = Script_int.of_int64 (Tez.to_mutez x) in\n          let result =\n            match Script_int.ediv x y with\n            | None -> None\n            | Some (q, r) -> (\n                match (Script_int.to_int64 q, Script_int.to_int64 r) with\n                | (Some q, Some r) -> (\n                    match (Tez.of_mutez q, Tez.of_mutez r) with\n                    | (Some q, Some r) -> Some (q, r)\n                    (* Cannot overflow *)\n                    | _ -> assert false)\n                (* Cannot overflow *)\n                | _ -> assert false)\n          in\n          (step [@ocaml.tailcall]) g gas k ks result stack\n      | IEdiv_tez (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let x = Script_int.abs (Script_int.of_int64 (Tez.to_mutez x)) in\n          let y = Script_int.abs (Script_int.of_int64 (Tez.to_mutez y)) in\n          let result =\n            match Script_int.ediv_n x y with\n            | None -> None\n            | Some (q, r) -> (\n                match Script_int.to_int64 r with\n                | None -> assert false (* Cannot overflow *)\n                | Some r -> (\n                    match Tez.of_mutez r with\n                    | None -> assert false (* Cannot overflow *)\n                    | Some r -> Some (q, r)))\n          in\n          (step [@ocaml.tailcall]) g gas k ks result stack\n      | IEdiv_int (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let res = Script_int.ediv x y in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IEdiv_nat (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let res = Script_int.ediv_n x y in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | ILsl_nat (kinfo, k) -> ilsl_nat None g gas (kinfo, k) ks accu stack\n      | ILsr_nat (kinfo, k) -> ilsr_nat None g gas (kinfo, k) ks accu stack\n      | IOr_nat (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let res = Script_int.logor x y in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IAnd_nat (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let res = Script_int.logand x y in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IAnd_int_nat (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let res = Script_int.logand x y in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IXor_nat (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let res = Script_int.logxor x y in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | INot_int (_, k) ->\n          let x = accu in\n          let res = Script_int.lognot x in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      (* control *)\n      | IIf {branch_if_true; branch_if_false; k; _} ->\n          let (res, stack) = stack in\n          if accu then\n            (step [@ocaml.tailcall])\n              g\n              gas\n              branch_if_true\n              (KCons (k, ks))\n              res\n              stack\n          else\n            (step [@ocaml.tailcall])\n              g\n              gas\n              branch_if_false\n              (KCons (k, ks))\n              res\n              stack\n      | ILoop (_, body, k) ->\n          let ks = KLoop_in (body, KCons (k, ks)) in\n          (next [@ocaml.tailcall]) g gas ks accu stack\n      | ILoop_left (_, bl, br) ->\n          let ks = KLoop_in_left (bl, KCons (br, ks)) in\n          (next [@ocaml.tailcall]) g gas ks accu stack\n      | IDip (_, b, k) ->\n          let ign = accu in\n          let ks = KUndip (ign, KCons (k, ks)) in\n          let (accu, stack) = stack in\n          (step [@ocaml.tailcall]) g gas b ks accu stack\n      | IExec (_, k) -> iexec None g gas k ks accu stack\n      | IApply (_, capture_ty, k) ->\n          let capture = accu in\n          let (lam, stack) = stack in\n          apply ctxt gas capture_ty capture lam >>=? fun (lam', ctxt, gas) ->\n          (step [@ocaml.tailcall]) (ctxt, sc) gas k ks lam' stack\n      | ILambda (_, lam, k) ->\n          (step [@ocaml.tailcall]) g gas k ks lam (accu, stack)\n      | IFailwith (_, kloc, tv) -> ifailwith None g gas kloc tv accu\n      (* comparison *)\n      | ICompare (_, ty, k) ->\n          let a = accu in\n          let (b, stack) = stack in\n          let r =\n            Script_int.of_int @@ Script_comparable.compare_comparable ty a b\n          in\n          (step [@ocaml.tailcall]) g gas k ks r stack\n      (* comparators *)\n      | IEq (_, k) ->\n          let a = accu in\n          let a = Script_int.compare a Script_int.zero in\n          let a = Compare.Int.(a = 0) in\n          (step [@ocaml.tailcall]) g gas k ks a stack\n      | INeq (_, k) ->\n          let a = accu in\n          let a = Script_int.compare a Script_int.zero in\n          let a = Compare.Int.(a <> 0) in\n          (step [@ocaml.tailcall]) g gas k ks a stack\n      | ILt (_, k) ->\n          let a = accu in\n          let a = Script_int.compare a Script_int.zero in\n          let a = Compare.Int.(a < 0) in\n          (step [@ocaml.tailcall]) g gas k ks a stack\n      | ILe (_, k) ->\n          let a = accu in\n          let a = Script_int.compare a Script_int.zero in\n          let a = Compare.Int.(a <= 0) in\n          (step [@ocaml.tailcall]) g gas k ks a stack\n      | IGt (_, k) ->\n          let a = accu in\n          let a = Script_int.compare a Script_int.zero in\n          let a = Compare.Int.(a > 0) in\n          (step [@ocaml.tailcall]) g gas k ks a stack\n      | IGe (_, k) ->\n          let a = accu in\n          let a = Script_int.compare a Script_int.zero in\n          let a = Compare.Int.(a >= 0) in\n          (step [@ocaml.tailcall]) g gas k ks a stack\n      (* packing *)\n      | IPack (_, ty, k) ->\n          let value = accu in\n          ( use_gas_counter_in_ctxt ctxt gas @@ fun ctxt ->\n            Script_ir_translator.pack_data ctxt ty value )\n          >>=? fun (bytes, ctxt, gas) ->\n          (step [@ocaml.tailcall]) (ctxt, sc) gas k ks bytes stack\n      | IUnpack (_, ty, k) ->\n          let bytes = accu in\n          ( use_gas_counter_in_ctxt ctxt gas @@ fun ctxt ->\n            unpack ctxt ~ty ~bytes )\n          >>=? fun (opt, ctxt, gas) ->\n          (step [@ocaml.tailcall]) (ctxt, sc) gas k ks opt stack\n      | IAddress (_, k) ->\n          let (_, address) = accu in\n          (step [@ocaml.tailcall]) g gas k ks address stack\n      | IContract (kinfo, t, entrypoint, k) -> (\n          let contract = accu in\n          match (contract, entrypoint) with\n          | ((contract, \"default\"), entrypoint)\n          | ((contract, entrypoint), \"default\") ->\n              let ctxt = update_context gas ctxt in\n              Script_ir_translator.parse_contract_for_script\n                ctxt\n                kinfo.iloc\n                t\n                contract\n                ~entrypoint\n              >>=? fun (ctxt, maybe_contract) ->\n              let gas = update_local_gas_counter ctxt in\n              let ctxt = outdated ctxt in\n              let accu = maybe_contract in\n              (step [@ocaml.tailcall]) (ctxt, sc) gas k ks accu stack\n          | _ -> (step [@ocaml.tailcall]) (ctxt, sc) gas k ks None stack)\n      | ITransfer_tokens (_, k) ->\n          let p = accu in\n          let (amount, ((tp, (destination, entrypoint)), stack)) = stack in\n          transfer (ctxt, sc) gas amount tp p destination entrypoint\n          >>=? fun (accu, ctxt, gas) ->\n          (step [@ocaml.tailcall]) (ctxt, sc) gas k ks accu stack\n      | IImplicit_account (_, k) ->\n          let key = accu in\n          let contract = Contract.implicit_contract key in\n          let res = (unit_t ~annot:None, (contract, \"default\")) in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IView (_, View_signature {name; input_ty; output_ty}, k) -> (\n          let input = accu in\n          let ((c, _entrypoint_is_ignored), stack) = stack in\n          let ctxt = update_context gas ctxt in\n          Contract.get_script ctxt c >>=? fun (ctxt, script_opt) ->\n          let return_none ctxt =\n            (step [@ocaml.tailcall])\n              (outdated ctxt, sc)\n              (update_local_gas_counter ctxt)\n              k\n              ks\n              None\n              stack\n          in\n          match script_opt with\n          | None -> (return_none [@ocaml.tailcall]) ctxt\n          | Some script -> (\n              parse_script\n                ~legacy:true\n                ~allow_forged_in_storage:true\n                ctxt\n                script\n              >>=? fun (Ex_script {storage; storage_type; views; _}, ctxt) ->\n              Gas.consume ctxt (Interp_costs.view_get name views)\n              >>?= fun ctxt ->\n              match SMap.find name views with\n              | None -> (return_none [@ocaml.tailcall]) ctxt\n              | Some view -> (\n                  let view_result =\n                    Script_ir_translator.parse_view_returning\n                      ctxt\n                      ~legacy:true\n                      storage_type\n                      view\n                  in\n                  trace_eval\n                    (fun () ->\n                      Script_tc_errors.Ill_typed_contract\n                        (Micheline.strip_locations view.view_code, []))\n                    view_result\n                  >>=? fun (Ex_view f, ctxt) ->\n                  match f with\n                  | Lam\n                      ( {\n                          kloc;\n                          kaft = Item_t (aft_ty, Bot_t, _);\n                          kbef = Item_t (bef_ty, Bot_t, _);\n                          kinstr;\n                        },\n                        _script_view ) -> (\n                      pair_t\n                        kloc\n                        (input_ty, None, None)\n                        (storage_type, None, None)\n                        ~annot:None\n                      >>?= fun pair_ty ->\n                      let open Gas_monad in\n                      let io_ty =\n                        Script_ir_translator.merge_types\n                          ~merge_type_error_flag:Default_merge_type_error\n                          ~legacy:true\n                          kloc\n                          aft_ty\n                          output_ty\n                        >>$ fun (out_eq, _ty) ->\n                        merge_types\n                          ~merge_type_error_flag:Default_merge_type_error\n                          ~legacy:true\n                          kloc\n                          bef_ty\n                          pair_ty\n                        >|$ fun (in_eq, _ty) -> (out_eq, in_eq)\n                      in\n                      Gas_monad.run ctxt io_ty >>?= fun (eq, ctxt) ->\n                      match eq with\n                      | Error _ -> (return_none [@ocaml.tailcall]) ctxt\n                      | Ok (Eq, Eq) -> (\n                          let kkinfo = kinfo_of_kinstr k in\n                          match kkinfo.kstack_ty with\n                          | Item_t (_, s, a) ->\n                              let kstack_ty = Item_t (output_ty, s, a) in\n                              let kkinfo = {kkinfo with kstack_ty} in\n                              let ks = KCons (ICons_some (kkinfo, k), ks) in\n                              (step [@ocaml.tailcall])\n                                ( outdated ctxt,\n                                  {\n                                    sc with\n                                    source = sc.self;\n                                    self = c;\n                                    amount = Tez.zero;\n                                  } )\n                                (update_local_gas_counter ctxt)\n                                kinstr\n                                (KView_exit (sc, KReturn (stack, ks)))\n                                (input, storage)\n                                (EmptyCell, EmptyCell))))))\n      | ICreate_contract\n          {\n            storage_type;\n            arg_type;\n            lambda = Lam (_, code);\n            views;\n            root_name;\n            k;\n            _;\n          } ->\n          (* Removed the instruction's arguments manager, spendable and delegatable *)\n          let delegate = accu in\n          let (credit, (init, stack)) = stack in\n          create_contract\n            g\n            gas\n            storage_type\n            arg_type\n            code\n            views\n            root_name\n            delegate\n            credit\n            init\n          >>=? fun (res, contract, ctxt, gas) ->\n          let stack = ((contract, \"default\"), stack) in\n          (step [@ocaml.tailcall]) (ctxt, sc) gas k ks res stack\n      | ISet_delegate (_, k) ->\n          let delegate = accu in\n          let operation = Delegation delegate in\n          let ctxt = update_context gas ctxt in\n          fresh_internal_nonce ctxt >>?= fun (ctxt, nonce) ->\n          let res =\n            (Internal_operation {source = sc.self; operation; nonce}, None)\n          in\n          let gas = update_local_gas_counter ctxt in\n          let ctxt = outdated ctxt in\n          (step [@ocaml.tailcall]) (ctxt, sc) gas k ks res stack\n      | IBalance (_, k) ->\n          let ctxt = update_context gas ctxt in\n          Contract.get_balance_carbonated ctxt sc.self\n          >>=? fun (ctxt, balance) ->\n          let gas = update_local_gas_counter ctxt in\n          let ctxt = outdated ctxt in\n          let g = (ctxt, sc) in\n          (step [@ocaml.tailcall]) g gas k ks balance (accu, stack)\n      | ILevel (_, k) ->\n          (step [@ocaml.tailcall]) g gas k ks sc.level (accu, stack)\n      | INow (_, k) -> (step [@ocaml.tailcall]) g gas k ks sc.now (accu, stack)\n      | ICheck_signature (_, k) ->\n          let key = accu and (signature, (message, stack)) = stack in\n          let res = Signature.check key signature message in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IHash_key (_, k) ->\n          let key = accu in\n          let res = Signature.Public_key.hash key in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IBlake2b (_, k) ->\n          let bytes = accu in\n          let hash = Raw_hashes.blake2b bytes in\n          (step [@ocaml.tailcall]) g gas k ks hash stack\n      | ISha256 (_, k) ->\n          let bytes = accu in\n          let hash = Raw_hashes.sha256 bytes in\n          (step [@ocaml.tailcall]) g gas k ks hash stack\n      | ISha512 (_, k) ->\n          let bytes = accu in\n          let hash = Raw_hashes.sha512 bytes in\n          (step [@ocaml.tailcall]) g gas k ks hash stack\n      | ISource (_, k) ->\n          let res = (sc.payer, \"default\") in\n          (step [@ocaml.tailcall]) g gas k ks res (accu, stack)\n      | ISender (_, k) ->\n          let res = (sc.source, \"default\") in\n          (step [@ocaml.tailcall]) g gas k ks res (accu, stack)\n      | ISelf (_, ty, entrypoint, k) ->\n          let res = (ty, (sc.self, entrypoint)) in\n          (step [@ocaml.tailcall]) g gas k ks res (accu, stack)\n      | ISelf_address (_, k) ->\n          let res = (sc.self, \"default\") in\n          (step [@ocaml.tailcall]) g gas k ks res (accu, stack)\n      | IAmount (_, k) ->\n          let accu = sc.amount and stack = (accu, stack) in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | IDig (_, _n, n', k) ->\n          let ((accu, stack), x) =\n            interp_stack_prefix_preserving_operation\n              (fun v stack -> (stack, v))\n              n'\n              accu\n              stack\n          in\n          let accu = x and stack = (accu, stack) in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | IDug (_, _n, n', k) ->\n          let v = accu in\n          let (accu, stack) = stack in\n          let ((accu, stack), ()) =\n            interp_stack_prefix_preserving_operation\n              (fun accu stack -> ((v, (accu, stack)), ()))\n              n'\n              accu\n              stack\n          in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | IDipn (_, _n, n', b, k) ->\n          let (accu, stack, restore_prefix) = kundip n' accu stack k in\n          let ks = KCons (restore_prefix, ks) in\n          (step [@ocaml.tailcall]) g gas b ks accu stack\n      | IDropn (_, _n, n', k) ->\n          let stack =\n            let rec aux :\n                type a s b t.\n                (b, t, b, t, a, s, a, s) stack_prefix_preservation_witness ->\n                a ->\n                s ->\n                b * t =\n             fun w accu stack ->\n              match w with\n              | KRest -> (accu, stack)\n              | KPrefix (_, w) ->\n                  let (accu, stack) = stack in\n                  aux w accu stack\n            in\n            aux n' accu stack\n          in\n          let (accu, stack) = stack in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | ISapling_empty_state (_, memo_size, k) ->\n          let state = Sapling.empty_state ~memo_size () in\n          (step [@ocaml.tailcall]) g gas k ks state (accu, stack)\n      | ISapling_verify_update (_, k) -> (\n          let transaction = accu in\n          let (state, stack) = stack in\n          let address = Contract.to_b58check sc.self in\n          let chain_id = Chain_id.to_b58check sc.chain_id in\n          let anti_replay = address ^ chain_id in\n          let ctxt = update_context gas ctxt in\n          Sapling.verify_update ctxt state transaction anti_replay\n          >>=? fun (ctxt, balance_state_opt) ->\n          let gas = update_local_gas_counter ctxt in\n          let ctxt = outdated ctxt in\n          match balance_state_opt with\n          | Some (balance, state) ->\n              let state = Some (Script_int.of_int64 balance, state) in\n              (step [@ocaml.tailcall]) (ctxt, sc) gas k ks state stack\n          | None -> (step [@ocaml.tailcall]) (ctxt, sc) gas k ks None stack)\n      | IChainId (_, k) ->\n          let accu = sc.chain_id and stack = (accu, stack) in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | INever _ -> ( match accu with _ -> .)\n      | IVoting_power (_, k) ->\n          let key_hash = accu in\n          let ctxt = update_context gas ctxt in\n          Vote.get_voting_power ctxt key_hash >>=? fun (ctxt, rolls) ->\n          let power = Script_int.(abs (of_int32 rolls)) in\n          let gas = update_local_gas_counter ctxt in\n          let ctxt = outdated ctxt in\n          (step [@ocaml.tailcall]) (ctxt, sc) gas k ks power stack\n      | ITotal_voting_power (_, k) ->\n          let ctxt = update_context gas ctxt in\n          Vote.get_total_voting_power ctxt >>=? fun (ctxt, rolls) ->\n          let power = Script_int.(abs (of_int32 rolls)) in\n          let gas = update_local_gas_counter ctxt in\n          let ctxt = outdated ctxt in\n          let g = (ctxt, sc) in\n          (step [@ocaml.tailcall]) g gas k ks power (accu, stack)\n      | IKeccak (_, k) ->\n          let bytes = accu in\n          let hash = Raw_hashes.keccak256 bytes in\n          (step [@ocaml.tailcall]) g gas k ks hash stack\n      | ISha3 (_, k) ->\n          let bytes = accu in\n          let hash = Raw_hashes.sha3_256 bytes in\n          (step [@ocaml.tailcall]) g gas k ks hash stack\n      | IAdd_bls12_381_g1 (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let accu = Bls12_381.G1.add x y in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | IAdd_bls12_381_g2 (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let accu = Bls12_381.G2.add x y in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | IAdd_bls12_381_fr (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let accu = Bls12_381.Fr.add x y in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | IMul_bls12_381_g1 (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let accu = Bls12_381.G1.mul x y in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | IMul_bls12_381_g2 (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let accu = Bls12_381.G2.mul x y in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | IMul_bls12_381_fr (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let accu = Bls12_381.Fr.mul x y in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | IMul_bls12_381_fr_z (_, k) ->\n          let x = accu and (y, stack) = stack in\n          let x = Bls12_381.Fr.of_z (Script_int.to_zint x) in\n          let res = Bls12_381.Fr.mul x y in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IMul_bls12_381_z_fr (_, k) ->\n          let y = accu and (x, stack) = stack in\n          let x = Bls12_381.Fr.of_z (Script_int.to_zint x) in\n          let res = Bls12_381.Fr.mul x y in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | IInt_bls12_381_fr (_, k) ->\n          let x = accu in\n          let res = Script_int.of_zint (Bls12_381.Fr.to_z x) in\n          (step [@ocaml.tailcall]) g gas k ks res stack\n      | INeg_bls12_381_g1 (_, k) ->\n          let x = accu in\n          let accu = Bls12_381.G1.negate x in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | INeg_bls12_381_g2 (_, k) ->\n          let x = accu in\n          let accu = Bls12_381.G2.negate x in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | INeg_bls12_381_fr (_, k) ->\n          let x = accu in\n          let accu = Bls12_381.Fr.negate x in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | IPairing_check_bls12_381 (_, k) ->\n          let pairs = accu in\n          let check = Bls12_381.pairing_check pairs.elements in\n          (step [@ocaml.tailcall]) g gas k ks check stack\n      | IComb (_, _, witness, k) ->\n          let rec aux :\n              type before after.\n              (before, after) comb_gadt_witness -> before -> after =\n           fun witness stack ->\n            match (witness, stack) with\n            | (Comb_one, stack) -> stack\n            | (Comb_succ witness', (a, tl)) ->\n                let (b, tl') = aux witness' tl in\n                ((a, b), tl')\n          in\n          let stack = aux witness (accu, stack) in\n          let (accu, stack) = stack in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | IUncomb (_, _, witness, k) ->\n          let rec aux :\n              type before after.\n              (before, after) uncomb_gadt_witness -> before -> after =\n           fun witness stack ->\n            match (witness, stack) with\n            | (Uncomb_one, stack) -> stack\n            | (Uncomb_succ witness', ((a, b), tl)) -> (a, aux witness' (b, tl))\n          in\n          let stack = aux witness (accu, stack) in\n          let (accu, stack) = stack in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | IComb_get (_, _, witness, k) ->\n          let comb = accu in\n          let rec aux :\n              type before after.\n              (before, after) comb_get_gadt_witness -> before -> after =\n           fun witness comb ->\n            match (witness, comb) with\n            | (Comb_get_zero, v) -> v\n            | (Comb_get_one, (a, _)) -> a\n            | (Comb_get_plus_two witness', (_, b)) -> aux witness' b\n          in\n          let accu = aux witness comb in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | IComb_set (_, _, witness, k) ->\n          let value = accu and (comb, stack) = stack in\n          let rec aux :\n              type value before after.\n              (value, before, after) comb_set_gadt_witness ->\n              value ->\n              before ->\n              after =\n           fun witness value item ->\n            match (witness, item) with\n            | (Comb_set_zero, _) -> value\n            | (Comb_set_one, (_hd, tl)) -> (value, tl)\n            | (Comb_set_plus_two witness', (hd, tl)) ->\n                (hd, aux witness' value tl)\n          in\n          let accu = aux witness value comb in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | IDup_n (_, _, witness, k) ->\n          let rec aux :\n              type before after.\n              (before, after) dup_n_gadt_witness -> before -> after =\n           fun witness stack ->\n            match (witness, stack) with\n            | (Dup_n_zero, (a, _)) -> a\n            | (Dup_n_succ witness', (_, tl)) -> aux witness' tl\n          in\n          let stack = (accu, stack) in\n          let accu = aux witness stack in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      (* Tickets *)\n      | ITicket (_, k) ->\n          let contents = accu and (amount, stack) = stack in\n          let ticketer = sc.self in\n          let accu = {ticketer; contents; amount} in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | IRead_ticket (_, k) ->\n          let {ticketer; contents; amount} = accu in\n          let stack = (accu, stack) in\n          let accu = ((ticketer, \"default\"), (contents, amount)) in\n          (step [@ocaml.tailcall]) g gas k ks accu stack\n      | ISplit_ticket (_, k) ->\n          let ticket = accu and ((amount_a, amount_b), stack) = stack in\n          let result =\n            if\n              Compare.Int.(\n                Script_int.(compare (add_n amount_a amount_b) ticket.amount) = 0)\n            then\n              Some\n                ( {ticket with amount = amount_a},\n                  {ticket with amount = amount_b} )\n            else None\n          in\n          (step [@ocaml.tailcall]) g gas k ks result stack\n      | IJoin_tickets (_, contents_ty, k) ->\n          let (ticket_a, ticket_b) = accu in\n          let result =\n            if\n              Compare.Int.(\n                Contract.compare ticket_a.ticketer ticket_b.ticketer = 0\n                && Script_comparable.compare_comparable\n                     contents_ty\n                     ticket_a.contents\n                     ticket_b.contents\n                   = 0)\n            then\n              Some\n                {\n                  ticketer = ticket_a.ticketer;\n                  contents = ticket_a.contents;\n                  amount = Script_int.add_n ticket_a.amount ticket_b.amount;\n                }\n            else None\n          in\n          (step [@ocaml.tailcall]) g gas k ks result stack\n      | IOpen_chest (_, k) ->\n          let open Timelock in\n          let chest_key = accu in\n          let (chest, (time_z, stack)) = stack in\n          (* If the time is not an integer we then consider the proof as\n             incorrect. Indeed the verification asks for an integer for practical reasons.\n             Therefore no proof can be correct.*)\n          let accu =\n            match Alpha_context.Script_int.to_int time_z with\n            | None -> R false\n            | Some time -> (\n                match open_chest chest chest_key ~time with\n                | Correct bytes -> L bytes\n                | Bogus_cipher -> R false\n                | Bogus_opening -> R true)\n          in\n          (step [@ocaml.tailcall]) g gas k ks accu stack)\n\n(*\n\n  Zero-cost logging\n  =================\n\n*)\n\n(*\n\n   The following functions insert a logging instruction and modify the\n   continuation to continue the logging process in the next execution\n   steps.\n\n   There is a special treatment of instructions that generate fresh\n   continuations: we pass a constructor as argument to their\n   evaluation rules so that they can instrument these fresh\n   continuations by themselves.\n\n   This on-the-fly instrumentation of the execution allows zero-cost\n   logging since logging instructions are only introduced if an\n   initial logging continuation is pushed in the initial continuation\n   that starts the evaluation.\n\n*)\nand log :\n    type a s b t r f. logger * logging_event -> (a, s, b, t, r, f) step_type =\n fun (logger, event) ((ctxt, _) as g) gas k ks accu stack ->\n  (match (k, event) with\n  | (ILog _, LogEntry) -> ()\n  | (_, LogEntry) -> log_entry logger ctxt gas k accu stack\n  | (_, LogExit prev_kinfo) -> log_exit logger ctxt gas prev_kinfo k accu stack) ;\n  let k = log_next_kinstr logger k in\n  let with_log k = match k with KLog _ -> k | _ -> KLog (k, logger) in\n  match k with\n  | IList_map (_, body, k) ->\n      (ilist_map [@ocaml.tailcall]) with_log g gas (body, k) ks accu stack\n  | IList_iter (_, body, k) ->\n      (ilist_iter [@ocaml.tailcall]) with_log g gas (body, k) ks accu stack\n  | ISet_iter (_, body, k) ->\n      (iset_iter [@ocaml.tailcall]) with_log g gas (body, k) ks accu stack\n  | IMap_map (_, body, k) ->\n      (imap_map [@ocaml.tailcall]) with_log g gas (body, k) ks accu stack\n  | IMap_iter (_, body, k) ->\n      (imap_iter [@ocaml.tailcall]) with_log g gas (body, k) ks accu stack\n  | ILoop (_, body, k) ->\n      let ks = with_log (KLoop_in (body, KCons (k, ks))) in\n      (next [@ocaml.tailcall]) g gas ks accu stack\n  | ILoop_left (_, bl, br) ->\n      let ks = with_log (KLoop_in_left (bl, KCons (br, ks))) in\n      (next [@ocaml.tailcall]) g gas ks accu stack\n  | IMul_teznat (kinfo, k) ->\n      let extra = (kinfo, k) in\n      (imul_teznat [@ocaml.tailcall]) (Some logger) g gas extra ks accu stack\n  | IMul_nattez (kinfo, k) ->\n      let extra = (kinfo, k) in\n      (imul_nattez [@ocaml.tailcall]) (Some logger) g gas extra ks accu stack\n  | ILsl_nat (kinfo, k) ->\n      let extra = (kinfo, k) in\n      (ilsl_nat [@ocaml.tailcall]) (Some logger) g gas extra ks accu stack\n  | ILsr_nat (kinfo, k) ->\n      let extra = (kinfo, k) in\n      (ilsr_nat [@ocaml.tailcall]) (Some logger) g gas extra ks accu stack\n  | IFailwith (_, kloc, tv) ->\n      (ifailwith [@ocaml.tailcall]) (Some logger) g gas kloc tv accu\n  | IExec (_, k) ->\n      (iexec [@ocaml.tailcall]) (Some logger) g gas k ks accu stack\n  | _ -> (step [@ocaml.tailcall]) g gas k (with_log ks) accu stack\n [@@inline]\n\nand klog :\n    type a s r f.\n    logger ->\n    outdated_context * step_constants ->\n    local_gas_counter ->\n    (a, s, r, f) continuation ->\n    (a, s, r, f) continuation ->\n    a ->\n    s ->\n    (r * f * outdated_context * local_gas_counter) tzresult Lwt.t =\n fun logger g gas ks0 ks accu stack ->\n  (match ks with KLog _ -> () | _ -> log_control logger ks) ;\n  let enable_log ki = log_kinstr logger ki in\n  let mk k = match k with KLog _ -> k | _ -> KLog (k, logger) in\n  match ks with\n  | KCons (ki, ks') ->\n      let log = enable_log ki in\n      let ks = mk ks' in\n      (step [@ocaml.tailcall]) g gas log ks accu stack\n  | KNil -> (next [@ocaml.tailcall]) g gas ks accu stack\n  | KLoop_in (ki, ks') ->\n      let ks' = mk ks' in\n      let ki = enable_log ki in\n      (kloop_in [@ocaml.tailcall]) g gas ks0 ki ks' accu stack\n  | KReturn (stack', ks') ->\n      let ks' = mk ks' in\n      let ks = KReturn (stack', ks') in\n      (next [@ocaml.tailcall]) g gas ks accu stack\n  | KMap_head (f, ks) -> (next [@ocaml.tailcall]) g gas ks (f accu) stack\n  | KLoop_in_left (ki, ks') ->\n      let ks' = mk ks' in\n      let ki = enable_log ki in\n      (kloop_in_left [@ocaml.tailcall]) g gas ks0 ki ks' accu stack\n  | KUndip (x, ks') ->\n      let ks' = mk ks' in\n      let ks = KUndip (x, ks') in\n      (next [@ocaml.tailcall]) g gas ks accu stack\n  | KIter (body, xs, ks') ->\n      let ks' = mk ks' in\n      let body = enable_log body in\n      (kiter [@ocaml.tailcall]) mk g gas (body, xs) ks' accu stack\n  | KList_enter_body (body, xs, ys, len, ks') ->\n      let ks' = mk ks' in\n      let extra = (body, xs, ys, len) in\n      (klist_enter [@ocaml.tailcall]) mk g gas extra ks' accu stack\n  | KList_exit_body (body, xs, ys, len, ks') ->\n      let ks' = mk ks' in\n      let extra = (body, xs, ys, len) in\n      (klist_exit [@ocaml.tailcall]) mk g gas extra ks' accu stack\n  | KMap_enter_body (body, xs, ys, ks') ->\n      let ks' = mk ks' in\n      (kmap_enter [@ocaml.tailcall]) mk g gas (body, xs, ys) ks' accu stack\n  | KMap_exit_body (body, xs, ys, yk, ks') ->\n      let ks' = mk ks' in\n      (kmap_exit [@ocaml.tailcall]) mk g gas (body, xs, ys, yk) ks' accu stack\n  | KView_exit (orig_step_constants, ks') ->\n      let g = (fst g, orig_step_constants) in\n      (next [@ocaml.tailcall]) g gas ks' accu stack\n  | KLog (_, _) ->\n      (* This case should never happen. *)\n      (next [@ocaml.tailcall]) g gas ks accu stack\n [@@inline]\n\n(*\n\n   Entrypoints\n   ===========\n\n*)\n\nlet step_descr ~log_now logger (ctxt, sc) descr accu stack =\n  let gas = (Gas.remaining_operation_gas ctxt :> int) in\n  (match logger with\n  | None -> step (outdated ctxt, sc) gas descr.kinstr KNil accu stack\n  | Some logger ->\n      (if log_now then\n       let kinfo = kinfo_of_kinstr descr.kinstr in\n       logger.log_interp descr.kinstr ctxt kinfo.iloc descr.kbef (accu, stack)) ;\n      let log =\n        ILog (kinfo_of_kinstr descr.kinstr, LogEntry, logger, descr.kinstr)\n      in\n      step (outdated ctxt, sc) gas log KNil accu stack)\n  >>=? fun (accu, stack, ctxt, gas) ->\n  return (accu, stack, update_context gas ctxt)\n\nlet interp logger g (Lam (code, _)) arg =\n  step_descr ~log_now:true logger g code arg (EmptyCell, EmptyCell)\n  >|=? fun (ret, (EmptyCell, EmptyCell), ctxt) -> (ret, ctxt)\n\nlet kstep logger ctxt step_constants kinstr accu stack =\n  let gas = (Gas.remaining_operation_gas ctxt :> int) in\n  let kinstr =\n    match logger with\n    | None -> kinstr\n    | Some logger -> ILog (kinfo_of_kinstr kinstr, LogEntry, logger, kinstr)\n  in\n  step (outdated ctxt, step_constants) gas kinstr KNil accu stack\n  >>=? fun (accu, stack, ctxt, gas) ->\n  return (accu, stack, update_context gas ctxt)\n\nlet internal_step ctxt step_constants gas kinstr accu stack =\n  step (ctxt, step_constants) gas kinstr KNil accu stack\n\nlet step logger ctxt step_constants descr stack =\n  step_descr ~log_now:false logger (ctxt, step_constants) descr stack\n\n(*\n\n   High-level functions\n   ====================\n\n*)\nlet execute logger ctxt mode step_constants ~entrypoint ~internal\n    unparsed_script cached_script arg :\n    (Script.expr\n    * packed_internal_operation list\n    * context\n    * Lazy_storage.diffs option\n    * ex_script\n    * int)\n    tzresult\n    Lwt.t =\n  (match cached_script with\n  | None ->\n      parse_script\n        ctxt\n        unparsed_script\n        ~legacy:true\n        ~allow_forged_in_storage:true\n  | Some ex_script -> return (ex_script, ctxt))\n  >>=? fun ( Ex_script\n               {\n                 code_size;\n                 code;\n                 arg_type;\n                 storage;\n                 storage_type;\n                 root_name;\n                 views;\n               },\n             ctxt ) ->\n  record_trace\n    (Bad_contract_parameter step_constants.self)\n    (find_entrypoint arg_type ~root_name entrypoint)\n  >>?= fun (box, _) ->\n  trace\n    (Bad_contract_parameter step_constants.self)\n    (parse_data ctxt ~legacy:false ~allow_forged:internal arg_type (box arg))\n  >>=? fun (arg, ctxt) ->\n  Script_ir_translator.collect_lazy_storage ctxt arg_type arg\n  >>?= fun (to_duplicate, ctxt) ->\n  Script_ir_translator.collect_lazy_storage ctxt storage_type storage\n  >>?= fun (to_update, ctxt) ->\n  trace\n    (Runtime_contract_error step_constants.self)\n    (interp logger (ctxt, step_constants) code (arg, storage))\n  >>=? fun ((ops, storage), ctxt) ->\n  Script_ir_translator.extract_lazy_storage_diff\n    ctxt\n    mode\n    ~temporary:false\n    ~to_duplicate\n    ~to_update\n    storage_type\n    storage\n  >>=? fun (storage, lazy_storage_diff, ctxt) ->\n  trace\n    Cannot_serialize_storage\n    ( unparse_data ctxt mode storage_type storage\n    >>=? fun (unparsed_storage, ctxt) ->\n      Lwt.return\n        ( Gas.consume ctxt (Script.strip_locations_cost unparsed_storage)\n        >>? fun ctxt -> ok (Micheline.strip_locations unparsed_storage, ctxt) )\n    )\n  >>=? fun (unparsed_storage, ctxt) ->\n  Lwt.return\n    (let (ops, op_diffs) = List.split ops.elements in\n     let lazy_storage_diff =\n       match\n         List.flatten\n           (List.map\n              (Option.value ~default:[])\n              (op_diffs @ [lazy_storage_diff]))\n       with\n       | [] -> None\n       | diff -> Some diff\n     in\n     let script =\n       Ex_script\n         {code_size; code; arg_type; storage; storage_type; root_name; views}\n     in\n     (* We consume gas after the fact in order to not have to instrument\n        [script_size] (for efficiency).\n        This is safe, as we already pay gas proportional to storage size\n        in [unparse_data]. *)\n     let (size, cost) = Script_ir_translator.script_size script in\n     Gas.consume ctxt cost >>? fun ctxt ->\n     ok (unparsed_storage, ops, ctxt, lazy_storage_diff, script, size))\n\ntype execution_result = {\n  ctxt : context;\n  storage : Script.expr;\n  lazy_storage_diff : Lazy_storage.diffs option;\n  operations : packed_internal_operation list;\n}\n\nlet execute ?logger ctxt ~cached_script mode step_constants ~script ~entrypoint\n    ~parameter ~internal =\n  execute\n    logger\n    ctxt\n    mode\n    step_constants\n    ~entrypoint\n    ~internal\n    script\n    cached_script\n    (Micheline.root parameter)\n  >|=? fun (storage, operations, ctxt, lazy_storage_diff, ex_script, approx_size)\n    -> ({ctxt; storage; lazy_storage_diff; operations}, (ex_script, approx_size))\n\n(*\n\n    Internals\n    =========\n\n*)\n\n(*\n\n   We export the internals definitions for tool that requires\n   a white-box view on the interpreter, typically snoop, the\n   gas model inference engine.\n\n*)\nmodule Internals = struct\n  type nonrec local_gas_counter = local_gas_counter\n\n  type nonrec outdated_context = outdated_context =\n    | OutDatedContext of Alpha_context.t\n  [@@unboxed]\n\n  let next logger g gas ks accu stack =\n    let ks =\n      match logger with None -> ks | Some logger -> KLog (ks, logger)\n    in\n    next g gas ks accu stack\n\n  let step (ctxt, step_constants) gas ks accu stack =\n    internal_step ctxt step_constants gas ks accu stack\nend\n" ;
                } ;
                { name = "Baking" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\nopen Misc\n\ntype error +=\n  | (* `Permanent *)\n      Insufficient_endorsing_power of {\n      endorsing_power : int;\n      consensus_threshold : int;\n    }\n\n(** For a given level computes who has the right to include an\n   endorsement in the next block. It returns a mapping from the\n   delegates with such rights to their endorsing slots.  This function\n   is only used by the 'validators' RPC.  *)\nval endorsing_rights :\n  context ->\n  Level.t ->\n  (context * Slot.t list Signature.Public_key_hash.Map.t) tzresult Lwt.t\n\n(** Computes the endorsing rights for a given level. Returns a map\n   from allocated first slots to their owner's public key, public key\n   hash, and endorsing power. *)\nval endorsing_rights_by_first_slot :\n  context ->\n  Level.t ->\n  (context * (public_key * public_key_hash * int) Slot.Map.t) tzresult Lwt.t\n\n(** Computes the bonus baking reward depending on the endorsing power. *)\nval bonus_baking_reward : context -> endorsing_power:int -> Tez.t tzresult\n\n(** [baking_rights ctxt level] is the lazy list of contract's\n    public key hashes that are allowed to propose for [level]\n    at each round. *)\nval baking_rights : context -> Level.t -> public_key lazy_list\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2021 Nomadic Labs <contact@nomadic-labs.com>                *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\nopen Misc\n\ntype error +=\n  | (* `Permanent *)\n      Insufficient_endorsing_power of {\n      endorsing_power : int;\n      consensus_threshold : int;\n    }\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"baking.insufficient_endorsing_power\"\n    ~title:\"Insufficient endorsing power\"\n    ~description:\n      \"The endorsing power is insufficient to satisfy the consensus threshold.\"\n    ~pp:(fun ppf (endorsing_power, consensus_threshold) ->\n      Format.fprintf\n        ppf\n        \"The endorsing power (%d) is insufficient to satisfy the consensus \\\n         threshold (%d).\"\n        endorsing_power\n        consensus_threshold)\n    Data_encoding.(\n      obj2 (req \"endorsing_power\" int31) (req \"consensus_threshold\" int31))\n    (function\n      | Insufficient_endorsing_power {endorsing_power; consensus_threshold} ->\n          Some (endorsing_power, consensus_threshold)\n      | _ -> None)\n    (fun (endorsing_power, consensus_threshold) ->\n      Insufficient_endorsing_power {endorsing_power; consensus_threshold})\n\nlet bonus_baking_reward ctxt ~endorsing_power =\n  let consensus_threshold = Constants.consensus_threshold ctxt in\n  let baking_reward_bonus_per_slot =\n    Constants.baking_reward_bonus_per_slot ctxt\n  in\n  let extra_endorsing_power = endorsing_power - consensus_threshold in\n  error_when\n    Compare.Int.(extra_endorsing_power < 0)\n    (Insufficient_endorsing_power {endorsing_power; consensus_threshold})\n  >>? fun () ->\n  Tez.(baking_reward_bonus_per_slot *? Int64.of_int extra_endorsing_power)\n\nlet baking_rights c level =\n  let rec f c round =\n    Stake_distribution.baking_rights_owner c level ~round\n    >>=? fun (c, _slot, (delegate, _)) ->\n    return (LCons (delegate, fun () -> f c (Round.succ round)))\n  in\n  f c Round.zero\n\nlet endorsing_rights (ctxt : t) level =\n  let consensus_committee_size = Constants.consensus_committee_size ctxt in\n  Slot.slot_range ~min:0 ~count:consensus_committee_size >>?= fun slots ->\n  List.fold_left_es\n    (fun (ctxt, acc) slot ->\n      Stake_distribution.slot_owner ctxt level slot >>=? fun (ctxt, (_, pkh)) ->\n      return (ctxt, (slot, pkh) :: acc))\n    (ctxt, [])\n    slots\n  >>=? fun (ctxt, right_owners) ->\n  let rights =\n    List.fold_left\n      (fun acc (slot, pkh) ->\n        let slots =\n          match Signature.Public_key_hash.Map.find pkh acc with\n          | None -> [slot]\n          | Some slots -> slot :: slots\n        in\n        Signature.Public_key_hash.Map.add pkh slots acc)\n      Signature.Public_key_hash.Map.empty\n      right_owners\n  in\n  return (ctxt, rights)\n\nlet endorsing_rights_by_first_slot ctxt level =\n  Slot.slot_range ~min:0 ~count:(Constants.consensus_committee_size ctxt)\n  >>?= fun slots ->\n  List.fold_left_es\n    (fun (ctxt, (delegates_map, slots_map)) slot ->\n      Stake_distribution.slot_owner ctxt level slot\n      >|=? fun (ctxt, (pk, pkh)) ->\n      let (initial_slot, delegates_map) =\n        match Signature.Public_key_hash.Map.find pkh delegates_map with\n        | None ->\n            (slot, Signature.Public_key_hash.Map.add pkh slot delegates_map)\n        | Some initial_slot -> (initial_slot, delegates_map)\n      in\n      (* [slots_map]'keys are the minimal slots of delegates because\n         we fold on slots in increasing order *)\n      let slots_map =\n        Slot.Map.update\n          initial_slot\n          (function\n            | None -> Some (pk, pkh, 1)\n            | Some (pk, pkh, count) -> Some (pk, pkh, count + 1))\n          slots_map\n      in\n      (ctxt, (delegates_map, slots_map)))\n    (ctxt, (Signature.Public_key_hash.Map.empty, Slot.Map.empty))\n    slots\n  >>=? fun (ctxt, (_, slots_map)) -> return (ctxt, slots_map)\n" ;
                } ;
                { name = "Amendment" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Only delegates with at least one roll take part in the amendment\n   procedure.  It works as follows:\n\n   - Proposal period: delegates can submit protocol amendment\n   proposals using the proposal operation. At the end of a proposal\n   period, the proposal with most supporters is selected and we move\n   to an exploration period. If there are no proposals, or a tie\n   between proposals, a new proposal period starts.\n\n   - Exploration period: delegates can cast votes to test or not the\n   winning proposal using the ballot operation.  At the end of an\n   exploration period if participation reaches the quorum and the\n   proposal has a supermajority in favor, we proceed to a cooldown\n   period. Otherwise we go back to a proposal period.  In any case, if\n   there is enough participation the quorum is updated.\n\n   - Cooldown period: Nothing happens, this period is only a time gap\n   between exploration and promotion periods. At the end of a cooldown\n   period we move to a promotion period.\n\n   - Promotion period: delegates can cast votes to promote or not the\n   proposal using the ballot operation.  At the end of a promotion\n   period if participation reaches the quorum and the proposal has a\n   supermajority in favor, we move to an adoption period. Otherwise we\n   go back to a proposal period.  In any case, if there is enough\n   participation the quorum is updated.\n\n   - Adoption period: At the end of an adoption period, the proposal\n   is activated as the new protocol.  *)\n\nopen Alpha_context\n\n(** If at the end of a voting period, moves to the next one following\n    the state machine of the amendment procedure. *)\nval may_start_new_voting_period : context -> context tzresult Lwt.t\n\ntype error +=\n  | Unexpected_proposal\n  | Unauthorized_proposal\n  | Too_many_proposals\n  | Empty_proposal\n\n(** Records a list of proposals for a delegate.\n    @raise Unexpected_proposal if [ctxt] is not in a proposal period.\n    @raise Unauthorized_proposal if [delegate] is not in the listing. *)\nval record_proposals :\n  context -> public_key_hash -> Protocol_hash.t list -> context tzresult Lwt.t\n\ntype error += Invalid_proposal | Unexpected_ballot | Unauthorized_ballot\n\nval record_ballot :\n  context ->\n  public_key_hash ->\n  Protocol_hash.t ->\n  Vote.ballot ->\n  context tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\n(** Returns the proposal submitted by the most delegates.\n    Returns None in case of a tie, if proposal quorum is below required\n    minimum or if there are no proposals. *)\nlet select_winning_proposal ctxt =\n  Vote.get_proposals ctxt >>=? fun proposals ->\n  let merge proposal vote winners =\n    match winners with\n    | None -> Some ([proposal], vote)\n    | Some (winners, winners_vote) as previous ->\n        if Compare.Int32.(vote = winners_vote) then\n          Some (proposal :: winners, winners_vote)\n        else if Compare.Int32.(vote > winners_vote) then Some ([proposal], vote)\n        else previous\n  in\n  match Protocol_hash.Map.fold merge proposals None with\n  | Some ([proposal], vote) ->\n      Vote.listing_size ctxt >>=? fun max_vote ->\n      let min_proposal_quorum = Constants.min_proposal_quorum ctxt in\n      let min_vote_to_pass =\n        Int32.div (Int32.mul min_proposal_quorum max_vote) 100_00l\n      in\n      if Compare.Int32.(vote >= min_vote_to_pass) then return_some proposal\n      else return_none\n  | _ -> return_none\n\n(* in case of a tie, let's do nothing. *)\n\n(** A proposal is approved if it has supermajority and the participation reaches\n    the current quorum.\n    Supermajority means the yays are more 8/10 of casted votes.\n    The participation is the ratio of all received votes, including passes, with\n    respect to the number of possible votes.\n    The participation EMA (exponential moving average) uses the last\n    participation EMA and the current participation./\n    The expected quorum is calculated using the last participation EMA, capped\n    by the min/max quorum protocol constants. *)\nlet approval_and_participation_ema (ballots : Vote.ballots) ~maximum_vote\n    ~participation_ema ~expected_quorum =\n  (* Note overflows: considering a maximum of 8e8 tokens, with roll size as\n     small as 1e3, there is a maximum of 8e5 rolls and thus votes.\n     In 'participation' an Int64 is used because in the worst case 'all_votes is\n     8e5 and after the multiplication is 8e9, making it potentially overflow a\n     signed Int32 which is 2e9. *)\n  let casted_votes = Int32.add ballots.yay ballots.nay in\n  let all_votes = Int32.add casted_votes ballots.pass in\n  let supermajority = Int32.div (Int32.mul 8l casted_votes) 10l in\n  let participation =\n    (* in centile of percentage *)\n    Int64.(\n      to_int32 (div (mul (of_int32 all_votes) 100_00L) (of_int32 maximum_vote)))\n  in\n  let approval =\n    Compare.Int32.(\n      participation >= expected_quorum && ballots.yay >= supermajority)\n  in\n  let new_participation_ema =\n    Int32.(div (add (mul 8l participation_ema) (mul 2l participation)) 10l)\n  in\n  (approval, new_participation_ema)\n\nlet get_approval_and_update_participation_ema ctxt =\n  Vote.get_ballots ctxt >>=? fun ballots ->\n  Vote.listing_size ctxt >>=? fun maximum_vote ->\n  Vote.get_participation_ema ctxt >>=? fun participation_ema ->\n  Vote.get_current_quorum ctxt >>=? fun expected_quorum ->\n  Vote.clear_ballots ctxt >>= fun ctxt ->\n  let (approval, new_participation_ema) =\n    approval_and_participation_ema\n      ballots\n      ~maximum_vote\n      ~participation_ema\n      ~expected_quorum\n  in\n  Vote.set_participation_ema ctxt new_participation_ema >|=? fun ctxt ->\n  (ctxt, approval)\n\n(** Implements the state machine of the amendment procedure. Note that\n   [update_listings], that computes the vote weight of each delegate, is run at\n   the end of each voting period. This state-machine prepare the voting_period\n   for the next block. *)\nlet start_new_voting_period ctxt =\n  Voting_period.get_current_kind ctxt >>=? fun kind ->\n  (match kind with\n  | Proposal -> (\n      select_winning_proposal ctxt >>=? fun proposal ->\n      Vote.clear_proposals ctxt >>= fun ctxt ->\n      match proposal with\n      | None -> Voting_period.reset ctxt\n      | Some proposal ->\n          Vote.init_current_proposal ctxt proposal >>=? Voting_period.succ)\n  | Exploration ->\n      get_approval_and_update_participation_ema ctxt\n      >>=? fun (ctxt, approved) ->\n      if approved then Voting_period.succ ctxt\n      else\n        Vote.clear_current_proposal ctxt >>=? fun ctxt ->\n        Voting_period.reset ctxt\n  | Cooldown -> Voting_period.succ ctxt\n  | Promotion ->\n      get_approval_and_update_participation_ema ctxt\n      >>=? fun (ctxt, approved) ->\n      if approved then Voting_period.succ ctxt\n      else Vote.clear_current_proposal ctxt >>=? Voting_period.reset\n  | Adoption ->\n      Vote.get_current_proposal ctxt >>=? fun proposal ->\n      activate ctxt proposal >>= fun ctxt ->\n      Vote.clear_current_proposal ctxt >>=? Voting_period.reset)\n  >>=? fun ctxt -> Vote.update_listings ctxt\n\ntype error +=\n  | (* `Branch *)\n      Invalid_proposal\n  | Unexpected_proposal\n  | Unauthorized_proposal\n  | Too_many_proposals\n  | Empty_proposal\n  | Unexpected_ballot\n  | Unauthorized_ballot\n\nlet () =\n  let open Data_encoding in\n  (* Invalid proposal *)\n  register_error_kind\n    `Branch\n    ~id:\"invalid_proposal\"\n    ~title:\"Invalid proposal\"\n    ~description:\"Ballot provided for a proposal that is not the current one.\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"Invalid proposal\")\n    empty\n    (function Invalid_proposal -> Some () | _ -> None)\n    (fun () -> Invalid_proposal) ;\n  (* Unexpected proposal *)\n  register_error_kind\n    `Branch\n    ~id:\"unexpected_proposal\"\n    ~title:\"Unexpected proposal\"\n    ~description:\"Proposal recorded outside of a proposal period.\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"Unexpected proposal\")\n    empty\n    (function Unexpected_proposal -> Some () | _ -> None)\n    (fun () -> Unexpected_proposal) ;\n  (* Unauthorized proposal *)\n  register_error_kind\n    `Branch\n    ~id:\"unauthorized_proposal\"\n    ~title:\"Unauthorized proposal\"\n    ~description:\n      \"The delegate provided for the proposal is not in the voting listings.\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"Unauthorized proposal\")\n    empty\n    (function Unauthorized_proposal -> Some () | _ -> None)\n    (fun () -> Unauthorized_proposal) ;\n  (* Unexpected ballot *)\n  register_error_kind\n    `Branch\n    ~id:\"unexpected_ballot\"\n    ~title:\"Unexpected ballot\"\n    ~description:\"Ballot recorded outside of a voting period.\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"Unexpected ballot\")\n    empty\n    (function Unexpected_ballot -> Some () | _ -> None)\n    (fun () -> Unexpected_ballot) ;\n  (* Unauthorized ballot *)\n  register_error_kind\n    `Branch\n    ~id:\"unauthorized_ballot\"\n    ~title:\"Unauthorized ballot\"\n    ~description:\n      \"The delegate provided for the ballot is not in the voting listings.\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"Unauthorized ballot\")\n    empty\n    (function Unauthorized_ballot -> Some () | _ -> None)\n    (fun () -> Unauthorized_ballot) ;\n  (* Too many proposals *)\n  register_error_kind\n    `Branch\n    ~id:\"too_many_proposals\"\n    ~title:\"Too many proposals\"\n    ~description:\"The delegate reached the maximum number of allowed proposals.\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"Too many proposals\")\n    empty\n    (function Too_many_proposals -> Some () | _ -> None)\n    (fun () -> Too_many_proposals) ;\n  (* Empty proposal *)\n  register_error_kind\n    `Branch\n    ~id:\"empty_proposal\"\n    ~title:\"Empty proposal\"\n    ~description:\"Proposal lists cannot be empty.\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"Empty proposal\")\n    empty\n    (function Empty_proposal -> Some () | _ -> None)\n    (fun () -> Empty_proposal)\n\nlet record_proposals ctxt delegate proposals =\n  (match proposals with\n  | [] -> error Empty_proposal\n  | _ :: _ -> Result.return_unit)\n  >>?= fun () ->\n  Voting_period.get_current_kind ctxt >>=? function\n  | Proposal ->\n      Vote.in_listings ctxt delegate >>= fun in_listings ->\n      if in_listings then (\n        Vote.recorded_proposal_count_for_delegate ctxt delegate\n        >>=? fun count ->\n        assert (Compare.Int.(Constants.max_proposals_per_delegate >= count)) ;\n        error_when\n          Compare.Int.(\n            List.compare_length_with\n              proposals\n              (Constants.max_proposals_per_delegate - count)\n            > 0)\n          Too_many_proposals\n        >>?= fun () ->\n        List.fold_left_es\n          (fun ctxt proposal -> Vote.record_proposal ctxt proposal delegate)\n          ctxt\n          proposals)\n      else fail Unauthorized_proposal\n  | Exploration | Cooldown | Promotion | Adoption -> fail Unexpected_proposal\n\nlet record_ballot ctxt delegate proposal ballot =\n  Voting_period.get_current_kind ctxt >>=? function\n  | Exploration | Promotion ->\n      Vote.get_current_proposal ctxt >>=? fun current_proposal ->\n      error_unless\n        (Protocol_hash.equal proposal current_proposal)\n        Invalid_proposal\n      >>?= fun () ->\n      Vote.has_recorded_ballot ctxt delegate >>= fun has_ballot ->\n      error_when has_ballot Unauthorized_ballot >>?= fun () ->\n      Vote.in_listings ctxt delegate >>= fun in_listings ->\n      if in_listings then Vote.record_ballot ctxt delegate ballot\n      else fail Unauthorized_ballot\n  | Cooldown | Proposal | Adoption -> fail Unexpected_ballot\n\nlet may_start_new_voting_period ctxt =\n  Voting_period.is_last_block ctxt >>=? fun is_last ->\n  if is_last then start_new_voting_period ctxt else return ctxt\n" ;
                } ;
                { name = "Apply_results" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Types representing results of applying an operation.\n\n    These are used internally by [Apply], and can be used for experimenting\n    with protocol updates, by clients to print out a summary of the\n    operation at pre-injection simulation and at confirmation time,\n    and by block explorers.\n *)\n\nopen Alpha_context\n\n(** Result of applying a {!Operation.t}. Follows the same structure. *)\ntype 'kind operation_metadata = {contents : 'kind contents_result_list}\n\nand packed_operation_metadata =\n  | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata\n  | No_operation_metadata : packed_operation_metadata\n\n(** Result of applying a {!Operation.contents_list}. Follows the same structure. *)\nand 'kind contents_result_list =\n  | Single_result : 'kind contents_result -> 'kind contents_result_list\n  | Cons_result :\n      'kind Kind.manager contents_result\n      * 'rest Kind.manager contents_result_list\n      -> ('kind * 'rest) Kind.manager contents_result_list\n\nand packed_contents_result_list =\n  | Contents_result_list :\n      'kind contents_result_list\n      -> packed_contents_result_list\n\n(** Result of applying an {!Operation.contents}. Follows the same structure. *)\nand 'kind contents_result =\n  | Preendorsement_result : {\n      balance_updates : Receipt.balance_updates;\n      delegate : Signature.Public_key_hash.t;\n      preendorsement_power : int;\n    }\n      -> Kind.preendorsement contents_result\n  | Endorsement_result : {\n      balance_updates : Receipt.balance_updates;\n      delegate : Signature.Public_key_hash.t;\n      endorsement_power : int;\n    }\n      -> Kind.endorsement contents_result\n  | Seed_nonce_revelation_result :\n      Receipt.balance_updates\n      -> Kind.seed_nonce_revelation contents_result\n  | Double_endorsement_evidence_result :\n      Receipt.balance_updates\n      -> Kind.double_endorsement_evidence contents_result\n  | Double_preendorsement_evidence_result :\n      Receipt.balance_updates\n      -> Kind.double_preendorsement_evidence contents_result\n  | Double_baking_evidence_result :\n      Receipt.balance_updates\n      -> Kind.double_baking_evidence contents_result\n  | Activate_account_result :\n      Receipt.balance_updates\n      -> Kind.activate_account contents_result\n  | Proposals_result : Kind.proposals contents_result\n  | Ballot_result : Kind.ballot contents_result\n  | Manager_operation_result : {\n      balance_updates : Receipt.balance_updates;\n      operation_result : 'kind manager_operation_result;\n      internal_operation_results : packed_internal_operation_result list;\n    }\n      -> 'kind Kind.manager contents_result\n\nand packed_contents_result =\n  | Contents_result : 'kind contents_result -> packed_contents_result\n\n(** The result of an operation in the queue. [Skipped] ones should\n    always be at the tail, and after a single [Failed]. *)\nand 'kind manager_operation_result =\n  | Applied of 'kind successful_manager_operation_result\n  | Backtracked of\n      'kind successful_manager_operation_result * error trace option\n  | Failed : 'kind Kind.manager * error trace -> 'kind manager_operation_result\n  | Skipped : 'kind Kind.manager -> 'kind manager_operation_result\n[@@coq_force_gadt]\n\n(** Result of applying a {!manager_operation_content}, either internal\n    or external. *)\nand _ successful_manager_operation_result =\n  | Reveal_result : {\n      consumed_gas : Gas.Arith.fp;\n    }\n      -> Kind.reveal successful_manager_operation_result\n  | Transaction_result : {\n      storage : Script.expr option;\n      lazy_storage_diff : Lazy_storage.diffs option;\n      balance_updates : Receipt.balance_updates;\n      originated_contracts : Contract.t list;\n      consumed_gas : Gas.Arith.fp;\n      storage_size : Z.t;\n      paid_storage_size_diff : Z.t;\n      allocated_destination_contract : bool;\n    }\n      -> Kind.transaction successful_manager_operation_result\n  | Origination_result : {\n      lazy_storage_diff : Lazy_storage.diffs option;\n      balance_updates : Receipt.balance_updates;\n      originated_contracts : Contract.t list;\n      consumed_gas : Gas.Arith.fp;\n      storage_size : Z.t;\n      paid_storage_size_diff : Z.t;\n    }\n      -> Kind.origination successful_manager_operation_result\n  | Delegation_result : {\n      consumed_gas : Gas.Arith.fp;\n    }\n      -> Kind.delegation successful_manager_operation_result\n  | Register_global_constant_result : {\n      (* The manager submitting the operation must pay\n          the cost of storage for the registered value.\n          We include the balance update here. *)\n      balance_updates : Receipt.balance_updates;\n      (* Gas consumed while validating and storing the registered\n          value. *)\n      consumed_gas : Gas.Arith.fp;\n      (* The size of the registered value in bytes.\n          Currently, this is simply the number of bytes in the binary\n          serialization of the Micheline value. *)\n      size_of_constant : Z.t;\n      (* The address of the newly registered value, being\n          the hash of its binary serialization. This could be\n          calulated on demand but we include it here in the\n          receipt for flexibility in the future. *)\n      global_address : Script_expr_hash.t;\n    }\n      -> Kind.register_global_constant successful_manager_operation_result\n  | Set_deposits_limit_result : {\n      consumed_gas : Gas.Arith.fp;\n    }\n      -> Kind.set_deposits_limit successful_manager_operation_result\n\nand packed_successful_manager_operation_result =\n  | Successful_manager_result :\n      'kind successful_manager_operation_result\n      -> packed_successful_manager_operation_result\n\nand packed_internal_operation_result =\n  | Internal_operation_result :\n      'kind internal_operation * 'kind manager_operation_result\n      -> packed_internal_operation_result\n\nval pack_migration_operation_results :\n  Migration.origination_result list ->\n  packed_successful_manager_operation_result list\n\n(** Serializer for {!packed_operation_result}. *)\nval operation_metadata_encoding : packed_operation_metadata Data_encoding.t\n\nval operation_data_and_metadata_encoding :\n  (Operation.packed_protocol_data * packed_operation_metadata) Data_encoding.t\n\ntype 'kind contents_and_result_list =\n  | Single_and_result :\n      'kind Alpha_context.contents * 'kind contents_result\n      -> 'kind contents_and_result_list\n  | Cons_and_result :\n      'kind Kind.manager Alpha_context.contents\n      * 'kind Kind.manager contents_result\n      * 'rest Kind.manager contents_and_result_list\n      -> ('kind * 'rest) Kind.manager contents_and_result_list\n\ntype packed_contents_and_result_list =\n  | Contents_and_result_list :\n      'kind contents_and_result_list\n      -> packed_contents_and_result_list\n\nval contents_and_result_list_encoding :\n  packed_contents_and_result_list Data_encoding.t\n\nval pack_contents_list :\n  'kind contents_list ->\n  'kind contents_result_list ->\n  'kind contents_and_result_list\n\nval unpack_contents_list :\n  'kind contents_and_result_list ->\n  'kind contents_list * 'kind contents_result_list\n\nval to_list : packed_contents_result_list -> packed_contents_result list\n\ntype ('a, 'b) eq = Eq : ('a, 'a) eq\n\nval kind_equal_list :\n  'kind contents_list ->\n  'kind2 contents_result_list ->\n  ('kind, 'kind2) eq option\n\ntype block_metadata = {\n  proposer : Signature.Public_key_hash.t;\n  baker : Signature.Public_key_hash.t;\n  level_info : Level.t;\n  voting_period_info : Voting_period.info;\n  nonce_hash : Nonce_hash.t option;\n  consumed_gas : Gas.Arith.fp;\n  deactivated : Signature.Public_key_hash.t list;\n  balance_updates : Receipt.balance_updates;\n  liquidity_baking_escape_ema : Liquidity_baking.escape_ema;\n  implicit_operations_results : packed_successful_manager_operation_result list;\n}\n\nval block_metadata_encoding : block_metadata Data_encoding.encoding\n\ntype precheck_result = {\n  consumed_gas : Gas.Arith.fp;\n  balance_updates : Receipt.balance_updates;\n}\n\ntype 'kind prechecked_contents = {\n  contents : 'kind contents;\n  result : precheck_result;\n}\n\ntype _ prechecked_contents_list =\n  | PrecheckedSingle :\n      'kind prechecked_contents\n      -> 'kind prechecked_contents_list\n  | PrecheckedCons :\n      'kind Kind.manager prechecked_contents\n      * 'rest Kind.manager prechecked_contents_list\n      -> ('kind * 'rest) Kind.manager prechecked_contents_list\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\nopen Data_encoding\n\nlet error_encoding =\n  def\n    \"error\"\n    ~description:\n      \"The full list of RPC errors would be too long to include.\\n\\\n       It is available at RPC `/errors` (GET).\\n\\\n       Errors specific to protocol Alpha have an id that starts with \\\n       `proto.alpha`.\"\n  @@ splitted\n       ~json:\n         (conv\n            (fun err ->\n              Data_encoding.Json.construct Error_monad.error_encoding err)\n            (fun json ->\n              Data_encoding.Json.destruct Error_monad.error_encoding json)\n            json)\n       ~binary:Error_monad.error_encoding\n\nlet trace_encoding = make_trace_encoding error_encoding\n\ntype _ successful_manager_operation_result =\n  | Reveal_result : {\n      consumed_gas : Gas.Arith.fp;\n    }\n      -> Kind.reveal successful_manager_operation_result\n  | Transaction_result : {\n      storage : Script.expr option;\n      lazy_storage_diff : Lazy_storage.diffs option;\n      balance_updates : Receipt.balance_updates;\n      originated_contracts : Contract.t list;\n      consumed_gas : Gas.Arith.fp;\n      storage_size : Z.t;\n      paid_storage_size_diff : Z.t;\n      allocated_destination_contract : bool;\n    }\n      -> Kind.transaction successful_manager_operation_result\n  | Origination_result : {\n      lazy_storage_diff : Lazy_storage.diffs option;\n      balance_updates : Receipt.balance_updates;\n      originated_contracts : Contract.t list;\n      consumed_gas : Gas.Arith.fp;\n      storage_size : Z.t;\n      paid_storage_size_diff : Z.t;\n    }\n      -> Kind.origination successful_manager_operation_result\n  | Delegation_result : {\n      consumed_gas : Gas.Arith.fp;\n    }\n      -> Kind.delegation successful_manager_operation_result\n  | Register_global_constant_result : {\n      balance_updates : Receipt.balance_updates;\n      consumed_gas : Gas.Arith.fp;\n      size_of_constant : Z.t;\n      global_address : Script_expr_hash.t;\n    }\n      -> Kind.register_global_constant successful_manager_operation_result\n  | Set_deposits_limit_result : {\n      consumed_gas : Gas.Arith.fp;\n    }\n      -> Kind.set_deposits_limit successful_manager_operation_result\n\nlet migration_origination_result_to_successful_manager_operation_result\n    ({\n       balance_updates;\n       originated_contracts;\n       storage_size;\n       paid_storage_size_diff;\n     } :\n      Migration.origination_result) =\n  Origination_result\n    {\n      lazy_storage_diff = None;\n      balance_updates;\n      originated_contracts;\n      consumed_gas = Gas.Arith.zero;\n      storage_size;\n      paid_storage_size_diff;\n    }\n\ntype packed_successful_manager_operation_result =\n  | Successful_manager_result :\n      'kind successful_manager_operation_result\n      -> packed_successful_manager_operation_result\n\nlet pack_migration_operation_results results =\n  List.map\n    (fun el ->\n      Successful_manager_result\n        (migration_origination_result_to_successful_manager_operation_result el))\n    results\n\ntype 'kind manager_operation_result =\n  | Applied of 'kind successful_manager_operation_result\n  | Backtracked of\n      'kind successful_manager_operation_result * error trace option\n  | Failed : 'kind Kind.manager * error trace -> 'kind manager_operation_result\n  | Skipped : 'kind Kind.manager -> 'kind manager_operation_result\n[@@coq_force_gadt]\n\ntype packed_internal_operation_result =\n  | Internal_operation_result :\n      'kind internal_operation * 'kind manager_operation_result\n      -> packed_internal_operation_result\n\nmodule Manager_result = struct\n  type 'kind case =\n    | MCase : {\n        op_case : 'kind Operation.Encoding.Manager_operations.case;\n        encoding : 'a Data_encoding.t;\n        kind : 'kind Kind.manager;\n        iselect :\n          packed_internal_operation_result ->\n          ('kind internal_operation * 'kind manager_operation_result) option;\n        select :\n          packed_successful_manager_operation_result ->\n          'kind successful_manager_operation_result option;\n        proj : 'kind successful_manager_operation_result -> 'a;\n        inj : 'a -> 'kind successful_manager_operation_result;\n        t : 'kind manager_operation_result Data_encoding.t;\n      }\n        -> 'kind case\n\n  let make ~op_case ~encoding ~kind ~iselect ~select ~proj ~inj =\n    let (Operation.Encoding.Manager_operations.MCase {name; _}) = op_case in\n    let t =\n      def (Format.asprintf \"operation.alpha.operation_result.%s\" name)\n      @@ union\n           ~tag_size:`Uint8\n           [\n             case\n               (Tag 0)\n               ~title:\"Applied\"\n               (merge_objs (obj1 (req \"status\" (constant \"applied\"))) encoding)\n               (fun o ->\n                 match o with\n                 | Skipped _ | Failed _ | Backtracked _ -> None\n                 | Applied o -> (\n                     match select (Successful_manager_result o) with\n                     | None -> None\n                     | Some o -> Some ((), proj o)))\n               (fun ((), x) -> Applied (inj x));\n             case\n               (Tag 1)\n               ~title:\"Failed\"\n               (obj2\n                  (req \"status\" (constant \"failed\"))\n                  (req \"errors\" trace_encoding))\n               (function Failed (_, errs) -> Some ((), errs) | _ -> None)\n               (fun ((), errs) -> Failed (kind, errs));\n             case\n               (Tag 2)\n               ~title:\"Skipped\"\n               (obj1 (req \"status\" (constant \"skipped\")))\n               (function Skipped _ -> Some () | _ -> None)\n               (fun () -> Skipped kind);\n             case\n               (Tag 3)\n               ~title:\"Backtracked\"\n               (merge_objs\n                  (obj2\n                     (req \"status\" (constant \"backtracked\"))\n                     (opt \"errors\" trace_encoding))\n                  encoding)\n               (fun o ->\n                 match o with\n                 | Skipped _ | Failed _ | Applied _ -> None\n                 | Backtracked (o, errs) -> (\n                     match select (Successful_manager_result o) with\n                     | None -> None\n                     | Some o -> Some (((), errs), proj o)))\n               (fun (((), errs), x) -> Backtracked (inj x, errs));\n           ]\n    in\n    MCase {op_case; encoding; kind; iselect; select; proj; inj; t}\n\n  let[@coq_axiom_with_reason \"gadt\"] reveal_case =\n    make\n      ~op_case:Operation.Encoding.Manager_operations.reveal_case\n      ~encoding:\n        Data_encoding.(\n          obj2\n            (dft \"consumed_gas\" Gas.Arith.n_integral_encoding Gas.Arith.zero)\n            (dft \"consumed_milligas\" Gas.Arith.n_fp_encoding Gas.Arith.zero))\n      ~iselect:(function\n        | Internal_operation_result (({operation = Reveal _; _} as op), res) ->\n            Some (op, res)\n        | _ -> None)\n      ~select:(function\n        | Successful_manager_result (Reveal_result _ as op) -> Some op\n        | _ -> None)\n      ~kind:Kind.Reveal_manager_kind\n      ~proj:(function\n        | Reveal_result {consumed_gas} ->\n            (Gas.Arith.ceil consumed_gas, consumed_gas))\n      ~inj:(fun (consumed_gas, consumed_milligas) ->\n        assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ;\n        Reveal_result {consumed_gas = consumed_milligas})\n\n  let[@coq_axiom_with_reason \"gadt\"] transaction_case =\n    make\n      ~op_case:Operation.Encoding.Manager_operations.transaction_case\n      ~encoding:\n        (obj10\n           (opt \"storage\" Script.expr_encoding)\n           (opt\n              (* The field [big_map_diff] is deprecated since 008, use [lazy_storage_diff] instead.\n                 It is kept here for a transitional period, for tools like indexers to update. *)\n              (* TODO: https://gitlab.com/tezos/tezos/-/issues/1948\n                 Remove it in 009 or later. *)\n              \"big_map_diff\"\n              Lazy_storage.legacy_big_map_diff_encoding)\n           (dft \"balance_updates\" Receipt.balance_updates_encoding [])\n           (dft \"originated_contracts\" (list Contract.encoding) [])\n           (dft \"consumed_gas\" Gas.Arith.n_integral_encoding Gas.Arith.zero)\n           (dft \"consumed_milligas\" Gas.Arith.n_fp_encoding Gas.Arith.zero)\n           (dft \"storage_size\" z Z.zero)\n           (dft \"paid_storage_size_diff\" z Z.zero)\n           (dft \"allocated_destination_contract\" bool false)\n           (opt \"lazy_storage_diff\" Lazy_storage.encoding))\n      ~iselect:(function\n        | Internal_operation_result (({operation = Transaction _; _} as op), res)\n          ->\n            Some (op, res)\n        | _ -> None)\n      ~select:(function\n        | Successful_manager_result (Transaction_result _ as op) -> Some op\n        | _ -> None)\n      ~kind:Kind.Transaction_manager_kind\n      ~proj:(function\n        | Transaction_result\n            {\n              storage;\n              lazy_storage_diff;\n              balance_updates;\n              originated_contracts;\n              consumed_gas;\n              storage_size;\n              paid_storage_size_diff;\n              allocated_destination_contract;\n            } ->\n            ( storage,\n              lazy_storage_diff,\n              balance_updates,\n              originated_contracts,\n              Gas.Arith.ceil consumed_gas,\n              consumed_gas,\n              storage_size,\n              paid_storage_size_diff,\n              allocated_destination_contract,\n              lazy_storage_diff ))\n      ~inj:\n        (fun ( storage,\n               legacy_lazy_storage_diff,\n               balance_updates,\n               originated_contracts,\n               consumed_gas,\n               consumed_milligas,\n               storage_size,\n               paid_storage_size_diff,\n               allocated_destination_contract,\n               lazy_storage_diff ) ->\n        assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ;\n        let lazy_storage_diff =\n          Option.either lazy_storage_diff legacy_lazy_storage_diff\n        in\n        Transaction_result\n          {\n            storage;\n            lazy_storage_diff;\n            balance_updates;\n            originated_contracts;\n            consumed_gas = consumed_milligas;\n            storage_size;\n            paid_storage_size_diff;\n            allocated_destination_contract;\n          })\n\n  let[@coq_axiom_with_reason \"gadt\"] origination_case =\n    make\n      ~op_case:Operation.Encoding.Manager_operations.origination_case\n      ~encoding:\n        (obj8\n           (opt\n              (* The field [big_map_diff] is deprecated since 008, use [lazy_storage_diff] instead.\n                 It is kept here for a transitional period, for tools like indexers to update. *)\n              (* TODO: https://gitlab.com/tezos/tezos/-/issues/1948\n                 Remove it in 009 or later. *)\n              \"big_map_diff\"\n              Lazy_storage.legacy_big_map_diff_encoding)\n           (dft \"balance_updates\" Receipt.balance_updates_encoding [])\n           (dft \"originated_contracts\" (list Contract.encoding) [])\n           (dft \"consumed_gas\" Gas.Arith.n_integral_encoding Gas.Arith.zero)\n           (dft \"consumed_milligas\" Gas.Arith.n_fp_encoding Gas.Arith.zero)\n           (dft \"storage_size\" z Z.zero)\n           (dft \"paid_storage_size_diff\" z Z.zero)\n           (opt \"lazy_storage_diff\" Lazy_storage.encoding))\n      ~iselect:(function\n        | Internal_operation_result (({operation = Origination _; _} as op), res)\n          ->\n            Some (op, res)\n        | _ -> None)\n      ~select:(function\n        | Successful_manager_result (Origination_result _ as op) -> Some op\n        | _ -> None)\n      ~proj:(function\n        | Origination_result\n            {\n              lazy_storage_diff;\n              balance_updates;\n              originated_contracts;\n              consumed_gas;\n              storage_size;\n              paid_storage_size_diff;\n            } ->\n            ( lazy_storage_diff,\n              balance_updates,\n              originated_contracts,\n              Gas.Arith.ceil consumed_gas,\n              consumed_gas,\n              storage_size,\n              paid_storage_size_diff,\n              lazy_storage_diff ))\n      ~kind:Kind.Origination_manager_kind\n      ~inj:\n        (fun ( legacy_lazy_storage_diff,\n               balance_updates,\n               originated_contracts,\n               consumed_gas,\n               consumed_milligas,\n               storage_size,\n               paid_storage_size_diff,\n               lazy_storage_diff ) ->\n        assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ;\n        let lazy_storage_diff =\n          Option.either lazy_storage_diff legacy_lazy_storage_diff\n        in\n        Origination_result\n          {\n            lazy_storage_diff;\n            balance_updates;\n            originated_contracts;\n            consumed_gas = consumed_milligas;\n            storage_size;\n            paid_storage_size_diff;\n          })\n\n  let[@coq_axiom_with_reason \"gadt\"] register_global_constant_case =\n    make\n      ~op_case:\n        Operation.Encoding.Manager_operations.register_global_constant_case\n      ~encoding:\n        (obj4\n           (req \"balance_updates\" Receipt.balance_updates_encoding)\n           (req \"consumed_gas\" Gas.Arith.n_integral_encoding)\n           (req \"storage_size\" z)\n           (req \"global_address\" Script_expr_hash.encoding))\n      ~iselect:(function\n        | Internal_operation_result\n            (({operation = Register_global_constant _; _} as op), res) ->\n            Some (op, res)\n        | _ -> None)\n      ~select:(function\n        | Successful_manager_result (Register_global_constant_result _ as op) ->\n            Some op\n        | _ -> None)\n      ~proj:(function\n        | Register_global_constant_result\n            {balance_updates; consumed_gas; size_of_constant; global_address} ->\n            (balance_updates, consumed_gas, size_of_constant, global_address))\n      ~kind:Kind.Register_global_constant_manager_kind\n      ~inj:\n        (fun (balance_updates, consumed_gas, size_of_constant, global_address) ->\n        Register_global_constant_result\n          {balance_updates; consumed_gas; size_of_constant; global_address})\n\n  let delegation_case =\n    make\n      ~op_case:Operation.Encoding.Manager_operations.delegation_case\n      ~encoding:\n        Data_encoding.(\n          obj2\n            (dft \"consumed_gas\" Gas.Arith.n_integral_encoding Gas.Arith.zero)\n            (dft \"consumed_milligas\" Gas.Arith.n_fp_encoding Gas.Arith.zero))\n      ~iselect:(function\n        | Internal_operation_result (({operation = Delegation _; _} as op), res)\n          ->\n            Some (op, res)\n        | _ -> None)\n      ~select:(function\n        | Successful_manager_result (Delegation_result _ as op) -> Some op\n        | _ -> None)\n      ~kind:Kind.Delegation_manager_kind\n      ~proj:(function[@coq_match_with_default]\n        | Delegation_result {consumed_gas} ->\n            (Gas.Arith.ceil consumed_gas, consumed_gas))\n      ~inj:(fun (consumed_gas, consumed_milligas) ->\n        assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ;\n        Delegation_result {consumed_gas = consumed_milligas})\n\n  let set_deposits_limit_case =\n    make\n      ~op_case:Operation.Encoding.Manager_operations.set_deposits_limit_case\n      ~encoding:\n        Data_encoding.(\n          obj2\n            (dft \"consumed_gas\" Gas.Arith.n_integral_encoding Gas.Arith.zero)\n            (dft \"consumed_milligas\" Gas.Arith.n_fp_encoding Gas.Arith.zero))\n      ~iselect:(function\n        | Internal_operation_result\n            (({operation = Set_deposits_limit _; _} as op), res) ->\n            Some (op, res)\n        | _ -> None)\n      ~select:(function\n        | Successful_manager_result (Set_deposits_limit_result _ as op) ->\n            Some op\n        | _ -> None)\n      ~kind:Kind.Set_deposits_limit_manager_kind\n      ~proj:(function\n        | Set_deposits_limit_result {consumed_gas} ->\n            (Gas.Arith.ceil consumed_gas, consumed_gas))\n      ~inj:(fun (consumed_gas, consumed_milligas) ->\n        assert (Gas.Arith.(equal (ceil consumed_milligas) consumed_gas)) ;\n        Set_deposits_limit_result {consumed_gas = consumed_milligas})\nend\n\nlet internal_operation_result_encoding :\n    packed_internal_operation_result Data_encoding.t =\n  let make (type kind)\n      (Manager_result.MCase res_case : kind Manager_result.case) =\n    let (Operation.Encoding.Manager_operations.MCase op_case) =\n      res_case.op_case\n    in\n    case\n      (Tag op_case.tag)\n      ~title:op_case.name\n      (merge_objs\n         (obj3\n            (req \"kind\" (constant op_case.name))\n            (req \"source\" Contract.encoding)\n            (req \"nonce\" uint16))\n         (merge_objs op_case.encoding (obj1 (req \"result\" res_case.t))))\n      (fun op ->\n        match res_case.iselect op with\n        | Some (op, res) ->\n            Some (((), op.source, op.nonce), (op_case.proj op.operation, res))\n        | None -> None)\n      (fun (((), source, nonce), (op, res)) ->\n        let op = {source; operation = op_case.inj op; nonce} in\n        Internal_operation_result (op, res))\n  in\n  def \"operation.alpha.internal_operation_result\"\n  @@ union\n       [\n         make Manager_result.reveal_case;\n         make Manager_result.transaction_case;\n         make Manager_result.origination_case;\n         make Manager_result.delegation_case;\n         make Manager_result.register_global_constant_case;\n         make Manager_result.set_deposits_limit_case;\n       ]\n\nlet successful_manager_operation_result_encoding :\n    packed_successful_manager_operation_result Data_encoding.t =\n  let make (type kind)\n      (Manager_result.MCase res_case : kind Manager_result.case) =\n    let (Operation.Encoding.Manager_operations.MCase op_case) =\n      res_case.op_case\n    in\n    case\n      (Tag op_case.tag)\n      ~title:op_case.name\n      (merge_objs (obj1 (req \"kind\" (constant op_case.name))) res_case.encoding)\n      (fun res ->\n        match res_case.select res with\n        | Some res -> Some ((), res_case.proj res)\n        | None -> None)\n      (fun ((), res) -> Successful_manager_result (res_case.inj res))\n  in\n  def \"operation.alpha.successful_manager_operation_result\"\n  @@ union\n       [\n         make Manager_result.reveal_case;\n         make Manager_result.transaction_case;\n         make Manager_result.origination_case;\n         make Manager_result.delegation_case;\n         make Manager_result.set_deposits_limit_case;\n       ]\n\ntype 'kind contents_result =\n  | Preendorsement_result : {\n      balance_updates : Receipt.balance_updates;\n      delegate : Signature.Public_key_hash.t;\n      preendorsement_power : int;\n    }\n      -> Kind.preendorsement contents_result\n  | Endorsement_result : {\n      balance_updates : Receipt.balance_updates;\n      delegate : Signature.Public_key_hash.t;\n      endorsement_power : int;\n    }\n      -> Kind.endorsement contents_result\n  | Seed_nonce_revelation_result :\n      Receipt.balance_updates\n      -> Kind.seed_nonce_revelation contents_result\n  | Double_endorsement_evidence_result :\n      Receipt.balance_updates\n      -> Kind.double_endorsement_evidence contents_result\n  | Double_preendorsement_evidence_result :\n      Receipt.balance_updates\n      -> Kind.double_preendorsement_evidence contents_result\n  | Double_baking_evidence_result :\n      Receipt.balance_updates\n      -> Kind.double_baking_evidence contents_result\n  | Activate_account_result :\n      Receipt.balance_updates\n      -> Kind.activate_account contents_result\n  | Proposals_result : Kind.proposals contents_result\n  | Ballot_result : Kind.ballot contents_result\n  | Manager_operation_result : {\n      balance_updates : Receipt.balance_updates;\n      operation_result : 'kind manager_operation_result;\n      internal_operation_results : packed_internal_operation_result list;\n    }\n      -> 'kind Kind.manager contents_result\n\ntype packed_contents_result =\n  | Contents_result : 'kind contents_result -> packed_contents_result\n\ntype packed_contents_and_result =\n  | Contents_and_result :\n      'kind Operation.contents * 'kind contents_result\n      -> packed_contents_and_result\n\ntype ('a, 'b) eq = Eq : ('a, 'a) eq [@@coq_force_gadt]\n\nlet equal_manager_kind :\n    type a b. a Kind.manager -> b Kind.manager -> (a, b) eq option =\n fun ka kb ->\n  match (ka, kb) with\n  | (Kind.Reveal_manager_kind, Kind.Reveal_manager_kind) -> Some Eq\n  | (Kind.Reveal_manager_kind, _) -> None\n  | (Kind.Transaction_manager_kind, Kind.Transaction_manager_kind) -> Some Eq\n  | (Kind.Transaction_manager_kind, _) -> None\n  | (Kind.Origination_manager_kind, Kind.Origination_manager_kind) -> Some Eq\n  | (Kind.Origination_manager_kind, _) -> None\n  | (Kind.Delegation_manager_kind, Kind.Delegation_manager_kind) -> Some Eq\n  | (Kind.Delegation_manager_kind, _) -> None\n  | ( Kind.Register_global_constant_manager_kind,\n      Kind.Register_global_constant_manager_kind ) ->\n      Some Eq\n  | (Kind.Register_global_constant_manager_kind, _) -> None\n  | (Kind.Set_deposits_limit_manager_kind, Kind.Set_deposits_limit_manager_kind)\n    ->\n      Some Eq\n  | (Kind.Set_deposits_limit_manager_kind, _) -> None\n\nmodule Encoding = struct\n  type 'kind case =\n    | Case : {\n        op_case : 'kind Operation.Encoding.case;\n        encoding : 'a Data_encoding.t;\n        select : packed_contents_result -> 'kind contents_result option;\n        mselect :\n          packed_contents_and_result ->\n          ('kind contents * 'kind contents_result) option;\n        proj : 'kind contents_result -> 'a;\n        inj : 'a -> 'kind contents_result;\n      }\n        -> 'kind case\n\n  let tagged_case tag name args proj inj =\n    let open Data_encoding in\n    case\n      tag\n      ~title:(String.capitalize_ascii name)\n      (merge_objs (obj1 (req \"kind\" (constant name))) args)\n      (fun x -> match proj x with None -> None | Some x -> Some ((), x))\n      (fun ((), x) -> inj x)\n\n  let[@coq_axiom_with_reason \"gadt\"] preendorsement_case =\n    Case\n      {\n        op_case = Operation.Encoding.preendorsement_case;\n        encoding =\n          obj3\n            (req \"balance_updates\" Receipt.balance_updates_encoding)\n            (req \"delegate\" Signature.Public_key_hash.encoding)\n            (req \"preendorsement_power\" int31);\n        select =\n          (function\n          | Contents_result (Preendorsement_result _ as op) -> Some op\n          | _ -> None);\n        mselect =\n          (function\n          | Contents_and_result ((Preendorsement _ as op), res) -> Some (op, res)\n          | _ -> None);\n        proj =\n          (function\n          | Preendorsement_result\n              {balance_updates; delegate; preendorsement_power} ->\n              (balance_updates, delegate, preendorsement_power));\n        inj =\n          (fun (balance_updates, delegate, preendorsement_power) ->\n            Preendorsement_result\n              {balance_updates; delegate; preendorsement_power});\n      }\n\n  let[@coq_axiom_with_reason \"gadt\"] endorsement_case =\n    Case\n      {\n        op_case = Operation.Encoding.endorsement_case;\n        encoding =\n          obj3\n            (req \"balance_updates\" Receipt.balance_updates_encoding)\n            (req \"delegate\" Signature.Public_key_hash.encoding)\n            (req \"endorsement_power\" int31);\n        select =\n          (function\n          | Contents_result (Endorsement_result _ as op) -> Some op | _ -> None);\n        mselect =\n          (function\n          | Contents_and_result ((Endorsement _ as op), res) -> Some (op, res)\n          | _ -> None);\n        proj =\n          (function\n          | Endorsement_result {balance_updates; delegate; endorsement_power} ->\n              (balance_updates, delegate, endorsement_power));\n        inj =\n          (fun (balance_updates, delegate, endorsement_power) ->\n            Endorsement_result {balance_updates; delegate; endorsement_power});\n      }\n\n  let[@coq_axiom_with_reason \"gadt\"] seed_nonce_revelation_case =\n    Case\n      {\n        op_case = Operation.Encoding.seed_nonce_revelation_case;\n        encoding = obj1 (req \"balance_updates\" Receipt.balance_updates_encoding);\n        select =\n          (function\n          | Contents_result (Seed_nonce_revelation_result _ as op) -> Some op\n          | _ -> None);\n        mselect =\n          (function\n          | Contents_and_result ((Seed_nonce_revelation _ as op), res) ->\n              Some (op, res)\n          | _ -> None);\n        proj = (fun (Seed_nonce_revelation_result bus) -> bus);\n        inj = (fun bus -> Seed_nonce_revelation_result bus);\n      }\n\n  let[@coq_axiom_with_reason \"gadt\"] double_endorsement_evidence_case =\n    Case\n      {\n        op_case = Operation.Encoding.double_endorsement_evidence_case;\n        encoding = obj1 (req \"balance_updates\" Receipt.balance_updates_encoding);\n        select =\n          (function\n          | Contents_result (Double_endorsement_evidence_result _ as op) ->\n              Some op\n          | _ -> None);\n        mselect =\n          (function\n          | Contents_and_result ((Double_endorsement_evidence _ as op), res) ->\n              Some (op, res)\n          | _ -> None);\n        proj = (fun (Double_endorsement_evidence_result bus) -> bus);\n        inj = (fun bus -> Double_endorsement_evidence_result bus);\n      }\n\n  let[@coq_axiom_with_reason \"gadt\"] double_preendorsement_evidence_case =\n    Case\n      {\n        op_case = Operation.Encoding.double_preendorsement_evidence_case;\n        encoding = obj1 (req \"balance_updates\" Receipt.balance_updates_encoding);\n        select =\n          (function\n          | Contents_result (Double_preendorsement_evidence_result _ as op) ->\n              Some op\n          | _ -> None);\n        mselect =\n          (function\n          | Contents_and_result ((Double_preendorsement_evidence _ as op), res)\n            ->\n              Some (op, res)\n          | _ -> None);\n        proj = (fun (Double_preendorsement_evidence_result bus) -> bus);\n        inj = (fun bus -> Double_preendorsement_evidence_result bus);\n      }\n\n  let[@coq_axiom_with_reason \"gadt\"] double_baking_evidence_case =\n    Case\n      {\n        op_case = Operation.Encoding.double_baking_evidence_case;\n        encoding = obj1 (req \"balance_updates\" Receipt.balance_updates_encoding);\n        select =\n          (function\n          | Contents_result (Double_baking_evidence_result _ as op) -> Some op\n          | _ -> None);\n        mselect =\n          (function\n          | Contents_and_result ((Double_baking_evidence _ as op), res) ->\n              Some (op, res)\n          | _ -> None);\n        proj = (fun (Double_baking_evidence_result bus) -> bus);\n        inj = (fun bus -> Double_baking_evidence_result bus);\n      }\n\n  let[@coq_axiom_with_reason \"gadt\"] activate_account_case =\n    Case\n      {\n        op_case = Operation.Encoding.activate_account_case;\n        encoding = obj1 (req \"balance_updates\" Receipt.balance_updates_encoding);\n        select =\n          (function\n          | Contents_result (Activate_account_result _ as op) -> Some op\n          | _ -> None);\n        mselect =\n          (function\n          | Contents_and_result ((Activate_account _ as op), res) ->\n              Some (op, res)\n          | _ -> None);\n        proj = (fun (Activate_account_result bus) -> bus);\n        inj = (fun bus -> Activate_account_result bus);\n      }\n\n  let[@coq_axiom_with_reason \"gadt\"] proposals_case =\n    Case\n      {\n        op_case = Operation.Encoding.proposals_case;\n        encoding = Data_encoding.empty;\n        select =\n          (function\n          | Contents_result (Proposals_result as op) -> Some op | _ -> None);\n        mselect =\n          (function\n          | Contents_and_result ((Proposals _ as op), res) -> Some (op, res)\n          | _ -> None);\n        proj = (fun Proposals_result -> ());\n        inj = (fun () -> Proposals_result);\n      }\n\n  let[@coq_axiom_with_reason \"gadt\"] ballot_case =\n    Case\n      {\n        op_case = Operation.Encoding.ballot_case;\n        encoding = Data_encoding.empty;\n        select =\n          (function\n          | Contents_result (Ballot_result as op) -> Some op | _ -> None);\n        mselect =\n          (function\n          | Contents_and_result ((Ballot _ as op), res) -> Some (op, res)\n          | _ -> None);\n        proj = (fun Ballot_result -> ());\n        inj = (fun () -> Ballot_result);\n      }\n\n  let[@coq_axiom_with_reason \"gadt\"] make_manager_case (type kind)\n      (Operation.Encoding.Case op_case :\n        kind Kind.manager Operation.Encoding.case)\n      (Manager_result.MCase res_case : kind Manager_result.case) mselect =\n    Case\n      {\n        op_case = Operation.Encoding.Case op_case;\n        encoding =\n          obj3\n            (req \"balance_updates\" Receipt.balance_updates_encoding)\n            (req \"operation_result\" res_case.t)\n            (dft\n               \"internal_operation_results\"\n               (list internal_operation_result_encoding)\n               []);\n        select =\n          (function\n          | Contents_result\n              (Manager_operation_result\n                ({operation_result = Applied res; _} as op)) -> (\n              match res_case.select (Successful_manager_result res) with\n              | Some res ->\n                  Some\n                    (Manager_operation_result\n                       {op with operation_result = Applied res})\n              | None -> None)\n          | Contents_result\n              (Manager_operation_result\n                ({operation_result = Backtracked (res, errs); _} as op)) -> (\n              match res_case.select (Successful_manager_result res) with\n              | Some res ->\n                  Some\n                    (Manager_operation_result\n                       {op with operation_result = Backtracked (res, errs)})\n              | None -> None)\n          | Contents_result\n              (Manager_operation_result\n                ({operation_result = Skipped kind; _} as op)) -> (\n              match equal_manager_kind kind res_case.kind with\n              | None -> None\n              | Some Eq ->\n                  Some\n                    (Manager_operation_result\n                       {op with operation_result = Skipped kind}))\n          | Contents_result\n              (Manager_operation_result\n                ({operation_result = Failed (kind, errs); _} as op)) -> (\n              match equal_manager_kind kind res_case.kind with\n              | None -> None\n              | Some Eq ->\n                  Some\n                    (Manager_operation_result\n                       {op with operation_result = Failed (kind, errs)}))\n          | Contents_result (Preendorsement_result _) -> None\n          | Contents_result (Endorsement_result _) -> None\n          | Contents_result Ballot_result -> None\n          | Contents_result (Seed_nonce_revelation_result _) -> None\n          | Contents_result (Double_endorsement_evidence_result _) -> None\n          | Contents_result (Double_preendorsement_evidence_result _) -> None\n          | Contents_result (Double_baking_evidence_result _) -> None\n          | Contents_result (Activate_account_result _) -> None\n          | Contents_result Proposals_result -> None);\n        mselect;\n        proj =\n          (fun (Manager_operation_result\n                 {\n                   balance_updates = bus;\n                   operation_result = r;\n                   internal_operation_results = rs;\n                 }) ->\n            (bus, r, rs));\n        inj =\n          (fun (bus, r, rs) ->\n            Manager_operation_result\n              {\n                balance_updates = bus;\n                operation_result = r;\n                internal_operation_results = rs;\n              });\n      }\n\n  let[@coq_axiom_with_reason \"gadt\"] reveal_case =\n    make_manager_case\n      Operation.Encoding.reveal_case\n      Manager_result.reveal_case\n      (function\n        | Contents_and_result\n            ((Manager_operation {operation = Reveal _; _} as op), res) ->\n            Some (op, res)\n        | _ -> None)\n\n  let[@coq_axiom_with_reason \"gadt\"] transaction_case =\n    make_manager_case\n      Operation.Encoding.transaction_case\n      Manager_result.transaction_case\n      (function\n        | Contents_and_result\n            ((Manager_operation {operation = Transaction _; _} as op), res) ->\n            Some (op, res)\n        | _ -> None)\n\n  let[@coq_axiom_with_reason \"gadt\"] origination_case =\n    make_manager_case\n      Operation.Encoding.origination_case\n      Manager_result.origination_case\n      (function\n        | Contents_and_result\n            ((Manager_operation {operation = Origination _; _} as op), res) ->\n            Some (op, res)\n        | _ -> None)\n\n  let[@coq_axiom_with_reason \"gadt\"] delegation_case =\n    make_manager_case\n      Operation.Encoding.delegation_case\n      Manager_result.delegation_case\n      (function\n        | Contents_and_result\n            ((Manager_operation {operation = Delegation _; _} as op), res) ->\n            Some (op, res)\n        | _ -> None)\n\n  let[@coq_axiom_with_reason \"gadt\"] register_global_constant_case =\n    make_manager_case\n      Operation.Encoding.register_global_constant_case\n      Manager_result.register_global_constant_case\n      (function\n        | Contents_and_result\n            ( (Manager_operation {operation = Register_global_constant _; _} as\n              op),\n              res ) ->\n            Some (op, res)\n        | _ -> None)\n\n  let[@coq_axiom_with_reason \"gadt\"] set_deposits_limit_case =\n    make_manager_case\n      Operation.Encoding.set_deposits_limit_case\n      Manager_result.set_deposits_limit_case\n      (function\n        | Contents_and_result\n            ( (Manager_operation {operation = Set_deposits_limit _; _} as op),\n              res ) ->\n            Some (op, res)\n        | _ -> None)\nend\n\nlet contents_result_encoding =\n  let open Encoding in\n  let make\n      (Case\n        {\n          op_case = Operation.Encoding.Case {tag; name; _};\n          encoding;\n          mselect = _;\n          select;\n          proj;\n          inj;\n        }) =\n    let proj x = match select x with None -> None | Some x -> Some (proj x) in\n    let inj x = Contents_result (inj x) in\n    tagged_case (Tag tag) name encoding proj inj\n  in\n  def \"operation.alpha.contents_result\"\n  @@ union\n       [\n         make seed_nonce_revelation_case;\n         make endorsement_case;\n         make preendorsement_case;\n         make double_preendorsement_evidence_case;\n         make double_endorsement_evidence_case;\n         make double_baking_evidence_case;\n         make activate_account_case;\n         make proposals_case;\n         make ballot_case;\n         make reveal_case;\n         make transaction_case;\n         make origination_case;\n         make delegation_case;\n         make register_global_constant_case;\n         make set_deposits_limit_case;\n       ]\n\nlet contents_and_result_encoding =\n  let open Encoding in\n  let make\n      (Case\n        {\n          op_case = Operation.Encoding.Case {tag; name; encoding; proj; inj; _};\n          mselect;\n          encoding = meta_encoding;\n          proj = meta_proj;\n          inj = meta_inj;\n          _;\n        }) =\n    let proj c =\n      match mselect c with\n      | Some (op, res) -> Some (proj op, meta_proj res)\n      | _ -> None\n    in\n    let inj (op, res) = Contents_and_result (inj op, meta_inj res) in\n    let encoding = merge_objs encoding (obj1 (req \"metadata\" meta_encoding)) in\n    tagged_case (Tag tag) name encoding proj inj\n  in\n  def \"operation.alpha.operation_contents_and_result\"\n  @@ union\n       [\n         make seed_nonce_revelation_case;\n         make endorsement_case;\n         make preendorsement_case;\n         make double_preendorsement_evidence_case;\n         make double_endorsement_evidence_case;\n         make double_baking_evidence_case;\n         make activate_account_case;\n         make proposals_case;\n         make ballot_case;\n         make reveal_case;\n         make transaction_case;\n         make origination_case;\n         make delegation_case;\n         make register_global_constant_case;\n         make set_deposits_limit_case;\n       ]\n\ntype 'kind contents_result_list =\n  | Single_result : 'kind contents_result -> 'kind contents_result_list\n  | Cons_result :\n      'kind Kind.manager contents_result\n      * 'rest Kind.manager contents_result_list\n      -> ('kind * 'rest) Kind.manager contents_result_list\n\ntype packed_contents_result_list =\n  | Contents_result_list :\n      'kind contents_result_list\n      -> packed_contents_result_list\n\nlet contents_result_list_encoding =\n  let rec to_list = function\n    | Contents_result_list (Single_result o) -> [Contents_result o]\n    | Contents_result_list (Cons_result (o, os)) ->\n        Contents_result o :: to_list (Contents_result_list os)\n  in\n  let rec of_list = function\n    | [] -> Error \"cannot decode empty operation result\"\n    | [Contents_result o] -> Ok (Contents_result_list (Single_result o))\n    | Contents_result o :: os -> (\n        of_list os >>? fun (Contents_result_list os) ->\n        match (o, os) with\n        | ( Manager_operation_result _,\n            Single_result (Manager_operation_result _) ) ->\n            Ok (Contents_result_list (Cons_result (o, os)))\n        | (Manager_operation_result _, Cons_result _) ->\n            Ok (Contents_result_list (Cons_result (o, os)))\n        | _ -> Error \"cannot decode ill-formed operation result\")\n  in\n  def \"operation.alpha.contents_list_result\"\n  @@ conv_with_guard to_list of_list (list contents_result_encoding)\n\ntype 'kind contents_and_result_list =\n  | Single_and_result :\n      'kind Alpha_context.contents * 'kind contents_result\n      -> 'kind contents_and_result_list\n  | Cons_and_result :\n      'kind Kind.manager Alpha_context.contents\n      * 'kind Kind.manager contents_result\n      * 'rest Kind.manager contents_and_result_list\n      -> ('kind * 'rest) Kind.manager contents_and_result_list\n\ntype packed_contents_and_result_list =\n  | Contents_and_result_list :\n      'kind contents_and_result_list\n      -> packed_contents_and_result_list\n\nlet contents_and_result_list_encoding =\n  let rec to_list = function\n    | Contents_and_result_list (Single_and_result (op, res)) ->\n        [Contents_and_result (op, res)]\n    | Contents_and_result_list (Cons_and_result (op, res, rest)) ->\n        Contents_and_result (op, res) :: to_list (Contents_and_result_list rest)\n  in\n  let rec of_list = function\n    | [] -> Error \"cannot decode empty combined operation result\"\n    | [Contents_and_result (op, res)] ->\n        Ok (Contents_and_result_list (Single_and_result (op, res)))\n    | Contents_and_result (op, res) :: rest -> (\n        of_list rest >>? fun (Contents_and_result_list rest) ->\n        match (op, rest) with\n        | (Manager_operation _, Single_and_result (Manager_operation _, _)) ->\n            Ok (Contents_and_result_list (Cons_and_result (op, res, rest)))\n        | (Manager_operation _, Cons_and_result (_, _, _)) ->\n            Ok (Contents_and_result_list (Cons_and_result (op, res, rest)))\n        | _ -> Error \"cannot decode ill-formed combined operation result\")\n  in\n  conv_with_guard to_list of_list (Variable.list contents_and_result_encoding)\n\ntype 'kind operation_metadata = {contents : 'kind contents_result_list}\n\ntype packed_operation_metadata =\n  | Operation_metadata : 'kind operation_metadata -> packed_operation_metadata\n  | No_operation_metadata : packed_operation_metadata\n\nlet operation_metadata_encoding =\n  def \"operation.alpha.result\"\n  @@ union\n       [\n         case\n           (Tag 0)\n           ~title:\"Operation_metadata\"\n           contents_result_list_encoding\n           (function\n             | Operation_metadata {contents} ->\n                 Some (Contents_result_list contents)\n             | _ -> None)\n           (fun (Contents_result_list contents) ->\n             Operation_metadata {contents});\n         case\n           (Tag 1)\n           ~title:\"No_operation_metadata\"\n           empty\n           (function No_operation_metadata -> Some () | _ -> None)\n           (fun () -> No_operation_metadata);\n       ]\n\nlet kind_equal :\n    type kind kind2.\n    kind contents -> kind2 contents_result -> (kind, kind2) eq option =\n fun op res ->\n  match (op, res) with\n  | (Endorsement _, Endorsement_result _) -> Some Eq\n  | (Endorsement _, _) -> None\n  | (Preendorsement _, Preendorsement_result _) -> Some Eq\n  | (Preendorsement _, _) -> None\n  | (Seed_nonce_revelation _, Seed_nonce_revelation_result _) -> Some Eq\n  | (Seed_nonce_revelation _, _) -> None\n  | (Double_preendorsement_evidence _, Double_preendorsement_evidence_result _)\n    ->\n      Some Eq\n  | (Double_preendorsement_evidence _, _) -> None\n  | (Double_endorsement_evidence _, Double_endorsement_evidence_result _) ->\n      Some Eq\n  | (Double_endorsement_evidence _, _) -> None\n  | (Double_baking_evidence _, Double_baking_evidence_result _) -> Some Eq\n  | (Double_baking_evidence _, _) -> None\n  | (Activate_account _, Activate_account_result _) -> Some Eq\n  | (Activate_account _, _) -> None\n  | (Proposals _, Proposals_result) -> Some Eq\n  | (Proposals _, _) -> None\n  | (Ballot _, Ballot_result) -> Some Eq\n  | (Ballot _, _) -> None\n  | (Failing_noop _, _) ->\n      (* the Failing_noop operation always fails and can't have result *)\n      None\n  | ( Manager_operation {operation = Reveal _; _},\n      Manager_operation_result {operation_result = Applied (Reveal_result _); _}\n    ) ->\n      Some Eq\n  | ( Manager_operation {operation = Reveal _; _},\n      Manager_operation_result\n        {operation_result = Backtracked (Reveal_result _, _); _} ) ->\n      Some Eq\n  | ( Manager_operation {operation = Reveal _; _},\n      Manager_operation_result\n        {\n          operation_result = Failed (Alpha_context.Kind.Reveal_manager_kind, _);\n          _;\n        } ) ->\n      Some Eq\n  | ( Manager_operation {operation = Reveal _; _},\n      Manager_operation_result\n        {operation_result = Skipped Alpha_context.Kind.Reveal_manager_kind; _}\n    ) ->\n      Some Eq\n  | (Manager_operation {operation = Reveal _; _}, _) -> None\n  | ( Manager_operation {operation = Transaction _; _},\n      Manager_operation_result\n        {operation_result = Applied (Transaction_result _); _} ) ->\n      Some Eq\n  | ( Manager_operation {operation = Transaction _; _},\n      Manager_operation_result\n        {operation_result = Backtracked (Transaction_result _, _); _} ) ->\n      Some Eq\n  | ( Manager_operation {operation = Transaction _; _},\n      Manager_operation_result\n        {\n          operation_result =\n            Failed (Alpha_context.Kind.Transaction_manager_kind, _);\n          _;\n        } ) ->\n      Some Eq\n  | ( Manager_operation {operation = Transaction _; _},\n      Manager_operation_result\n        {\n          operation_result = Skipped Alpha_context.Kind.Transaction_manager_kind;\n          _;\n        } ) ->\n      Some Eq\n  | (Manager_operation {operation = Transaction _; _}, _) -> None\n  | ( Manager_operation {operation = Origination _; _},\n      Manager_operation_result\n        {operation_result = Applied (Origination_result _); _} ) ->\n      Some Eq\n  | ( Manager_operation {operation = Origination _; _},\n      Manager_operation_result\n        {operation_result = Backtracked (Origination_result _, _); _} ) ->\n      Some Eq\n  | ( Manager_operation {operation = Origination _; _},\n      Manager_operation_result\n        {\n          operation_result =\n            Failed (Alpha_context.Kind.Origination_manager_kind, _);\n          _;\n        } ) ->\n      Some Eq\n  | ( Manager_operation {operation = Origination _; _},\n      Manager_operation_result\n        {\n          operation_result = Skipped Alpha_context.Kind.Origination_manager_kind;\n          _;\n        } ) ->\n      Some Eq\n  | (Manager_operation {operation = Origination _; _}, _) -> None\n  | ( Manager_operation {operation = Delegation _; _},\n      Manager_operation_result\n        {operation_result = Applied (Delegation_result _); _} ) ->\n      Some Eq\n  | ( Manager_operation {operation = Delegation _; _},\n      Manager_operation_result\n        {operation_result = Backtracked (Delegation_result _, _); _} ) ->\n      Some Eq\n  | ( Manager_operation {operation = Delegation _; _},\n      Manager_operation_result\n        {\n          operation_result =\n            Failed (Alpha_context.Kind.Delegation_manager_kind, _);\n          _;\n        } ) ->\n      Some Eq\n  | ( Manager_operation {operation = Delegation _; _},\n      Manager_operation_result\n        {\n          operation_result = Skipped Alpha_context.Kind.Delegation_manager_kind;\n          _;\n        } ) ->\n      Some Eq\n  | (Manager_operation {operation = Delegation _; _}, _) -> None\n  | ( Manager_operation {operation = Register_global_constant _; _},\n      Manager_operation_result\n        {operation_result = Applied (Register_global_constant_result _); _} ) ->\n      Some Eq\n  | ( Manager_operation {operation = Register_global_constant _; _},\n      Manager_operation_result\n        {\n          operation_result = Backtracked (Register_global_constant_result _, _);\n          _;\n        } ) ->\n      Some Eq\n  | ( Manager_operation {operation = Register_global_constant _; _},\n      Manager_operation_result\n        {\n          operation_result =\n            Failed (Alpha_context.Kind.Register_global_constant_manager_kind, _);\n          _;\n        } ) ->\n      Some Eq\n  | ( Manager_operation {operation = Register_global_constant _; _},\n      Manager_operation_result\n        {\n          operation_result =\n            Skipped Alpha_context.Kind.Register_global_constant_manager_kind;\n          _;\n        } ) ->\n      Some Eq\n  | (Manager_operation {operation = Register_global_constant _; _}, _) -> None\n  | ( Manager_operation {operation = Set_deposits_limit _; _},\n      Manager_operation_result\n        {operation_result = Applied (Set_deposits_limit_result _); _} ) ->\n      Some Eq\n  | ( Manager_operation {operation = Set_deposits_limit _; _},\n      Manager_operation_result\n        {operation_result = Backtracked (Set_deposits_limit_result _, _); _} )\n    ->\n      Some Eq\n  | ( Manager_operation {operation = Set_deposits_limit _; _},\n      Manager_operation_result\n        {\n          operation_result =\n            Failed (Alpha_context.Kind.Set_deposits_limit_manager_kind, _);\n          _;\n        } ) ->\n      Some Eq\n  | ( Manager_operation {operation = Set_deposits_limit _; _},\n      Manager_operation_result\n        {\n          operation_result =\n            Skipped Alpha_context.Kind.Set_deposits_limit_manager_kind;\n          _;\n        } ) ->\n      Some Eq\n  | (Manager_operation {operation = Set_deposits_limit _; _}, _) -> None\n\nlet rec kind_equal_list :\n    type kind kind2.\n    kind contents_list -> kind2 contents_result_list -> (kind, kind2) eq option\n    =\n fun contents res ->\n  match (contents, res) with\n  | (Single op, Single_result res) -> (\n      match kind_equal op res with None -> None | Some Eq -> Some Eq)\n  | (Cons (op, ops), Cons_result (res, ress)) -> (\n      match kind_equal op res with\n      | None -> None\n      | Some Eq -> (\n          match kind_equal_list ops ress with\n          | None -> None\n          | Some Eq -> Some Eq))\n  | _ -> None\n\nlet[@coq_axiom_with_reason \"gadt\"] rec pack_contents_list :\n    type kind.\n    kind contents_list ->\n    kind contents_result_list ->\n    kind contents_and_result_list =\n fun contents res ->\n  match (contents, res) with\n  | (Single op, Single_result res) -> Single_and_result (op, res)\n  | (Cons (op, ops), Cons_result (res, ress)) ->\n      Cons_and_result (op, res, pack_contents_list ops ress)\n  | ( Single (Manager_operation _),\n      Cons_result (Manager_operation_result _, Single_result _) ) ->\n      .\n  | ( Cons (_, _),\n      Single_result (Manager_operation_result {operation_result = Failed _; _})\n    ) ->\n      .\n  | ( Cons (_, _),\n      Single_result (Manager_operation_result {operation_result = Skipped _; _})\n    ) ->\n      .\n  | ( Cons (_, _),\n      Single_result (Manager_operation_result {operation_result = Applied _; _})\n    ) ->\n      .\n  | ( Cons (_, _),\n      Single_result\n        (Manager_operation_result {operation_result = Backtracked _; _}) ) ->\n      .\n  | (Single _, Cons_result _) -> .\n\nlet rec unpack_contents_list :\n    type kind.\n    kind contents_and_result_list ->\n    kind contents_list * kind contents_result_list = function\n  | Single_and_result (op, res) -> (Single op, Single_result res)\n  | Cons_and_result (op, res, rest) ->\n      let (ops, ress) = unpack_contents_list rest in\n      (Cons (op, ops), Cons_result (res, ress))\n\nlet rec to_list = function\n  | Contents_result_list (Single_result o) -> [Contents_result o]\n  | Contents_result_list (Cons_result (o, os)) ->\n      Contents_result o :: to_list (Contents_result_list os)\n\nlet operation_data_and_metadata_encoding =\n  def \"operation.alpha.operation_with_metadata\"\n  @@ union\n       [\n         case\n           (Tag 0)\n           ~title:\"Operation_with_metadata\"\n           (obj2\n              (req \"contents\" (dynamic_size contents_and_result_list_encoding))\n              (opt \"signature\" Signature.encoding))\n           (function\n             | (Operation_data _, No_operation_metadata) -> None\n             | (Operation_data op, Operation_metadata res) -> (\n                 match kind_equal_list op.contents res.contents with\n                 | None ->\n                     Pervasives.failwith\n                       \"cannot decode inconsistent combined operation result\"\n                 | Some Eq ->\n                     Some\n                       ( Contents_and_result_list\n                           (pack_contents_list op.contents res.contents),\n                         op.signature )))\n           (fun (Contents_and_result_list contents, signature) ->\n             let (op_contents, res_contents) = unpack_contents_list contents in\n             ( Operation_data {contents = op_contents; signature},\n               Operation_metadata {contents = res_contents} ));\n         case\n           (Tag 1)\n           ~title:\"Operation_without_metadata\"\n           (obj2\n              (req \"contents\" (dynamic_size Operation.contents_list_encoding))\n              (opt \"signature\" Signature.encoding))\n           (function\n             | (Operation_data op, No_operation_metadata) ->\n                 Some (Contents_list op.contents, op.signature)\n             | (Operation_data _, Operation_metadata _) -> None)\n           (fun (Contents_list contents, signature) ->\n             (Operation_data {contents; signature}, No_operation_metadata));\n       ]\n\ntype block_metadata = {\n  proposer : Signature.Public_key_hash.t;\n  baker : Signature.Public_key_hash.t;\n  level_info : Level.t;\n  voting_period_info : Voting_period.info;\n  nonce_hash : Nonce_hash.t option;\n  consumed_gas : Gas.Arith.fp;\n  deactivated : Signature.Public_key_hash.t list;\n  balance_updates : Receipt.balance_updates;\n  liquidity_baking_escape_ema : Liquidity_baking.escape_ema;\n  implicit_operations_results : packed_successful_manager_operation_result list;\n}\n\nlet block_metadata_encoding =\n  let open Data_encoding in\n  def \"block_header.alpha.metadata\"\n  @@ conv\n       (fun {\n              proposer;\n              baker;\n              level_info;\n              voting_period_info;\n              nonce_hash;\n              consumed_gas;\n              deactivated;\n              balance_updates;\n              liquidity_baking_escape_ema;\n              implicit_operations_results;\n            } ->\n         ( proposer,\n           baker,\n           level_info,\n           voting_period_info,\n           nonce_hash,\n           consumed_gas,\n           deactivated,\n           balance_updates,\n           liquidity_baking_escape_ema,\n           implicit_operations_results ))\n       (fun ( proposer,\n              baker,\n              level_info,\n              voting_period_info,\n              nonce_hash,\n              consumed_gas,\n              deactivated,\n              balance_updates,\n              liquidity_baking_escape_ema,\n              implicit_operations_results ) ->\n         {\n           proposer;\n           baker;\n           level_info;\n           voting_period_info;\n           nonce_hash;\n           consumed_gas;\n           deactivated;\n           balance_updates;\n           liquidity_baking_escape_ema;\n           implicit_operations_results;\n         })\n       (obj10\n          (req \"proposer\" Signature.Public_key_hash.encoding)\n          (req \"baker\" Signature.Public_key_hash.encoding)\n          (req \"level_info\" Level.encoding)\n          (req \"voting_period_info\" Voting_period.info_encoding)\n          (req \"nonce_hash\" (option Nonce_hash.encoding))\n          (req \"consumed_gas\" Gas.Arith.n_fp_encoding)\n          (req \"deactivated\" (list Signature.Public_key_hash.encoding))\n          (req \"balance_updates\" Receipt.balance_updates_encoding)\n          (req \"liquidity_baking_escape_ema\" int32)\n          (req\n             \"implicit_operations_results\"\n             (list successful_manager_operation_result_encoding)))\n\ntype precheck_result = {\n  consumed_gas : Gas.Arith.fp;\n  balance_updates : Receipt.balance_updates;\n}\n\ntype 'kind prechecked_contents = {\n  contents : 'kind contents;\n  result : precheck_result;\n}\n\ntype _ prechecked_contents_list =\n  | PrecheckedSingle :\n      'kind prechecked_contents\n      -> 'kind prechecked_contents_list\n  | PrecheckedCons :\n      'kind Kind.manager prechecked_contents\n      * 'rest Kind.manager prechecked_contents_list\n      -> ('kind * 'rest) Kind.manager prechecked_contents_list\n" ;
                } ;
                { name = "Apply" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020-2021 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** This module supports advancing the ledger state by applying [operation]s.\n\n    Each operation application takes and returns an [Alpha_context.t], representing\n    the old and new state, respectively.\n\n    The [Main] module provides wrappers for the functionality in this module,\n    satisfying the Protocol signature.\n *)\n\nopen Alpha_context\nopen Apply_results\n\ntype error +=\n  | (* `Temporary *)\n      Wrong_consensus_operation_branch of\n      Block_hash.t * Block_hash.t\n\ntype error +=\n  | (* `Permanent *)\n      Wrong_level_for_consensus_operation of {\n      expected : Raw_level.t;\n      provided : Raw_level.t;\n    }\n  | (* `Permanent *)\n      Wrong_round_for_consensus_operation of {\n      expected : Round.t;\n      provided : Round.t;\n    }\n  | (* `Permanent *)\n      Preendorsement_round_too_high of {\n      block_round : Round.t;\n      provided : Round.t;\n    }\n\ntype error +=\n  | (* `Permanent *) Internal_operation_replay of packed_internal_operation\n\ntype denunciation_kind = Preendorsement | Endorsement | Block\n\ntype error += (* `Permanent *) Invalid_denunciation of denunciation_kind\n\ntype error +=\n  | (* `Permanent *)\n      Inconsistent_denunciation of {\n      kind : denunciation_kind;\n      delegate1 : Signature.Public_key_hash.t;\n      delegate2 : Signature.Public_key_hash.t;\n    }\n\ntype error +=\n  | (* `Temporary *)\n      Too_early_denunciation of {\n      kind : denunciation_kind;\n      level : Raw_level.t;\n      current : Raw_level.t;\n    }\n\ntype error +=\n  | (* `Permanent *)\n      Outdated_denunciation of {\n      kind : denunciation_kind;\n      level : Raw_level.t;\n      last_cycle : Cycle.t;\n    }\n\ntype error +=\n  | (* `Permanent *)\n      Invalid_double_baking_evidence of {\n      hash1 : Block_hash.t;\n      level1 : Raw_level.t;\n      round1 : Round.t;\n      hash2 : Block_hash.t;\n      level2 : Raw_level.t;\n      round2 : Round.t;\n    }\n\ntype error +=\n  | (* Permanent *) Invalid_activation of {pkh : Ed25519.Public_key_hash.t}\n\ntype error += (* Permanent *) Gas_quota_exceeded_init_deserialize\n\ntype error += (* `Permanent *) Inconsistent_sources\n\ntype error += (* `Permanent *) Failing_noop_error\n\ntype error += (* `Branch *) Empty_transaction of Contract.t\n\nval begin_partial_construction :\n  t ->\n  predecessor_level:Level.t ->\n  escape_vote:bool ->\n  ( t\n    * packed_successful_manager_operation_result list\n    * Liquidity_baking.escape_ema,\n    error trace )\n  result\n  Lwt.t\n\ntype 'a full_construction = {\n  ctxt : t;\n  protocol_data : 'a;\n  payload_producer : Signature.public_key_hash;\n  block_producer : Signature.public_key_hash;\n  round : Round.t;\n  implicit_operations_results : packed_successful_manager_operation_result list;\n  liquidity_baking_escape_ema : Liquidity_baking.escape_ema;\n}\n\nval begin_full_construction :\n  t ->\n  predecessor_timestamp:Time.t ->\n  predecessor_level:Level.t ->\n  predecessor_round:Round.t ->\n  round:Round.t ->\n  Block_header.contents ->\n  Block_header.contents full_construction tzresult Lwt.t\n\nval begin_application :\n  t ->\n  Chain_id.t ->\n  Block_header.t ->\n  Fitness.t ->\n  predecessor_timestamp:Time.t ->\n  predecessor_level:Level.t ->\n  predecessor_round:Round.t ->\n  (t\n  * Signature.public_key\n  * Signature.public_key_hash\n  * packed_successful_manager_operation_result list\n  * Liquidity_baking.escape_ema)\n  tzresult\n  Lwt.t\n\ntype apply_mode =\n  | Application of {\n      predecessor_block : Block_hash.t;\n      payload_hash : Block_payload_hash.t;\n      locked_round : Round.t option;\n      predecessor_level : Level.t;\n      predecessor_round : Round.t;\n      round : Round.t;\n    } (* Both partial and normal *)\n  | Full_construction of {\n      predecessor_block : Block_hash.t;\n      payload_hash : Block_payload_hash.t;\n      predecessor_level : Level.t;\n      predecessor_round : Round.t;\n      round : Round.t;\n    }\n  | Partial_construction of {\n      predecessor_level : Level.t;\n      predecessor_round : Round.t;\n      grand_parent_round : Round.t;\n    }\n\nval apply_operation :\n  t ->\n  Chain_id.t ->\n  apply_mode ->\n  Script_ir_translator.unparsing_mode ->\n  payload_producer:public_key_hash ->\n  Operation_list_hash.elt ->\n  'a operation ->\n  (t * 'a operation_metadata, error trace) result Lwt.t\n\ntype finalize_application_mode =\n  | Finalize_full_construction of {\n      level : Raw_level.t;\n      predecessor_round : Round.t;\n    }\n  | Finalize_application of Fitness.t\n\nval finalize_application :\n  t ->\n  finalize_application_mode ->\n  Alpha_context.Block_header.contents ->\n  payload_producer:public_key_hash ->\n  block_producer:public_key_hash ->\n  Liquidity_baking.escape_ema ->\n  packed_successful_manager_operation_result list ->\n  round:Round.t ->\n  predecessor:Block_hash.t ->\n  migration_balance_updates:Receipt.balance_updates ->\n  (t * Fitness.t * block_metadata, error trace) result Lwt.t\n\nval apply_manager_contents_list :\n  t ->\n  Script_ir_translator.unparsing_mode ->\n  payload_producer:public_key_hash ->\n  Chain_id.t ->\n  'a Kind.manager prechecked_contents_list ->\n  (t * 'a Kind.manager contents_result_list) Lwt.t\n\nval apply_contents_list :\n  t ->\n  Chain_id.t ->\n  apply_mode ->\n  Script_ir_translator.unparsing_mode ->\n  payload_producer:public_key_hash ->\n  'kind operation ->\n  'kind contents_list ->\n  (t * 'kind contents_result_list) tzresult Lwt.t\n\n(** [precheck_manager_contents_list validation_state contents_list]\n   Returns an updated context, and a list of prechecked contents\n   containing balance updates for fees related to each manager\n   operation in [contents_list]\n\n   If [mempool_mode], the function checks whether the total gas limit\n   of this batch of operation is below the [gas_limit] of a block and\n   fails with a permanent error when above. Otherwise, the gas limit\n   of the batch is removed from the one of the block (when possible)\n   before moving on. *)\nval precheck_manager_contents_list :\n  t ->\n  'kind Kind.manager contents_list ->\n  mempool_mode:bool ->\n  (context * 'kind Kind.manager prechecked_contents_list) tzresult Lwt.t\n\n(** [value_of_key ctxt k] builds a value identified by key [k]\n    so that it can be put into the cache. *)\nval value_of_key : t -> Context.Cache.key -> Context.Cache.value tzresult Lwt.t\n\n(** [cache_layout] describes how the caches needed by the protocol.\n   The length of the list defines the number of caches while each\n   element of this list corresponds to the size limit of each cache. *)\nval cache_layout : int list\n\n(** Check if endorsements are required for a given level. *)\nval are_endorsements_required : t -> level:Raw_level.t -> bool tzresult Lwt.t\n\n(** Check if a block's endorsing power is at least the minim required. *)\nval check_minimum_endorsements :\n  endorsing_power:int -> minimum:int -> unit tzresult Lwt.t\n\n(** [check_manager_signature validation_state op raw_operation]\n    The function starts by retrieving the public key hash [pkh] of the manager\n    operation. In case the operation is batched, the function also checks that\n    the sources are all the same.\n    Once the [pkh] is retrieved, the function looks for its associated public\n    key. For that, the manager operation is inspected to check if it contains\n    a public key revelation. If not, the public key is searched in the context.\n\n    @return [Error Invalid_signature] if the signature check fails\n    @return [Error Unrevealed_manager_key] if the manager has not yet been\n    revealed\n    @return [Error Failure \"get_manager_key\"] if the key is not found in the\n    context\n    @return [Error Inconsistent_sources] if the operations in a batch are not\n    from the same manager *)\nval check_manager_signature :\n  t ->\n  Chain_id.t ->\n  'a Kind.manager contents_list ->\n  'b operation ->\n  (unit, error trace) result Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Tezos Protocol Implementation - Main Entry Points *)\n\nopen Alpha_context\n\ntype error +=\n  | (* `Permanent *)\n      Not_enough_endorsements of {\n      required : int;\n      endorsements : int;\n    }\n  | (* `Temporary *)\n      Wrong_consensus_operation_branch of\n      Block_hash.t * Block_hash.t\n  | (* `Permanent *)\n      Invalid_double_baking_evidence of {\n      hash1 : Block_hash.t;\n      level1 : Raw_level.t;\n      round1 : Round.t;\n      hash2 : Block_hash.t;\n      level2 : Raw_level.t;\n      round2 : Round.t;\n    }\n  | (* `Permanent *)\n      Wrong_level_for_consensus_operation of {\n      expected : Raw_level.t;\n      provided : Raw_level.t;\n    }\n  | (* `Permanent *)\n      Wrong_round_for_consensus_operation of {\n      expected : Round.t;\n      provided : Round.t;\n    }\n  | (* `Permanent *)\n      Preendorsement_round_too_high of {\n      block_round : Round.t;\n      provided : Round.t;\n    }\n  | (* `Permanent *)\n      Unexpected_endorsement_in_block\n  | (* `Permanent *)\n      Unexpected_preendorsement_in_block\n  | (* `Permanent *)\n      Wrong_payload_hash_for_consensus_operation of {\n      expected : Block_payload_hash.t;\n      provided : Block_payload_hash.t;\n    }\n  | (* `Permanent *) Wrong_slot_used_for_consensus_operation\n  | (* `Temporary *)\n      Consensus_operation_for_future_level of {\n      expected : Raw_level.t;\n      provided : Raw_level.t;\n    }\n  | (* `Temporary *)\n      Consensus_operation_for_future_round of {\n      expected : Round.t;\n      provided : Round.t;\n    }\n  | (* `Outdated *)\n      Consensus_operation_for_old_level of {\n      expected : Raw_level.t;\n      provided : Raw_level.t;\n    }\n  | (* `Branch *)\n      Consensus_operation_for_old_round of {\n      expected : Round.t;\n      provided : Round.t;\n    }\n  | (* `Branch *)\n      Consensus_operation_on_competing_proposal of {\n      expected : Block_payload_hash.t;\n      provided : Block_payload_hash.t;\n    }\n  | (* `Permanent *)\n      Set_deposits_limit_on_originated_contract\n  | (* `Temporary *)\n      Set_deposits_limit_on_unregistered_delegate of\n      Signature.Public_key_hash.t\n  | (* `Permanent *)\n      Set_deposits_limit_too_high of {\n      limit : Tez.t;\n      max_limit : Tez.t;\n    }\n  | (* `Branch *) Empty_transaction of Contract.t\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"operations.wrong_slot\"\n    ~title:\"wrong slot\"\n    ~description:\"wrong slot\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"wrong slot\")\n    Data_encoding.empty\n    (function Wrong_slot_used_for_consensus_operation -> Some () | _ -> None)\n    (fun () -> Wrong_slot_used_for_consensus_operation) ;\n  register_error_kind\n    `Permanent\n    ~id:\"operation.not_enough_endorsements\"\n    ~title:\"Not enough endorsements\"\n    ~description:\n      \"The block being validated does not include the required minimum number \\\n       of endorsements.\"\n    ~pp:(fun ppf (required, endorsements) ->\n      Format.fprintf\n        ppf\n        \"Wrong number of endorsements (%i), at least %i are expected\"\n        endorsements\n        required)\n    Data_encoding.(obj2 (req \"required\" int31) (req \"endorsements\" int31))\n    (function\n      | Not_enough_endorsements {required; endorsements} ->\n          Some (required, endorsements)\n      | _ -> None)\n    (fun (required, endorsements) ->\n      Not_enough_endorsements {required; endorsements}) ;\n  register_error_kind\n    `Temporary\n    ~id:\"operation.wrong_consensus_operation_branch\"\n    ~title:\"Wrong consensus operation branch\"\n    ~description:\n      \"Trying to include an endorsement or preendorsement which points to the \\\n       wrong block.\\n\\\n      \\       It should be the predecessor for preendorsements and the \\\n       grandfather for endorsements.\"\n    ~pp:(fun ppf (e, p) ->\n      Format.fprintf\n        ppf\n        \"Wrong branch %a, expected %a\"\n        Block_hash.pp\n        p\n        Block_hash.pp\n        e)\n    Data_encoding.(\n      obj2\n        (req \"expected\" Block_hash.encoding)\n        (req \"provided\" Block_hash.encoding))\n    (function\n      | Wrong_consensus_operation_branch (e, p) -> Some (e, p) | _ -> None)\n    (fun (e, p) -> Wrong_consensus_operation_branch (e, p)) ;\n  register_error_kind\n    `Permanent\n    ~id:\"block.invalid_double_baking_evidence\"\n    ~title:\"Invalid double baking evidence\"\n    ~description:\n      \"A double-baking evidence is inconsistent  (two distinct level)\"\n    ~pp:(fun ppf (hash1, level1, round1, hash2, level2, round2) ->\n      Format.fprintf\n        ppf\n        \"Invalid double-baking evidence (hash: %a and %a, levels/rounds: \\\n         (%ld,%ld) and (%ld,%ld))\"\n        Block_hash.pp\n        hash1\n        Block_hash.pp\n        hash2\n        (Raw_level.to_int32 level1)\n        (Round.to_int32 round1)\n        (Raw_level.to_int32 level2)\n        (Round.to_int32 round2))\n    Data_encoding.(\n      obj6\n        (req \"hash1\" Block_hash.encoding)\n        (req \"level1\" Raw_level.encoding)\n        (req \"round1\" Round.encoding)\n        (req \"hash2\" Block_hash.encoding)\n        (req \"level2\" Raw_level.encoding)\n        (req \"round2\" Round.encoding))\n    (function\n      | Invalid_double_baking_evidence\n          {hash1; level1; round1; hash2; level2; round2} ->\n          Some (hash1, level1, round1, hash2, level2, round2)\n      | _ -> None)\n    (fun (hash1, level1, round1, hash2, level2, round2) ->\n      Invalid_double_baking_evidence\n        {hash1; level1; round1; hash2; level2; round2}) ;\n  register_error_kind\n    `Permanent\n    ~id:\"wrong_level_for_consensus_operation\"\n    ~title:\"wrong level for consensus operation\"\n    ~description:\"Wrong level for consensus operation.\"\n    ~pp:(fun ppf (expected, provided) ->\n      Format.fprintf\n        ppf\n        \"Wrong level for consensus operation (expected: %a, provided: %a).\"\n        Raw_level.pp\n        expected\n        Raw_level.pp\n        provided)\n    Data_encoding.(\n      obj2\n        (req \"expected\" Raw_level.encoding)\n        (req \"provided\" Raw_level.encoding))\n    (function\n      | Wrong_level_for_consensus_operation {expected; provided} ->\n          Some (expected, provided)\n      | _ -> None)\n    (fun (expected, provided) ->\n      Wrong_level_for_consensus_operation {expected; provided}) ;\n  register_error_kind\n    `Permanent\n    ~id:\"wrong_round_for_consensus_operation\"\n    ~title:\"wrong round for consensus operation\"\n    ~description:\"Wrong round for consensus operation.\"\n    ~pp:(fun ppf (expected, provided) ->\n      Format.fprintf\n        ppf\n        \"Wrong round for consensus operation (expected: %a, provided: %a).\"\n        Round.pp\n        expected\n        Round.pp\n        provided)\n    Data_encoding.(\n      obj2 (req \"expected\" Round.encoding) (req \"provided\" Round.encoding))\n    (function\n      | Wrong_round_for_consensus_operation {expected; provided} ->\n          Some (expected, provided)\n      | _ -> None)\n    (fun (expected, provided) ->\n      Wrong_round_for_consensus_operation {expected; provided}) ;\n  register_error_kind\n    `Permanent\n    ~id:\"preendorsement_round_too_high\"\n    ~title:\"preendorsement round too high\"\n    ~description:\"Preendorsement round too high.\"\n    ~pp:(fun ppf (block_round, provided) ->\n      Format.fprintf\n        ppf\n        \"Preendorsement round too high (block_round: %a, provided: %a).\"\n        Round.pp\n        block_round\n        Round.pp\n        provided)\n    Data_encoding.(\n      obj2 (req \"block_round\" Round.encoding) (req \"provided\" Round.encoding))\n    (function\n      | Preendorsement_round_too_high {block_round; provided} ->\n          Some (block_round, provided)\n      | _ -> None)\n    (fun (block_round, provided) ->\n      Preendorsement_round_too_high {block_round; provided}) ;\n  register_error_kind\n    `Permanent\n    ~id:\"wrong_payload_hash_for_consensus_operation\"\n    ~title:\"wrong payload hash for consensus operation\"\n    ~description:\"Wrong payload hash for consensus operation.\"\n    ~pp:(fun ppf (expected, provided) ->\n      Format.fprintf\n        ppf\n        \"Wrong payload hash for consensus operation (expected: %a, provided: \\\n         %a).\"\n        Block_payload_hash.pp_short\n        expected\n        Block_payload_hash.pp_short\n        provided)\n    Data_encoding.(\n      obj2\n        (req \"expected\" Block_payload_hash.encoding)\n        (req \"provided\" Block_payload_hash.encoding))\n    (function\n      | Wrong_payload_hash_for_consensus_operation {expected; provided} ->\n          Some (expected, provided)\n      | _ -> None)\n    (fun (expected, provided) ->\n      Wrong_payload_hash_for_consensus_operation {expected; provided}) ;\n  register_error_kind\n    `Permanent\n    ~id:\"unexpected_endorsement_in_block\"\n    ~title:\"unexpected endorsement in block\"\n    ~description:\"Unexpected endorsement in block.\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"Unexpected endorsement in block.\")\n    Data_encoding.empty\n    (function Unexpected_endorsement_in_block -> Some () | _ -> None)\n    (fun () -> Unexpected_endorsement_in_block) ;\n  register_error_kind\n    `Permanent\n    ~id:\"unexpected_preendorsement_in_block\"\n    ~title:\"unexpected preendorsement in block\"\n    ~description:\"Unexpected preendorsement in block.\"\n    ~pp:(fun ppf () -> Format.fprintf ppf \"Unexpected preendorsement in block.\")\n    Data_encoding.empty\n    (function Unexpected_preendorsement_in_block -> Some () | _ -> None)\n    (fun () -> Unexpected_preendorsement_in_block) ;\n  register_error_kind\n    `Temporary\n    ~id:\"consensus_operation_for_future_level\"\n    ~title:\"Consensus operation for future level\"\n    ~description:\"Consensus operation for future level.\"\n    ~pp:(fun ppf (expected, provided) ->\n      Format.fprintf\n        ppf\n        \"Consensus operation for future level\\n\\\n        \\                            (expected: %a, provided: %a).\"\n        Raw_level.pp\n        expected\n        Raw_level.pp\n        provided)\n    Data_encoding.(\n      obj2\n        (req \"expected\" Raw_level.encoding)\n        (req \"provided\" Raw_level.encoding))\n    (function\n      | Consensus_operation_for_future_level {expected; provided} ->\n          Some (expected, provided)\n      | _ -> None)\n    (fun (expected, provided) ->\n      Consensus_operation_for_future_level {expected; provided}) ;\n  register_error_kind\n    `Temporary\n    ~id:\"consensus_operation_for_future_round\"\n    ~title:\"Consensus operation for future round\"\n    ~description:\"Consensus operation for future round.\"\n    ~pp:(fun ppf (expected, provided) ->\n      Format.fprintf\n        ppf\n        \"Consensus operation for future round (expected: %a, provided: %a).\"\n        Round.pp\n        expected\n        Round.pp\n        provided)\n    Data_encoding.(\n      obj2 (req \"expected_max\" Round.encoding) (req \"provided\" Round.encoding))\n    (function\n      | Consensus_operation_for_future_round {expected; provided} ->\n          Some (expected, provided)\n      | _ -> None)\n    (fun (expected, provided) ->\n      Consensus_operation_for_future_round {expected; provided}) ;\n  register_error_kind\n    `Outdated\n    ~id:\"consensus_operation_for_old_level\"\n    ~title:\"Consensus operation for old level\"\n    ~description:\"Consensus operation for old level.\"\n    ~pp:(fun ppf (expected, provided) ->\n      Format.fprintf\n        ppf\n        \"Consensus operation for old level (expected: %a, provided: %a).\"\n        Raw_level.pp\n        expected\n        Raw_level.pp\n        provided)\n    Data_encoding.(\n      obj2\n        (req \"expected\" Raw_level.encoding)\n        (req \"provided\" Raw_level.encoding))\n    (function\n      | Consensus_operation_for_old_level {expected; provided} ->\n          Some (expected, provided)\n      | _ -> None)\n    (fun (expected, provided) ->\n      Consensus_operation_for_old_level {expected; provided}) ;\n  register_error_kind\n    `Branch\n    ~id:\"consensus_operation_for_old_round\"\n    ~title:\"Consensus operation for old round\"\n    ~description:\"Consensus operation for old round.\"\n    ~pp:(fun ppf (expected, provided) ->\n      Format.fprintf\n        ppf\n        \"Consensus operation for old round (expected_min: %a, provided: %a).\"\n        Round.pp\n        expected\n        Round.pp\n        provided)\n    Data_encoding.(\n      obj2 (req \"expected_min\" Round.encoding) (req \"provided\" Round.encoding))\n    (function\n      | Consensus_operation_for_old_round {expected; provided} ->\n          Some (expected, provided)\n      | _ -> None)\n    (fun (expected, provided) ->\n      Consensus_operation_for_old_round {expected; provided}) ;\n  register_error_kind\n    `Branch\n    ~id:\"consensus_operation_on_competing_proposal\"\n    ~title:\"Consensus operation on competing proposal\"\n    ~description:\"Consensus operation on competing proposal.\"\n    ~pp:(fun ppf (expected, provided) ->\n      Format.fprintf\n        ppf\n        \"Consensus operation on competing proposal (expected: %a, provided: \\\n         %a).\"\n        Block_payload_hash.pp_short\n        expected\n        Block_payload_hash.pp_short\n        provided)\n    Data_encoding.(\n      obj2\n        (req \"expected\" Block_payload_hash.encoding)\n        (req \"provided\" Block_payload_hash.encoding))\n    (function\n      | Consensus_operation_on_competing_proposal {expected; provided} ->\n          Some (expected, provided)\n      | _ -> None)\n    (fun (expected, provided) ->\n      Consensus_operation_on_competing_proposal {expected; provided}) ;\n  register_error_kind\n    `Permanent\n    ~id:\"operation.set_deposits_limit_on_originated_contract\"\n    ~title:\"Set deposits limit on an originated contract\"\n    ~description:\"Cannot set deposits limit on an originated contract.\"\n    ~pp:(fun ppf () ->\n      Format.fprintf ppf \"Cannot set deposits limit on an originated contract.\")\n    Data_encoding.empty\n    (function\n      | Set_deposits_limit_on_originated_contract -> Some () | _ -> None)\n    (fun () -> Set_deposits_limit_on_originated_contract) ;\n  register_error_kind\n    `Temporary\n    ~id:\"operation.set_deposits_limit_on_unregistered_delegate\"\n    ~title:\"Set deposits limit on an unregistered delegate\"\n    ~description:\"Cannot set deposits limit on an unregistered delegate.\"\n    ~pp:(fun ppf c ->\n      Format.fprintf\n        ppf\n        \"Cannot set a deposits limit on the unregistered delegate %a.\"\n        Signature.Public_key_hash.pp\n        c)\n    Data_encoding.(obj1 (req \"delegate\" Signature.Public_key_hash.encoding))\n    (function\n      | Set_deposits_limit_on_unregistered_delegate c -> Some c | _ -> None)\n    (fun c -> Set_deposits_limit_on_unregistered_delegate c) ;\n  register_error_kind\n    `Permanent\n    ~id:\"operation.set_deposits_limit_too_high\"\n    ~title:\"Set deposits limit to a too high value\"\n    ~description:\n      \"Cannot set deposits limit such that the active stake overflows.\"\n    ~pp:(fun ppf (limit, max_limit) ->\n      Format.fprintf\n        ppf\n        \"Cannot set deposits limit to %a as it is higher the allowed maximum \\\n         %a.\"\n        Tez.pp\n        limit\n        Tez.pp\n        max_limit)\n    Data_encoding.(\n      obj2 (req \"limit\" Tez.encoding) (req \"max_limit\" Tez.encoding))\n    (function\n      | Set_deposits_limit_too_high {limit; max_limit} -> Some (limit, max_limit)\n      | _ -> None)\n    (fun (limit, max_limit) -> Set_deposits_limit_too_high {limit; max_limit}) ;\n  register_error_kind\n    `Branch\n    ~id:\"contract.empty_transaction\"\n    ~title:\"Empty transaction\"\n    ~description:\"Forbidden to credit 0\234\156\169 to a contract without code.\"\n    ~pp:(fun ppf contract ->\n      Format.fprintf\n        ppf\n        \"Transactions of 0\234\156\169 towards a contract without code are forbidden \\\n         (%a).\"\n        Contract.pp\n        contract)\n    Data_encoding.(obj1 (req \"contract\" Contract.encoding))\n    (function Empty_transaction c -> Some c | _ -> None)\n    (fun c -> Empty_transaction c)\n\ntype error += (* `Temporary *) Wrong_voting_period of int32 * int32\n\ntype error +=\n  | (* `Permanent *) Internal_operation_replay of packed_internal_operation\n\ntype denunciation_kind = Preendorsement | Endorsement | Block\n\nlet denunciation_kind_encoding =\n  let open Data_encoding in\n  string_enum\n    [\n      (\"preendorsement\", Preendorsement);\n      (\"endorsement\", Endorsement);\n      (\"block\", Block);\n    ]\n\nlet pp_denunciation_kind fmt : denunciation_kind -> unit = function\n  | Preendorsement -> Format.fprintf fmt \"preendorsement\"\n  | Endorsement -> Format.fprintf fmt \"endorsement\"\n  | Block -> Format.fprintf fmt \"baking\"\n\ntype error += (* `Permanent *)\n              Invalid_denunciation of denunciation_kind\n\ntype error +=\n  | (* `Permanent *)\n      Inconsistent_denunciation of {\n      kind : denunciation_kind;\n      delegate1 : Signature.Public_key_hash.t;\n      delegate2 : Signature.Public_key_hash.t;\n    }\n\ntype error += (* `Branch *) Unrequired_denunciation\n\ntype error +=\n  | (* `Temporary *)\n      Too_early_denunciation of {\n      kind : denunciation_kind;\n      level : Raw_level.t;\n      current : Raw_level.t;\n    }\n\ntype error +=\n  | (* `Permanent *)\n      Outdated_denunciation of {\n      kind : denunciation_kind;\n      level : Raw_level.t;\n      last_cycle : Cycle.t;\n    }\n\ntype error +=\n  | (* Permanent *) Invalid_activation of {pkh : Ed25519.Public_key_hash.t}\n\ntype error += (* Permanent *) Multiple_revelation\n\ntype error += (* Permanent *) Gas_quota_exceeded_init_deserialize\n\ntype error += (* `Permanent *) Inconsistent_sources\n\ntype error += (* `Permanent *) Failing_noop_error\n\ntype error +=\n  | (* `Permanent *)\n      Zero_frozen_deposits of Signature.Public_key_hash.t\n\nlet () =\n  register_error_kind\n    `Temporary\n    ~id:\"operation.wrong_voting_period\"\n    ~title:\"Wrong voting period\"\n    ~description:\n      \"Trying to include a proposal or ballot meant for another voting period\"\n    ~pp:(fun ppf (e, p) ->\n      Format.fprintf ppf \"Wrong voting period %ld, current is %ld\" p e)\n    Data_encoding.(\n      obj2 (req \"current_index\" int32) (req \"provided_index\" int32))\n    (function Wrong_voting_period (e, p) -> Some (e, p) | _ -> None)\n    (fun (e, p) -> Wrong_voting_period (e, p)) ;\n  register_error_kind\n    `Permanent\n    ~id:\"internal_operation_replay\"\n    ~title:\"Internal operation replay\"\n    ~description:\"An internal operation was emitted twice by a script\"\n    ~pp:(fun ppf (Internal_operation {nonce; _}) ->\n      Format.fprintf\n        ppf\n        \"Internal operation %d was emitted twice by a script\"\n        nonce)\n    Operation.internal_operation_encoding\n    (function Internal_operation_replay op -> Some op | _ -> None)\n    (fun op -> Internal_operation_replay op) ;\n  register_error_kind\n    `Permanent\n    ~id:\"block.invalid_denunciation\"\n    ~title:\"Invalid denunciation\"\n    ~description:\"A denunciation is malformed\"\n    ~pp:(fun ppf kind ->\n      Format.fprintf\n        ppf\n        \"Malformed double-%a evidence\"\n        pp_denunciation_kind\n        kind)\n    Data_encoding.(obj1 (req \"kind\" denunciation_kind_encoding))\n    (function Invalid_denunciation kind -> Some kind | _ -> None)\n    (fun kind -> Invalid_denunciation kind) ;\n  register_error_kind\n    `Permanent\n    ~id:\"block.inconsistent_denunciation\"\n    ~title:\"Inconsistent denunciation\"\n    ~description:\n      \"A denunciation operation is inconsistent (two distinct delegates)\"\n    ~pp:(fun ppf (kind, delegate1, delegate2) ->\n      Format.fprintf\n        ppf\n        \"Inconsistent double-%a evidence (distinct delegate: %a and %a)\"\n        pp_denunciation_kind\n        kind\n        Signature.Public_key_hash.pp_short\n        delegate1\n        Signature.Public_key_hash.pp_short\n        delegate2)\n    Data_encoding.(\n      obj3\n        (req \"kind\" denunciation_kind_encoding)\n        (req \"delegate1\" Signature.Public_key_hash.encoding)\n        (req \"delegate2\" Signature.Public_key_hash.encoding))\n    (function\n      | Inconsistent_denunciation {kind; delegate1; delegate2} ->\n          Some (kind, delegate1, delegate2)\n      | _ -> None)\n    (fun (kind, delegate1, delegate2) ->\n      Inconsistent_denunciation {kind; delegate1; delegate2}) ;\n  register_error_kind\n    `Branch\n    ~id:\"block.unrequired_denunciation\"\n    ~title:\"Unrequired denunciation\"\n    ~description:\"A denunciation is unrequired\"\n    ~pp:(fun ppf _ ->\n      Format.fprintf\n        ppf\n        \"A valid denunciation cannot be applied: the associated delegate has \\\n         already been denounced for this level.\")\n    Data_encoding.unit\n    (function Unrequired_denunciation -> Some () | _ -> None)\n    (fun () -> Unrequired_denunciation) ;\n  register_error_kind\n    `Temporary\n    ~id:\"block.too_early_denunciation\"\n    ~title:\"Too early denunciation\"\n    ~description:\"A denunciation is too far in the future\"\n    ~pp:(fun ppf (kind, level, current) ->\n      Format.fprintf\n        ppf\n        \"A double-%a denunciation is too far in the future (current level: %a, \\\n         given level: %a)\"\n        pp_denunciation_kind\n        kind\n        Raw_level.pp\n        current\n        Raw_level.pp\n        level)\n    Data_encoding.(\n      obj3\n        (req \"kind\" denunciation_kind_encoding)\n        (req \"level\" Raw_level.encoding)\n        (req \"current\" Raw_level.encoding))\n    (function\n      | Too_early_denunciation {kind; level; current} ->\n          Some (kind, level, current)\n      | _ -> None)\n    (fun (kind, level, current) ->\n      Too_early_denunciation {kind; level; current}) ;\n  register_error_kind\n    `Permanent\n    ~id:\"block.outdated_denunciation\"\n    ~title:\"Outdated denunciation\"\n    ~description:\"A denunciation is outdated.\"\n    ~pp:(fun ppf (kind, level, last_cycle) ->\n      Format.fprintf\n        ppf\n        \"A double-%a is outdated (last acceptable cycle: %a, given level: %a)\"\n        pp_denunciation_kind\n        kind\n        Cycle.pp\n        last_cycle\n        Raw_level.pp\n        level)\n    Data_encoding.(\n      obj3\n        (req \"kind\" denunciation_kind_encoding)\n        (req \"level\" Raw_level.encoding)\n        (req \"last\" Cycle.encoding))\n    (function\n      | Outdated_denunciation {kind; level; last_cycle} ->\n          Some (kind, level, last_cycle)\n      | _ -> None)\n    (fun (kind, level, last_cycle) ->\n      Outdated_denunciation {kind; level; last_cycle}) ;\n  register_error_kind\n    `Permanent\n    ~id:\"operation.invalid_activation\"\n    ~title:\"Invalid activation\"\n    ~description:\n      \"The given key and secret do not correspond to any existing preallocated \\\n       contract\"\n    ~pp:(fun ppf pkh ->\n      Format.fprintf\n        ppf\n        \"Invalid activation. The public key %a does not match any commitment.\"\n        Ed25519.Public_key_hash.pp\n        pkh)\n    Data_encoding.(obj1 (req \"pkh\" Ed25519.Public_key_hash.encoding))\n    (function Invalid_activation {pkh} -> Some pkh | _ -> None)\n    (fun pkh -> Invalid_activation {pkh}) ;\n  register_error_kind\n    `Permanent\n    ~id:\"block.multiple_revelation\"\n    ~title:\"Multiple revelations were included in a manager operation\"\n    ~description:\n      \"A manager operation should not contain more than one revelation\"\n    ~pp:(fun ppf () ->\n      Format.fprintf\n        ppf\n        \"Multiple revelations were included in a manager operation\")\n    Data_encoding.empty\n    (function Multiple_revelation -> Some () | _ -> None)\n    (fun () -> Multiple_revelation) ;\n  register_error_kind\n    `Permanent\n    ~id:\"gas_exhausted.init_deserialize\"\n    ~title:\"Not enough gas for initial deserialization of script expressions\"\n    ~description:\n      \"Gas limit was not high enough to deserialize the transaction parameters \\\n       or origination script code or initial storage, making the operation \\\n       impossible to parse within the provided gas bounds.\"\n    Data_encoding.empty\n    (function Gas_quota_exceeded_init_deserialize -> Some () | _ -> None)\n    (fun () -> Gas_quota_exceeded_init_deserialize) ;\n  register_error_kind\n    `Permanent\n    ~id:\"operation.inconsistent_sources\"\n    ~title:\"Inconsistent sources in operation pack\"\n    ~description:\n      \"The operation pack includes operations from different sources.\"\n    ~pp:(fun ppf () ->\n      Format.pp_print_string\n        ppf\n        \"The operation pack includes operations from different sources.\")\n    Data_encoding.empty\n    (function Inconsistent_sources -> Some () | _ -> None)\n    (fun () -> Inconsistent_sources) ;\n  register_error_kind\n    `Permanent\n    ~id:\"operation.failing_noop\"\n    ~title:\"Failing_noop operation are not executed by the protocol\"\n    ~description:\n      \"The failing_noop operation is an operation that is not and never will \\\n       be executed by the protocol.\"\n    ~pp:(fun ppf () ->\n      Format.fprintf\n        ppf\n        \"The failing_noop operation cannot be executed by the protocol\")\n    Data_encoding.empty\n    (function Failing_noop_error -> Some () | _ -> None)\n    (fun () -> Failing_noop_error) ;\n  register_error_kind\n    `Permanent\n    ~id:\"delegate.zero_frozen_deposits\"\n    ~title:\"Zero frozen deposits\"\n    ~description:\"The delegate has zero frozen deposits.\"\n    ~pp:(fun ppf delegate ->\n      Format.fprintf\n        ppf\n        \"Delegate %a has zero frozen deposits; it is not allowed to \\\n         bake/preendorse/endorse.\"\n        Signature.Public_key_hash.pp\n        delegate)\n    Data_encoding.(obj1 (req \"delegate\" Signature.Public_key_hash.encoding))\n    (function Zero_frozen_deposits delegate -> Some delegate | _ -> None)\n    (fun delegate -> Zero_frozen_deposits delegate)\n\nopen Apply_results\n\nlet cache_layout = Constants_repr.cache_layout\n\n(**\n\n   Retrieving the source code of a contract from its address is costly\n   because it requires I/Os. For this reason, we put the corresponding\n   Micheline expression in the cache.\n\n   Elaborating a Micheline node into the well-typed script abstract\n   syntax tree is also a costly operation. The result of this operation\n   is cached as well.\n\n*)\n\nlet apply_manager_operation_content :\n    type kind.\n    Alpha_context.t ->\n    Script_ir_translator.unparsing_mode ->\n    payer:Contract.t ->\n    source:Contract.t ->\n    chain_id:Chain_id.t ->\n    internal:bool ->\n    gas_consumed_in_precheck:Gas.cost option ->\n    kind manager_operation ->\n    (context\n    * kind successful_manager_operation_result\n    * packed_internal_operation list)\n    tzresult\n    Lwt.t =\n fun ctxt\n     mode\n     ~payer\n     ~source\n     ~chain_id\n     ~internal\n     ~gas_consumed_in_precheck\n     operation ->\n  let before_operation =\n    (* This context is not used for backtracking. Only to compute\n         gas consumption and originations for the operation result. *)\n    ctxt\n  in\n  Contract.must_exist ctxt source >>=? fun () ->\n  Gas.consume ctxt Michelson_v1_gas.Cost_of.manager_operation >>?= fun ctxt ->\n  (match gas_consumed_in_precheck with\n  | None -> Ok ctxt\n  | Some gas -> Gas.consume ctxt gas)\n  >>?= fun ctxt ->\n  let consume_deserialization_gas = Script.When_needed in\n  (* [note]: deserialization gas has already been accounted for in the gas\n     consumed by the precheck and the lazy_exprs have been forced. *)\n  match operation with\n  | Reveal _ ->\n      return\n        (* No-op: action already performed by `precheck_manager_contents`. *)\n        ( ctxt,\n          (Reveal_result\n             {consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt}\n            : kind successful_manager_operation_result),\n          [] )\n  | Transaction {amount; parameters; destination; entrypoint} -> (\n      Script.force_decode_in_context\n        ~consume_deserialization_gas\n        ctxt\n        parameters\n      >>?= fun (parameter, ctxt) ->\n      (match Contract.is_implicit destination with\n      | None ->\n          (if Tez.(amount = zero) then\n           (* Detect potential call to non existent contract. *)\n           Contract.must_exist ctxt destination\n          else return_unit)\n          >>=? fun () ->\n          (* Since the contract is originated, nothing will be allocated\n             or the next transfer of tokens will fail. *)\n          return_false\n      | Some _ ->\n          (* Transfers of zero to implicit accounts are forbidden. *)\n          error_when Tez.(amount = zero) (Empty_transaction destination)\n          >>?= fun () ->\n          (* If the implicit contract is not yet allocated at this point then\n             the next transfer of tokens will allocate it. *)\n          Contract.allocated ctxt destination >|=? not)\n      >>=? fun allocated_destination_contract ->\n      Token.transfer ctxt (`Contract source) (`Contract destination) amount\n      >>=? fun (ctxt, balance_updates) ->\n      Script_cache.find ctxt destination >>=? fun (ctxt, cache_key, script) ->\n      match script with\n      | None ->\n          Lwt.return\n            ( ( (match entrypoint with\n                | \"default\" -> Result.return_unit\n                | entrypoint ->\n                    error (Script_tc_errors.No_such_entrypoint entrypoint))\n              >>? fun () ->\n                match Micheline.root parameter with\n                | Prim (_, D_Unit, [], _) ->\n                    (* Allow [Unit] parameter to non-scripted contracts. *)\n                    ok ctxt\n                | _ ->\n                    error\n                      (Script_interpreter.Bad_contract_parameter destination) )\n            >|? fun ctxt ->\n              let result =\n                Transaction_result\n                  {\n                    storage = None;\n                    lazy_storage_diff = None;\n                    balance_updates;\n                    originated_contracts = [];\n                    consumed_gas =\n                      Gas.consumed ~since:before_operation ~until:ctxt;\n                    storage_size = Z.zero;\n                    paid_storage_size_diff = Z.zero;\n                    allocated_destination_contract;\n                  }\n              in\n              (ctxt, result, []) )\n      | Some (script, script_ir) ->\n          let now = Script_timestamp.now ctxt in\n          let level =\n            (Level.current ctxt).level |> Raw_level.to_int32\n            |> Script_int.of_int32 |> Script_int.abs\n          in\n          let step_constants =\n            let open Script_interpreter in\n            {source; payer; self = destination; amount; chain_id; now; level}\n          in\n          Script_interpreter.execute\n            ctxt\n            ~cached_script:(Some script_ir)\n            mode\n            step_constants\n            ~script\n            ~parameter\n            ~entrypoint\n            ~internal\n          >>=? fun ( {ctxt; storage; lazy_storage_diff; operations},\n                     (updated_cached_script, updated_size) ) ->\n          Contract.update_script_storage\n            ctxt\n            destination\n            storage\n            lazy_storage_diff\n          >>=? fun ctxt ->\n          Fees.record_paid_storage_space ctxt destination\n          >>=? fun (ctxt, new_size, paid_storage_size_diff) ->\n          Contract.originated_from_current_nonce\n            ~since:before_operation\n            ~until:ctxt\n          >>=? fun originated_contracts ->\n          Lwt.return\n            ( Script_cache.update\n                ctxt\n                cache_key\n                ( {script with storage = Script.lazy_expr storage},\n                  updated_cached_script )\n                updated_size\n            >|? fun ctxt ->\n              let result =\n                Transaction_result\n                  {\n                    storage = Some storage;\n                    lazy_storage_diff;\n                    balance_updates;\n                    originated_contracts;\n                    consumed_gas =\n                      Gas.consumed ~since:before_operation ~until:ctxt;\n                    storage_size = new_size;\n                    paid_storage_size_diff;\n                    allocated_destination_contract;\n                  }\n              in\n              (ctxt, result, operations) ))\n  | Origination {delegate; script; preorigination; credit} ->\n      Script.force_decode_in_context\n        ~consume_deserialization_gas\n        ctxt\n        script.storage\n      >>?= fun (_unparsed_storage, ctxt) ->\n      Script.force_decode_in_context\n        ~consume_deserialization_gas\n        ctxt\n        script.code\n      >>?= fun (unparsed_code, ctxt) ->\n      Script_ir_translator.parse_script\n        ctxt\n        ~legacy:false\n        ~allow_forged_in_storage:internal\n        script\n      >>=? fun (Ex_script parsed_script, ctxt) ->\n      let views_result =\n        Script_ir_translator.typecheck_views\n          ctxt\n          ~legacy:false\n          parsed_script.storage_type\n          parsed_script.views\n      in\n      trace\n        (Script_tc_errors.Ill_typed_contract (unparsed_code, []))\n        views_result\n      >>=? fun ctxt ->\n      Script_ir_translator.collect_lazy_storage\n        ctxt\n        parsed_script.storage_type\n        parsed_script.storage\n      >>?= fun (to_duplicate, ctxt) ->\n      let to_update = Script_ir_translator.no_lazy_storage_id in\n      Script_ir_translator.extract_lazy_storage_diff\n        ctxt\n        Optimized\n        parsed_script.storage_type\n        parsed_script.storage\n        ~to_duplicate\n        ~to_update\n        ~temporary:false\n      >>=? fun (storage, lazy_storage_diff, ctxt) ->\n      Script_ir_translator.unparse_data\n        ctxt\n        Optimized\n        parsed_script.storage_type\n        storage\n      >>=? fun (storage, ctxt) ->\n      let storage = Script.lazy_expr (Micheline.strip_locations storage) in\n      let script = {script with storage} in\n      (match preorigination with\n      | Some contract ->\n          assert internal ;\n          (* The preorigination field is only used to early return\n                 the address of an originated contract in Michelson.\n                 It cannot come from the outside. *)\n          ok (ctxt, contract)\n      | None -> Contract.fresh_contract_from_current_nonce ctxt)\n      >>?= fun (ctxt, contract) ->\n      Contract.raw_originate\n        ctxt\n        ~prepaid_bootstrap_storage:false\n        contract\n        ~script:(script, lazy_storage_diff)\n      >>=? fun ctxt ->\n      (match delegate with\n      | None -> return ctxt\n      | Some delegate -> Delegate.init ctxt contract delegate)\n      >>=? fun ctxt ->\n      Token.transfer ctxt (`Contract source) (`Contract contract) credit\n      >>=? fun (ctxt, balance_updates) ->\n      Fees.record_paid_storage_space ctxt contract\n      >|=? fun (ctxt, size, paid_storage_size_diff) ->\n      let result =\n        Origination_result\n          {\n            lazy_storage_diff;\n            balance_updates;\n            originated_contracts = [contract];\n            consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt;\n            storage_size = size;\n            paid_storage_size_diff;\n          }\n      in\n      (ctxt, result, [])\n  | Delegation delegate ->\n      Delegate.set ctxt source delegate >|=? fun ctxt ->\n      ( ctxt,\n        Delegation_result\n          {consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt},\n        [] )\n  | Register_global_constant {value} ->\n      (* Decode the value and consume gas appropriately *)\n      Script.force_decode_in_context ~consume_deserialization_gas ctxt value\n      >>?= fun (expr, ctxt) ->\n      (* Set the key to the value in storage. *)\n      Global_constants_storage.register ctxt expr\n      >>=? fun (ctxt, address, size) ->\n      (* The burn and the reporting of the burn are calculated differently.\n\n         [Fees.record_global_constant_storage_space] does the actual burn\n         based on the size of the constant registered, and this causes a\n         change in account balance.\n\n         On the other hand, the receipt is calculated\n         with the help of [Fees.cost_of_bytes], and is included in block metadata\n         and the client output. The receipt is also used during simulation,\n         letting the client automatically set an appropriate storage limit.\n         TODO : is this concern still honored by the token management\n         refactoring ? *)\n      let (ctxt, paid_size) =\n        Fees.record_global_constant_storage_space ctxt size\n      in\n      let result =\n        Register_global_constant_result\n          {\n            balance_updates = [];\n            consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt;\n            size_of_constant = paid_size;\n            global_address = address;\n          }\n      in\n      return (ctxt, result, [])\n  | Set_deposits_limit limit -> (\n      (match limit with\n      | None -> return_unit\n      | Some limit ->\n          let frozen_deposits_percentage =\n            Constants.frozen_deposits_percentage ctxt\n          in\n          let max_limit =\n            Tez.of_mutez_exn\n              Int64.(\n                mul (of_int frozen_deposits_percentage) Int64.(div max_int 100L))\n          in\n          fail_when\n            Tez.(limit > max_limit)\n            (Set_deposits_limit_too_high {limit; max_limit}))\n      >>=? fun () ->\n      Contract.is_implicit source |> function\n      | None -> fail Set_deposits_limit_on_originated_contract\n      | Some delegate ->\n          Delegate.registered ctxt delegate >>=? fun is_registered ->\n          fail_unless\n            is_registered\n            (Set_deposits_limit_on_unregistered_delegate delegate)\n          >>=? fun () ->\n          Delegate.set_frozen_deposits_limit ctxt delegate limit >>= fun ctxt ->\n          return\n            ( ctxt,\n              Set_deposits_limit_result\n                {\n                  consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt;\n                },\n              [] ))\n\ntype success_or_failure = Success of context | Failure\n\nlet apply_internal_manager_operations ctxt mode ~payer ~chain_id ops =\n  let[@coq_struct \"ctxt\"] rec apply ctxt applied worklist =\n    match worklist with\n    | [] -> Lwt.return (Success ctxt, List.rev applied)\n    | Internal_operation ({source; operation; nonce} as op) :: rest -> (\n        (if internal_nonce_already_recorded ctxt nonce then\n         fail (Internal_operation_replay (Internal_operation op))\n        else\n          let ctxt = record_internal_nonce ctxt nonce in\n          apply_manager_operation_content\n            ctxt\n            mode\n            ~source\n            ~payer\n            ~chain_id\n            ~internal:true\n            ~gas_consumed_in_precheck:None\n            operation)\n        >>= function\n        | Error errors ->\n            let result =\n              Internal_operation_result\n                (op, Failed (manager_kind op.operation, errors))\n            in\n            let skipped =\n              List.rev_map\n                (fun (Internal_operation op) ->\n                  Internal_operation_result\n                    (op, Skipped (manager_kind op.operation)))\n                rest\n            in\n            Lwt.return (Failure, List.rev (skipped @ result :: applied))\n        | Ok (ctxt, result, emitted) ->\n            apply\n              ctxt\n              (Internal_operation_result (op, Applied result) :: applied)\n              (emitted @ rest))\n  in\n  apply ctxt [] ops\n\nlet precheck_manager_contents (type kind) ctxt (op : kind Kind.manager contents)\n    ~(only_batch : bool) : (context * precheck_result) tzresult Lwt.t =\n  let[@coq_match_with_default] (Manager_operation\n                                 {\n                                   source;\n                                   fee;\n                                   counter;\n                                   operation;\n                                   gas_limit;\n                                   storage_limit;\n                                 }) =\n    op\n  in\n  (if only_batch then\n   (* Gas.consume_limit_in_block will only raise a \"temporary\" error, however\n      when the precheck is called on a batch in isolation (like e.g. in the\n      mempool) it must \"refuse\" operations whose total gas_limit (the sum of\n      the gas_limits of each operation) is already above the block limit. We\n      add the \"permanent\" error Gas.Gas_limit_too_high on top of the trace to\n      this effect. *)\n   record_trace Gas.Gas_limit_too_high\n  else fun errs -> errs)\n  @@ Gas.consume_limit_in_block ctxt gas_limit\n  >>?= fun ctxt ->\n  let ctxt = Gas.set_limit ctxt gas_limit in\n  let ctxt_before = ctxt in\n  Fees.check_storage_limit ctxt ~storage_limit >>?= fun () ->\n  let source_contract = Contract.implicit_contract source in\n  Contract.must_be_allocated ctxt source_contract >>=? fun () ->\n  Contract.check_counter_increment ctxt source counter >>=? fun () ->\n  let consume_deserialization_gas = Script.Always in\n  (* We want to always consume the deserialization gas here, independently of\n     the internal state of the lazy_exprs in the arguments. Otherwise we might\n     risk getting different results if the operation has already been\n     deserialized before (e.g. when retrieve in JSON format). *)\n  (match operation with\n  | Reveal pk -> Contract.reveal_manager_key ctxt source pk\n  | Transaction {parameters; _} ->\n      Lwt.return\n      @@ record_trace Gas_quota_exceeded_init_deserialize\n      @@ (* Fail early if not enough gas for complete deserialization\n             cost or if deserialization fails. The gas consumed here is\n            \"replayed\" in [apply_manager_contents]. *)\n      ( Script.force_decode_in_context\n          ~consume_deserialization_gas\n          ctxt\n          parameters\n      >|? fun (_arg, ctxt) -> ctxt )\n  | Origination {script; _} ->\n      Lwt.return\n      @@ record_trace Gas_quota_exceeded_init_deserialize\n      @@ (* See comment in the Transaction branch *)\n      ( Script.force_decode_in_context\n          ~consume_deserialization_gas\n          ctxt\n          script.code\n      >>? fun (_code, ctxt) ->\n        Script.force_decode_in_context\n          ~consume_deserialization_gas\n          ctxt\n          script.storage\n        >|? fun (_storage, ctxt) -> ctxt )\n  | Register_global_constant {value} ->\n      Lwt.return\n      @@ record_trace Gas_quota_exceeded_init_deserialize\n      @@ (* See comment in the Transaction branch *)\n      ( Script.force_decode_in_context ~consume_deserialization_gas ctxt value\n      >|? fun (_value, ctxt) -> ctxt )\n  | _ -> return ctxt)\n  >>=? fun ctxt ->\n  Contract.increment_counter ctxt source >>=? fun ctxt ->\n  Token.transfer ctxt (`Contract source_contract) `Block_fees fee\n  >|=? fun (ctxt, balance_updates) ->\n  let consumed_gas = Gas.consumed ~since:ctxt_before ~until:ctxt in\n  (ctxt, {balance_updates; consumed_gas})\n\n(** [burn_storage_fees ctxt smopr storage_limit payer] burns the storage fees\n    associated to the transaction or origination result [smopr].\n    Returns an updated context, an updated storage limit with the space consumed\n    by the operation subtracted, and [smopr] with the relevant balance updates\n    included. *)\nlet burn_storage_fees :\n    type kind.\n    context ->\n    kind successful_manager_operation_result ->\n    storage_limit:Z.t ->\n    payer:Contract.t ->\n    (context * Z.t * kind successful_manager_operation_result) tzresult Lwt.t =\n fun ctxt smopr ~storage_limit ~payer ->\n  match smopr with\n  | Transaction_result payload ->\n      let consumed = payload.paid_storage_size_diff in\n      let payer = `Contract payer in\n      Fees.burn_storage_fees ctxt ~storage_limit ~payer consumed\n      >>=? fun (ctxt, storage_limit, storage_bus) ->\n      (if payload.allocated_destination_contract then\n       Fees.burn_origination_fees ctxt ~storage_limit ~payer\n      else return (ctxt, storage_limit, []))\n      >>=? fun (ctxt, storage_limit, origination_bus) ->\n      let balance_updates =\n        storage_bus @ payload.balance_updates @ origination_bus\n      in\n      return\n        ( ctxt,\n          storage_limit,\n          Transaction_result\n            {\n              storage = payload.storage;\n              lazy_storage_diff = payload.lazy_storage_diff;\n              balance_updates;\n              originated_contracts = payload.originated_contracts;\n              consumed_gas = payload.consumed_gas;\n              storage_size = payload.storage_size;\n              paid_storage_size_diff = payload.paid_storage_size_diff;\n              allocated_destination_contract =\n                payload.allocated_destination_contract;\n            } )\n  | Origination_result payload ->\n      let consumed = payload.paid_storage_size_diff in\n      let payer = `Contract payer in\n      Fees.burn_storage_fees ctxt ~storage_limit ~payer consumed\n      >>=? fun (ctxt, storage_limit, storage_bus) ->\n      Fees.burn_origination_fees ctxt ~storage_limit ~payer\n      >>=? fun (ctxt, storage_limit, origination_bus) ->\n      let balance_updates =\n        storage_bus @ origination_bus @ payload.balance_updates\n      in\n      return\n        ( ctxt,\n          storage_limit,\n          Origination_result\n            {\n              lazy_storage_diff = payload.lazy_storage_diff;\n              balance_updates;\n              originated_contracts = payload.originated_contracts;\n              consumed_gas = payload.consumed_gas;\n              storage_size = payload.storage_size;\n              paid_storage_size_diff = payload.paid_storage_size_diff;\n            } )\n  | Reveal_result _ | Delegation_result _ -> return (ctxt, storage_limit, smopr)\n  | Register_global_constant_result payload ->\n      let consumed = payload.size_of_constant in\n      let payer = `Contract payer in\n      Fees.burn_storage_fees ctxt ~storage_limit ~payer consumed\n      >>=? fun (ctxt, storage_limit, storage_bus) ->\n      let balance_updates = storage_bus @ payload.balance_updates in\n      return\n        ( ctxt,\n          storage_limit,\n          Register_global_constant_result\n            {\n              balance_updates;\n              consumed_gas = payload.consumed_gas;\n              size_of_constant = payload.size_of_constant;\n              global_address = payload.global_address;\n            } )\n  | Set_deposits_limit_result _ -> return (ctxt, storage_limit, smopr)\n\nlet apply_manager_contents (type kind) ctxt mode chain_id\n    ~gas_consumed_in_precheck (op : kind Kind.manager contents) :\n    (success_or_failure\n    * kind manager_operation_result\n    * packed_internal_operation_result list)\n    Lwt.t =\n  let[@coq_match_with_default] (Manager_operation\n                                 {\n                                   source;\n                                   operation;\n                                   gas_limit;\n                                   storage_limit;\n                                   _;\n                                 }) =\n    op\n  in\n  (* We do not expose the internal scaling to the users. Instead, we multiply\n       the specified gas limit by the internal scaling. *)\n  let ctxt = Gas.set_limit ctxt gas_limit in\n  let source = Contract.implicit_contract source in\n  apply_manager_operation_content\n    ctxt\n    mode\n    ~source\n    ~payer:source\n    ~internal:false\n    ~gas_consumed_in_precheck\n    ~chain_id\n    operation\n  >>= function\n  | Ok (ctxt, operation_results, internal_operations) -> (\n      apply_internal_manager_operations\n        ctxt\n        mode\n        ~payer:source\n        ~chain_id\n        internal_operations\n      >>= function\n      | (Success ctxt, internal_operations_results) -> (\n          burn_storage_fees ctxt operation_results ~storage_limit ~payer:source\n          >>= function\n          | Ok (ctxt, storage_limit, operation_results) -> (\n              List.fold_left_es\n                (fun (ctxt, storage_limit, res) iopr ->\n                  let (Internal_operation_result (op, mopr)) = iopr in\n                  match mopr with\n                  | Applied smopr ->\n                      burn_storage_fees ctxt smopr ~storage_limit ~payer:source\n                      >>=? fun (ctxt, storage_limit, smopr) ->\n                      let iopr =\n                        Internal_operation_result (op, Applied smopr)\n                      in\n                      return (ctxt, storage_limit, iopr :: res)\n                  | _ -> return (ctxt, storage_limit, iopr :: res))\n                (ctxt, storage_limit, [])\n                internal_operations_results\n              >|= function\n              | Ok (ctxt, _, internal_operations_results) ->\n                  ( Success ctxt,\n                    Applied operation_results,\n                    List.rev internal_operations_results )\n              | Error errors ->\n                  ( Failure,\n                    Backtracked (operation_results, Some errors),\n                    internal_operations_results ))\n          | Error errors ->\n              Lwt.return\n                ( Failure,\n                  Backtracked (operation_results, Some errors),\n                  internal_operations_results ))\n      | (Failure, internal_operations_results) ->\n          Lwt.return\n            (Failure, Applied operation_results, internal_operations_results))\n  | Error errors ->\n      Lwt.return (Failure, Failed (manager_kind operation, errors), [])\n\nlet skipped_operation_result :\n    type kind. kind manager_operation -> kind manager_operation_result =\n  function\n  | operation -> (\n      match operation with\n      | Reveal _ ->\n          Applied\n            (Reveal_result {consumed_gas = Gas.Arith.zero}\n              : kind successful_manager_operation_result)\n      | _ -> Skipped (manager_kind operation))\n\nlet rec mark_skipped :\n    type kind.\n    payload_producer:Signature.Public_key_hash.t ->\n    Level.t ->\n    kind Kind.manager prechecked_contents_list ->\n    kind Kind.manager contents_result_list =\n fun ~payload_producer level prechecked_contents_list ->\n  match[@coq_match_with_default] prechecked_contents_list with\n  | PrecheckedSingle\n      {\n        contents = Manager_operation {operation; _};\n        result = {balance_updates; _};\n      } ->\n      Single_result\n        (Manager_operation_result\n           {\n             balance_updates;\n             operation_result = skipped_operation_result operation;\n             internal_operation_results = [];\n           })\n  | PrecheckedCons\n      ( {\n          contents = Manager_operation {operation; _};\n          result = {balance_updates; _};\n        },\n        rest ) ->\n      Cons_result\n        ( Manager_operation_result\n            {\n              balance_updates;\n              operation_result = skipped_operation_result operation;\n              internal_operation_results = [];\n            },\n          mark_skipped ~payload_producer level rest )\n\n(** Returns an updated context, and a list of prechecked contents containing\n    balance updates for fees related to each manager operation in\n    [contents_list]. *)\nlet precheck_manager_contents_list ctxt contents_list ~mempool_mode =\n  let rec rec_precheck_manager_contents_list :\n      type kind.\n      Alpha_context.t ->\n      kind Kind.manager contents_list ->\n      (context * kind Kind.manager prechecked_contents_list) tzresult Lwt.t =\n   fun ctxt contents_list ->\n    match[@coq_match_with_default] contents_list with\n    | Single contents ->\n        precheck_manager_contents ctxt contents ~only_batch:mempool_mode\n        >>=? fun (ctxt, result) ->\n        return (ctxt, PrecheckedSingle {contents; result})\n    | Cons (contents, rest) ->\n        precheck_manager_contents ctxt contents ~only_batch:mempool_mode\n        >>=? fun (ctxt, result) ->\n        rec_precheck_manager_contents_list ctxt rest\n        >>=? fun (ctxt, results_rest) ->\n        return (ctxt, PrecheckedCons ({contents; result}, results_rest))\n  in\n  let ctxt = if mempool_mode then Gas.reset_block_gas ctxt else ctxt in\n  rec_precheck_manager_contents_list ctxt contents_list\n\nlet check_manager_signature ctxt chain_id (op : _ Kind.manager contents_list)\n    raw_operation =\n  (* Currently, the [op] only contains one signature, so\n     all operations are required to be from the same manager. This may\n     change in the future, allowing several managers to group-sign a\n     sequence of transactions. *)\n  let check_same_manager (source, source_key) manager =\n    match manager with\n    | None ->\n        (* Consistency already checked by\n           [reveal_manager_key] in [precheck_manager_contents]. *)\n        ok (source, source_key)\n    | Some (manager, manager_key) ->\n        if Signature.Public_key_hash.equal source manager then\n          ok (source, Option.either manager_key source_key)\n        else error Inconsistent_sources\n  in\n  let rec find_source :\n      type kind.\n      kind Kind.manager contents_list ->\n      (Signature.public_key_hash * Signature.public_key option) option ->\n      (Signature.public_key_hash * Signature.public_key option) tzresult =\n   fun contents_list manager ->\n    let source (type kind) = function[@coq_match_with_default]\n      | (Manager_operation {source; operation = Reveal key; _} :\n          kind Kind.manager contents) ->\n          (source, Some key)\n      | Manager_operation {source; _} -> (source, None)\n    in\n    match contents_list with\n    | Single op -> check_same_manager (source op) manager\n    | Cons (op, rest) ->\n        check_same_manager (source op) manager >>? fun manager ->\n        find_source rest (Some manager)\n  in\n  find_source op None >>?= fun (source, source_key) ->\n  (match source_key with\n  | Some key -> return key\n  | None -> Contract.get_manager_key ctxt source)\n  >>=? fun public_key ->\n  Lwt.return (Operation.check_signature public_key chain_id raw_operation)\n\nlet rec apply_manager_contents_list_rec :\n    type kind.\n    Alpha_context.t ->\n    Script_ir_translator.unparsing_mode ->\n    payload_producer:public_key_hash ->\n    Chain_id.t ->\n    kind Kind.manager prechecked_contents_list ->\n    (success_or_failure * kind Kind.manager contents_result_list) Lwt.t =\n fun ctxt mode ~payload_producer chain_id prechecked_contents_list ->\n  let level = Level.current ctxt in\n  match[@coq_match_with_default] prechecked_contents_list with\n  | PrecheckedSingle\n      {\n        contents = Manager_operation _ as op;\n        result = {consumed_gas; balance_updates};\n      } ->\n      apply_manager_contents\n        ctxt\n        mode\n        chain_id\n        ~gas_consumed_in_precheck:(Some consumed_gas)\n        op\n      >|= fun (ctxt_result, operation_result, internal_operation_results) ->\n      let result =\n        Manager_operation_result\n          {balance_updates; operation_result; internal_operation_results}\n      in\n      (ctxt_result, Single_result result)\n  | PrecheckedCons\n      ( {\n          contents = Manager_operation _ as op;\n          result = {consumed_gas; balance_updates};\n        },\n        rest ) -> (\n      apply_manager_contents\n        ctxt\n        mode\n        chain_id\n        ~gas_consumed_in_precheck:(Some consumed_gas)\n        op\n      >>= function\n      | (Failure, operation_result, internal_operation_results) ->\n          let result =\n            Manager_operation_result\n              {balance_updates; operation_result; internal_operation_results}\n          in\n          Lwt.return\n            ( Failure,\n              Cons_result (result, mark_skipped ~payload_producer level rest) )\n      | (Success ctxt, operation_result, internal_operation_results) ->\n          let result =\n            Manager_operation_result\n              {balance_updates; operation_result; internal_operation_results}\n          in\n          apply_manager_contents_list_rec\n            ctxt\n            mode\n            ~payload_producer\n            chain_id\n            rest\n          >|= fun (ctxt_result, results) ->\n          (ctxt_result, Cons_result (result, results)))\n\nlet mark_backtracked results =\n  let rec mark_contents_list :\n      type kind.\n      kind Kind.manager contents_result_list ->\n      kind Kind.manager contents_result_list = function\n    | Single_result (Manager_operation_result op) ->\n        Single_result\n          (Manager_operation_result\n             {\n               balance_updates = op.balance_updates;\n               operation_result =\n                 mark_manager_operation_result op.operation_result;\n               internal_operation_results =\n                 List.map\n                   mark_internal_operation_results\n                   op.internal_operation_results;\n             })\n    | Cons_result (Manager_operation_result op, rest) ->\n        Cons_result\n          ( Manager_operation_result\n              {\n                balance_updates = op.balance_updates;\n                operation_result =\n                  mark_manager_operation_result op.operation_result;\n                internal_operation_results =\n                  List.map\n                    mark_internal_operation_results\n                    op.internal_operation_results;\n              },\n            mark_contents_list rest )\n  and mark_internal_operation_results (Internal_operation_result (kind, result))\n      =\n    Internal_operation_result (kind, mark_manager_operation_result result)\n  and mark_manager_operation_result :\n      type kind. kind manager_operation_result -> kind manager_operation_result\n      = function\n    | (Failed _ | Skipped _ | Backtracked _) as result -> result\n    | Applied (Reveal_result _) as result -> result\n    | Applied result -> Backtracked (result, None)\n  in\n  mark_contents_list results\n  [@@coq_axiom_with_reason \"non-top-level mutual recursion\"]\n\ntype apply_mode =\n  | Application of {\n      predecessor_block : Block_hash.t;\n      payload_hash : Block_payload_hash.t;\n      locked_round : Round.t option;\n      predecessor_level : Level.t;\n      predecessor_round : Round.t;\n      round : Round.t;\n    } (* Both partial and normal *)\n  | Full_construction of {\n      predecessor_block : Block_hash.t;\n      payload_hash : Block_payload_hash.t;\n      predecessor_level : Level.t;\n      predecessor_round : Round.t;\n      round : Round.t;\n    }\n  | Partial_construction of {\n      predecessor_level : Level.t;\n      predecessor_round : Round.t;\n      grand_parent_round : Round.t;\n    }\n\nlet get_predecessor_level = function\n  | Application {predecessor_level; _}\n  | Full_construction {predecessor_level; _}\n  | Partial_construction {predecessor_level; _} ->\n      predecessor_level\n\nlet record_operation (type kind) ctxt (operation : kind operation) : context =\n  match operation.protocol_data.contents with\n  | Single (Preendorsement _) -> ctxt\n  | Single (Endorsement _) -> ctxt\n  | Single\n      ( Failing_noop _ | Proposals _ | Ballot _ | Seed_nonce_revelation _\n      | Double_endorsement_evidence _ | Double_preendorsement_evidence _\n      | Double_baking_evidence _ | Activate_account _ | Manager_operation _ )\n  | Cons (Manager_operation _, _) ->\n      let hash = Operation.hash operation in\n      record_non_consensus_operation_hash ctxt hash\n\ntype 'consensus_op_kind expected_consensus_content = {\n  payload_hash : Block_payload_hash.t;\n  branch : Block_hash.t;\n  level : Level.t;\n  round : Round.t;\n}\n\n(* The [Alpha_context] is modified only in [Full_construction] mode\n   when we check a preendorsement if the [preendorsement_quorum_round]\n   was not set. *)\nlet compute_expected_consensus_content (type consensus_op_kind)\n    ~(current_level : Level.t) ~(proposal_level : Level.t)\n    (ctxt : Alpha_context.t) (application_mode : apply_mode)\n    (operation_kind : consensus_op_kind consensus_operation_type)\n    (operation_round : Round.t) (operation_level : Raw_level.t) :\n    (Alpha_context.t * consensus_op_kind expected_consensus_content) tzresult\n    Lwt.t =\n  match operation_kind with\n  | Endorsement -> (\n      match Consensus.endorsement_branch ctxt with\n      | None -> (\n          match application_mode with\n          | Application _ | Full_construction _ ->\n              fail Unexpected_endorsement_in_block\n          | Partial_construction _ ->\n              fail\n                (Consensus_operation_for_future_level\n                   {expected = proposal_level.level; provided = operation_level})\n          )\n      | Some (branch, payload_hash) -> (\n          match application_mode with\n          | Application {predecessor_round; _}\n          | Full_construction {predecessor_round; _}\n          | Partial_construction {predecessor_round; _} ->\n              return\n                ( ctxt,\n                  {\n                    payload_hash;\n                    branch;\n                    level = proposal_level;\n                    round = predecessor_round;\n                  } )))\n  | Preendorsement -> (\n      match application_mode with\n      | Application {locked_round = None; _} ->\n          fail Unexpected_preendorsement_in_block\n      | Application\n          {\n            payload_hash;\n            predecessor_block = branch;\n            locked_round = Some locked_round;\n            _;\n          } ->\n          return\n            ( ctxt,\n              {\n                payload_hash;\n                branch;\n                level = current_level;\n                round = locked_round;\n              } )\n      | Partial_construction {predecessor_round; _} -> (\n          match Consensus.endorsement_branch ctxt with\n          | None ->\n              fail\n                (Consensus_operation_for_future_level\n                   {expected = proposal_level.level; provided = operation_level})\n          | Some (branch, payload_hash) ->\n              return\n                ( ctxt,\n                  {\n                    payload_hash;\n                    branch;\n                    level = proposal_level;\n                    round = predecessor_round;\n                  } ))\n      | Full_construction {payload_hash; predecessor_block = branch; _} ->\n          let (ctxt', round) =\n            match Consensus.get_preendorsements_quorum_round ctxt with\n            | None ->\n                ( Consensus.set_preendorsements_quorum_round ctxt operation_round,\n                  operation_round )\n            | Some round -> (ctxt, round)\n          in\n          return (ctxt', {payload_hash; branch; level = current_level; round}))\n\nlet check_level (apply_mode : apply_mode) ~expected ~provided =\n  match apply_mode with\n  | Application _ | Full_construction _ ->\n      error_unless\n        (Raw_level.equal expected provided)\n        (Wrong_level_for_consensus_operation {expected; provided})\n  | Partial_construction _ ->\n      (* Valid grand parent's endorsements were treated by\n         [validate_grand_parent_endorsement]. *)\n      error_when\n        Raw_level.(expected > provided)\n        (Consensus_operation_for_old_level {expected; provided})\n      >>? fun () ->\n      error_when\n        Raw_level.(expected < provided)\n        (Consensus_operation_for_future_level {expected; provided})\n\nlet check_payload_hash (apply_mode : apply_mode) ~expected ~provided =\n  match apply_mode with\n  | Application _ | Full_construction _ ->\n      error_unless\n        (Block_payload_hash.equal expected provided)\n        (Wrong_payload_hash_for_consensus_operation {expected; provided})\n  | Partial_construction _ ->\n      error_unless\n        (Block_payload_hash.equal expected provided)\n        (Consensus_operation_on_competing_proposal {expected; provided})\n\nlet check_operation_branch ~expected ~provided =\n  error_unless\n    (Block_hash.equal expected provided)\n    (Wrong_consensus_operation_branch (expected, provided))\n\nlet check_round (type kind) (operation_kind : kind consensus_operation_type)\n    (apply_mode : apply_mode) ~(expected : Round.t) ~(provided : Round.t) :\n    unit tzresult =\n  match apply_mode with\n  | Partial_construction _ ->\n      error_when\n        Round.(expected > provided)\n        (Consensus_operation_for_old_round {expected; provided})\n      >>? fun () ->\n      error_when\n        Round.(expected < provided)\n        (Consensus_operation_for_future_round {expected; provided})\n  | Full_construction {round; _} | Application {round; _} ->\n      (match operation_kind with\n      | Preendorsement ->\n          error_when\n            Round.(round <= provided)\n            (Preendorsement_round_too_high {block_round = round; provided})\n      | Endorsement -> Result.return_unit)\n      >>? fun () ->\n      error_unless\n        (Round.equal expected provided)\n        (Wrong_round_for_consensus_operation {expected; provided})\n\nlet check_consensus_content (type kind) (apply_mode : apply_mode)\n    (content : consensus_content) (operation_branch : Block_hash.t)\n    (operation_kind : kind consensus_operation_type)\n    (expected_content : kind expected_consensus_content) : unit tzresult =\n  let expected_level = expected_content.level.level in\n  let provided_level = content.level in\n  let expected_round = expected_content.round in\n  let provided_round = content.round in\n  check_level apply_mode ~expected:expected_level ~provided:provided_level\n  >>? fun () ->\n  check_round\n    operation_kind\n    apply_mode\n    ~expected:expected_round\n    ~provided:provided_round\n  >>? fun () ->\n  check_operation_branch\n    ~expected:expected_content.branch\n    ~provided:operation_branch\n  >>? fun () ->\n  check_payload_hash\n    apply_mode\n    ~expected:expected_content.payload_hash\n    ~provided:content.block_payload_hash\n\n(* Validate the 'operation.shell.branch' field of the operation. It MUST point\n   to the grandfather: the block hash used in the payload_hash. Otherwise we could produce\n   a preendorsement pointing to the direct proposal. This preendorsement wouldn't be able to\n   propagate for a subsequent proposal using it as a locked_round evidence. *)\nlet validate_consensus_contents (type kind) ctxt chain_id\n    (operation_kind : kind consensus_operation_type)\n    (operation : kind operation) (apply_mode : apply_mode)\n    (content : consensus_content) :\n    (context * public_key_hash * int) tzresult Lwt.t =\n  let current_level = Level.current ctxt in\n  let proposal_level = get_predecessor_level apply_mode in\n  let slot_map =\n    match operation_kind with\n    | Preendorsement -> Consensus.allowed_preendorsements ctxt\n    | Endorsement -> Consensus.allowed_endorsements ctxt\n  in\n  compute_expected_consensus_content\n    ~current_level\n    ~proposal_level\n    ctxt\n    apply_mode\n    operation_kind\n    content.round\n    content.level\n  >>=? fun (ctxt, expected_content) ->\n  check_consensus_content\n    apply_mode\n    content\n    operation.shell.branch\n    operation_kind\n    expected_content\n  >>?= fun () ->\n  match Slot.Map.find content.slot slot_map with\n  | None -> fail Wrong_slot_used_for_consensus_operation\n  | Some (delegate_pk, delegate_pkh, voting_power) ->\n      Delegate.frozen_deposits ctxt delegate_pkh >>=? fun frozen_deposits ->\n      fail_unless\n        Tez.(frozen_deposits.current_amount > zero)\n        (Zero_frozen_deposits delegate_pkh)\n      >>=? fun () ->\n      Operation.check_signature delegate_pk chain_id operation >>?= fun () ->\n      return (ctxt, delegate_pkh, voting_power)\n\nlet apply_manager_contents_list ctxt mode ~payload_producer chain_id\n    prechecked_contents_list =\n  apply_manager_contents_list_rec\n    ctxt\n    mode\n    ~payload_producer\n    chain_id\n    prechecked_contents_list\n  >>= fun (ctxt_result, results) ->\n  match ctxt_result with\n  | Failure -> Lwt.return (ctxt (* backtracked *), mark_backtracked results)\n  | Success ctxt ->\n      Lazy_storage.cleanup_temporaries ctxt >|= fun ctxt -> (ctxt, results)\n\nlet check_denunciation_age ctxt kind given_level =\n  let max_slashing_period = Constants.max_slashing_period ctxt in\n  let current_cycle = (Level.current ctxt).cycle in\n  let given_cycle = (Level.from_raw ctxt given_level).cycle in\n  let last_slashable_cycle = Cycle.add given_cycle max_slashing_period in\n  fail_when\n    Cycle.(given_cycle > current_cycle)\n    (Too_early_denunciation\n       {kind; level = given_level; current = (Level.current ctxt).level})\n  >>=? fun () ->\n  fail_unless\n    Cycle.(last_slashable_cycle > current_cycle)\n    (Outdated_denunciation\n       {kind; level = given_level; last_cycle = last_slashable_cycle})\n\nlet punish_delegate ctxt delegate level mistake mk_result ~payload_producer =\n  let (already_slashed, punish) =\n    match mistake with\n    | `Double_baking ->\n        ( Delegate.already_slashed_for_double_baking,\n          Delegate.punish_double_baking )\n    | `Double_endorsing ->\n        ( Delegate.already_slashed_for_double_endorsing,\n          Delegate.punish_double_endorsing )\n  in\n  already_slashed ctxt delegate level >>=? fun slashed ->\n  fail_when slashed Unrequired_denunciation >>=? fun () ->\n  punish ctxt delegate level >>=? fun (ctxt, burned, punish_balance_updates) ->\n  (match Tez.(burned /? 2L) with\n  | Ok reward ->\n      Token.transfer\n        ctxt\n        `Double_signing_evidence_rewards\n        (`Contract (Contract.implicit_contract payload_producer))\n        reward\n  | Error _ -> (* reward is Tez.zero *) return (ctxt, []))\n  >|=? fun (ctxt, reward_balance_updates) ->\n  let balance_updates = reward_balance_updates @ punish_balance_updates in\n  (ctxt, Single_result (mk_result balance_updates))\n\nlet punish_double_endorsement_or_preendorsement (type kind) ctxt ~chain_id\n    ~preendorsement ~(op1 : kind Kind.consensus Operation.t)\n    ~(op2 : kind Kind.consensus Operation.t) ~payload_producer :\n    (t * kind Kind.double_consensus_operation_evidence contents_result_list)\n    tzresult\n    Lwt.t =\n  let mk_result (balance_updates : Receipt.balance_updates) :\n      kind Kind.double_consensus_operation_evidence contents_result =\n    match op1.protocol_data.contents with\n    | Single (Preendorsement _) ->\n        Double_preendorsement_evidence_result balance_updates\n    | Single (Endorsement _) ->\n        Double_endorsement_evidence_result balance_updates\n  in\n  match (op1.protocol_data.contents, op2.protocol_data.contents) with\n  | (Single (Preendorsement e1), Single (Preendorsement e2))\n  | (Single (Endorsement e1), Single (Endorsement e2)) ->\n      let kind = if preendorsement then Preendorsement else Endorsement in\n      let op1_hash = Operation.hash op1 in\n      let op2_hash = Operation.hash op2 in\n      fail_unless\n        (Raw_level.(e1.level = e2.level)\n        && Round.(e1.round = e2.round)\n        && (not\n              (Block_payload_hash.equal\n                 e1.block_payload_hash\n                 e2.block_payload_hash))\n        && (* we require an order on hashes to avoid the existence of\n              equivalent evidences *)\n        Operation_hash.(op1_hash < op2_hash))\n        (Invalid_denunciation kind)\n      >>=? fun () ->\n      (* Disambiguate: levels are equal *)\n      let level = Level.from_raw ctxt e1.level in\n      check_denunciation_age ctxt kind level.level >>=? fun () ->\n      Stake_distribution.slot_owner ctxt level e1.slot\n      >>=? fun (ctxt, (delegate1_pk, delegate1)) ->\n      Stake_distribution.slot_owner ctxt level e2.slot\n      >>=? fun (ctxt, (_delegate2_pk, delegate2)) ->\n      fail_unless\n        (Signature.Public_key_hash.equal delegate1 delegate2)\n        (Inconsistent_denunciation {kind; delegate1; delegate2})\n      >>=? fun () ->\n      let (delegate_pk, delegate) = (delegate1_pk, delegate1) in\n      Operation.check_signature delegate_pk chain_id op1 >>?= fun () ->\n      Operation.check_signature delegate_pk chain_id op2 >>?= fun () ->\n      punish_delegate\n        ctxt\n        delegate\n        level\n        `Double_endorsing\n        mk_result\n        ~payload_producer\n\nlet punish_double_baking ctxt chain_id bh1 bh2 ~payload_producer =\n  let hash1 = Block_header.hash bh1 in\n  let hash2 = Block_header.hash bh2 in\n  Fitness.from_raw bh1.shell.fitness >>?= fun bh1_fitness ->\n  let round1 = Fitness.round bh1_fitness in\n  Fitness.from_raw bh2.shell.fitness >>?= fun bh2_fitness ->\n  let round2 = Fitness.round bh2_fitness in\n  ( Raw_level.of_int32 bh1.shell.level >>?= fun level1 ->\n    Raw_level.of_int32 bh2.shell.level >>?= fun level2 ->\n    fail_unless\n      (Compare.Int32.(bh1.shell.level = bh2.shell.level)\n      && Round.(round1 = round2)\n      && (* we require an order on hashes to avoid the existence of\n            equivalent evidences *)\n      Block_hash.(hash1 < hash2))\n      (Invalid_double_baking_evidence\n         {hash1; level1; round1; hash2; level2; round2}) )\n  >>=? fun () ->\n  Raw_level.of_int32 bh1.shell.level >>?= fun raw_level ->\n  check_denunciation_age ctxt Block raw_level >>=? fun () ->\n  let level = Level.from_raw ctxt raw_level in\n  let committee_size = Constants.consensus_committee_size ctxt in\n  Round.to_slot round1 ~committee_size >>?= fun slot1 ->\n  Stake_distribution.slot_owner ctxt level slot1\n  >>=? fun (ctxt, (delegate1_pk, delegate1)) ->\n  Round.to_slot round2 ~committee_size >>?= fun slot2 ->\n  Stake_distribution.slot_owner ctxt level slot2\n  >>=? fun (ctxt, (_delegate2_pk, delegate2)) ->\n  fail_unless\n    Signature.Public_key_hash.(delegate1 = delegate2)\n    (Inconsistent_denunciation {kind = Block; delegate1; delegate2})\n  >>=? fun () ->\n  let (delegate_pk, delegate) = (delegate1_pk, delegate1) in\n  Block_header.check_signature bh1 chain_id delegate_pk >>?= fun () ->\n  Block_header.check_signature bh2 chain_id delegate_pk >>?= fun () ->\n  punish_delegate\n    ctxt\n    delegate\n    level\n    `Double_baking\n    ~payload_producer\n    (fun balance_updates -> Double_baking_evidence_result balance_updates)\n\nlet is_parent_endorsement ctxt ~proposal_level ~grand_parent_round\n    (operation : 'a operation) (operation_content : consensus_content) =\n  match Consensus.grand_parent_branch ctxt with\n  | None -> false\n  | Some (great_grand_parent_hash, grand_parent_payload_hash) ->\n      (* Check level *)\n      Raw_level.(proposal_level.Level.level = succ operation_content.level)\n      (* Check round *)\n      && Round.(grand_parent_round = operation_content.round)\n      (* Check payload *)\n      && Block_payload_hash.(\n           grand_parent_payload_hash = operation_content.block_payload_hash)\n      && (* Check branch *)\n      Block_hash.(great_grand_parent_hash = operation.shell.branch)\n\nlet validate_grand_parent_endorsement ctxt chain_id\n    (op : Kind.endorsement operation) =\n  match op.protocol_data.contents with\n  | Single (Endorsement e) ->\n      let level = Level.from_raw ctxt e.level in\n      Stake_distribution.slot_owner ctxt level e.slot\n      >>=? fun (ctxt, (delegate_pk, pkh)) ->\n      Operation.check_signature delegate_pk chain_id op >>?= fun () ->\n      Consensus.record_grand_parent_endorsement ctxt pkh >>?= fun ctxt ->\n      return\n        ( ctxt,\n          Single_result\n            (Endorsement_result\n               {\n                 balance_updates = [];\n                 delegate = pkh;\n                 endorsement_power =\n                   0 (* dummy endorsement power: this will never be used *);\n               }) )\n\nlet apply_contents_list (type kind) ctxt chain_id (apply_mode : apply_mode) mode\n    ~payload_producer (operation : kind operation)\n    (contents_list : kind contents_list) :\n    (context * kind contents_result_list) tzresult Lwt.t =\n  let mempool_mode =\n    match apply_mode with\n    | Partial_construction _ -> true\n    | Full_construction _ | Application _ -> false\n  in\n  match[@coq_match_with_default] contents_list with\n  | Single (Preendorsement consensus_content) ->\n      validate_consensus_contents\n        ctxt\n        chain_id\n        Preendorsement\n        operation\n        apply_mode\n        consensus_content\n      >>=? fun (ctxt, delegate, voting_power) ->\n      Consensus.record_preendorsement\n        ctxt\n        ~initial_slot:consensus_content.slot\n        ~power:voting_power\n        consensus_content.round\n      >>?= fun ctxt ->\n      return\n        ( ctxt,\n          Single_result\n            (Preendorsement_result\n               {\n                 balance_updates = [];\n                 delegate;\n                 preendorsement_power = voting_power;\n               }) )\n  | Single (Endorsement consensus_content) -> (\n      let proposal_level = get_predecessor_level apply_mode in\n      match apply_mode with\n      | Partial_construction {grand_parent_round; _}\n        when is_parent_endorsement\n               ctxt\n               ~proposal_level\n               ~grand_parent_round\n               operation\n               consensus_content ->\n          validate_grand_parent_endorsement ctxt chain_id operation\n      | _ ->\n          validate_consensus_contents\n            ctxt\n            chain_id\n            Endorsement\n            operation\n            apply_mode\n            consensus_content\n          >>=? fun (ctxt, delegate, voting_power) ->\n          Consensus.record_endorsement\n            ctxt\n            ~initial_slot:consensus_content.slot\n            ~power:voting_power\n          >>?= fun ctxt ->\n          return\n            ( ctxt,\n              Single_result\n                (Endorsement_result\n                   {\n                     balance_updates = [];\n                     delegate;\n                     endorsement_power = voting_power;\n                   }) ))\n  | Single (Seed_nonce_revelation {level; nonce}) ->\n      let level = Level.from_raw ctxt level in\n      Nonce.reveal ctxt level nonce >>=? fun ctxt ->\n      let tip = Constants.seed_nonce_revelation_tip ctxt in\n      let contract = Contract.implicit_contract payload_producer in\n      Token.transfer ctxt `Revelation_rewards (`Contract contract) tip\n      >|=? fun (ctxt, balance_updates) ->\n      (ctxt, Single_result (Seed_nonce_revelation_result balance_updates))\n  | Single (Double_preendorsement_evidence {op1; op2}) ->\n      punish_double_endorsement_or_preendorsement\n        ctxt\n        ~preendorsement:true\n        ~chain_id\n        ~op1\n        ~op2\n        ~payload_producer\n  | Single (Double_endorsement_evidence {op1; op2}) ->\n      punish_double_endorsement_or_preendorsement\n        ctxt\n        ~preendorsement:false\n        ~chain_id\n        ~op1\n        ~op2\n        ~payload_producer\n  | Single (Double_baking_evidence {bh1; bh2}) ->\n      punish_double_baking ctxt chain_id bh1 bh2 ~payload_producer\n  | Single (Activate_account {id = pkh; activation_code}) ->\n      let blinded_pkh =\n        Blinded_public_key_hash.of_ed25519_pkh activation_code pkh\n      in\n      let src = `Collected_commitments blinded_pkh in\n      Token.allocated ctxt src >>=? fun src_exists ->\n      fail_unless src_exists (Invalid_activation {pkh}) >>=? fun _ ->\n      let contract = Contract.implicit_contract (Signature.Ed25519 pkh) in\n      Token.balance ctxt src >>=? fun amount ->\n      Token.transfer ctxt src (`Contract contract) amount\n      >>=? fun (ctxt, bupds) ->\n      return (ctxt, Single_result (Activate_account_result bupds))\n  | Single (Proposals {source; period; proposals}) ->\n      Delegate.pubkey ctxt source >>=? fun delegate ->\n      Operation.check_signature delegate chain_id operation >>?= fun () ->\n      Voting_period.get_current ctxt >>=? fun {index = current_period; _} ->\n      error_unless\n        Compare.Int32.(current_period = period)\n        (Wrong_voting_period (current_period, period))\n      >>?= fun () ->\n      Amendment.record_proposals ctxt source proposals >|=? fun ctxt ->\n      (ctxt, Single_result Proposals_result)\n  | Single (Ballot {source; period; proposal; ballot}) ->\n      Delegate.pubkey ctxt source >>=? fun delegate ->\n      Operation.check_signature delegate chain_id operation >>?= fun () ->\n      Voting_period.get_current ctxt >>=? fun {index = current_period; _} ->\n      error_unless\n        Compare.Int32.(current_period = period)\n        (Wrong_voting_period (current_period, period))\n      >>?= fun () ->\n      Amendment.record_ballot ctxt source proposal ballot >|=? fun ctxt ->\n      (ctxt, Single_result Ballot_result)\n  | Single (Failing_noop _) ->\n      (* Failing_noop _ always fails *)\n      fail Failing_noop_error\n  | Single (Manager_operation _) as op ->\n      precheck_manager_contents_list ctxt op ~mempool_mode\n      >>=? fun (ctxt, prechecked_contents_list) ->\n      check_manager_signature ctxt chain_id op operation >>=? fun () ->\n      apply_manager_contents_list\n        ctxt\n        mode\n        ~payload_producer\n        chain_id\n        prechecked_contents_list\n      >|= ok\n  | Cons (Manager_operation _, _) as op ->\n      precheck_manager_contents_list ctxt op ~mempool_mode\n      >>=? fun (ctxt, prechecked_contents_list) ->\n      check_manager_signature ctxt chain_id op operation >>=? fun () ->\n      apply_manager_contents_list\n        ctxt\n        mode\n        ~payload_producer\n        chain_id\n        prechecked_contents_list\n      >|= ok\n\nlet apply_operation ctxt chain_id (apply_mode : apply_mode) mode\n    ~payload_producer hash operation =\n  let ctxt = Contract.init_origination_nonce ctxt hash in\n  let ctxt = record_operation ctxt operation in\n  apply_contents_list\n    ctxt\n    chain_id\n    apply_mode\n    mode\n    ~payload_producer\n    operation\n    operation.protocol_data.contents\n  >|=? fun (ctxt, result) ->\n  let ctxt = Gas.set_unlimited ctxt in\n  let ctxt = Contract.unset_origination_nonce ctxt in\n  (ctxt, {contents = result})\n\nlet may_start_new_cycle ctxt =\n  match Level.dawn_of_a_new_cycle ctxt with\n  | None -> return (ctxt, [], [])\n  | Some last_cycle ->\n      Seed.cycle_end ctxt last_cycle >>=? fun (ctxt, unrevealed) ->\n      Delegate.cycle_end ctxt last_cycle unrevealed\n      >>=? fun (ctxt, balance_updates, deactivated) ->\n      Bootstrap.cycle_end ctxt last_cycle >|=? fun ctxt ->\n      (ctxt, balance_updates, deactivated)\n\nlet init_allowed_consensus_operations ctxt ~endorsement_level\n    ~preendorsement_level =\n  Delegate.prepare_stake_distribution ctxt >>=? fun ctxt ->\n  (if Level.(endorsement_level = preendorsement_level) then\n   Baking.endorsing_rights_by_first_slot ctxt endorsement_level\n   >>=? fun (ctxt, slots) ->\n   let consensus_operations = slots in\n   return (ctxt, consensus_operations, consensus_operations)\n  else\n    Baking.endorsing_rights_by_first_slot ctxt endorsement_level\n    >>=? fun (ctxt, endorsements_slots) ->\n    let endorsements = endorsements_slots in\n    Baking.endorsing_rights_by_first_slot ctxt preendorsement_level\n    >>=? fun (ctxt, preendorsements_slots) ->\n    let preendorsements = preendorsements_slots in\n    return (ctxt, endorsements, preendorsements))\n  >>=? fun (ctxt, allowed_endorsements, allowed_preendorsements) ->\n  return\n    (Consensus.initialize_consensus_operation\n       ctxt\n       ~allowed_endorsements\n       ~allowed_preendorsements)\n\nlet apply_liquidity_baking_subsidy ctxt ~escape_vote =\n  Liquidity_baking.on_subsidy_allowed\n    ctxt\n    ~escape_vote\n    (fun ctxt liquidity_baking_cpmm_contract ->\n      let ctxt =\n        (* We set a gas limit of 1/20th the block limit, which is ~10x\n           actual usage here in Granada. Gas consumed is reported in\n           the Transaction receipt, but not counted towards the block\n           limit. The gas limit is reset to unlimited at the end of\n           this function.*)\n        Gas.set_limit\n          ctxt\n          (Gas.Arith.integral_exn\n             (Z.div\n                (Gas.Arith.integral_to_z\n                   (Constants.hard_gas_limit_per_block ctxt))\n                (Z.of_int 20)))\n      in\n      let backtracking_ctxt = ctxt in\n      (let liquidity_baking_subsidy = Constants.liquidity_baking_subsidy ctxt in\n       (* credit liquidity baking subsidy to CPMM contract *)\n       Token.transfer\n         ~origin:Subsidy\n         ctxt\n         `Liquidity_baking_subsidies\n         (`Contract liquidity_baking_cpmm_contract)\n         liquidity_baking_subsidy\n       >>=? fun (ctxt, balance_updates) ->\n       Script_cache.find ctxt liquidity_baking_cpmm_contract\n       >>=? fun (ctxt, cache_key, script) ->\n       match script with\n       | None -> fail (Script_tc_errors.No_such_entrypoint \"default\")\n       | Some (script, script_ir) -> (\n           let now = Script_timestamp.now ctxt in\n           let level =\n             (Level.current ctxt).level |> Raw_level.to_int32\n             |> Script_int.of_int32 |> Script_int.abs\n           in\n           let step_constants =\n             let open Script_interpreter in\n             (* Using dummy values for source, payer, and chain_id\n                since they are not used within the CPMM default\n                entrypoint. *)\n             {\n               source = liquidity_baking_cpmm_contract;\n               payer = liquidity_baking_cpmm_contract;\n               self = liquidity_baking_cpmm_contract;\n               amount = liquidity_baking_subsidy;\n               chain_id = Chain_id.zero;\n               now;\n               level;\n             }\n           in\n           let parameter =\n             Micheline.strip_locations\n               Michelson_v1_primitives.(Prim (0, D_Unit, [], []))\n           in\n           (*\n                 Call CPPM default entrypoint with parameter Unit.\n                 This is necessary for the CPMM's xtz_pool in storage to\n                 increase since it cannot use BALANCE due to a transfer attack.\n\n                 Mimicks a transaction.\n\n                 There is no:\n                 - storage burn (extra storage is free)\n                 - fees (the operation is mandatory)\n          *)\n           Script_interpreter.execute\n             ctxt\n             Optimized\n             step_constants\n             ~script\n             ~parameter\n             ~cached_script:(Some script_ir)\n             ~entrypoint:\"default\"\n             ~internal:false\n           >>=? fun ( {ctxt; storage; lazy_storage_diff; operations},\n                      (updated_cached_script, updated_size) ) ->\n           match operations with\n           | _ :: _ ->\n               (* No internal operations are expected here. Something bad may be happening. *)\n               return (backtracking_ctxt, [])\n           | [] ->\n               (* update CPMM storage *)\n               Contract.update_script_storage\n                 ctxt\n                 liquidity_baking_cpmm_contract\n                 storage\n                 lazy_storage_diff\n               >>=? fun ctxt ->\n               Fees.record_paid_storage_space\n                 ctxt\n                 liquidity_baking_cpmm_contract\n               >>=? fun (ctxt, new_size, paid_storage_size_diff) ->\n               let consumed_gas =\n                 Gas.consumed ~since:backtracking_ctxt ~until:ctxt\n               in\n               Script_cache.update\n                 ctxt\n                 cache_key\n                 ( {script with storage = Script.lazy_expr storage},\n                   updated_cached_script )\n                 updated_size\n               >>?= fun ctxt ->\n               let result =\n                 Transaction_result\n                   {\n                     storage = Some storage;\n                     lazy_storage_diff;\n                     balance_updates;\n                     (* At this point in application the origination nonce has not been initialized so it's not possible to originate new contracts. We've checked above that none were originated. *)\n                     originated_contracts = [];\n                     consumed_gas;\n                     storage_size = new_size;\n                     paid_storage_size_diff;\n                     allocated_destination_contract = false;\n                   }\n               in\n               let ctxt = Gas.set_unlimited ctxt in\n               return (ctxt, [Successful_manager_result result])))\n      >|= function\n      | Ok (ctxt, results) -> Ok (ctxt, results)\n      | Error _ ->\n          (* Do not fail if something bad happens during CPMM contract call. *)\n          let ctxt = Gas.set_unlimited backtracking_ctxt in\n          Ok (ctxt, []))\n\ntype 'a full_construction = {\n  ctxt : t;\n  protocol_data : 'a;\n  payload_producer : Signature.public_key_hash;\n  block_producer : Signature.public_key_hash;\n  round : Round.t;\n  implicit_operations_results : packed_successful_manager_operation_result list;\n  liquidity_baking_escape_ema : Liquidity_baking.escape_ema;\n}\n\nlet begin_full_construction ctxt ~predecessor_timestamp ~predecessor_level\n    ~predecessor_round ~round protocol_data =\n  let round_durations = Constants.round_durations ctxt in\n  let timestamp = Timestamp.current ctxt in\n  Block_header.check_timestamp\n    round_durations\n    ~timestamp\n    ~round\n    ~predecessor_timestamp\n    ~predecessor_round\n  >>?= fun () ->\n  let current_level = Level.current ctxt in\n  Stake_distribution.baking_rights_owner ctxt current_level ~round\n  >>=? fun (ctxt, _slot, (_block_producer_pk, block_producer)) ->\n  Delegate.frozen_deposits ctxt block_producer >>=? fun frozen_deposits ->\n  fail_unless\n    Tez.(frozen_deposits.current_amount > zero)\n    (Zero_frozen_deposits block_producer)\n  >>=? fun () ->\n  Stake_distribution.baking_rights_owner\n    ctxt\n    current_level\n    ~round:protocol_data.Block_header.payload_round\n  >>=? fun (ctxt, _slot, (_payload_producer_pk, payload_producer)) ->\n  init_allowed_consensus_operations\n    ctxt\n    ~endorsement_level:predecessor_level\n    ~preendorsement_level:current_level\n  >>=? fun ctxt ->\n  let escape_vote = protocol_data.liquidity_baking_escape_vote in\n  apply_liquidity_baking_subsidy ctxt ~escape_vote\n  >|=? fun ( ctxt,\n             liquidity_baking_operations_results,\n             liquidity_baking_escape_ema ) ->\n  {\n    ctxt;\n    protocol_data;\n    payload_producer;\n    block_producer;\n    round;\n    implicit_operations_results = liquidity_baking_operations_results;\n    liquidity_baking_escape_ema;\n  }\n\nlet begin_partial_construction ctxt ~predecessor_level ~escape_vote =\n  (* In the mempool, only consensus operations for [predecessor_level]\n     (that is, head's level) are allowed, contrary to block validation\n     where endorsements are for the previous level and\n     preendorsements, if any, for the block's level. *)\n  init_allowed_consensus_operations\n    ctxt\n    ~endorsement_level:predecessor_level\n    ~preendorsement_level:predecessor_level\n  >>=? fun ctxt -> apply_liquidity_baking_subsidy ctxt ~escape_vote\n\nlet begin_application ctxt chain_id (block_header : Block_header.t) fitness\n    ~predecessor_timestamp ~predecessor_level ~predecessor_round =\n  let round = Fitness.round fitness in\n  let current_level = Level.current ctxt in\n  Stake_distribution.baking_rights_owner ctxt current_level ~round\n  >>=? fun (ctxt, _slot, (block_producer_pk, block_producer)) ->\n  let round_durations = Constants.round_durations ctxt in\n  let timestamp = block_header.shell.timestamp in\n  Block_header.begin_validate_block_header\n    ~block_header\n    ~chain_id\n    ~predecessor_timestamp\n    ~predecessor_round\n    ~fitness\n    ~timestamp\n    ~delegate_pk:block_producer_pk\n    ~round_durations\n    ~proof_of_work_threshold:(Constants.proof_of_work_threshold ctxt)\n    ~expected_commitment:current_level.expected_commitment\n  >>?= fun () ->\n  Delegate.frozen_deposits ctxt block_producer >>=? fun frozen_deposits ->\n  fail_unless\n    Tez.(frozen_deposits.current_amount > zero)\n    (Zero_frozen_deposits block_producer)\n  >>=? fun () ->\n  Stake_distribution.baking_rights_owner\n    ctxt\n    current_level\n    ~round:block_header.protocol_data.contents.payload_round\n  >>=? fun (ctxt, _slot, (payload_producer_pk, _payload_producer)) ->\n  init_allowed_consensus_operations\n    ctxt\n    ~endorsement_level:predecessor_level\n    ~preendorsement_level:current_level\n  >>=? fun ctxt ->\n  let escape_vote =\n    block_header.Block_header.protocol_data.contents\n      .liquidity_baking_escape_vote\n  in\n  apply_liquidity_baking_subsidy ctxt ~escape_vote\n  >|=? fun ( ctxt,\n             liquidity_baking_operations_results,\n             liquidity_baking_escape_ema ) ->\n  ( ctxt,\n    payload_producer_pk,\n    block_producer,\n    liquidity_baking_operations_results,\n    liquidity_baking_escape_ema )\n\ntype finalize_application_mode =\n  | Finalize_full_construction of {\n      level : Raw_level.t;\n      predecessor_round : Round.t;\n    }\n  | Finalize_application of Fitness.t\n\nlet compute_payload_hash (ctxt : Alpha_context.t) ~(predecessor : Block_hash.t)\n    ~(payload_round : Round.t) : Block_payload_hash.t =\n  let non_consensus_operations = non_consensus_operations ctxt in\n  let operations_hash = Operation_list_hash.compute non_consensus_operations in\n  Block_payload.hash ~predecessor payload_round operations_hash\n\nlet are_endorsements_required ctxt ~level =\n  Alpha_context.First_level_of_tenderbake.get ctxt\n  >|=? fun first_Tenderbake_level ->\n  (* NB: the first level is the level of the migration block. This\n     block was proposed by an Emmy* baker. There are no\n     endorsements for this block. Therefore the block at the next\n     level cannot contain endorsements. *)\n  let tenderbake_level_position = Raw_level.diff level first_Tenderbake_level in\n  Compare.Int32.(tenderbake_level_position > 1l)\n\nlet check_minimum_endorsements ~endorsing_power ~minimum =\n  fail_when\n    Compare.Int.(endorsing_power < minimum)\n    (Not_enough_endorsements\n       {required = minimum; endorsements = endorsing_power})\n\nlet finalize_application_check_validity ctxt (mode : finalize_application_mode)\n    protocol_data ~round ~predecessor ~endorsing_power ~consensus_threshold\n    ~required_endorsements =\n  (if required_endorsements then\n   check_minimum_endorsements ~endorsing_power ~minimum:consensus_threshold\n  else return_unit)\n  >>=? fun () ->\n  let block_payload_hash =\n    compute_payload_hash\n      ctxt\n      ~predecessor\n      ~payload_round:protocol_data.Block_header.payload_round\n  in\n  let locked_round_evidence =\n    Option.map\n      (fun (preendorsement_round, preendorsement_count) ->\n        Block_header.{preendorsement_round; preendorsement_count})\n      (Consensus.locked_round_evidence ctxt)\n  in\n  (match mode with\n  | Finalize_application fitness -> ok fitness\n  | Finalize_full_construction {level; predecessor_round} ->\n      let locked_round =\n        match locked_round_evidence with\n        | None -> None\n        | Some {preendorsement_round; _} -> Some preendorsement_round\n      in\n      Fitness.create ~level ~round ~predecessor_round ~locked_round)\n  >>?= fun fitness ->\n  let checkable_payload_hash : Block_header.checkable_payload_hash =\n    match mode with\n    | Finalize_application _ -> Expected_payload_hash block_payload_hash\n    | Finalize_full_construction _ -> (\n        match locked_round_evidence with\n        | Some _ -> Expected_payload_hash block_payload_hash\n        | None ->\n            (* In full construction, when there is no locked round\n               evidence (and thus no preendorsements), the baker cannot\n               know the payload hash before selecting the operations. We\n               may dismiss checking the initially given\n               payload_hash. However, to be valid, the baker must patch\n               the resulting block header with the actual payload\n               hash. *)\n            No_check)\n  in\n  Block_header.finalize_validate_block_header\n    ~block_header_contents:protocol_data\n    ~round\n    ~fitness\n    ~checkable_payload_hash\n    ~locked_round_evidence\n    ~consensus_threshold\n  >>?= fun () -> return (fitness, block_payload_hash)\n\nlet record_endorsing_participation ctxt =\n  let validators = Consensus.allowed_endorsements ctxt in\n  Slot.Map.fold_es\n    (fun initial_slot (_delegate_pk, delegate, power) ctxt ->\n      let participation =\n        if Slot.Set.mem initial_slot (Consensus.endorsements_seen ctxt) then\n          Delegate.Participated\n        else Delegate.Didn't_participate\n      in\n      Delegate.record_endorsing_participation\n        ctxt\n        ~delegate\n        ~participation\n        ~endorsing_power:power)\n    validators\n    ctxt\n\nlet finalize_application ctxt (mode : finalize_application_mode) protocol_data\n    ~payload_producer ~block_producer liquidity_baking_escape_ema\n    implicit_operations_results ~round ~predecessor ~migration_balance_updates =\n  let level = Alpha_context.Level.current ctxt in\n  let block_endorsing_power = Consensus.current_endorsement_power ctxt in\n  let consensus_threshold = Constants.consensus_threshold ctxt in\n  are_endorsements_required ctxt ~level:level.level\n  >>=? fun required_endorsements ->\n  finalize_application_check_validity\n    ctxt\n    mode\n    protocol_data\n    ~round\n    ~predecessor\n    ~endorsing_power:block_endorsing_power\n    ~consensus_threshold\n    ~required_endorsements\n  >>=? fun (fitness, block_payload_hash) ->\n  (* from this point nothing should fail *)\n  (* We mark the endorsement branch as the grand parent branch when\n     accessible. This will not be present before the first two blocks\n     of tenderbake. *)\n  (match Consensus.endorsement_branch ctxt with\n  | Some predecessor_branch ->\n      Consensus.store_grand_parent_branch ctxt predecessor_branch >>= return\n  | None -> return ctxt)\n  >>=? fun ctxt ->\n  (* We mark the current payload hash as the predecessor one => this\n     will only be accessed by the successor block now. *)\n  Consensus.store_endorsement_branch ctxt (predecessor, block_payload_hash)\n  >>= fun ctxt ->\n  Round.update ctxt round >>=? fun ctxt ->\n  (* end of level  *)\n  (match protocol_data.Block_header.seed_nonce_hash with\n  | None -> return ctxt\n  | Some nonce_hash ->\n      Nonce.record_hash ctxt {nonce_hash; delegate = block_producer})\n  >>=? fun ctxt ->\n  (if required_endorsements then\n   record_endorsing_participation ctxt >>=? fun ctxt ->\n   Baking.bonus_baking_reward ctxt ~endorsing_power:block_endorsing_power\n   >>?= fun rewards_bonus -> return (ctxt, Some rewards_bonus)\n  else return (ctxt, None))\n  >>=? fun (ctxt, reward_bonus) ->\n  let baking_reward = Constants.baking_reward_fixed_portion ctxt in\n  Delegate.record_baking_activity_and_pay_rewards_and_fees\n    ctxt\n    ~payload_producer\n    ~block_producer\n    ~baking_reward\n    ~reward_bonus\n  >>=? fun (ctxt, baking_receipts) ->\n  (* end of cycle *)\n  (if Level.may_snapshot_rolls ctxt then Stake_distribution.snapshot ctxt\n  else return ctxt)\n  >>=? fun ctxt ->\n  may_start_new_cycle ctxt\n  >>=? fun (ctxt, cycle_end_balance_updates, deactivated) ->\n  Amendment.may_start_new_voting_period ctxt >>=? fun ctxt ->\n  let balance_updates =\n    migration_balance_updates @ baking_receipts @ cycle_end_balance_updates\n  in\n  let consumed_gas =\n    Gas.Arith.sub\n      (Gas.Arith.fp @@ Constants.hard_gas_limit_per_block ctxt)\n      (Gas.block_level ctxt)\n  in\n  Voting_period.get_rpc_current_info ctxt >|=? fun voting_period_info ->\n  let receipt =\n    Apply_results.\n      {\n        proposer = payload_producer;\n        baker = block_producer;\n        level_info = level;\n        voting_period_info;\n        nonce_hash = protocol_data.seed_nonce_hash;\n        consumed_gas;\n        deactivated;\n        balance_updates;\n        liquidity_baking_escape_ema;\n        implicit_operations_results;\n      }\n  in\n  (ctxt, fitness, receipt)\n\nlet value_of_key ctxt k = Cache.Admin.value_of_key ctxt k\n" ;
                } ;
                { name = "Services_registration" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020-2021 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Functions for RPC service registration, using [Updater.rpc_context] and\n    [RPC_service.t] from the Protocol Environment.\n\n    This module is a frontend to a mutable service directory. The various\n    [register] functions update the directory as a side-effect.\n\n    The [get_rpc_services] function returns the resulting [RPC_context]. It is\n    parameterized by [Updater.rpc_context] which acts as the service prefix (in\n    practice meaning this type will be passed to each handler). Hence,\n    Protocol RPC services provide a {i read-only} view of the Ledger state.\n  *)\n\nopen Alpha_context\n\ntype rpc_context = {\n  block_hash : Block_hash.t;\n  block_header : Block_header.shell_header;\n  context : t;\n}\n\nval rpc_init : Updater.rpc_context -> rpc_context Error_monad.tzresult Lwt.t\n\nval register0 :\n  chunked:bool ->\n  ( [< RPC_service.meth],\n    Updater.rpc_context,\n    Updater.rpc_context,\n    'a,\n    'b,\n    'c )\n  RPC_service.t ->\n  (t -> 'a -> 'b -> 'c Error_monad.tzresult Lwt.t) ->\n  unit\n\nval register0_noctxt :\n  chunked:bool ->\n  ([< RPC_service.meth], Updater.rpc_context, 'a, 'b, 'c, 'd) RPC_service.t ->\n  ('b -> 'c -> 'd Error_monad.tzresult Lwt.t) ->\n  unit\n\nval register1 :\n  chunked:bool ->\n  ( [< RPC_service.meth],\n    Updater.rpc_context,\n    Updater.rpc_context * 'a,\n    'b,\n    'c,\n    'd )\n  RPC_service.t ->\n  (t -> 'a -> 'b -> 'c -> 'd Error_monad.tzresult Lwt.t) ->\n  unit\n\nval register2 :\n  chunked:bool ->\n  ( [< RPC_service.meth],\n    Updater.rpc_context,\n    (Updater.rpc_context * 'a) * 'b,\n    'c,\n    'd,\n    'e )\n  RPC_service.t ->\n  (t -> 'a -> 'b -> 'c -> 'd -> 'e Error_monad.tzresult Lwt.t) ->\n  unit\n\nval opt_register0 :\n  chunked:bool ->\n  ( [< RPC_service.meth],\n    Updater.rpc_context,\n    Updater.rpc_context,\n    'a,\n    'b,\n    'c )\n  RPC_service.t ->\n  (t -> 'a -> 'b -> 'c option Error_monad.tzresult Lwt.t) ->\n  unit\n\nval opt_register1 :\n  chunked:bool ->\n  ( [< RPC_service.meth],\n    Updater.rpc_context,\n    Updater.rpc_context * 'a,\n    'b,\n    'c,\n    'd )\n  RPC_service.t ->\n  (t -> 'a -> 'b -> 'c -> 'd option Error_monad.tzresult Lwt.t) ->\n  unit\n\nval opt_register2 :\n  chunked:bool ->\n  ( [< RPC_service.meth],\n    Updater.rpc_context,\n    (Updater.rpc_context * 'a) * 'b,\n    'c,\n    'd,\n    'e )\n  RPC_service.t ->\n  (t -> 'a -> 'b -> 'c -> 'd -> 'e option Error_monad.tzresult Lwt.t) ->\n  unit\n\nval get_rpc_services : unit -> Updater.rpc_context RPC_directory.directory\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\ntype rpc_context = {\n  block_hash : Block_hash.t;\n  block_header : Block_header.shell_header;\n  context : Alpha_context.t;\n}\n\nlet rpc_init ({block_hash; block_header; context} : Updater.rpc_context) =\n  let level = block_header.level in\n  let timestamp = block_header.timestamp in\n  Alpha_context.prepare\n    ~level\n    ~predecessor_timestamp:timestamp\n    ~timestamp\n    context\n  >|=? fun (context, _, _) -> {block_hash; block_header; context}\n\nlet rpc_services =\n  ref (RPC_directory.empty : Updater.rpc_context RPC_directory.t)\n\nlet register0_fullctxt ~chunked s f =\n  rpc_services :=\n    RPC_directory.register ~chunked !rpc_services s (fun ctxt q i ->\n        rpc_init ctxt >>=? fun ctxt -> f ctxt q i)\n\nlet register0 ~chunked s f =\n  register0_fullctxt ~chunked s (fun {context; _} -> f context)\n\nlet register0_noctxt ~chunked s f =\n  rpc_services :=\n    RPC_directory.register ~chunked !rpc_services s (fun _ q i -> f q i)\n\nlet register1_fullctxt ~chunked s f =\n  rpc_services :=\n    RPC_directory.register ~chunked !rpc_services s (fun (ctxt, arg) q i ->\n        rpc_init ctxt >>=? fun ctxt -> f ctxt arg q i)\n\nlet register1 ~chunked s f =\n  register1_fullctxt ~chunked s (fun {context; _} x -> f context x)\n\nlet register2_fullctxt ~chunked s f =\n  rpc_services :=\n    RPC_directory.register\n      ~chunked\n      !rpc_services\n      s\n      (fun ((ctxt, arg1), arg2) q i ->\n        rpc_init ctxt >>=? fun ctxt -> f ctxt arg1 arg2 q i)\n\nlet register2 ~chunked s f =\n  register2_fullctxt ~chunked s (fun {context; _} a1 a2 q i ->\n      f context a1 a2 q i)\n\nlet opt_register0_fullctxt ~chunked s f =\n  rpc_services :=\n    RPC_directory.opt_register ~chunked !rpc_services s (fun ctxt q i ->\n        rpc_init ctxt >>=? fun ctxt -> f ctxt q i)\n\nlet opt_register0 ~chunked s f =\n  opt_register0_fullctxt ~chunked s (fun {context; _} -> f context)\n\nlet opt_register1_fullctxt ~chunked s f =\n  rpc_services :=\n    RPC_directory.opt_register ~chunked !rpc_services s (fun (ctxt, arg) q i ->\n        rpc_init ctxt >>=? fun ctxt -> f ctxt arg q i)\n\nlet opt_register1 ~chunked s f =\n  opt_register1_fullctxt ~chunked s (fun {context; _} x -> f context x)\n\nlet opt_register2_fullctxt ~chunked s f =\n  rpc_services :=\n    RPC_directory.opt_register\n      ~chunked\n      !rpc_services\n      s\n      (fun ((ctxt, arg1), arg2) q i ->\n        rpc_init ctxt >>=? fun ctxt -> f ctxt arg1 arg2 q i)\n\nlet opt_register2 ~chunked s f =\n  opt_register2_fullctxt ~chunked s (fun {context; _} a1 a2 q i ->\n      f context a1 a2 q i)\n\nlet get_rpc_services () =\n  let p =\n    RPC_directory.map\n      (fun c ->\n        rpc_init c >|= function\n        | Error t ->\n            raise (Failure (Format.asprintf \"%a\" Error_monad.pp_trace t))\n        | Ok c -> c.context)\n      (Storage_description.build_directory Alpha_context.description)\n  in\n  RPC_directory.register_dynamic_directory\n    !rpc_services\n    RPC_path.(open_root / \"context\" / \"raw\" / \"json\")\n    (fun _ -> Lwt.return p)\n" ;
                } ;
                { name = "Constants_services" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\nval errors :\n  'a #RPC_context.simple -> 'a -> Data_encoding.json_schema shell_tzresult Lwt.t\n\n(** Returns all the constants of the protocol *)\nval all : 'a #RPC_context.simple -> 'a -> Constants.t shell_tzresult Lwt.t\n\nval register : unit -> unit\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\nlet custom_root =\n  (RPC_path.(open_root / \"context\" / \"constants\")\n    : RPC_context.t RPC_path.context)\n\nmodule S = struct\n  open Data_encoding\n\n  let errors =\n    RPC_service.get_service\n      ~description:\"Schema for all the RPC errors from this protocol version\"\n      ~query:RPC_query.empty\n      ~output:json_schema\n      RPC_path.(custom_root / \"errors\")\n\n  let all =\n    RPC_service.get_service\n      ~description:\"All constants\"\n      ~query:RPC_query.empty\n      ~output:Alpha_context.Constants.encoding\n      custom_root\nend\n\nlet register () =\n  let open Services_registration in\n  register0_noctxt ~chunked:true S.errors (fun () () ->\n      return Data_encoding.Json.(schema error_encoding)) ;\n  register0 ~chunked:false S.all (fun ctxt () () ->\n      return @@ Constants.all ctxt)\n\nlet errors ctxt block = RPC_context.make_call0 S.errors ctxt block () ()\n\nlet all ctxt block = RPC_context.make_call0 S.all ctxt block () ()\n" ;
                } ;
                { name = "Sapling_services" ;
                  interface = None ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2019-2020 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\nlet custom_root =\n  (RPC_path.(open_root / \"context\" / \"sapling\")\n    : RPC_context.t RPC_path.context)\n\ntype diff_query = {\n  offset_commitment : Int64.t option;\n  offset_nullifier : Int64.t option;\n}\n\nmodule S = struct\n  module Args = struct\n    type ('query_type, 'output_type) t = {\n      name : string;\n      description : string;\n      query : 'query_type RPC_query.t;\n      output : 'output_type Data_encoding.t;\n      f : context -> Sapling.Id.t -> 'query_type -> 'output_type tzresult Lwt.t;\n    }\n\n    let get_diff_query : diff_query RPC_query.t =\n      let open RPC_query in\n      query (fun offset_commitment offset_nullifier ->\n          {offset_commitment; offset_nullifier})\n      |+ opt_field\n           ~descr:\n             \"Commitments and ciphertexts are returned from the specified \\\n              offset up to the most recent.\"\n           \"offset_commitment\"\n           RPC_arg.uint63\n           (fun {offset_commitment; _} -> offset_commitment)\n      |+ opt_field\n           ~descr:\n             \"Nullifiers are returned from the specified offset up to the most \\\n              recent.\"\n           \"offset_nullifier\"\n           RPC_arg.uint63\n           (fun {offset_nullifier; _} -> offset_nullifier)\n      |> seal\n\n    let encoding =\n      let open Data_encoding in\n      merge_objs (obj1 (req \"root\" Sapling.root_encoding)) Sapling.diff_encoding\n\n    let get_diff =\n      {\n        name = \"get_diff\";\n        description =\n          \"Returns the root and a diff of a state starting from an optional \\\n           offset which is zero by default.\";\n        query = get_diff_query;\n        output = encoding;\n        f =\n          (fun ctxt id {offset_commitment; offset_nullifier} ->\n            Sapling.get_diff ctxt id ?offset_commitment ?offset_nullifier ());\n      }\n  end\n\n  let make_service Args.{name; description; query; output; f} =\n    let path = RPC_path.(custom_root /: Sapling.rpc_arg / name) in\n    let service = RPC_service.get_service ~description ~query ~output path in\n    (service, fun ctxt id q () -> f ctxt id q)\n\n  let get_diff = make_service Args.get_diff\nend\n\nlet register () =\n  let reg ~chunked (service, f) =\n    Services_registration.register1 ~chunked service f\n  in\n  reg ~chunked:false S.get_diff\n\nlet mk_call1 (service, _f) ctxt block id q =\n  RPC_context.make_call1 service ctxt block id q ()\n\nlet get_diff ctxt block id ?offset_commitment ?offset_nullifier () =\n  mk_call1 S.get_diff ctxt block id {offset_commitment; offset_nullifier}\n" ;
                } ;
                { name = "Contract_services" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2019-2020 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\nval list : 'a #RPC_context.simple -> 'a -> Contract.t list shell_tzresult Lwt.t\n\ntype info = {\n  balance : Tez.t;\n  delegate : public_key_hash option;\n  counter : counter option;\n  script : Script.t option;\n}\n\nval info_encoding : info Data_encoding.t\n\nval info :\n  'a #RPC_context.simple -> 'a -> Contract.t -> info shell_tzresult Lwt.t\n\nval balance :\n  'a #RPC_context.simple -> 'a -> Contract.t -> Tez.t shell_tzresult Lwt.t\n\nval manager_key :\n  'a #RPC_context.simple ->\n  'a ->\n  public_key_hash ->\n  public_key option shell_tzresult Lwt.t\n\nval delegate :\n  'a #RPC_context.simple ->\n  'a ->\n  Contract.t ->\n  public_key_hash shell_tzresult Lwt.t\n\nval delegate_opt :\n  'a #RPC_context.simple ->\n  'a ->\n  Contract.t ->\n  public_key_hash option shell_tzresult Lwt.t\n\nval counter :\n  'a #RPC_context.simple ->\n  'a ->\n  public_key_hash ->\n  counter shell_tzresult Lwt.t\n\nval script :\n  'a #RPC_context.simple -> 'a -> Contract.t -> Script.t shell_tzresult Lwt.t\n\nval script_opt :\n  'a #RPC_context.simple ->\n  'a ->\n  Contract.t ->\n  Script.t option shell_tzresult Lwt.t\n\nval storage :\n  'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr shell_tzresult Lwt.t\n\nval entrypoint_type :\n  'a #RPC_context.simple ->\n  'a ->\n  Contract.t ->\n  string ->\n  Script.expr shell_tzresult Lwt.t\n\nval list_entrypoints :\n  'a #RPC_context.simple ->\n  'a ->\n  Contract.t ->\n  (Michelson_v1_primitives.prim list list * (string * Script.expr) list)\n  shell_tzresult\n  Lwt.t\n\nval storage_opt :\n  'a #RPC_context.simple ->\n  'a ->\n  Contract.t ->\n  Script.expr option shell_tzresult Lwt.t\n\nval big_map_get :\n  'a #RPC_context.simple ->\n  'a ->\n  Big_map.Id.t ->\n  Script_expr_hash.t ->\n  Script.expr shell_tzresult Lwt.t\n\nval contract_big_map_get_opt :\n  'a #RPC_context.simple ->\n  'a ->\n  Contract.t ->\n  Script.expr * Script.expr ->\n  Script.expr option shell_tzresult Lwt.t\n\nval single_sapling_get_diff :\n  'a #RPC_context.simple ->\n  'a ->\n  Contract.t ->\n  ?offset_commitment:int64 ->\n  ?offset_nullifier:int64 ->\n  unit ->\n  (Sapling.root * Sapling.diff) shell_tzresult Lwt.t\n\nval register : unit -> unit\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2019-2020 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\nlet custom_root =\n  (RPC_path.(open_root / \"context\" / \"contracts\")\n    : RPC_context.t RPC_path.context)\n\nlet big_map_root =\n  (RPC_path.(open_root / \"context\" / \"big_maps\")\n    : RPC_context.t RPC_path.context)\n\ntype info = {\n  balance : Tez.t;\n  delegate : public_key_hash option;\n  counter : counter option;\n  script : Script.t option;\n}\n\nlet info_encoding =\n  let open Data_encoding in\n  conv\n    (fun {balance; delegate; script; counter} ->\n      (balance, delegate, script, counter))\n    (fun (balance, delegate, script, counter) ->\n      {balance; delegate; script; counter})\n  @@ obj4\n       (req \"balance\" Tez.encoding)\n       (opt \"delegate\" Signature.Public_key_hash.encoding)\n       (opt \"script\" Script.encoding)\n       (opt \"counter\" n)\n\nmodule S = struct\n  open Data_encoding\n\n  let balance =\n    RPC_service.get_service\n      ~description:\"Access the balance of a contract.\"\n      ~query:RPC_query.empty\n      ~output:Tez.encoding\n      RPC_path.(custom_root /: Contract.rpc_arg / \"balance\")\n\n  let manager_key =\n    RPC_service.get_service\n      ~description:\"Access the manager of a contract.\"\n      ~query:RPC_query.empty\n      ~output:(option Signature.Public_key.encoding)\n      RPC_path.(custom_root /: Contract.rpc_arg / \"manager_key\")\n\n  let delegate =\n    RPC_service.get_service\n      ~description:\"Access the delegate of a contract, if any.\"\n      ~query:RPC_query.empty\n      ~output:Signature.Public_key_hash.encoding\n      RPC_path.(custom_root /: Contract.rpc_arg / \"delegate\")\n\n  let counter =\n    RPC_service.get_service\n      ~description:\"Access the counter of a contract, if any.\"\n      ~query:RPC_query.empty\n      ~output:z\n      RPC_path.(custom_root /: Contract.rpc_arg / \"counter\")\n\n  let script =\n    RPC_service.get_service\n      ~description:\"Access the code and data of the contract.\"\n      ~query:RPC_query.empty\n      ~output:Script.encoding\n      RPC_path.(custom_root /: Contract.rpc_arg / \"script\")\n\n  let storage =\n    RPC_service.get_service\n      ~description:\"Access the data of the contract.\"\n      ~query:RPC_query.empty\n      ~output:Script.expr_encoding\n      RPC_path.(custom_root /: Contract.rpc_arg / \"storage\")\n\n  let entrypoint_type =\n    RPC_service.get_service\n      ~description:\"Return the type of the given entrypoint of the contract\"\n      ~query:RPC_query.empty\n      ~output:Script.expr_encoding\n      RPC_path.(\n        custom_root /: Contract.rpc_arg / \"entrypoints\" /: RPC_arg.string)\n\n  let list_entrypoints =\n    RPC_service.get_service\n      ~description:\"Return the list of entrypoints of the contract\"\n      ~query:RPC_query.empty\n      ~output:\n        (obj2\n           (dft\n              \"unreachable\"\n              (Data_encoding.list\n                 (obj1\n                    (req\n                       \"path\"\n                       (Data_encoding.list\n                          Michelson_v1_primitives.prim_encoding))))\n              [])\n           (req \"entrypoints\" (assoc Script.expr_encoding)))\n      RPC_path.(custom_root /: Contract.rpc_arg / \"entrypoints\")\n\n  let contract_big_map_get_opt =\n    RPC_service.post_service\n      ~description:\n        \"Access the value associated with a key in a big map of the contract \\\n         (deprecated).\"\n      ~query:RPC_query.empty\n      ~input:\n        (obj2\n           (req \"key\" Script.expr_encoding)\n           (req \"type\" Script.expr_encoding))\n      ~output:(option Script.expr_encoding)\n      RPC_path.(custom_root /: Contract.rpc_arg / \"big_map_get\")\n\n  let big_map_get =\n    RPC_service.get_service\n      ~description:\"Access the value associated with a key in a big map.\"\n      ~query:RPC_query.empty\n      ~output:Script.expr_encoding\n      RPC_path.(big_map_root /: Big_map.Id.rpc_arg /: Script_expr_hash.rpc_arg)\n\n  type big_map_get_all_query = {offset : int option; length : int option}\n\n  let rpc_arg_uint : int RPC_arg.t =\n    let int_of_string s =\n      int_of_string_opt s\n      |> Option.to_result\n           ~none:(Format.sprintf \"Cannot parse integer value %s\" s)\n      >>? fun i ->\n      if Compare.Int.(i < 0) then\n        Error (Format.sprintf \"Negative integer: %d\" i)\n      else Ok i\n    in\n    RPC_arg.make\n      ~name:\"uint\"\n      ~descr:\"A non-negative integer (greater than or equal to 0).\"\n      ~destruct:int_of_string\n      ~construct:string_of_int\n      ()\n\n  let big_map_get_all_query : big_map_get_all_query RPC_query.t =\n    let open RPC_query in\n    query (fun offset length -> {offset; length})\n    |+ opt_field\n         ~descr:\n           \"Skip the first [offset] values. Useful in combination with \\\n            [length] for pagination.\"\n         \"offset\"\n         rpc_arg_uint\n         (fun t -> t.offset)\n    |+ opt_field\n         ~descr:\n           \"Only retrieve [length] values. Useful in combination with [offset] \\\n            for pagination.\"\n         \"length\"\n         rpc_arg_uint\n         (fun t -> t.length)\n    |> seal\n\n  let big_map_get_all =\n    RPC_service.get_service\n      ~description:\n        \"Get the (optionally paginated) list of values in a big map. Order of \\\n         values is unspecified, but is guaranteed to be consistent.\"\n      ~query:big_map_get_all_query\n      ~output:(list Script.expr_encoding)\n      RPC_path.(big_map_root /: Big_map.Id.rpc_arg)\n\n  let info =\n    RPC_service.get_service\n      ~description:\"Access the complete status of a contract.\"\n      ~query:RPC_query.empty\n      ~output:info_encoding\n      RPC_path.(custom_root /: Contract.rpc_arg)\n\n  let list =\n    RPC_service.get_service\n      ~description:\n        \"All existing contracts (including non-empty default contracts).\"\n      ~query:RPC_query.empty\n      ~output:(list Contract.encoding)\n      custom_root\n\n  module Sapling = struct\n    (*\n      Sapling: these RPCs are like Sapling RPCs (sapling_services.ml)\n      specialized for contracts containing a single sapling state.\n    *)\n\n    let single_sapling_get_id ctxt contract_id =\n      Contract.get_script ctxt contract_id >>=? fun (ctxt, script) ->\n      match script with\n      | None -> return (None, ctxt)\n      | Some script ->\n          let ctxt = Gas.set_unlimited ctxt in\n          Script_ir_translator.parse_script\n            ctxt\n            ~legacy:true\n            ~allow_forged_in_storage:true\n            script\n          >|= fun tzresult ->\n          tzresult >>? fun (Ex_script script, ctxt) ->\n          Script_ir_translator.get_single_sapling_state\n            ctxt\n            script.storage_type\n            script.storage\n\n    let make_service\n        Sapling_services.S.Args.{name; description; query; output; f} =\n      let name = \"single_sapling_\" ^ name in\n      let path = RPC_path.(custom_root /: Contract.rpc_arg / name) in\n      let service = RPC_service.get_service ~description ~query ~output path in\n      ( service,\n        fun ctxt contract_id q () ->\n          single_sapling_get_id ctxt contract_id >>=? fun (sapling_id, ctxt) ->\n          Option.map_es (fun sapling_id -> f ctxt sapling_id q) sapling_id )\n\n    let get_diff = make_service Sapling_services.S.Args.get_diff\n\n    let register () =\n      let reg chunked (service, f) =\n        Services_registration.opt_register1 ~chunked service f\n      in\n      reg false get_diff\n\n    let mk_call1 (service, _f) ctxt block id q =\n      RPC_context.make_call1 service ctxt block id q ()\n  end\nend\n\nlet[@coq_axiom_with_reason \"gadt\"] register () =\n  let open Services_registration in\n  register0 ~chunked:true S.list (fun ctxt () () -> Contract.list ctxt >|= ok) ;\n  let register_field ~chunked s f =\n    opt_register1 ~chunked s (fun ctxt contract () () ->\n        Contract.exists ctxt contract >>=? function\n        | true -> f ctxt contract >|=? Option.some\n        | false -> return_none)\n  in\n  let register_opt_field ~chunked s f =\n    opt_register1 ~chunked s (fun ctxt contract () () ->\n        Contract.exists ctxt contract >>=? function\n        | true -> f ctxt contract\n        | false -> return_none)\n  in\n  let do_big_map_get ctxt id key =\n    let open Script_ir_translator in\n    let ctxt = Gas.set_unlimited ctxt in\n    Big_map.exists ctxt id >>=? fun (ctxt, types) ->\n    match types with\n    | None -> return_none\n    | Some (_, value_type) -> (\n        parse_big_map_value_ty ctxt ~legacy:true (Micheline.root value_type)\n        >>?= fun (Ex_ty value_type, ctxt) ->\n        Big_map.get_opt ctxt id key >>=? fun (_ctxt, value) ->\n        match value with\n        | None -> return_none\n        | Some value ->\n            parse_data\n              ctxt\n              ~legacy:true\n              ~allow_forged:true\n              value_type\n              (Micheline.root value)\n            >>=? fun (value, ctxt) ->\n            unparse_data ctxt Readable value_type value\n            >|=? fun (value, _ctxt) -> Some (Micheline.strip_locations value))\n  in\n  let do_big_map_get_all ?offset ?length ctxt id =\n    let open Script_ir_translator in\n    let ctxt = Gas.set_unlimited ctxt in\n    Big_map.exists ctxt id >>=? fun (ctxt, types) ->\n    match types with\n    | None -> raise Not_found\n    | Some (_, value_type) ->\n        parse_big_map_value_ty ctxt ~legacy:true (Micheline.root value_type)\n        >>?= fun (Ex_ty value_type, ctxt) ->\n        Big_map.list_values ?offset ?length ctxt id >>=? fun (ctxt, values) ->\n        List.fold_left_s\n          (fun acc value ->\n            acc >>?= fun (ctxt, rev_values) ->\n            parse_data\n              ctxt\n              ~legacy:true\n              ~allow_forged:true\n              value_type\n              (Micheline.root value)\n            >>=? fun (value, ctxt) ->\n            unparse_data ctxt Readable value_type value\n            >|=? fun (value, ctxt) ->\n            (ctxt, Micheline.strip_locations value :: rev_values))\n          (Ok (ctxt, []))\n          values\n        >|=? fun (_ctxt, rev_values) -> List.rev rev_values\n  in\n  register_field ~chunked:false S.balance Contract.get_balance ;\n  opt_register1 ~chunked:false S.manager_key (fun ctxt contract () () ->\n      match Contract.is_implicit contract with\n      | None -> return_none\n      | Some mgr -> (\n          Contract.is_manager_key_revealed ctxt mgr >>=? function\n          | false -> return_some None\n          | true ->\n              Contract.get_manager_key ctxt mgr >|=? fun key -> Some (Some key))) ;\n  register_opt_field ~chunked:false S.delegate Delegate.find ;\n  opt_register1 ~chunked:false S.counter (fun ctxt contract () () ->\n      match Contract.is_implicit contract with\n      | None -> return_none\n      | Some mgr ->\n          Contract.get_counter ctxt mgr >|=? fun counter -> Some counter) ;\n  register_opt_field ~chunked:true S.script (fun c v ->\n      Contract.get_script c v >|=? fun (_, v) -> v) ;\n  register_opt_field ~chunked:true S.storage (fun ctxt contract ->\n      Contract.get_script ctxt contract >>=? fun (ctxt, script) ->\n      match script with\n      | None -> return_none\n      | Some script ->\n          let ctxt = Gas.set_unlimited ctxt in\n          let open Script_ir_translator in\n          parse_script ctxt ~legacy:true ~allow_forged_in_storage:true script\n          >>=? fun (Ex_script script, ctxt) ->\n          unparse_script ctxt Readable script >>=? fun (script, ctxt) ->\n          Script.force_decode_in_context\n            ~consume_deserialization_gas:When_needed\n            ctxt\n            script.storage\n          >>?= fun (storage, _ctxt) -> return_some storage) ;\n  opt_register2 ~chunked:true S.entrypoint_type (fun ctxt v entrypoint () () ->\n      Contract.get_script_code ctxt v >>=? fun (_, expr) ->\n      match expr with\n      | None -> return_none\n      | Some expr ->\n          let ctxt = Gas.set_unlimited ctxt in\n          let legacy = true in\n          let open Script_ir_translator in\n          Script.force_decode_in_context\n            ~consume_deserialization_gas:When_needed\n            ctxt\n            expr\n          >>?= fun (expr, _) ->\n          parse_toplevel ctxt ~legacy expr\n          >>=? fun ({arg_type; root_name; _}, ctxt) ->\n          Lwt.return\n            (( parse_parameter_ty ctxt ~legacy arg_type\n             >>? fun (Ex_ty arg_type, _) ->\n               Script_ir_translator.find_entrypoint\n                 ~root_name\n                 arg_type\n                 entrypoint )\n             |> function\n             | Ok (_f, Ex_ty ty) ->\n                 unparse_ty ~loc:() ctxt ty >|? fun (ty_node, _) ->\n                 Some (Micheline.strip_locations ty_node)\n             | Error _ -> Result.return_none)) ;\n  opt_register1 ~chunked:true S.list_entrypoints (fun ctxt v () () ->\n      Contract.get_script_code ctxt v >>=? fun (_, expr) ->\n      match expr with\n      | None -> return_none\n      | Some expr ->\n          let ctxt = Gas.set_unlimited ctxt in\n          let legacy = true in\n          let open Script_ir_translator in\n          Script.force_decode_in_context\n            ~consume_deserialization_gas:When_needed\n            ctxt\n            expr\n          >>?= fun (expr, _) ->\n          parse_toplevel ctxt ~legacy expr\n          >>=? fun ({arg_type; root_name; _}, ctxt) ->\n          Lwt.return\n            ( ( parse_parameter_ty ctxt ~legacy arg_type\n              >>? fun (Ex_ty arg_type, _) ->\n                Script_ir_translator.list_entrypoints ~root_name arg_type ctxt\n              )\n            >|? fun (unreachable_entrypoint, map) ->\n              Some\n                ( unreachable_entrypoint,\n                  Entrypoints_map.fold\n                    (fun entry (_, ty) acc ->\n                      (entry, Micheline.strip_locations ty) :: acc)\n                    map\n                    [] ) )) ;\n  opt_register1\n    ~chunked:true\n    S.contract_big_map_get_opt\n    (fun ctxt contract () (key, key_type) ->\n      Contract.get_script ctxt contract >>=? fun (ctxt, script) ->\n      let key_type_node = Micheline.root key_type in\n      Script_ir_translator.parse_comparable_ty ctxt key_type_node\n      >>?= fun (Ex_comparable_ty key_type, ctxt) ->\n      Script_ir_translator.parse_comparable_data\n        ctxt\n        key_type\n        (Micheline.root key)\n      >>=? fun (key, ctxt) ->\n      Script_ir_translator.hash_comparable_data ctxt key_type key\n      >>=? fun (key, ctxt) ->\n      match script with\n      | None -> return_none\n      | Some script -> (\n          let ctxt = Gas.set_unlimited ctxt in\n          let open Script_ir_translator in\n          parse_script ctxt ~legacy:true ~allow_forged_in_storage:true script\n          >>=? fun (Ex_script script, ctxt) ->\n          Script_ir_translator.collect_lazy_storage\n            ctxt\n            script.storage_type\n            script.storage\n          >>?= fun (ids, _ctxt) ->\n          match Script_ir_translator.list_of_big_map_ids ids with\n          | [] | _ :: _ :: _ -> return_some None\n          | [id] -> do_big_map_get ctxt id key >|=? Option.some)) ;\n  opt_register2 ~chunked:true S.big_map_get (fun ctxt id key () () ->\n      do_big_map_get ctxt id key) ;\n  register1 ~chunked:true S.big_map_get_all (fun ctxt id {offset; length} () ->\n      do_big_map_get_all ?offset ?length ctxt id) ;\n  register_field ~chunked:false S.info (fun ctxt contract ->\n      Contract.get_balance ctxt contract >>=? fun balance ->\n      Delegate.find ctxt contract >>=? fun delegate ->\n      (match Contract.is_implicit contract with\n      | Some manager ->\n          Contract.get_counter ctxt manager >>=? fun counter ->\n          return_some counter\n      | None -> return_none)\n      >>=? fun counter ->\n      Contract.get_script ctxt contract >>=? fun (ctxt, script) ->\n      (match script with\n      | None -> return (None, ctxt)\n      | Some script ->\n          let ctxt = Gas.set_unlimited ctxt in\n          let open Script_ir_translator in\n          parse_script ctxt ~legacy:true ~allow_forged_in_storage:true script\n          >>=? fun (Ex_script script, ctxt) ->\n          unparse_script ctxt Readable script >|=? fun (script, ctxt) ->\n          (Some script, ctxt))\n      >|=? fun (script, _ctxt) -> {balance; delegate; script; counter}) ;\n  S.Sapling.register ()\n\nlet list ctxt block = RPC_context.make_call0 S.list ctxt block () ()\n\nlet info ctxt block contract =\n  RPC_context.make_call1 S.info ctxt block contract () ()\n\nlet balance ctxt block contract =\n  RPC_context.make_call1 S.balance ctxt block contract () ()\n\nlet manager_key ctxt block mgr =\n  RPC_context.make_call1\n    S.manager_key\n    ctxt\n    block\n    (Contract.implicit_contract mgr)\n    ()\n    ()\n\nlet delegate ctxt block contract =\n  RPC_context.make_call1 S.delegate ctxt block contract () ()\n\nlet delegate_opt ctxt block contract =\n  RPC_context.make_opt_call1 S.delegate ctxt block contract () ()\n\nlet counter ctxt block mgr =\n  RPC_context.make_call1\n    S.counter\n    ctxt\n    block\n    (Contract.implicit_contract mgr)\n    ()\n    ()\n\nlet script ctxt block contract =\n  RPC_context.make_call1 S.script ctxt block contract () ()\n\nlet script_opt ctxt block contract =\n  RPC_context.make_opt_call1 S.script ctxt block contract () ()\n\nlet storage ctxt block contract =\n  RPC_context.make_call1 S.storage ctxt block contract () ()\n\nlet entrypoint_type ctxt block contract entrypoint =\n  RPC_context.make_call2 S.entrypoint_type ctxt block contract entrypoint () ()\n\nlet list_entrypoints ctxt block contract =\n  RPC_context.make_call1 S.list_entrypoints ctxt block contract () ()\n\nlet storage_opt ctxt block contract =\n  RPC_context.make_opt_call1 S.storage ctxt block contract () ()\n\nlet big_map_get ctxt block id key =\n  RPC_context.make_call2 S.big_map_get ctxt block id key () ()\n\nlet contract_big_map_get_opt ctxt block contract key =\n  RPC_context.make_call1 S.contract_big_map_get_opt ctxt block contract () key\n\nlet single_sapling_get_diff ctxt block id ?offset_commitment ?offset_nullifier\n    () =\n  S.Sapling.(mk_call1 get_diff)\n    ctxt\n    block\n    id\n    Sapling_services.{offset_commitment; offset_nullifier}\n" ;
                } ;
                { name = "Delegate_services" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\nval list :\n  'a #RPC_context.simple ->\n  'a ->\n  ?active:bool ->\n  ?inactive:bool ->\n  unit ->\n  Signature.Public_key_hash.t list shell_tzresult Lwt.t\n\ntype info = {\n  full_balance : Tez.t;  (** Balance + Frozen balance *)\n  current_frozen_deposits : Tez.t;\n  frozen_deposits : Tez.t;\n  staking_balance : Tez.t;\n  frozen_deposits_limit : Tez.t option;\n  delegated_contracts : Contract.t list;\n  delegated_balance : Tez.t;\n  deactivated : bool;\n  grace_period : Cycle.t;\n  voting_power : int32;\n}\n\nval info_encoding : info Data_encoding.t\n\nval info :\n  'a #RPC_context.simple ->\n  'a ->\n  Signature.Public_key_hash.t ->\n  info shell_tzresult Lwt.t\n\nval full_balance :\n  'a #RPC_context.simple ->\n  'a ->\n  Signature.Public_key_hash.t ->\n  Tez.t shell_tzresult Lwt.t\n\nval current_frozen_deposits :\n  'a #RPC_context.simple ->\n  'a ->\n  Signature.Public_key_hash.t ->\n  Tez.t shell_tzresult Lwt.t\n\nval frozen_deposits :\n  'a #RPC_context.simple ->\n  'a ->\n  Signature.Public_key_hash.t ->\n  Tez.t shell_tzresult Lwt.t\n\nval staking_balance :\n  'a #RPC_context.simple ->\n  'a ->\n  Signature.Public_key_hash.t ->\n  Tez.t shell_tzresult Lwt.t\n\nval frozen_deposits_limit :\n  'a #RPC_context.simple ->\n  'a ->\n  Signature.Public_key_hash.t ->\n  Tez.t option shell_tzresult Lwt.t\n\nval delegated_contracts :\n  'a #RPC_context.simple ->\n  'a ->\n  Signature.Public_key_hash.t ->\n  Contract.t list shell_tzresult Lwt.t\n\nval delegated_balance :\n  'a #RPC_context.simple ->\n  'a ->\n  Signature.Public_key_hash.t ->\n  Tez.t shell_tzresult Lwt.t\n\nval deactivated :\n  'a #RPC_context.simple ->\n  'a ->\n  Signature.Public_key_hash.t ->\n  bool shell_tzresult Lwt.t\n\nval grace_period :\n  'a #RPC_context.simple ->\n  'a ->\n  Signature.Public_key_hash.t ->\n  Cycle.t shell_tzresult Lwt.t\n\nval voting_power :\n  'a #RPC_context.simple -> 'a -> public_key_hash -> int32 shell_tzresult Lwt.t\n\nval participation :\n  'a #RPC_context.simple ->\n  'a ->\n  public_key_hash ->\n  Delegate.participation_info shell_tzresult Lwt.t\n\nval register : unit -> unit\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2020 Metastate AG <hello@metastate.dev>                     *)\n(* Copyright (c) 2021 Nomadic Labs, <contact@nomadic-labs.com>               *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\ntype error += Balance_rpc_non_delegate of public_key_hash\n\nlet () =\n  register_error_kind\n    `Temporary\n    ~id:\"delegate_service.balance_rpc_on_non_delegate\"\n    ~title:\"Balance request for an unregistered delegate\"\n    ~description:\"The account whose balance was requested is not a delegate.\"\n    ~pp:(fun ppf pkh ->\n      Format.fprintf\n        ppf\n        \"The implicit account (%a) whose balance was requested is not a \\\n         registered delegate. To get the balance of this account you can use \\\n         the ../context/contracts/%a/balance RPC.\"\n        Signature.Public_key_hash.pp\n        pkh\n        Signature.Public_key_hash.pp\n        pkh)\n    Data_encoding.(obj1 (req \"pkh\" Signature.Public_key_hash.encoding))\n    (function Balance_rpc_non_delegate pkh -> Some pkh | _ -> None)\n    (fun pkh -> Balance_rpc_non_delegate pkh)\n\ntype info = {\n  full_balance : Tez.t;\n  current_frozen_deposits : Tez.t;\n  frozen_deposits : Tez.t;\n  staking_balance : Tez.t;\n  frozen_deposits_limit : Tez.t option;\n  delegated_contracts : Contract.t list;\n  delegated_balance : Tez.t;\n  deactivated : bool;\n  grace_period : Cycle.t;\n  voting_power : int32;\n}\n\nlet info_encoding =\n  let open Data_encoding in\n  conv\n    (fun {\n           full_balance;\n           current_frozen_deposits;\n           frozen_deposits;\n           staking_balance;\n           frozen_deposits_limit;\n           delegated_contracts;\n           delegated_balance;\n           deactivated;\n           grace_period;\n           voting_power;\n         } ->\n      ( full_balance,\n        current_frozen_deposits,\n        frozen_deposits,\n        staking_balance,\n        frozen_deposits_limit,\n        delegated_contracts,\n        delegated_balance,\n        deactivated,\n        grace_period,\n        voting_power ))\n    (fun ( full_balance,\n           current_frozen_deposits,\n           frozen_deposits,\n           staking_balance,\n           frozen_deposits_limit,\n           delegated_contracts,\n           delegated_balance,\n           deactivated,\n           grace_period,\n           voting_power ) ->\n      {\n        full_balance;\n        current_frozen_deposits;\n        frozen_deposits;\n        staking_balance;\n        frozen_deposits_limit;\n        delegated_contracts;\n        delegated_balance;\n        deactivated;\n        grace_period;\n        voting_power;\n      })\n    (obj10\n       (req \"full_balance\" Tez.encoding)\n       (req \"current_frozen_deposits\" Tez.encoding)\n       (req \"frozen_deposits\" Tez.encoding)\n       (req \"staking_balance\" Tez.encoding)\n       (opt \"frozen_deposits_limit\" Tez.encoding)\n       (req \"delegated_contracts\" (list Contract.encoding))\n       (req \"delegated_balance\" Tez.encoding)\n       (req \"deactivated\" bool)\n       (req \"grace_period\" Cycle.encoding)\n       (req \"voting_power\" int32))\n\nlet participation_info_encoding =\n  let open Data_encoding in\n  conv\n    (fun {\n           Delegate.expected_cycle_activity;\n           minimal_cycle_activity;\n           missed_slots;\n           missed_levels;\n           remaining_allowed_missed_slots;\n           expected_endorsing_rewards;\n         } ->\n      ( expected_cycle_activity,\n        minimal_cycle_activity,\n        missed_slots,\n        missed_levels,\n        remaining_allowed_missed_slots,\n        expected_endorsing_rewards ))\n    (fun ( expected_cycle_activity,\n           minimal_cycle_activity,\n           missed_slots,\n           missed_levels,\n           remaining_allowed_missed_slots,\n           expected_endorsing_rewards ) ->\n      {\n        expected_cycle_activity;\n        minimal_cycle_activity;\n        missed_slots;\n        missed_levels;\n        remaining_allowed_missed_slots;\n        expected_endorsing_rewards;\n      })\n    (obj6\n       (req \"expected_cycle_activity\" int31)\n       (req \"minimal_cycle_activity\" int31)\n       (req \"missed_slots\" int31)\n       (req \"missed_levels\" int31)\n       (req \"remaining_allowed_missed_slots\" int31)\n       (req \"expected_endorsing_rewards\" Tez.encoding))\n\nmodule S = struct\n  let raw_path = RPC_path.(open_root / \"context\" / \"delegates\")\n\n  open Data_encoding\n\n  type list_query = {active : bool; inactive : bool}\n\n  let list_query : list_query RPC_query.t =\n    let open RPC_query in\n    query (fun active inactive -> {active; inactive})\n    |+ flag \"active\" (fun t -> t.active)\n    |+ flag \"inactive\" (fun t -> t.inactive)\n    |> seal\n\n  let list_delegate =\n    RPC_service.get_service\n      ~description:\"Lists all registered delegates.\"\n      ~query:list_query\n      ~output:(list Signature.Public_key_hash.encoding)\n      raw_path\n\n  let path = RPC_path.(raw_path /: Signature.Public_key_hash.rpc_arg)\n\n  let info =\n    RPC_service.get_service\n      ~description:\"Everything about a delegate.\"\n      ~query:RPC_query.empty\n      ~output:info_encoding\n      path\n\n  let full_balance =\n    RPC_service.get_service\n      ~description:\n        \"Returns the full balance (in mutez) of a given delegate, including \\\n         the frozen deposits. It does not include its delegated balance.\"\n      ~query:RPC_query.empty\n      ~output:Tez.encoding\n      RPC_path.(path / \"full_balance\")\n\n  let current_frozen_deposits =\n    RPC_service.get_service\n      ~description:\n        \"Returns the current amount of the frozen deposits (in mutez).\"\n      ~query:RPC_query.empty\n      ~output:Tez.encoding\n      RPC_path.(path / \"current_frozen_deposits\")\n\n  let frozen_deposits =\n    RPC_service.get_service\n      ~description:\n        \"Returns the initial amount (that is, at the beginning of a cycle) of \\\n         the frozen deposits (in mutez). This amount is the same as the \\\n         current amount of the frozen deposits, unless the delegate has been \\\n         punished.\"\n      ~query:RPC_query.empty\n      ~output:Tez.encoding\n      RPC_path.(path / \"frozen_deposits\")\n\n  let staking_balance =\n    RPC_service.get_service\n      ~description:\n        \"Returns the total amount of tokens (in mutez) delegated to a given \\\n         delegate. This includes the balances of all the contracts that \\\n         delegate to it, but also the balance of the delegate itself and its \\\n         frozen deposits.\"\n      ~query:RPC_query.empty\n      ~output:Tez.encoding\n      RPC_path.(path / \"staking_balance\")\n\n  let frozen_deposits_limit =\n    RPC_service.get_service\n      ~description:\n        \"Returns the frozen deposits limit for the given delegate or none if \\\n         no limit is set.\"\n      ~query:RPC_query.empty\n      ~output:(Data_encoding.option Tez.encoding)\n      RPC_path.(path / \"frozen_deposits_limit\")\n\n  let delegated_contracts =\n    RPC_service.get_service\n      ~description:\n        \"Returns the list of contracts that delegate to a given delegate.\"\n      ~query:RPC_query.empty\n      ~output:(list Contract.encoding)\n      RPC_path.(path / \"delegated_contracts\")\n\n  let delegated_balance =\n    RPC_service.get_service\n      ~description:\n        \"Returns the sum (in mutez) of all balances of all the contracts that \\\n         delegate to a given delegate. This excludes the delegate's own \\\n         balance and its frozen deposits.\"\n      ~query:RPC_query.empty\n      ~output:Tez.encoding\n      RPC_path.(path / \"delegated_balance\")\n\n  let deactivated =\n    RPC_service.get_service\n      ~description:\n        \"Tells whether the delegate is currently tagged as deactivated or not.\"\n      ~query:RPC_query.empty\n      ~output:bool\n      RPC_path.(path / \"deactivated\")\n\n  let grace_period =\n    RPC_service.get_service\n      ~description:\n        \"Returns the cycle by the end of which the delegate might be \\\n         deactivated if she fails to execute any delegate action. A \\\n         deactivated delegate might be reactivated (without loosing any stake) \\\n         by simply re-registering as a delegate. For deactivated delegates, \\\n         this value contains the cycle at which they were deactivated.\"\n      ~query:RPC_query.empty\n      ~output:Cycle.encoding\n      RPC_path.(path / \"grace_period\")\n\n  let voting_power =\n    RPC_service.get_service\n      ~description:\n        \"The number of rolls in the vote listings for a given delegate\"\n      ~query:RPC_query.empty\n      ~output:Data_encoding.int32\n      RPC_path.(path / \"voting_power\")\n\n  let participation =\n    RPC_service.get_service\n      ~description:\n        \"Returns cycle and level participation information. In particular this \\\n         indicates, in the field 'expected_cycle_activity', the number of \\\n         slots the delegate is expected to have in the cycle based on its \\\n         active stake. The field 'minimal_cycle_activity' indicates the \\\n         minimal endorsing slots in the cycle required to get endorsing \\\n         rewards. It is computed based on 'expected_cycle_activity. The fields \\\n         'missed_slots' and 'missed_levels' indicate the number of missed \\\n         endorsing slots and missed levels (for endorsing) in the cycle so \\\n         far. 'missed_slots' indicates the number of missed endorsing slots in \\\n         the cycle so far. The field 'remaining_allowed_missed_slots' \\\n         indicates the remaining amount of endorsing slots that can be missed \\\n         in the cycle before forfeiting the rewards. Finally, \\\n         'expected_endorsing_rewards' indicates the endorsing rewards that \\\n         will be distributed at the end of the cycle if activity at that point \\\n         will be greater than the minimal required; if the activity is already \\\n         known to be below the required minimum, then the rewards are zero.\"\n      ~query:RPC_query.empty\n      ~output:participation_info_encoding\n      RPC_path.(path / \"participation\")\nend\n\nlet register () =\n  let open Services_registration in\n  register0 ~chunked:true S.list_delegate (fun ctxt q () ->\n      Delegate.list ctxt >>= fun delegates ->\n      match q with\n      | {active = true; inactive = false} ->\n          List.filter_es\n            (fun pkh -> Delegate.deactivated ctxt pkh >|=? not)\n            delegates\n      | {active = false; inactive = true} ->\n          List.filter_es (fun pkh -> Delegate.deactivated ctxt pkh) delegates\n      | _ -> return delegates) ;\n  register1 ~chunked:false S.info (fun ctxt pkh () () ->\n      Delegate.check_delegate ctxt pkh >>=? fun () ->\n      Delegate.full_balance ctxt pkh >>=? fun full_balance ->\n      Delegate.frozen_deposits ctxt pkh >>=? fun frozen_deposits ->\n      Delegate.staking_balance ctxt pkh >>=? fun staking_balance ->\n      Delegate.frozen_deposits_limit ctxt pkh >>=? fun frozen_deposits_limit ->\n      Delegate.delegated_contracts ctxt pkh >>= fun delegated_contracts ->\n      Delegate.delegated_balance ctxt pkh >>=? fun delegated_balance ->\n      Delegate.deactivated ctxt pkh >>=? fun deactivated ->\n      Delegate.grace_period ctxt pkh >>=? fun grace_period ->\n      Vote.get_voting_power_free ctxt pkh >|=? fun voting_power ->\n      {\n        full_balance;\n        current_frozen_deposits = frozen_deposits.current_amount;\n        frozen_deposits = frozen_deposits.initial_amount;\n        staking_balance;\n        frozen_deposits_limit;\n        delegated_contracts;\n        delegated_balance;\n        deactivated;\n        grace_period;\n        voting_power;\n      }) ;\n  register1 ~chunked:false S.full_balance (fun ctxt pkh () () ->\n      trace (Balance_rpc_non_delegate pkh) (Delegate.check_delegate ctxt pkh)\n      >>=? fun () -> Delegate.full_balance ctxt pkh) ;\n  register1 ~chunked:false S.current_frozen_deposits (fun ctxt pkh () () ->\n      Delegate.check_delegate ctxt pkh >>=? fun () ->\n      Delegate.frozen_deposits ctxt pkh >>=? fun deposits ->\n      return deposits.current_amount) ;\n  register1 ~chunked:false S.frozen_deposits (fun ctxt pkh () () ->\n      Delegate.check_delegate ctxt pkh >>=? fun () ->\n      Delegate.frozen_deposits ctxt pkh >>=? fun deposits ->\n      return deposits.initial_amount) ;\n  register1 ~chunked:false S.staking_balance (fun ctxt pkh () () ->\n      Delegate.check_delegate ctxt pkh >>=? fun () ->\n      Delegate.staking_balance ctxt pkh) ;\n  register1 ~chunked:false S.frozen_deposits_limit (fun ctxt pkh () () ->\n      Delegate.check_delegate ctxt pkh >>=? fun () ->\n      Delegate.frozen_deposits_limit ctxt pkh) ;\n  register1 ~chunked:true S.delegated_contracts (fun ctxt pkh () () ->\n      Delegate.check_delegate ctxt pkh >>=? fun () ->\n      Delegate.delegated_contracts ctxt pkh >|= ok) ;\n  register1 ~chunked:false S.delegated_balance (fun ctxt pkh () () ->\n      Delegate.check_delegate ctxt pkh >>=? fun () ->\n      Delegate.delegated_balance ctxt pkh) ;\n  register1 ~chunked:false S.deactivated (fun ctxt pkh () () ->\n      Delegate.check_delegate ctxt pkh >>=? fun () ->\n      Delegate.deactivated ctxt pkh) ;\n  register1 ~chunked:false S.grace_period (fun ctxt pkh () () ->\n      Delegate.check_delegate ctxt pkh >>=? fun () ->\n      Delegate.grace_period ctxt pkh) ;\n  register1 ~chunked:false S.voting_power (fun ctxt pkh () () ->\n      Delegate.check_delegate ctxt pkh >>=? fun () ->\n      Vote.get_voting_power_free ctxt pkh) ;\n  register1 ~chunked:false S.participation (fun ctxt pkh () () ->\n      Delegate.check_delegate ctxt pkh >>=? fun () ->\n      Delegate.delegate_participation_info ctxt pkh)\n\nlet list ctxt block ?(active = true) ?(inactive = false) () =\n  RPC_context.make_call0 S.list_delegate ctxt block {active; inactive} ()\n\nlet info ctxt block pkh = RPC_context.make_call1 S.info ctxt block pkh () ()\n\nlet full_balance ctxt block pkh =\n  RPC_context.make_call1 S.full_balance ctxt block pkh () ()\n\nlet current_frozen_deposits ctxt block pkh =\n  RPC_context.make_call1 S.current_frozen_deposits ctxt block pkh () ()\n\nlet frozen_deposits ctxt block pkh =\n  RPC_context.make_call1 S.frozen_deposits ctxt block pkh () ()\n\nlet staking_balance ctxt block pkh =\n  RPC_context.make_call1 S.staking_balance ctxt block pkh () ()\n\nlet frozen_deposits_limit ctxt block pkh =\n  RPC_context.make_call1 S.frozen_deposits_limit ctxt block pkh () ()\n\nlet delegated_contracts ctxt block pkh =\n  RPC_context.make_call1 S.delegated_contracts ctxt block pkh () ()\n\nlet delegated_balance ctxt block pkh =\n  RPC_context.make_call1 S.delegated_balance ctxt block pkh () ()\n\nlet deactivated ctxt block pkh =\n  RPC_context.make_call1 S.deactivated ctxt block pkh () ()\n\nlet grace_period ctxt block pkh =\n  RPC_context.make_call1 S.grace_period ctxt block pkh () ()\n\nlet voting_power ctxt block pkh =\n  RPC_context.make_call1 S.voting_power ctxt block pkh () ()\n\nlet participation ctxt block pkh =\n  RPC_context.make_call1 S.participation ctxt block pkh () ()\n" ;
                } ;
                { name = "Voting_services" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\nval ballots : 'a #RPC_context.simple -> 'a -> Vote.ballots shell_tzresult Lwt.t\n\nval ballot_list :\n  'a #RPC_context.simple ->\n  'a ->\n  (Signature.Public_key_hash.t * Vote.ballot) list shell_tzresult Lwt.t\n\nval current_period :\n  'a #RPC_context.simple -> 'a -> Voting_period.info shell_tzresult Lwt.t\n\nval successor_period :\n  'a #RPC_context.simple -> 'a -> Voting_period.info shell_tzresult Lwt.t\n\nval current_quorum :\n  'a #RPC_context.simple -> 'a -> Int32.t shell_tzresult Lwt.t\n\nval listings :\n  'a #RPC_context.simple ->\n  'a ->\n  (Signature.Public_key_hash.t * int32) list shell_tzresult Lwt.t\n\nval proposals :\n  'a #RPC_context.simple ->\n  'a ->\n  Int32.t Protocol_hash.Map.t shell_tzresult Lwt.t\n\nval current_proposal :\n  'a #RPC_context.simple -> 'a -> Protocol_hash.t option shell_tzresult Lwt.t\n\nval register : unit -> unit\n\nval total_voting_power :\n  'a #RPC_context.simple -> 'a -> Int32.t shell_tzresult Lwt.t\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\nmodule S = struct\n  let path = RPC_path.(open_root / \"votes\")\n\n  let ballots =\n    RPC_service.get_service\n      ~description:\"Sum of ballots casted so far during a voting period.\"\n      ~query:RPC_query.empty\n      ~output:Vote.ballots_encoding\n      RPC_path.(path / \"ballots\")\n\n  let ballot_list =\n    RPC_service.get_service\n      ~description:\"Ballots casted so far during a voting period.\"\n      ~query:RPC_query.empty\n      ~output:\n        Data_encoding.(\n          list\n            (obj2\n               (req \"pkh\" Signature.Public_key_hash.encoding)\n               (req \"ballot\" Vote.ballot_encoding)))\n      RPC_path.(path / \"ballot_list\")\n\n  let current_period =\n    RPC_service.get_service\n      ~description:\n        \"Returns the voting period (index, kind, starting position) and \\\n         related information (position, remaining) of the interrogated block.\"\n      ~query:RPC_query.empty\n      ~output:Voting_period.info_encoding\n      RPC_path.(path / \"current_period\")\n\n  let successor_period =\n    RPC_service.get_service\n      ~description:\n        \"Returns the voting period (index, kind, starting position) and \\\n         related information (position, remaining) of the next block.Useful to \\\n         craft operations that will be valid in the next block.\"\n      ~query:RPC_query.empty\n      ~output:Voting_period.info_encoding\n      RPC_path.(path / \"successor_period\")\n\n  let current_quorum =\n    RPC_service.get_service\n      ~description:\"Current expected quorum.\"\n      ~query:RPC_query.empty\n      ~output:Data_encoding.int32\n      RPC_path.(path / \"current_quorum\")\n\n  let listings =\n    RPC_service.get_service\n      ~description:\n        \"List of delegates with their voting weight, in number of rolls.\"\n      ~query:RPC_query.empty\n      ~output:Vote.listings_encoding\n      RPC_path.(path / \"listings\")\n\n  let proposals =\n    RPC_service.get_service\n      ~description:\"List of proposals with number of supporters.\"\n      ~query:RPC_query.empty\n      ~output:(Protocol_hash.Map.encoding Data_encoding.int32)\n      RPC_path.(path / \"proposals\")\n\n  let current_proposal =\n    RPC_service.get_service\n      ~description:\"Current proposal under evaluation.\"\n      ~query:RPC_query.empty\n      ~output:(Data_encoding.option Protocol_hash.encoding)\n      RPC_path.(path / \"current_proposal\")\n\n  let total_voting_power =\n    RPC_service.get_service\n      ~description:\n        \"Total number of rolls for the delegates in the voting listings.\"\n      ~query:RPC_query.empty\n      ~output:Data_encoding.int32\n      RPC_path.(path / \"total_voting_power\")\nend\n\nlet register () =\n  let open Services_registration in\n  register0 ~chunked:false S.ballots (fun ctxt () () -> Vote.get_ballots ctxt) ;\n  register0 ~chunked:true S.ballot_list (fun ctxt () () ->\n      Vote.get_ballot_list ctxt >|= ok) ;\n  register0 ~chunked:false S.current_period (fun ctxt () () ->\n      Voting_period.get_rpc_current_info ctxt) ;\n  register0 ~chunked:false S.successor_period (fun ctxt () () ->\n      Voting_period.get_rpc_succ_info ctxt) ;\n  register0 ~chunked:false S.current_quorum (fun ctxt () () ->\n      Vote.get_current_quorum ctxt) ;\n  register0 ~chunked:true S.proposals (fun ctxt () () ->\n      Vote.get_proposals ctxt) ;\n  register0 ~chunked:true S.listings (fun ctxt () () ->\n      Vote.get_listings ctxt >|= ok) ;\n  register0 ~chunked:false S.current_proposal (fun ctxt () () ->\n      Vote.find_current_proposal ctxt) ;\n  register0 ~chunked:false S.total_voting_power (fun ctxt () () ->\n      Vote.get_total_voting_power_free ctxt)\n  [@@coq_axiom_with_reason\n    \"disabled because we would need to re-create the error e in order to have \\\n     different polymorphic variables\"]\n\nlet ballots ctxt block = RPC_context.make_call0 S.ballots ctxt block () ()\n\nlet ballot_list ctxt block =\n  RPC_context.make_call0 S.ballot_list ctxt block () ()\n\nlet current_period ctxt block =\n  RPC_context.make_call0 S.current_period ctxt block () ()\n\nlet successor_period ctxt block =\n  RPC_context.make_call0 S.successor_period ctxt block () ()\n\nlet current_quorum ctxt block =\n  RPC_context.make_call0 S.current_quorum ctxt block () ()\n\nlet listings ctxt block = RPC_context.make_call0 S.listings ctxt block () ()\n\nlet proposals ctxt block = RPC_context.make_call0 S.proposals ctxt block () ()\n\nlet current_proposal ctxt block =\n  RPC_context.make_call0 S.current_proposal ctxt block () ()\n\nlet total_voting_power ctxt block =\n  RPC_context.make_call0 S.total_voting_power ctxt block () ()\n" ;
                } ;
                { name = "Alpha_services" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2019-2020 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** This declares Protocol RPC services.\n\n    Protocol RPC services are read-only, and support querying the state of the\n    ledger (including information such as existing contracts, delegation,\n    voting, and so on), at a given block height.\n\n    This is a mostly internal module used from [rpc_services] in [Main].\n *)\n\nopen Alpha_context\n\nmodule Seed : sig\n  val get : 'a #RPC_context.simple -> 'a -> Seed.seed shell_tzresult Lwt.t\nend\n\nmodule Nonce : sig\n  type info = Revealed of Nonce.t | Missing of Nonce_hash.t | Forgotten\n\n  val get :\n    'a #RPC_context.simple -> 'a -> Raw_level.t -> info shell_tzresult Lwt.t\nend\n\nmodule Contract = Contract_services\nmodule Constants = Constants_services\nmodule Delegate = Delegate_services\nmodule Voting = Voting_services\nmodule Sapling = Sapling_services\n\nmodule Liquidity_baking : sig\n  val get_cpmm_address :\n    'a #RPC_context.simple ->\n    'a ->\n    Alpha_context.Contract.t shell_tzresult Lwt.t\nend\n\nmodule Cache : sig\n  val cached_contracts :\n    'a #RPC_context.simple ->\n    'a ->\n    (Alpha_context.Contract.t * int) list shell_tzresult Lwt.t\n\n  val contract_cache_size :\n    'a #RPC_context.simple -> 'a -> int shell_tzresult Lwt.t\n\n  val contract_cache_size_limit :\n    'a #RPC_context.simple -> 'a -> int shell_tzresult Lwt.t\n\n  val contract_rank :\n    'a #RPC_context.simple ->\n    'a ->\n    Alpha_context.Contract.t ->\n    int option shell_tzresult Lwt.t\nend\n\nval register : unit -> unit\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(* Copyright (c) 2019-2020 Nomadic Labs <contact@nomadic-labs.com>           *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\nopen Alpha_context\n\nlet custom_root = RPC_path.open_root\n\nmodule Seed = struct\n  module S = struct\n    open Data_encoding\n\n    let seed =\n      RPC_service.post_service\n        ~description:\"Seed of the cycle to which the block belongs.\"\n        ~query:RPC_query.empty\n        ~input:empty\n        ~output:Seed.seed_encoding\n        RPC_path.(custom_root / \"context\" / \"seed\")\n  end\n\n  let () =\n    let open Services_registration in\n    register0 ~chunked:false S.seed (fun ctxt () () ->\n        let l = Level.current ctxt in\n        Seed.for_cycle ctxt l.cycle)\n\n  let get ctxt block = RPC_context.make_call0 S.seed ctxt block () ()\nend\n\nmodule Nonce = struct\n  type info = Revealed of Nonce.t | Missing of Nonce_hash.t | Forgotten\n\n  let info_encoding =\n    let open Data_encoding in\n    union\n      [\n        case\n          (Tag 0)\n          ~title:\"Revealed\"\n          (obj1 (req \"nonce\" Nonce.encoding))\n          (function Revealed nonce -> Some nonce | _ -> None)\n          (fun nonce -> Revealed nonce);\n        case\n          (Tag 1)\n          ~title:\"Missing\"\n          (obj1 (req \"hash\" Nonce_hash.encoding))\n          (function Missing nonce -> Some nonce | _ -> None)\n          (fun nonce -> Missing nonce);\n        case\n          (Tag 2)\n          ~title:\"Forgotten\"\n          empty\n          (function Forgotten -> Some () | _ -> None)\n          (fun () -> Forgotten);\n      ]\n\n  module S = struct\n    let get =\n      RPC_service.get_service\n        ~description:\"Info about the nonce of a previous block.\"\n        ~query:RPC_query.empty\n        ~output:info_encoding\n        RPC_path.(custom_root / \"context\" / \"nonces\" /: Raw_level.rpc_arg)\n  end\n\n  let register () =\n    let open Services_registration in\n    register1 ~chunked:false S.get (fun ctxt raw_level () () ->\n        let level = Level.from_raw ctxt raw_level in\n        Nonce.get ctxt level >|= function\n        | Ok (Revealed nonce) -> ok (Revealed nonce)\n        | Ok (Unrevealed {nonce_hash; _}) -> ok (Missing nonce_hash)\n        | Error _ -> ok Forgotten)\n\n  let get ctxt block level = RPC_context.make_call1 S.get ctxt block level () ()\nend\n\nmodule Contract = Contract_services\nmodule Constants = Constants_services\nmodule Delegate = Delegate_services\nmodule Voting = Voting_services\nmodule Sapling = Sapling_services\n\nmodule Liquidity_baking = struct\n  module S = struct\n    let get_cpmm_address =\n      RPC_service.get_service\n        ~description:\"Liquidity baking CPMM address\"\n        ~query:RPC_query.empty\n        ~output:Alpha_context.Contract.encoding\n        RPC_path.(custom_root / \"context\" / \"liquidity_baking\" / \"cpmm_address\")\n  end\n\n  let register () =\n    let open Services_registration in\n    register0 ~chunked:false S.get_cpmm_address (fun ctxt () () ->\n        Alpha_context.Liquidity_baking.get_cpmm_address ctxt)\n\n  let get_cpmm_address ctxt block =\n    RPC_context.make_call0 S.get_cpmm_address ctxt block () ()\nend\n\nmodule Cache = struct\n  module S = struct\n    let cached_contracts =\n      RPC_service.get_service\n        ~description:\"Return the list of cached contracts\"\n        ~query:RPC_query.empty\n        ~output:\n          Data_encoding.(list @@ tup2 Alpha_context.Contract.encoding int31)\n        RPC_path.(custom_root / \"context\" / \"cache\" / \"contracts\" / \"all\")\n\n    let contract_cache_size =\n      RPC_service.get_service\n        ~description:\"Return the size of the contract cache\"\n        ~query:RPC_query.empty\n        ~output:Data_encoding.int31\n        RPC_path.(custom_root / \"context\" / \"cache\" / \"contracts\" / \"size\")\n\n    let contract_cache_size_limit =\n      RPC_service.get_service\n        ~description:\"Return the size limit of the contract cache\"\n        ~query:RPC_query.empty\n        ~output:Data_encoding.int31\n        RPC_path.(\n          custom_root / \"context\" / \"cache\" / \"contracts\" / \"size_limit\")\n\n    let contract_rank =\n      RPC_service.post_service\n        ~description:\n          \"Return the number of cached contracts older than the provided \\\n           contract\"\n        ~query:RPC_query.empty\n        ~input:Alpha_context.Contract.encoding\n        ~output:Data_encoding.(option int31)\n        RPC_path.(custom_root / \"context\" / \"cache\" / \"contracts\" / \"rank\")\n  end\n\n  let register () =\n    let open Services_registration in\n    register0 ~chunked:true S.cached_contracts (fun ctxt () () ->\n        Script_cache.entries ctxt |> Lwt.return) ;\n    register0 ~chunked:false S.contract_cache_size (fun ctxt () () ->\n        Script_cache.size ctxt |> return) ;\n    register0 ~chunked:false S.contract_cache_size_limit (fun ctxt () () ->\n        Script_cache.size_limit ctxt |> return) ;\n    register0 ~chunked:false S.contract_rank (fun ctxt () contract ->\n        Script_cache.contract_rank ctxt contract |> return)\n\n  let cached_contracts ctxt block =\n    RPC_context.make_call0 S.cached_contracts ctxt block () ()\n\n  let contract_cache_size ctxt block =\n    RPC_context.make_call0 S.contract_cache_size ctxt block () ()\n\n  let contract_cache_size_limit ctxt block =\n    RPC_context.make_call0 S.contract_cache_size_limit ctxt block () ()\n\n  let contract_rank ctxt block contract =\n    RPC_context.make_call0 S.contract_rank ctxt block () contract\nend\n\nlet register () =\n  Contract.register () ;\n  Constants.register () ;\n  Delegate.register () ;\n  Nonce.register () ;\n  Voting.register () ;\n  Sapling.register () ;\n  Liquidity_baking.register () ;\n  Cache.register ()\n" ;
                } ;
                { name = "Main" ;
                  interface = Some "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(** Tezos Protocol Implementation - Protocol Signature Instance\n\n    This module is the  entrypoint to the protocol for shells and other\n    embedders.  This signature is an instance of\n    {{!Tezos_protocol_environment_sigs.V3.T.Updater.PROTOCOL} the\n    [Updater.PROTOCOL] signature} from the\n    {{:https://tezos.gitlab.io/shell/the_big_picture.html#the-economic-protocol-environment-and-compiler}\n    Protocol Environment}.\n\n    Each Protocol depends on a version of the Protocol Environment. For the\n    currently developed protocol, this is normally the latest version.  You can\n    see {{!Tezos_protocol_environment_sigs} the full list of versions here}.\n\n    For details on how Protocol and Environment interact, see\n    {{:https://tezos.gitlab.io/shell/the_big_picture.html} this overview}.\n *)\n\ntype validation_mode =\n  | Application of {\n      block_header : Alpha_context.Block_header.t;\n      fitness : Alpha_context.Fitness.t;\n      payload_producer : Alpha_context.public_key_hash;\n      block_producer : Alpha_context.public_key_hash;\n      predecessor_round : Alpha_context.Round.t;\n      predecessor_level : Alpha_context.Level.t;\n    }\n  | Partial_application of {\n      block_header : Alpha_context.Block_header.t;\n      fitness : Alpha_context.Fitness.t;\n      payload_producer : Alpha_context.public_key_hash;\n      block_producer : Alpha_context.public_key_hash;\n      predecessor_level : Alpha_context.Level.t;\n      predecessor_round : Alpha_context.Round.t;\n    }\n  (* Mempool only *)\n  | Partial_construction of {\n      predecessor : Block_hash.t;\n      predecessor_fitness : Fitness.t;\n      predecessor_level : Alpha_context.Level.t;\n      predecessor_round : Alpha_context.Round.t;\n    }\n  (* Baker only *)\n  | Full_construction of {\n      predecessor : Block_hash.t;\n      payload_producer : Alpha_context.public_key_hash;\n      block_producer : Alpha_context.public_key_hash;\n      protocol_data_contents : Alpha_context.Block_header.contents;\n      level : Int32.t;\n      round : Alpha_context.Round.t;\n      predecessor_level : Alpha_context.Level.t;\n      predecessor_round : Alpha_context.Round.t;\n    }\n\ntype validation_state = {\n  mode : validation_mode;\n  chain_id : Chain_id.t;\n  ctxt : Alpha_context.t;\n  op_count : int;\n  migration_balance_updates : Alpha_context.Receipt.balance_updates;\n  liquidity_baking_escape_ema : Int32.t;\n  implicit_operations_results :\n    Apply_results.packed_successful_manager_operation_result list;\n}\n\ntype operation_data = Alpha_context.packed_protocol_data\n\ntype operation = Alpha_context.packed_operation = {\n  shell : Operation.shell_header;\n  protocol_data : operation_data;\n}\n\nval init_cache : Context.t -> Context.t Lwt.t\n\n(** [check_manager_signature validation_state op raw_operation]\n    The function starts by retrieving the public key hash [pkh] of the manager\n    operation. In case the operation is batched, the function also checks that\n    the sources are all the same.\n    Once the [pkh] is retrieved, the function looks for its associated public\n    key. For that, the manager operation is inspected to check if it contains\n    a public key revelation. If not, the public key is searched in the context.\n\n    @return [Error Invalid_signature] if the signature check fails\n    @return [Error Unrevealed_manager_key] if the manager has not yet been\n    revealed\n    @return [Error Failure \"get_manager_key\"] if the key is not found in the\n    context\n    @return [Error Inconsistent_sources] if the operations in a batch are not\n    from the same manager *)\nval check_manager_signature :\n  validation_state ->\n  'b Alpha_context.Kind.manager Alpha_context.contents_list ->\n  'a Alpha_context.operation ->\n  unit tzresult Lwt.t\n\n(** [precheck_manager validation_state op] returns [()] if the manager operation\n    [op] is solveable, returns an error otherwise. An operation is solveable if\n    it is well-formed and can pay the fees to be included in a block with either\n    a success or a failure status.\n    This function uses [Apply.precheck_manager_contents_list] but discard the\n    context and balance update *)\nval precheck_manager :\n  validation_state ->\n  'a Alpha_context.Kind.manager Alpha_context.contents_list ->\n  unit tzresult Lwt.t\n\ninclude\n  Updater.PROTOCOL\n    with type block_header_data = Alpha_context.Block_header.protocol_data\n     and type block_header_metadata = Apply_results.block_metadata\n     and type block_header = Alpha_context.Block_header.t\n     and type operation_data := operation_data\n     and type operation_receipt = Apply_results.packed_operation_metadata\n     and type operation := operation\n     and type validation_state := validation_state\n" ;
                  implementation = "(*****************************************************************************)\n(*                                                                           *)\n(* Open Source License                                                       *)\n(* Copyright (c) 2018 Dynamic Ledger Solutions, Inc. <contact@tezos.com>     *)\n(*                                                                           *)\n(* Permission is hereby granted, free of charge, to any person obtaining a   *)\n(* copy of this software and associated documentation files (the \"Software\"),*)\n(* to deal in the Software without restriction, including without limitation *)\n(* the rights to use, copy, modify, merge, publish, distribute, sublicense,  *)\n(* and/or sell copies of the Software, and to permit persons to whom the     *)\n(* Software is furnished to do so, subject to the following conditions:      *)\n(*                                                                           *)\n(* The above copyright notice and this permission notice shall be included   *)\n(* in all copies or substantial portions of the Software.                    *)\n(*                                                                           *)\n(* THE SOFTWARE IS PROVIDED \"AS IS\", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR*)\n(* IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,  *)\n(* FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL   *)\n(* THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER*)\n(* LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING   *)\n(* FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER       *)\n(* DEALINGS IN THE SOFTWARE.                                                 *)\n(*                                                                           *)\n(*****************************************************************************)\n\n(* Tezos Protocol Implementation - Protocol Signature Instance *)\n\ntype block_header_data = Alpha_context.Block_header.protocol_data\n\ntype block_header = Alpha_context.Block_header.t = {\n  shell : Block_header.shell_header;\n  protocol_data : block_header_data;\n}\n\nlet block_header_data_encoding =\n  Alpha_context.Block_header.protocol_data_encoding\n\ntype block_header_metadata = Apply_results.block_metadata\n\nlet block_header_metadata_encoding = Apply_results.block_metadata_encoding\n\ntype operation_data = Alpha_context.packed_protocol_data =\n  | Operation_data :\n      'kind Alpha_context.Operation.protocol_data\n      -> operation_data\n\nlet operation_data_encoding = Alpha_context.Operation.protocol_data_encoding\n\ntype operation_receipt = Apply_results.packed_operation_metadata =\n  | Operation_metadata :\n      'kind Apply_results.operation_metadata\n      -> operation_receipt\n  | No_operation_metadata : operation_receipt\n\nlet operation_receipt_encoding = Apply_results.operation_metadata_encoding\n\nlet operation_data_and_receipt_encoding =\n  Apply_results.operation_data_and_metadata_encoding\n\ntype operation = Alpha_context.packed_operation = {\n  shell : Operation.shell_header;\n  protocol_data : operation_data;\n}\n\nlet acceptable_passes = Alpha_context.Operation.acceptable_passes\n\nlet max_block_length = Alpha_context.Block_header.max_header_length\n\nlet max_operation_data_length =\n  Alpha_context.Constants.max_operation_data_length\n\nlet validation_passes =\n  let open Alpha_context.Constants in\n  Updater.\n    [\n      (* 2048 endorsements *)\n      {max_size = 2048 * 2048; max_op = Some 2048};\n      (* 32k of voting operations *)\n      {max_size = 32 * 1024; max_op = None};\n      (* revelations, wallet activations and denunciations *)\n      {\n        max_size = max_anon_ops_per_block * 1024;\n        max_op = Some max_anon_ops_per_block;\n      };\n      (* 512kB *)\n      {max_size = 512 * 1024; max_op = None};\n    ]\n\nlet rpc_services =\n  Alpha_services.register () ;\n  Services_registration.get_rpc_services ()\n\ntype validation_mode =\n  | Application of {\n      block_header : Alpha_context.Block_header.t;\n      fitness : Alpha_context.Fitness.t;\n      payload_producer : Alpha_context.public_key_hash;\n      block_producer : Alpha_context.public_key_hash;\n      predecessor_round : Alpha_context.Round.t;\n      predecessor_level : Alpha_context.Level.t;\n    }\n  | Partial_application of {\n      block_header : Alpha_context.Block_header.t;\n      fitness : Alpha_context.Fitness.t;\n      payload_producer : Alpha_context.public_key_hash;\n      block_producer : Alpha_context.public_key_hash;\n      predecessor_level : Alpha_context.Level.t;\n      predecessor_round : Alpha_context.Round.t;\n    }\n  (* Mempool only *)\n  | Partial_construction of {\n      predecessor : Block_hash.t;\n      predecessor_fitness : Fitness.t;\n      predecessor_level : Alpha_context.Level.t;\n      predecessor_round : Alpha_context.Round.t;\n    }\n  (* Baker only *)\n  | Full_construction of {\n      predecessor : Block_hash.t;\n      payload_producer : Alpha_context.public_key_hash;\n      block_producer : Alpha_context.public_key_hash;\n      protocol_data_contents : Alpha_context.Block_header.contents;\n      level : Int32.t;\n      round : Alpha_context.Round.t;\n      predecessor_level : Alpha_context.Level.t;\n      predecessor_round : Alpha_context.Round.t;\n    }\n\ntype validation_state = {\n  mode : validation_mode;\n  chain_id : Chain_id.t;\n  ctxt : Alpha_context.t;\n  op_count : int;\n  migration_balance_updates : Alpha_context.Receipt.balance_updates;\n  liquidity_baking_escape_ema : Int32.t;\n  implicit_operations_results :\n    Apply_results.packed_successful_manager_operation_result list;\n}\n\nlet cache_layout = Apply.cache_layout\n\nlet begin_partial_application ~chain_id ~ancestor_context:ctxt\n    ~predecessor_timestamp ~(predecessor_fitness : Fitness.t)\n    (block_header : Alpha_context.Block_header.t) =\n  (* Note: we don't have access to the predecessor context. *)\n  let level = block_header.shell.level in\n  let timestamp = block_header.shell.timestamp in\n  Alpha_context.Fitness.from_raw block_header.shell.fitness >>?= fun fitness ->\n  Alpha_context.Fitness.round_from_raw predecessor_fitness\n  >>?= fun predecessor_round ->\n  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ctxt\n  >>=? fun (ctxt, migration_balance_updates, migration_operation_results) ->\n  Alpha_context.Raw_level.of_int32 (Int32.pred level)\n  >>?= fun predecessor_level ->\n  let predecessor_level =\n    Alpha_context.Level.(from_raw ctxt predecessor_level)\n  in\n  Apply.begin_application\n    ctxt\n    chain_id\n    block_header\n    fitness\n    ~predecessor_timestamp\n    ~predecessor_level\n    ~predecessor_round\n  >>=? fun ( ctxt,\n             payload_producer_pk,\n             block_producer,\n             liquidity_baking_operations_results,\n             liquidity_baking_escape_ema ) ->\n  let mode =\n    Partial_application\n      {\n        block_header;\n        fitness;\n        predecessor_level;\n        predecessor_round;\n        payload_producer = Signature.Public_key.hash payload_producer_pk;\n        block_producer;\n      }\n  in\n  return\n    {\n      mode;\n      chain_id;\n      ctxt;\n      op_count = 0;\n      migration_balance_updates;\n      liquidity_baking_escape_ema;\n      implicit_operations_results =\n        Apply_results.pack_migration_operation_results\n          migration_operation_results\n        @ liquidity_baking_operations_results;\n    }\n\n(* During applications the valid consensus operations are:\n * Endorsements on previous block with the right round, level, payload_hash (of the predecessor block)\n * Preendorsements on current level, previous round, and the payload_hash of the current block\n   Those endorsements justify that the previous block was finalized.\n   Those preendorsements justify the locked_round part of the fitness of the current block\n *)\nlet begin_application ~chain_id ~predecessor_context:ctxt ~predecessor_timestamp\n    ~predecessor_fitness (block_header : Alpha_context.Block_header.t) =\n  let level = block_header.shell.level in\n  let timestamp = block_header.shell.timestamp in\n  Alpha_context.Fitness.from_raw block_header.shell.fitness >>?= fun fitness ->\n  Alpha_context.Fitness.round_from_raw predecessor_fitness\n  >>?= fun predecessor_round ->\n  Alpha_context.Raw_level.of_int32 (Int32.pred level)\n  >>?= fun predecessor_level ->\n  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ctxt\n  >>=? fun (ctxt, migration_balance_updates, migration_operation_results) ->\n  let predecessor_level = Alpha_context.Level.from_raw ctxt predecessor_level in\n  Apply.begin_application\n    ctxt\n    chain_id\n    block_header\n    fitness\n    ~predecessor_timestamp\n    ~predecessor_level\n    ~predecessor_round\n  >>=? fun ( ctxt,\n             payload_producer,\n             block_producer,\n             liquidity_baking_operations_results,\n             liquidity_baking_escape_ema ) ->\n  let mode =\n    Application\n      {\n        block_header;\n        fitness;\n        predecessor_round;\n        predecessor_level;\n        payload_producer = Signature.Public_key.hash payload_producer;\n        block_producer;\n      }\n  in\n  return\n    {\n      mode;\n      chain_id;\n      ctxt;\n      op_count = 0;\n      migration_balance_updates;\n      liquidity_baking_escape_ema;\n      implicit_operations_results =\n        Apply_results.pack_migration_operation_results\n          migration_operation_results\n        @ liquidity_baking_operations_results;\n    }\n\nlet begin_construction ~chain_id ~predecessor_context:ctxt\n    ~predecessor_timestamp ~predecessor_level ~predecessor_fitness ~predecessor\n    ~timestamp ?(protocol_data : block_header_data option) () =\n  let level = Int32.succ predecessor_level in\n  Alpha_context.prepare ~level ~predecessor_timestamp ~timestamp ctxt\n  >>=? fun (ctxt, migration_balance_updates, migration_operation_results) ->\n  Alpha_context.Raw_level.of_int32 predecessor_level\n  >>?= fun predecessor_level ->\n  let predecessor_level =\n    Alpha_context.Level.(from_raw ctxt predecessor_level)\n  in\n  (match protocol_data with\n  | None ->\n      Alpha_context.Fitness.round_from_raw predecessor_fitness\n      >>?= fun predecessor_round ->\n      let escape_vote = false in\n      Apply.begin_partial_construction ctxt ~predecessor_level ~escape_vote\n      >>=? fun ( ctxt,\n                 liquidity_baking_operations_results,\n                 liquidity_baking_escape_ema ) ->\n      let mode =\n        Partial_construction\n          {\n            predecessor;\n            predecessor_fitness;\n            predecessor_level;\n            predecessor_round;\n          }\n      in\n      return\n        ( mode,\n          ctxt,\n          liquidity_baking_operations_results,\n          liquidity_baking_escape_ema )\n  | Some proto_header ->\n      Alpha_context.Fitness.round_from_raw predecessor_fitness\n      >>?= fun predecessor_round ->\n      let round_durations = Alpha_context.Constants.round_durations ctxt in\n      Alpha_context.Round.round_of_timestamp\n        round_durations\n        ~predecessor_timestamp\n        ~predecessor_round\n        ~timestamp\n      >>?= fun round ->\n      (* The endorsement/preendorsement validation rules for construction are the\n         same as for application. *)\n      Apply.begin_full_construction\n        ctxt\n        ~predecessor_timestamp\n        ~predecessor_round\n        ~predecessor_level\n        ~round\n        proto_header.contents\n      >>=? fun {\n                 ctxt;\n                 protocol_data = protocol_data_contents;\n                 payload_producer;\n                 block_producer;\n                 round;\n                 liquidity_baking_escape_ema;\n                 implicit_operations_results =\n                   liquidity_baking_operations_results;\n               } ->\n      let mode =\n        Full_construction\n          {\n            predecessor;\n            payload_producer;\n            block_producer;\n            level;\n            round;\n            protocol_data_contents;\n            predecessor_round;\n            predecessor_level;\n          }\n      in\n      return\n        ( mode,\n          ctxt,\n          liquidity_baking_operations_results,\n          liquidity_baking_escape_ema ))\n  >|=? fun ( mode,\n             ctxt,\n             liquidity_baking_operations_results,\n             liquidity_baking_escape_ema ) ->\n  {\n    mode;\n    chain_id;\n    ctxt;\n    op_count = 0;\n    migration_balance_updates;\n    liquidity_baking_escape_ema;\n    implicit_operations_results =\n      Apply_results.pack_migration_operation_results migration_operation_results\n      @ liquidity_baking_operations_results;\n  }\n\nlet apply_operation_with_mode mode ctxt chain_id data op_count operation\n    ~payload_producer =\n  let {shell; protocol_data = Operation_data protocol_data} = operation in\n  let operation : _ Alpha_context.operation = {shell; protocol_data} in\n  Apply.apply_operation\n    ctxt\n    chain_id\n    mode\n    Optimized\n    ~payload_producer\n    (Alpha_context.Operation.hash operation)\n    operation\n  >|=? fun (ctxt, result) ->\n  let op_count = op_count + 1 in\n  ({data with ctxt; op_count}, Operation_metadata result)\n\nlet apply_operation ({mode; chain_id; ctxt; op_count; _} as data)\n    (operation : Alpha_context.packed_operation) =\n  match mode with\n  | Partial_application _\n    when not\n           (List.exists\n              (Compare.Int.equal 0)\n              (Alpha_context.Operation.acceptable_passes operation)) ->\n      (* Multipass validation only considers operations in pass 0. *)\n      let op_count = op_count + 1 in\n      return ({data with ctxt; op_count}, No_operation_metadata)\n  | Partial_application\n      {\n        block_header =\n          {\n            shell = {predecessor; _};\n            protocol_data = {contents = {payload_hash; _}; _};\n          };\n        fitness;\n        payload_producer;\n        predecessor_round;\n        predecessor_level;\n        _;\n      } ->\n      let locked_round = Alpha_context.Fitness.locked_round fitness in\n      apply_operation_with_mode\n        (Apply.Application\n           {\n             payload_hash;\n             predecessor_block = predecessor;\n             predecessor_round;\n             predecessor_level;\n             locked_round;\n             round = Alpha_context.Fitness.round fitness;\n           })\n        ctxt\n        chain_id\n        data\n        op_count\n        operation\n        ~payload_producer\n  | Application\n      {\n        block_header =\n          {\n            shell = {predecessor; _};\n            protocol_data = {contents = {payload_hash; _}; _};\n          };\n        fitness;\n        payload_producer;\n        predecessor_round;\n        predecessor_level;\n        _;\n      } ->\n      let locked_round = Alpha_context.Fitness.locked_round fitness in\n      apply_operation_with_mode\n        (Apply.Application\n           {\n             payload_hash;\n             predecessor_block = predecessor;\n             predecessor_round;\n             predecessor_level;\n             locked_round;\n             round = Alpha_context.Fitness.round fitness;\n           })\n        ctxt\n        chain_id\n        data\n        op_count\n        operation\n        ~payload_producer\n  | Partial_construction\n      {predecessor_level; predecessor_round; predecessor_fitness; _} ->\n      Alpha_context.Fitness.predecessor_round_from_raw predecessor_fitness\n      >>?= fun grand_parent_round ->\n      apply_operation_with_mode\n        (Apply.Partial_construction\n           {predecessor_round; predecessor_level; grand_parent_round})\n        ctxt\n        chain_id\n        data\n        op_count\n        operation\n        ~payload_producer:Signature.Public_key_hash.zero\n  | Full_construction\n      {\n        payload_producer;\n        predecessor;\n        predecessor_round;\n        predecessor_level;\n        protocol_data_contents = {payload_hash; _};\n        round;\n        _;\n      } ->\n      apply_operation_with_mode\n        (Apply.Full_construction\n           {\n             payload_hash;\n             predecessor_block = predecessor;\n             predecessor_level;\n             predecessor_round;\n             round;\n           })\n        ctxt\n        chain_id\n        data\n        op_count\n        operation\n        ~payload_producer\n\nlet cache_nonce_from_block_header shell contents =\n  let open Alpha_context.Block_header in\n  let shell =\n    Block_header.\n      {\n        level = 0l;\n        proto_level = 0;\n        predecessor = shell.predecessor;\n        timestamp = Time.of_seconds 0L;\n        validation_passes = 0;\n        operations_hash = shell.operations_hash;\n        fitness = [];\n        context = Context_hash.zero;\n      }\n  in\n  let contents =\n    {\n      contents with\n      payload_hash = Block_payload_hash.zero;\n      proof_of_work_nonce =\n        Bytes.make Constants_repr.proof_of_work_nonce_size '0';\n    }\n  in\n  let protocol_data = {signature = Signature.zero; contents} in\n  let x = {shell; protocol_data} in\n  Block_hash.to_bytes (hash x)\n\nlet finalize_block_application ctxt round ~cache_nonce finalize_application_mode\n    protocol_data payload_producer block_producer liquidity_baking_escape_ema\n    implicit_operations_results predecessor migration_balance_updates op_count =\n  Apply.finalize_application\n    ctxt\n    finalize_application_mode\n    protocol_data\n    ~payload_producer\n    ~block_producer\n    liquidity_baking_escape_ema\n    implicit_operations_results\n    ~round\n    ~predecessor\n    ~migration_balance_updates\n  >>=? fun (ctxt, fitness, receipt) ->\n  Alpha_context.Cache.Admin.sync ctxt ~cache_nonce >>= fun ctxt ->\n  let level = Alpha_context.Level.current ctxt in\n  let raw_level = Alpha_context.Raw_level.to_int32 level.level in\n  let commit_message =\n    Format.asprintf\n      \"lvl %ld, fit:%a, round %a, %d ops\"\n      raw_level\n      Alpha_context.Fitness.pp\n      fitness\n      Alpha_context.Round.pp\n      round\n      op_count\n  in\n  let validation_result =\n    Alpha_context.finalize\n      ~commit_message\n      ctxt\n      (Alpha_context.Fitness.to_raw fitness)\n  in\n  return (validation_result, receipt)\n\ntype error += Missing_shell_header\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"main.missing_shell_header\"\n    ~title:\"Missing shell_header during finalisation of a block\"\n    ~description:\n      \"During finalisation of a block header in Application mode or Full \\\n       construction mode, a shell header should be provided so that a cache \\\n       nonce can be computed.\"\n    ~pp:(fun ppf () ->\n      Format.fprintf\n        ppf\n        \"No shell header provided during the finalisation of a block.\")\n    Data_encoding.unit\n    (function Missing_shell_header -> Some () | _ -> None)\n    (fun () -> Missing_shell_header)\n\nlet finalize_block\n    {\n      mode;\n      ctxt;\n      op_count;\n      migration_balance_updates;\n      liquidity_baking_escape_ema;\n      implicit_operations_results;\n      _;\n    } shell_header =\n  match mode with\n  | Partial_construction {predecessor_fitness; _} ->\n      Alpha_context.Voting_period.get_rpc_current_info ctxt\n      >>=? fun voting_period_info ->\n      let level_info = Alpha_context.Level.current ctxt in\n      let fitness = predecessor_fitness in\n      let ctxt = Alpha_context.finalize ctxt fitness in\n      return\n        ( ctxt,\n          Apply_results.\n            {\n              proposer = Signature.Public_key_hash.zero;\n              baker = Signature.Public_key_hash.zero;\n              level_info;\n              voting_period_info;\n              nonce_hash = None;\n              consumed_gas = Alpha_context.Gas.Arith.zero;\n              deactivated = [];\n              balance_updates = migration_balance_updates;\n              liquidity_baking_escape_ema;\n              implicit_operations_results;\n            } )\n  | Partial_application {fitness; block_producer; _} ->\n      (* For partial application we do not completely check the block validity.\n         Validating the endorsements is sufficient for a good precheck *)\n      let level = Alpha_context.Level.current ctxt in\n      let included_endorsements =\n        Alpha_context.Consensus.current_endorsement_power ctxt\n      in\n      let minimum = Alpha_context.Constants.consensus_threshold ctxt in\n      Apply.are_endorsements_required ctxt ~level:level.level\n      >>=? fun endorsements_required ->\n      (if endorsements_required then\n       Apply.check_minimum_endorsements\n         ~endorsing_power:included_endorsements\n         ~minimum\n      else return_unit)\n      >>=? fun () ->\n      Alpha_context.Voting_period.get_rpc_current_info ctxt\n      >|=? fun voting_period_info ->\n      let level_info = Alpha_context.Level.current ctxt in\n      let ctxt =\n        Alpha_context.finalize ctxt (Alpha_context.Fitness.to_raw fitness)\n      in\n      ( ctxt,\n        Apply_results.\n          {\n            proposer = Signature.Public_key_hash.zero;\n            (* We cannot retrieve the proposer as it requires the\n               frozen deposit that might not be available depending on\n               the context given to the partial application. *)\n            baker = block_producer;\n            level_info;\n            voting_period_info;\n            nonce_hash = None;\n            consumed_gas = Alpha_context.Gas.Arith.zero;\n            deactivated = [];\n            balance_updates = migration_balance_updates;\n            liquidity_baking_escape_ema;\n            implicit_operations_results;\n          } )\n  | Application\n      {\n        payload_producer;\n        fitness;\n        block_producer;\n        block_header = {protocol_data = {contents = protocol_data; _}; shell};\n        _;\n      } ->\n      let round = Alpha_context.Fitness.round fitness in\n      let cache_nonce = cache_nonce_from_block_header shell protocol_data in\n      finalize_block_application\n        ctxt\n        ~cache_nonce\n        round\n        (Finalize_application fitness)\n        protocol_data\n        payload_producer\n        block_producer\n        liquidity_baking_escape_ema\n        implicit_operations_results\n        shell.predecessor\n        migration_balance_updates\n        op_count\n  | Full_construction\n      {\n        predecessor;\n        predecessor_round;\n        protocol_data_contents;\n        round;\n        level;\n        payload_producer;\n        block_producer;\n        _;\n      } ->\n      Option.value_e\n        shell_header\n        ~error:(Error_monad.trace_of_error Missing_shell_header)\n      >>?= fun shell_header ->\n      let cache_nonce =\n        cache_nonce_from_block_header shell_header protocol_data_contents\n      in\n      Alpha_context.Raw_level.of_int32 level >>?= fun level ->\n      finalize_block_application\n        ctxt\n        round\n        ~cache_nonce\n        (Finalize_full_construction {level; predecessor_round})\n        protocol_data_contents\n        payload_producer\n        block_producer\n        liquidity_baking_escape_ema\n        implicit_operations_results\n        predecessor\n        migration_balance_updates\n        op_count\n\nlet relative_position_within_block op1 op2 =\n  let open Alpha_context in\n  let (Operation_data op1) = op1.protocol_data in\n  let (Operation_data op2) = op2.protocol_data in\n  match[@coq_match_with_default] (op1.contents, op2.contents) with\n  | (Single (Preendorsement _), Single (Preendorsement _)) -> 0\n  | (Single (Preendorsement _), _) -> -1\n  | (_, Single (Preendorsement _)) -> 1\n  | (Single (Endorsement _), Single (Endorsement _)) -> 0\n  | (Single (Endorsement _), _) -> -1\n  | (_, Single (Endorsement _)) -> 1\n  | (Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _)) -> 0\n  | (_, Single (Seed_nonce_revelation _)) -> 1\n  | (Single (Seed_nonce_revelation _), _) -> -1\n  | ( Single (Double_preendorsement_evidence _),\n      Single (Double_preendorsement_evidence _) ) ->\n      0\n  | (_, Single (Double_preendorsement_evidence _)) -> 1\n  | (Single (Double_preendorsement_evidence _), _) -> -1\n  | ( Single (Double_endorsement_evidence _),\n      Single (Double_endorsement_evidence _) ) ->\n      0\n  | (_, Single (Double_endorsement_evidence _)) -> 1\n  | (Single (Double_endorsement_evidence _), _) -> -1\n  | (Single (Double_baking_evidence _), Single (Double_baking_evidence _)) -> 0\n  | (_, Single (Double_baking_evidence _)) -> 1\n  | (Single (Double_baking_evidence _), _) -> -1\n  | (Single (Activate_account _), Single (Activate_account _)) -> 0\n  | (_, Single (Activate_account _)) -> 1\n  | (Single (Activate_account _), _) -> -1\n  | (Single (Proposals _), Single (Proposals _)) -> 0\n  | (_, Single (Proposals _)) -> 1\n  | (Single (Proposals _), _) -> -1\n  | (Single (Ballot _), Single (Ballot _)) -> 0\n  | (_, Single (Ballot _)) -> 1\n  | (Single (Ballot _), _) -> -1\n  | (Single (Failing_noop _), Single (Failing_noop _)) -> 0\n  | (_, Single (Failing_noop _)) -> 1\n  | (Single (Failing_noop _), _) -> -1\n  (* Manager operations with smaller counter are pre-validated first. *)\n  | (Single (Manager_operation op1), Single (Manager_operation op2)) ->\n      Z.compare op1.counter op2.counter\n  | (Cons (Manager_operation op1, _), Single (Manager_operation op2)) ->\n      Z.compare op1.counter op2.counter\n  | (Single (Manager_operation op1), Cons (Manager_operation op2, _)) ->\n      Z.compare op1.counter op2.counter\n  | (Cons (Manager_operation op1, _), Cons (Manager_operation op2, _)) ->\n      Z.compare op1.counter op2.counter\n\nlet init_cache ctxt =\n  Context.Cache.set_cache_layout ctxt cache_layout >>= fun ctxt ->\n  Lwt.return (Context.Cache.clear ctxt)\n\nlet init ctxt block_header =\n  let level = block_header.Block_header.level in\n  let timestamp = block_header.timestamp in\n  let typecheck (ctxt : Alpha_context.context) (script : Alpha_context.Script.t)\n      =\n    let allow_forged_in_storage =\n      false\n      (* There should be no forged value in bootstrap contracts. *)\n    in\n    Script_ir_translator.parse_script\n      ctxt\n      ~legacy:true\n      ~allow_forged_in_storage\n      script\n    >>=? fun (Ex_script parsed_script, ctxt) ->\n    Script_ir_translator.extract_lazy_storage_diff\n      ctxt\n      Optimized\n      parsed_script.storage_type\n      parsed_script.storage\n      ~to_duplicate:Script_ir_translator.no_lazy_storage_id\n      ~to_update:Script_ir_translator.no_lazy_storage_id\n      ~temporary:false\n    >>=? fun (storage, lazy_storage_diff, ctxt) ->\n    Script_ir_translator.unparse_data\n      ctxt\n      Optimized\n      parsed_script.storage_type\n      storage\n    >|=? fun (storage, ctxt) ->\n    let storage =\n      Alpha_context.Script.lazy_expr (Micheline.strip_locations storage)\n    in\n    (({script with storage}, lazy_storage_diff), ctxt)\n  in\n  (* The cache must be synced at the end of block validation, so we do\n     so here for the first block in a protocol where `finalize_block`\n     is not called. *)\n  Alpha_context.Raw_level.of_int32 level >>?= fun raw_level ->\n  let init_fitness =\n    Alpha_context.Fitness.create_without_locked_round\n      ~level:raw_level\n      ~round:Alpha_context.Round.zero\n      ~predecessor_round:Alpha_context.Round.zero\n  in\n  init_cache ctxt >>= fun ctxt ->\n  Alpha_context.prepare_first_block ~typecheck ~level ~timestamp ctxt\n  >>=? fun ctxt ->\n  let cache_nonce =\n    cache_nonce_from_block_header\n      block_header\n      {\n        payload_hash = Block_payload_hash.zero;\n        payload_round = Alpha_context.Round.zero;\n        liquidity_baking_escape_vote = false;\n        seed_nonce_hash = None;\n        proof_of_work_nonce =\n          Bytes.make Constants_repr.proof_of_work_nonce_size '0';\n      }\n  in\n  Alpha_context.Cache.Admin.sync ctxt ~cache_nonce >>= fun ctxt ->\n  return\n    (Alpha_context.finalize ctxt (Alpha_context.Fitness.to_raw init_fitness))\n\nlet value_of_key ~chain_id:_ ~predecessor_context:ctxt ~predecessor_timestamp\n    ~predecessor_level:pred_level ~predecessor_fitness:_ ~predecessor:_\n    ~timestamp =\n  let level = Int32.succ pred_level in\n  Alpha_context.prepare ctxt ~level ~predecessor_timestamp ~timestamp\n  >>=? fun (ctxt, _, _) -> return (Apply.value_of_key ctxt)\n\nlet check_manager_signature {chain_id; ctxt; _} op raw_op =\n  Apply.check_manager_signature ctxt chain_id op raw_op\n\nlet precheck_manager {ctxt; _} op =\n  (* We do not account for the gas limit of the batch in the block\n     since this function does not return a context, but we check that\n     this limit is within bounds (and fail otherwise with a\n     permanenent error). *)\n  Apply.precheck_manager_contents_list ctxt op ~mempool_mode:true\n  >|=? fun (_ :\n             Alpha_context.t\n             * 'kind Alpha_context.Kind.manager\n               Apply_results.prechecked_contents_list) -> ()\n\n(* Vanity nonce: 1031119008347755 *)\n" ;
                }] ;
}
end


module Registered =
  Tezos_protocol_updater.Registered_protocol.Register_embedded_V4
    (Tezos_protocol_012_Psithaca.Environment)
    (Tezos_protocol_012_Psithaca.Protocol.Main)
    (Source)