Source file registerer.ml

module Source = struct
  let hash =
    Some (Tezos_crypto.Hashed.Protocol_hash.of_b58check_exn "PtCJ7pwoxe8JasnHY8YonnLYjcVHmhiARPJvqcC6VfHT5s8k8sY")
  let sources = Tezos_base.Protocol.
{ expected_env = V0 ;
  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 Stuff} ****************************************************************)\n\ntype 'a lazyt = unit -> 'a\ntype 'a lazy_list_t = LCons of 'a * ('a lazy_list_t tzresult Lwt.t lazyt)\ntype 'a lazy_list = 'a lazy_list_t tzresult Lwt.t\n\n(** Include bounds *)\nval (-->) : int -> int -> int list\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\ntype 'a lazyt = unit -> 'a\ntype 'a lazy_list_t = LCons of 'a * ('a lazy_list_t tzresult Lwt.t lazyt)\ntype 'a lazy_list = 'a lazy_list_t tzresult Lwt.t\n\nlet rec (-->) i j = (* [i; i+1; ...; j] *)\n  if Compare.Int.(i > j)\n  then []\n  else i :: (succ i --> j)\n\nlet rec (--->) i j = (* [i; i+1; ...; j] *)\n  if Compare.Int32.(i > j)\n  then []\n  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\n      List.rev acc\n    else if Compare.Char.(String.get path i = delim) then\n      do_slashes acc limit (i + 1)\n    else\n      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\n        List.rev acc\n      else\n        List.rev (String.sub path i (l - i) :: acc)\n    else\n      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\n        List.rev acc\n      else\n        List.rev (String.sub path i (j - i) :: acc)\n    else if Compare.Char.(String.get path j = delim) then\n      do_slashes (String.sub path i (j - i) :: acc) limit j\n    else\n      do_component acc limit i (j + 1) in\n  if Compare.Int.(limit > 0) then\n    do_slashes [] limit 0\n  else\n    [ path ]\n\nlet pp_print_paragraph ppf description =\n  Format.fprintf ppf \"@[%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 = function\n    | xs when Compare.Int.(n <= 0) -> Some (List.rev acc, xs)\n    | [] -> None\n    | x :: xs -> loop (x :: acc) (n-1) xs 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\n    None\n\nlet rec remove_elem_from_list nb = function\n  | [] -> []\n  | l when Compare.Int.(nb <= 0) -> l\n  | _ :: tl -> remove_elem_from_list (nb - 1) tl\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(** 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 registred 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 ->\n  get:('key -> 'a option tzresult Lwt.t) ->\n  'a Data_encoding.t -> unit\n\n(** Return a description for a prefixed fragment of the given context.\n    All keys registred 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 : { rpc_arg: 'a RPC_arg.t ;\n            encoding: 'a Data_encoding.t ;\n            compare: 'a -> 'a -> int } -> ('key, 'a, 'key * 'a) args\n  | Pair : ('key, 'a, 'inter_key) args *\n           ('inter_key, 'b, 'sub_key) args -> ('key, 'a * 'b, 'sub_key) args\n\n(** Return a description for a indexed sub-context.\n    All keys registred in the subcontext will be shared by the external\n    context. One should provide a function to list all the registred\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 -> 'sub_key t\n\n(** Helpers for manipulating and defining indexes. *)\n\nval pack: ('key, 'a, 'sub_key) args -> 'key -> 'a -> 'sub_key\nval unpack: ('key, 'a, 'sub_key) args -> 'sub_key -> 'key * 'a\n\nmodule type INDEX = sig\n  type t\n  val path_length: int\n  val to_path: t -> string list -> string list\n  val of_path: string list -> t option\n  val rpc_arg: t RPC_arg.t\n  val encoding: t Data_encoding.t\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 description ref\n\nand 'key description =\n  | Empty : 'key description\n  | Value : { get: 'key -> 'a option tzresult Lwt.t ;\n              encoding: 'a Data_encoding.t } -> 'key description\n  | NamedDir: 'key t StringMap.t -> 'key description\n  | IndexedDir: { 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 }-> 'key description\n\nlet rec register_named_subcontext : type r. r t -> string list -> r t =\n  fun dir names ->\n    match !dir, names with\n    | _, [] -> dir\n    | Value _, _ -> invalid_arg \"\"\n    | IndexedDir _, _ -> invalid_arg \"\"\n    | Empty, name :: names ->\n        let subdir = ref Empty in\n        dir := NamedDir (StringMap.singleton name subdir) ;\n        register_named_subcontext subdir names\n    | NamedDir map, name :: names ->\n        let subdir =\n          match StringMap.find_opt name map with\n          | Some subdir -> subdir\n          | None ->\n              let subdir = ref Empty in\n              dir := NamedDir (StringMap.add name subdir map) ;\n              subdir in\n        register_named_subcontext subdir names\n\ntype (_, _, _) args =\n  | One : { rpc_arg: 'a RPC_arg.t ;\n            encoding: 'a Data_encoding.t ;\n            compare: 'a -> 'a -> int } -> ('key, 'a, 'key * 'a) args\n  | Pair : ('key, 'a, 'inter_key) args *\n           ('inter_key, 'b, 'sub_key) args -> ('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\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\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\n        | 0 -> compare_r b1 b2\n        | x -> x\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 ->\n            if equal i j then loop acc i l\n            else loop (j :: acc) j l in\n      loop [i] i l\n\nlet rec register_indexed_subcontext\n  : type r a b. r t -> list:(r -> a list tzresult Lwt.t) ->\n  (r, a, b) args -> b t =\n  fun dir ~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 =\n          list r >>=? fun l ->\n          return (destutter equal_left l) in\n        let list_right r =\n          let a, k = unpack left r in\n          list a >>=? fun l ->\n          return\n            (List.map snd\n               (List.filter (fun (x, _) ->  equal_left x k) l)) in\n        register_indexed_subcontext\n          (register_indexed_subcontext dir ~list:list_left left)\n          ~list:list_right right\n    | One { rpc_arg = arg ; encoding = arg_encoding ; _ } ->\n        match !dir with\n        | Value _ -> invalid_arg \"\"\n        | NamedDir _ -> invalid_arg \"\"\n        | Empty ->\n            let subdir = ref Empty in\n            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 -> invalid_arg \"\"\n            | Some RPC_arg.Eq -> subdir\n\nlet register_value :\n  type a b. a t -> get:(a -> b option tzresult Lwt.t) -> b Data_encoding.t -> unit =\n  fun dir ~get encoding ->\n    match !dir with\n    | Empty -> dir := Value { get ; encoding }\n    | _ -> invalid_arg \"\"\n\nlet create () = ref Empty\n\nlet rec pp : type a. Format.formatter -> a t -> unit = fun ppf dir ->\n  match !dir with\n  | Empty ->\n      Format.fprintf ppf \"EMPTY\"\n  | Value _e ->\n      Format.fprintf ppf \"Value\"\n  | NamedDir map ->\n      Format.fprintf ppf \"@[<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 pp_item : type a. Format.formatter -> (string * a t) -> unit =\n  fun ppf (name, dir) ->\n    Format.fprintf ppf \"@[<v 2>%s@ %a@]\"\n      name\n      pp dir\n\n\nmodule type INDEX = sig\n  type t\n  val path_length: int\n  val to_path: t -> string list -> string list\n  val of_path: string list -> t option\n  val rpc_arg: t RPC_arg.t\n  val encoding: t Data_encoding.t\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 } -> 'key handler\n\ntype _ opt_handler =\n    Opt_handler :\n      { encoding: 'a Data_encoding.t ;\n        get: 'key -> int -> 'a option tzresult Lwt.t } -> 'key opt_handler\n\nlet rec combine_object = function\n  | [] -> Handler { encoding = Data_encoding.unit ;\n                    get = fun _ _ -> return_unit }\n  | (name, Opt_handler handler) :: fields ->\n      let Handler handlers = combine_object fields in\n      Handler { encoding =\n                  Data_encoding.merge_objs\n                    Data_encoding.(obj1 (opt name (dynamic_size handler.encoding)))\n                    handlers.encoding ;\n                get = fun k i ->\n                  handler.get k i >>=? fun v1 ->\n                  handlers.get k i >>=? fun v2 ->\n                  return (v1, v2) }\n\ntype query = {\n  depth: int ;\n}\n\nlet depth_query =\n  let open RPC_query in\n  query (fun depth -> { depth })\n  |+ field \"depth\" RPC_arg.int 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 : type ikey. (key, ikey) RPC_path.t -> ikey opt_handler -> unit =\n      fun path (Opt_handler { encoding ; get }) ->\n        let service =\n          RPC_service.get_service\n            ~query: depth_query\n            ~output: encoding\n            path in\n        rpc_dir :=\n          RPC_directory.register !rpc_dir service begin\n            fun k q () ->\n              get k (q.depth + 1) >>=? function\n              | None -> raise Not_found\n              | Some x -> return x\n          end in\n    let rec build_handler : type ikey. ikey t -> (key, ikey) RPC_path.t -> ikey opt_handler =\n      fun dir path ->\n        match !dir with\n        | Empty -> Opt_handler { encoding = Data_encoding.unit ;\n                                 get = fun _ _ -> return_none }\n        | Value { get ; encoding } ->\n            let handler =\n              Opt_handler {\n                encoding ;\n                get =\n                  fun k i -> if Compare.Int.(i < 0) then return_none else get k\n              } in\n            register 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 in\n            let Handler handler = combine_object fields in\n            let handler =\n              Opt_handler\n                { encoding = handler.encoding ;\n                  get = fun k i ->\n                    if Compare.Int.(i < 0) then\n                      return_none\n                    else\n                      handler.get k (i-1) >>=? fun v ->\n                      return_some v } in\n            register path handler ;\n            handler\n        | IndexedDir { arg ; arg_encoding ; list ; subdir } ->\n            let Opt_handler handler =\n              build_handler subdir RPC_path.(path /: arg) in\n            let encoding =\n              let open Data_encoding in\n              union [\n                case (Tag 0)\n                  ~title:\"Leaf\"\n                  (dynamic_size arg_encoding)\n                  (function (key, None) -> Some key | _ -> None)\n                  (fun key -> (key, None)) ;\n                case (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              ] 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                map_p\n                  (fun key ->\n                     if Compare.Int.(i = 1) then\n                       return (key, None)\n                     else\n                       handler.get (k, key) (i-1) >>=? fun value ->\n                       return (key, value))\n                  keys >>=? fun values ->\n                return_some values in\n            let handler =\n              Opt_handler {\n                encoding = Data_encoding.(list (dynamic_size encoding)) ;\n                get ;\n              } in\n            register path handler ;\n            handler in\n    ignore (build_handler dir RPC_path.open_root : key opt_handler) ;\n    !rpc_dir\n\n" ;
                } ;
                { name = "State_hash" ;
                  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\nlet random_state_hash = \"\\076\\064\\204\" (* rng(53): never used... *)\n\ninclude Blake2B.Make(Base58)(struct\n    let name = \"random\"\n    let title = \"A random generation state\"\n    let b58check_prefix = random_state_hash\n    let size = None\n  end)\n\nlet () =\n  Base58.check_encoded_prefix b58check_encoding \"rng\" 53\n\n" ;
                } ;
                { name = "Nonce_hash" ;
                  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\n(* 32 *)\nlet nonce_hash = \"\\069\\220\\169\" (* nce(53) *)\n\ninclude Blake2B.Make(Base58)(struct\n    let name = \"cycle_nonce\"\n    let title = \"A nonce hash\"\n    let b58check_prefix = nonce_hash\n    let size = None\n  end)\n\nlet () =\n  Base58.check_encoded_prefix b58check_encoding \"nce\" 53\n" ;
                } ;
                { name = "Script_expr_hash" ;
                  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\nlet script_expr_hash = \"\\013\\044\\064\\027\" (* expr(54) *)\n\ninclude Blake2B.Make(Base58)(struct\n    let name = \"script_expr\"\n    let title = \"A script expression ID\"\n    let b58check_prefix = script_expr_hash\n    let size = None\n  end)\n\nlet () =\n  Base58.check_encoded_prefix b58check_encoding \"expr\" 54\n" ;
                } ;
                { name = "Contract_hash" ;
                  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\n(* 20 *)\nlet contract_hash = \"\\002\\090\\121\" (* KT1(36) *)\n\ninclude Blake2B.Make(Base58)(struct\n    let name = \"Contract_hash\"\n    let title = \"A contract ID\"\n    let b58check_prefix = contract_hash\n    let size = Some 20\n  end)\n\nlet () =\n  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\ninclude S.HASH\n\nval encoding : t Data_encoding.t\nval rpc_arg : t RPC_arg.t\n\ntype activation_code\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\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 = Blake2B.Make(Base58)(struct\n    let name = \"Blinded public key hash\"\n    let title = \"A blinded public key hash\"\n    let b58check_prefix = \"\\001\\002\\049\\223\"\n    let size = Some Ed25519.Public_key_hash.size\n  end)\n\ninclude H\n\nlet () =\n  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 = MBytes.t\n\nlet activation_code_size = Ed25519.Public_key_hash.size\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\n    invalid_arg \"Blinded_public_key_hash.activation_code_of_hex\" ;\n  MBytes.of_hex (`Hex h)\n\nmodule Index = H\n" ;
                } ;
                { name = "Qty_repr" ;
                  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\nmodule type QTY = sig\n  val id : string\nend\n\nmodule type S = sig\n  type qty\n\n  type error +=\n    | Addition_overflow of qty * qty (* `Temporary *)\n    | Subtraction_underflow of qty * qty (* `Temporary *)\n    | Multiplication_overflow of qty * int64 (* `Temporary *)\n    | Negative_multiplicator of qty * int64 (* `Temporary *)\n    | Invalid_divisor of qty * int64 (* `Temporary *)\n\n  val id : string\n  val zero : qty\n  val one_mutez : qty\n  val one_cent : qty\n  val fifty_cents : qty\n  val one : qty\n\n  val ( -? ) : qty -> qty -> qty tzresult\n  val ( +? ) : qty -> qty -> qty tzresult\n  val ( *? ) : qty -> int64 -> qty tzresult\n  val ( /? ) : qty -> int64 -> qty tzresult\n\n  val to_mutez : qty -> int64\n\n  (** [of_mutez n] (micro tez) is None if n is negative *)\n  val of_mutez : int64 -> qty option\n\n  (** [of_mutez_exn n] fails if n is negative.\n      It should only be used at toplevel for constants. *)\n  val of_mutez_exn : int64 -> qty\n\n  (** It should only be used at toplevel for constants. *)\n  val add_exn : qty -> qty -> qty\n\n  (** It should only be used at toplevel for constants. *)\n  val mul_exn : qty -> int -> qty\n\n  val encoding : qty Data_encoding.t\n\n  val to_int64 : qty -> int64\n\n  include Compare.S with type t := qty\n\n  val pp: Format.formatter -> qty -> unit\n\n  val of_string: string -> qty option\n  val to_string: qty -> string\n\nend\n\nmodule Make (T: QTY) : S = struct\n\n  type qty = int64 (* invariant: positive *)\n\n  type error +=\n    | Addition_overflow of qty * qty (* `Temporary *)\n    | Subtraction_underflow of qty * qty (* `Temporary *)\n    | Multiplication_overflow of qty * int64 (* `Temporary *)\n    | Negative_multiplicator of qty * int64 (* `Temporary *)\n    | Invalid_divisor of qty * int64 (* `Temporary *)\n\n  include Compare.Int64\n  let zero = 0L\n  (* all other constant are defined from the value of one micro tez *)\n  let one_mutez = 1L\n  let one_cent = Int64.mul one_mutez 10_000L\n  let fifty_cents = Int64.mul one_cent 50L\n  (* 1 tez = 100 cents = 1_000_000 mutez *)\n  let one = Int64.mul one_cent 100L\n  let id = T.id\n\n  let 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 &&\n            List.for_all (fun s -> String.length s = 3) tl\n          )\n      | [] -> false 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.Int.(List.length l > 2) then\n        false\n      else\n        triplets (List.rev l) 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 String.get s i else '0') in\n      try\n        Some (Int64.of_string (remove_commas left ^ pad_to_six (remove_commas right)))\n      with _ -> None 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\n            parse left right\n          else\n            None\n        else if Compare.Int.(String.length right > 0)\n             && Compare.Int.(String.length right <= 6) then\n          parse left right\n        else None\n    | [ left ] ->\n        if not (String.contains s ',') || integers left then\n          parse left \"\"\n        else None\n    | _ -> None\n\n  let pp ppf amount =\n    let mult_int = 1_000_000L in\n    let rec left ppf amount =\n      let d, r = Int64.(div amount 1000L), Int64.(rem amount 1000L) in\n      if d > 0L then\n        Format.fprintf ppf \"%a%03Ld\" left d r\n      else\n        Format.fprintf ppf \"%Ld\" r in\n    let right ppf amount =\n      let triplet ppf v =\n        if Compare.Int.(v mod 10 > 0) then\n          Format.fprintf ppf \"%03d\" v\n        else if Compare.Int.(v mod 100 > 0) then\n          Format.fprintf ppf \"%02d\" (v / 10)\n        else\n          Format.fprintf ppf \"%d\" (v / 100) in\n      let hi, lo = amount / 1000, amount mod 1000 in\n      if Compare.Int.(lo = 0) then\n        Format.fprintf ppf \"%a\" triplet hi\n      else\n        Format.fprintf ppf \"%03d%a\" hi triplet lo in\n    let ints, decs =\n      Int64.(div amount mult_int),\n      Int64.(to_int (rem amount mult_int)) in\n    Format.fprintf ppf \"%a\" left ints ;\n    if Compare.Int.(decs > 0) then\n      Format.fprintf ppf \".%a\" right decs\n\n  let to_string t =\n    Format.asprintf \"%a\" pp t\n\n  let (-) t1 t2 =\n    if t2 <= t1\n    then Some (Int64.sub t1 t2)\n    else None\n\n  let ( -? ) t1 t2 =\n    match t1 - t2 with\n    | None -> error (Subtraction_underflow (t1, t2))\n    | Some v -> ok v\n\n  let ( +? ) t1 t2 =\n    let t = Int64.add t1 t2 in\n    if t < t1\n    then error (Addition_overflow (t1, t2))\n    else ok t\n\n  let ( *? ) t m =\n    let open Compare.Int64 in\n    let open Int64 in\n    let rec step cur pow acc =\n      if cur = 0L then\n        ok acc\n      else\n        pow +? pow >>? fun npow ->\n        if logand cur 1L = 1L then\n          acc +? pow >>? fun nacc ->\n          step (shift_right_logical cur 1) npow nacc\n        else\n          step (shift_right_logical cur 1) npow acc in\n    if m < 0L then\n      error (Negative_multiplicator (t, m))\n    else\n      match step m t 0L with\n      | Ok res -> Ok res\n      | Error ([ Addition_overflow _ ] as errs) ->\n          Error (Multiplication_overflow (t, m) :: errs)\n      | Error errs -> Error errs\n\n  let ( /? ) t d =\n    if d <= 0L then\n      error (Invalid_divisor (t, d))\n    else\n      ok (Int64.div t d)\n\n  let add_exn t1 t2 =\n    let t = Int64.add t1 t2 in\n    if t <= 0L\n    then invalid_arg \"add_exn\"\n    else t\n\n  let mul_exn t m =\n    match t *? Int64.(of_int m) with\n    | Ok v -> v\n    | Error _ -> invalid_arg \"mul_exn\"\n\n  let of_mutez t =\n    if t < 0L then None\n    else Some t\n\n  let of_mutez_exn x =\n    match of_mutez x with\n    | None -> invalid_arg \"Qty.of_mutez\"\n    | Some v -> v\n\n  let to_int64 t = t\n  let to_mutez t = t\n\n  let encoding =\n    let open Data_encoding in\n    (check_size 10 (conv Z.of_int64 (Json.wrap_error Z.to_int64) n))\n\n  let () =\n    let open Data_encoding in\n    register_error_kind\n      `Temporary\n      ~id:(T.id ^ \".addition_overflow\")\n      ~title:(\"Overflowing \" ^ T.id ^ \" addition\")\n      ~pp: (fun ppf (opa, opb) ->\n          Format.fprintf ppf \"Overflowing addition of %a %s and %a %s\"\n            pp opa T.id pp opb T.id)\n      ~description:\n        (\"An addition of two \" ^ T.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:(T.id ^ \".subtraction_underflow\")\n      ~title:(\"Underflowing \" ^ T.id ^ \" subtraction\")\n      ~pp: (fun ppf (opa, opb) ->\n          Format.fprintf ppf \"Underflowing subtraction of %a %s and %a %s\"\n            pp opa T.id pp opb T.id)\n      ~description:\n        (\"An subtraction of two \" ^ T.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:(T.id ^ \".multiplication_overflow\")\n      ~title:(\"Overflowing \" ^ T.id ^ \" multiplication\")\n      ~pp: (fun ppf (opa, opb) ->\n          Format.fprintf ppf \"Overflowing multiplication of %a %s and %Ld\"\n            pp opa T.id opb)\n      ~description:\n        (\"A multiplication of a \" ^ T.id ^ \" amount by an integer overflowed\")\n      (obj2\n         (req \"amount\" encoding)\n         (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:(T.id ^ \".negative_multiplicator\")\n      ~title:(\"Negative \" ^ T.id ^ \" multiplicator\")\n      ~pp: (fun ppf (opa, opb) ->\n          Format.fprintf ppf \"Multiplication of %a %s by negative integer %Ld\"\n            pp opa T.id opb)\n      ~description:\n        (\"Multiplication of a \" ^ T.id ^ \" amount by a negative integer\")\n      (obj2\n         (req \"amount\" encoding)\n         (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:(T.id ^ \".invalid_divisor\")\n      ~title:(\"Invalid \" ^ T.id ^ \" divisor\")\n      ~pp: (fun ppf (opa, opb) ->\n          Format.fprintf ppf \"Division of %a %s by non positive integer %Ld\"\n            pp opa T.id opb)\n      ~description:\n        (\"Multiplication of a \" ^ T.id ^ \" amount by a non positive integer\")\n      (obj2\n         (req \"amount\" encoding)\n         (req \"divisor\" int64))\n      (function Invalid_divisor (a, b) -> Some (a, b) | _ -> None)\n      (fun (a, b) -> Invalid_divisor (a, b))\n\nend\n" ;
                } ;
                { name = "Tez_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\ntype tez = t\n\ninclude (Qty_repr.S with type qty := 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\ninclude Qty_repr.Make (struct let id = \"tez\" end)\n\ntype t = qty\ntype tez = qty\n\nlet encoding =\n  Data_encoding.def \"mutez\" @@\n  encoding\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\ntype period = t\ninclude Compare.S with type t := t\nval encoding : period Data_encoding.t\nval pp: Format.formatter -> period -> unit\n\n\nval to_seconds : period -> int64\n\n(** [of_second period] fails if period is not positive *)\nval of_seconds : int64 -> period tzresult\n\n(** [of_second period] fails if period is not positive.\n    It should only be used at toplevel for constants. *)\nval of_seconds_exn : int64 -> period\n\nval mult : int32 -> period -> period tzresult\n\nval one_second : period\nval one_minute : period\nval one_hour : period\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 = Int64.t\ntype period = t\ninclude (Compare.Int64 : Compare.S with type t := t)\nlet encoding = Data_encoding.int64\n\nlet pp ppf v = Format.fprintf ppf \"%Ld\" v\n\ntype error += (* `Permanent *)\n  | Malformed_period\n  | Invalid_arg\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 () -> Format.fprintf ppf \"Malformed period\")\n    empty\n    (function Malformed_period -> Some () | _ -> None)\n    (fun () -> Malformed_period) ;\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\nlet of_seconds t =\n  if Compare.Int64.(t >= 0L)\n  then ok t\n  else error Malformed_period\nlet to_seconds t = t\nlet of_seconds_exn t =\n  match of_seconds t with\n  | Ok t -> t\n  | _ -> invalid_arg \"Period.of_seconds_exn\"\n\nlet mult i p =\n  (* TODO check overflow *)\n  if Compare.Int32.(i < 0l)\n  then error Invalid_arg\n  else ok (Int64.mul (Int64.of_int32 i) p)\n\nlet one_second = of_seconds_exn 1L\nlet one_minute = of_seconds_exn 60L\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 include Time end)\ntype time = t\n\nval pp: Format.formatter -> t -> unit\nval of_seconds: string -> time option\nval to_seconds_string: time -> string\n\nval (+?) : time -> Period_repr.t -> time tzresult\n\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 Time\ntype time = t\n\ntype error += Timestamp_add (* `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 () ->\n        Format.fprintf ppf \"Overflow when adding timestamps.\")\n    Data_encoding.empty\n    (function Timestamp_add -> Some () | _ -> None)\n    (fun () -> Timestamp_add)\n\nlet of_seconds s =\n  try Some (of_seconds (Int64.of_string s))\n  with _ -> None\nlet to_seconds = to_seconds\nlet to_seconds_string s = Int64.to_string (to_seconds s)\n\nlet pp = pp_hum\n\nlet (+?) x y =\n  (* TODO check overflow *)\n  try ok (add x (Period_repr.to_seconds y))\n  with _exn -> Error [ Timestamp_add ]\n" ;
                } ;
                { name = "Constants_repr" ;
                  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\nlet version_number = \"\\000\"\nlet proof_of_work_nonce_size = 8\nlet nonce_length = 32\nlet max_revelations_per_block = 32\nlet max_operation_data_length = 16 * 1024 ; (* 16kB *)\n\ntype fixed = {\n  proof_of_work_nonce_size : int ;\n  nonce_length : int ;\n  max_revelations_per_block : int ;\n  max_operation_data_length : int ;\n}\n\nlet fixed_encoding =\n  let open Data_encoding in\n  conv\n    (fun c ->\n       (c.proof_of_work_nonce_size,\n        c.nonce_length,\n        c.max_revelations_per_block,\n        c.max_operation_data_length))\n    (fun (proof_of_work_nonce_size,\n          nonce_length,\n          max_revelations_per_block,\n          max_operation_data_length) ->\n      { proof_of_work_nonce_size ;\n        nonce_length ;\n        max_revelations_per_block ;\n        max_operation_data_length ;\n      } )\n    (obj4\n       (req \"proof_of_work_nonce_size\" uint8)\n       (req \"nonce_length\" uint8)\n       (req \"max_revelations_per_block\" uint8)\n       (req \"max_operation_data_length\" int31))\n\nlet fixed = {\n  proof_of_work_nonce_size ;\n  nonce_length ;\n  max_revelations_per_block ;\n  max_operation_data_length ;\n}\n\ntype 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  endorsers_per_block: int ;\n  hard_gas_limit_per_operation: Z.t ;\n  hard_gas_limit_per_block: Z.t ;\n  proof_of_work_threshold: int64 ;\n  tokens_per_roll: Tez_repr.t ;\n  michelson_maximum_type_size: int;\n  seed_nonce_revelation_tip: Tez_repr.t ;\n  origination_burn: Tez_repr.t ;\n  block_security_deposit: Tez_repr.t ;\n  endorsement_security_deposit: Tez_repr.t ;\n  block_reward: Tez_repr.t ;\n  endorsement_reward: Tez_repr.t ;\n  cost_per_byte: Tez_repr.t ;\n  hard_storage_limit_per_operation: Z.t ;\n}\n\nlet default = {\n  preserved_cycles = 5 ;\n  blocks_per_cycle = 4096l ;\n  blocks_per_commitment = 32l ;\n  blocks_per_roll_snapshot = 256l ;\n  blocks_per_voting_period = 32768l ;\n  time_between_blocks =\n    List.map Period_repr.of_seconds_exn [ 60L ; 75L ] ;\n  endorsers_per_block = 32 ;\n  hard_gas_limit_per_operation = Z.of_int 400_000 ;\n  hard_gas_limit_per_block = Z.of_int 4_000_000 ;\n  proof_of_work_threshold =\n    Int64.(sub (shift_left 1L 46) 1L) ;\n  tokens_per_roll =\n    Tez_repr.(mul_exn one 10_000) ;\n  michelson_maximum_type_size = 1000 ;\n  seed_nonce_revelation_tip = begin\n    match Tez_repr.(one /? 8L) with\n    | Ok c -> c\n    | Error _ -> assert false\n  end ;\n  origination_burn = Tez_repr.of_mutez_exn 257_000L ;\n  block_security_deposit = Tez_repr.(mul_exn one 512) ;\n  endorsement_security_deposit = Tez_repr.(mul_exn one 64) ;\n  block_reward = Tez_repr.(mul_exn one 16) ;\n  endorsement_reward = Tez_repr.(mul_exn one 2) ;\n  hard_storage_limit_per_operation = Z.of_int 60_000 ;\n  cost_per_byte = Tez_repr.of_mutez_exn 1_000L ;\n}\n\nmodule CompareListInt = Compare.List (Compare.Int)\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_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.michelson_maximum_type_size,\n          c.seed_nonce_revelation_tip,\n          c.origination_burn,\n          c.block_security_deposit,\n          c.endorsement_security_deposit,\n          c.block_reward),\n         (c.endorsement_reward,\n          c.cost_per_byte,\n          c.hard_storage_limit_per_operation))) )\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            michelson_maximum_type_size,\n            seed_nonce_revelation_tip,\n            origination_burn,\n            block_security_deposit,\n            endorsement_security_deposit,\n            block_reward),\n           (endorsement_reward,\n            cost_per_byte,\n            hard_storage_limit_per_operation))) ->\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        michelson_maximum_type_size ;\n        seed_nonce_revelation_tip ;\n        origination_burn ;\n        block_security_deposit ;\n        endorsement_security_deposit ;\n        block_reward ;\n        endorsement_reward ;\n        cost_per_byte ;\n        hard_storage_limit_per_operation ;\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_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 \"hard_gas_limit_per_operation\" z)\n          (req \"hard_gas_limit_per_block\" z))\n       (merge_objs\n          (obj8\n             (req \"proof_of_work_threshold\" int64)\n             (req \"tokens_per_roll\" Tez_repr.encoding)\n             (req \"michelson_maximum_type_size\" uint16)\n             (req \"seed_nonce_revelation_tip\" Tez_repr.encoding)\n             (req \"origination_burn\" Tez_repr.encoding)\n             (req \"block_security_deposit\" Tez_repr.encoding)\n             (req \"endorsement_security_deposit\" Tez_repr.encoding)\n             (req \"block_reward\" Tez_repr.encoding))\n          (obj3\n             (req \"endorsement_reward\" Tez_repr.encoding)\n             (req \"cost_per_byte\" Tez_repr.encoding)\n             (req \"hard_storage_limit_per_operation\" z))))\n\ntype t = {\n  fixed : fixed ;\n  parametric : parametric ;\n}\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" ;
                } ;
                { name = "Fitness_repr" ;
                  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\ntype error += Invalid_fitness (* `Permanent *)\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"invalid_fitness\"\n    ~title:\"Invalid fitness\"\n    ~description:\"Fitness representation should be exactly 8 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\nlet int64_to_bytes i =\n  let b = MBytes.create 8 in\n  MBytes.set_int64 b 0 i;\n  b\n\nlet int64_of_bytes b =\n  if Compare.Int.(MBytes.length b <> 8) then\n    error Invalid_fitness\n  else\n    ok (MBytes.get_int64 b 0)\n\nlet from_int64 fitness =\n  [ MBytes.of_string Constants_repr.version_number ;\n    int64_to_bytes fitness ]\n\nlet to_int64 = function\n  | [ version ;\n      fitness ]\n    when Compare.String.\n           (MBytes.to_string version = Constants_repr.version_number) ->\n      int64_of_bytes fitness\n  | [] -> ok 0L\n  | _ -> error Invalid_fitness\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\ntype raw_level = t\nval encoding: raw_level Data_encoding.t\nval rpc_arg: raw_level RPC_arg.arg\nval pp: Format.formatter -> raw_level -> unit\ninclude Compare.S with type t := raw_level\n\nval to_int32: raw_level -> int32\nval of_int32_exn: int32 -> raw_level\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\nval pred: raw_level -> 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\ntype raw_level = t\ninclude (Compare.Int32 : Compare.S with type t := t)\nlet encoding = Data_encoding.int32\nlet pp ppf level = Format.fprintf ppf \"%ld\" level\nlet rpc_arg =\n  let construct raw_level = Int32.to_string raw_level in\n  let destruct str =\n    match Int32.of_string str with\n    | exception _ -> Error \"Cannot parse level\"\n    | raw_level -> Ok raw_level in\n  RPC_arg.make\n    ~descr:\"A level integer\"\n    ~name: \"block_level\"\n    ~construct\n    ~destruct\n    ()\n\nlet root = 0l\nlet succ = Int32.succ\nlet pred l =\n  if l = 0l\n  then None\n  else Some (Int32.pred l)\n\nlet diff = Int32.sub\n\nlet to_int32 l = l\nlet of_int32_exn l =\n  if Compare.Int32.(l >= 0l)\n  then l\n  else invalid_arg \"Level_repr.of_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 ppf \"The level is %s but should be non-negative.\" (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  try Ok (of_int32_exn l)\n  with _ -> Error [Unexpected_level l]\n\nmodule Index = struct\n  type t = raw_level\n  let path_length = 1\n  let to_path level l = Int32.to_string level :: l\n  let of_path = function\n    | [s] -> begin\n        try Some (Int32.of_string s)\n        with _ -> None\n      end\n    | _ -> None\n  let rpc_arg = rpc_arg\n  let encoding = encoding\n  let compare = compare\nend\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\ntype t\ntype voting_period = t\nval encoding: voting_period Data_encoding.t\nval rpc_arg: voting_period RPC_arg.arg\nval pp: Format.formatter -> voting_period -> unit\ninclude Compare.S with type t := voting_period\n\nval to_int32: voting_period -> int32\nval of_int32_exn: int32 -> voting_period\n\nval root: voting_period\nval succ: voting_period -> voting_period\n\ntype kind =\n  | Proposal\n  | Testing_vote\n  | Testing\n  | Promotion_vote\n\nval kind_encoding: kind 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 = int32\ntype voting_period = t\ninclude (Compare.Int32 : Compare.S with type t := t)\nlet encoding = Data_encoding.int32\nlet pp ppf level = Format.fprintf ppf \"%ld\" level\nlet rpc_arg =\n  let construct voting_period = Int32.to_string voting_period in\n  let destruct str =\n    match Int32.of_string str with\n    | exception _ -> Error \"Cannot parse voting period\"\n    | voting_period -> Ok voting_period in\n  RPC_arg.make\n    ~descr:\"A voting period\"\n    ~name: \"voting_period\"\n    ~construct\n    ~destruct\n    ()\n\nlet root = 0l\nlet succ = Int32.succ\n\nlet to_int32 l = l\nlet of_int32_exn l =\n  if Compare.Int32.(l >= 0l)\n  then l\n  else invalid_arg \"Voting_period_repr.of_int32\"\n\ntype kind =\n  | Proposal\n  | Testing_vote\n  | Testing\n  | Promotion_vote\n\nlet kind_encoding =\n  let open Data_encoding in\n  union ~tag_size:`Uint8 [\n    case (Tag 0)\n      ~title:\"Proposal\"\n      (constant \"proposal\")\n      (function Proposal -> Some () | _ -> None)\n      (fun () -> Proposal) ;\n    case (Tag 1)\n      ~title:\"Testing_vote\"\n      (constant \"testing_vote\")\n      (function Testing_vote -> Some () | _ -> None)\n      (fun () -> Testing_vote) ;\n    case (Tag 2)\n      ~title:\"Testing\"\n      (constant \"testing\")\n      (function Testing -> Some () | _ -> None)\n      (fun () -> Testing) ;\n    case (Tag 3)\n      ~title:\"Promotion_vote\"\n      (constant \"promotion_vote\")\n      (function Promotion_vote -> Some () | _ -> None)\n      (fun () -> Promotion_vote) ;\n  ]\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\ntype cycle = t\ninclude Compare.S with type t := t\nval encoding: cycle Data_encoding.t\nval rpc_arg: cycle RPC_arg.arg\nval pp: Format.formatter -> cycle -> unit\n\nval root: cycle\nval pred: cycle -> cycle option\nval add: cycle -> int -> cycle\nval sub: cycle -> int -> cycle option\nval succ: cycle -> cycle\n\nval to_int32: cycle -> int32\nval of_int32_exn: int32 -> cycle\n\nmodule Map : S.MAP 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(*                                                                           *)\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\ntype cycle = t\n\nlet encoding = Data_encoding.int32\nlet rpc_arg =\n  let construct = Int32.to_string in\n  let destruct str =\n    match Int32.of_string str with\n    | exception _ -> Error \"Cannot parse cycle\"\n    | cycle -> Ok cycle in\n  RPC_arg.make\n    ~descr:\"A cycle integer\"\n    ~name: \"block_cycle\"\n    ~construct\n    ~destruct\n    ()\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\nlet succ = Int32.succ\nlet pred = function\n  | 0l -> None\n  | 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 to_int32 i = i\n\nlet of_int32_exn l =\n  if Compare.Int32.(l >= 0l)\n  then l\n  else invalid_arg \"Level_repr.Cycle.of_int32\"\n\nmodule Index = struct\n  type t = cycle\n  let path_length = 1\n  let to_path c l =\n    Int32.to_string (to_int32 c) :: l\n  let of_path = function\n    | [s] -> begin\n        try Some (Int32.of_string s)\n        with _ -> None\n      end\n    | _ -> None\n  let rpc_arg = rpc_arg\n  let encoding = encoding\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\ntype t = private {\n  level: Raw_level_repr.t (** The level of the block relative to genesis. This\n                              is also the Shell's notion of level. *);\n  level_position: int32 (** The level of the block relative to the block that\n                            starts protocol alpha. This is specific to the\n                            protocol alpha. Other protocols might or might not\n                            include a similar notion. *);\n  cycle: Cycle_repr.t (** The current cycle's number. Note that cycles are a\n                          protocol-specific notion. As a result, the cycle\n                          number starts at 0 with the first block of protocol\n                          alpha. *);\n  cycle_position: int32 (** The current level of the block relative to the first\n                            block of the current cycle. *);\n  voting_period: Voting_period_repr.t ;\n  voting_period_position: int32 ;\n  expected_commitment: bool ;\n}\n\n(* Note that, the type `t` above must respect some invariants (hence the\n   `private` annotation). Notably:\n\n   level_position = cycle * blocks_per_cycle + cycle_position\n*)\n\n\n\ntype level = t\n\ninclude Compare.S with type t := level\n\nval encoding: level Data_encoding.t\nval pp: Format.formatter -> level -> unit\nval pp_full: Format.formatter -> level -> unit\n\nval root: Raw_level_repr.t -> level\n\nval from_raw:\n  first_level:Raw_level_repr.t ->\n  blocks_per_cycle:int32 ->\n  blocks_per_voting_period:int32 ->\n  blocks_per_commitment:int32 ->\n  Raw_level_repr.t -> level\n\nval diff: level -> level -> int32\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  voting_period: Voting_period_repr.t ;\n  voting_period_position: int32 ;\n  expected_commitment: bool ;\n}\n\ninclude Compare.Make(struct\n    type nonrec t = t\n    let compare { level = l1 } { level = l2 } = Raw_level_repr.compare l1 l2\n  end)\n\ntype level = t\n\nlet pp ppf { level } = Raw_level_repr.pp ppf level\n\nlet pp_full ppf l =\n  Format.fprintf ppf\n    \"%a.%ld (cycle %a.%ld) (vote %a.%ld)\"\n    Raw_level_repr.pp l.level l.level_position\n    Cycle_repr.pp l.cycle l.cycle_position\n    Voting_period_repr.pp l.voting_period l.voting_period_position\n\nlet encoding =\n  let open Data_encoding in\n  conv\n    (fun { level ; level_position ;\n           cycle ; cycle_position ;\n           voting_period; voting_period_position ;\n           expected_commitment } ->\n      (level, level_position,\n       cycle, cycle_position,\n       voting_period, voting_period_position,\n       expected_commitment))\n    (fun (level, level_position,\n          cycle, cycle_position,\n          voting_period, voting_period_position,\n          expected_commitment) ->\n      { level ; level_position ;\n        cycle ; cycle_position ;\n        voting_period ; voting_period_position ;\n        expected_commitment })\n    (obj7\n       (req \"level\"\n          ~description:\n            \"The level of the block relative to genesis. This is also \\\n             the Shell's notion of level\"\n          Raw_level_repr.encoding)\n       (req \"level_position\"\n          ~description:\n            \"The level of the block relative to the block that starts \\\n             protocol alpha. This is specific to the protocol \\\n             alpha. Other protocols might or might not include a \\\n             similar notion.\"\n          int32)\n       (req \"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 0 \\\n             with the first block of protocol alpha.\"\n          Cycle_repr.encoding)\n       (req \"cycle_position\"\n          ~description:\n            \"The current level of the block relative to the first \\\n             block of the current cycle.\"\n          int32)\n       (req \"voting_period\"\n          ~description:\n            \"The current voting period's index. Note that cycles are a \\\n             protocol-specific notion. As a result, the voting period \\\n             index starts at 0 with the first block of protocol alpha.\"\n          Voting_period_repr.encoding)\n       (req \"voting_period_position\"\n          ~description:\n            \"The current level of the block relative to the first \\\n             block of the current voting period.\"\n          int32)\n       (req \"expected_commitment\"\n          ~description:\n            \"Tells wether the baker of this block has to commit a seed \\\n             nonce hash.\"\n          bool))\n\nlet root first_level =\n  { level = first_level ;\n    level_position = 0l ;\n    cycle = Cycle_repr.root ;\n    cycle_position = 0l ;\n    voting_period = Voting_period_repr.root ;\n    voting_period_position = 0l ;\n    expected_commitment = false ;\n  }\n\nlet from_raw\n    ~first_level ~blocks_per_cycle ~blocks_per_voting_period\n    ~blocks_per_commitment\n    level =\n  let raw_level = Raw_level_repr.to_int32 level in\n  let first_level = Raw_level_repr.to_int32 first_level in\n  let level_position =\n    Compare.Int32.max 0l (Int32.sub raw_level first_level) in\n  let cycle =\n    Cycle_repr.of_int32_exn (Int32.div level_position blocks_per_cycle) in\n  let cycle_position = Int32.rem level_position blocks_per_cycle in\n  let voting_period =\n    Voting_period_repr.of_int32_exn\n      (Int32.div level_position blocks_per_voting_period) in\n  let voting_period_position =\n    Int32.rem level_position blocks_per_voting_period in\n  let expected_commitment =\n    Compare.Int32.(Int32.rem cycle_position blocks_per_commitment =\n                   Int32.pred blocks_per_commitment) in\n  { level ; level_position ;\n    cycle ; cycle_position ;\n    voting_period ; voting_period_position ;\n    expected_commitment }\n\nlet diff { level = l1 ; _ } { level = l2 ; _ } =\n  Int32.sub (Raw_level_repr.to_int32 l1) (Raw_level_repr.to_int32 l2)\n\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 globaly 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\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 -> MBytes.t 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 -> MBytes.t * sequence\n\n(** Generates the next random value as a bounded [int32] *)\nval take_int32 : sequence -> int32 -> int32 * 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(** [intial_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 : MBytes.t -> 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\nval initial_nonce_hash_0 : Nonce_hash.t\n\n(** {2 Serializers} **********************************************************)\n\nval nonce_encoding  : nonce Data_encoding.t\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\ntype t = T of State_hash.t\ntype sequence = S of State_hash.t\ntype nonce = MBytes.t\n\nlet nonce_encoding = Data_encoding.Fixed.bytes Constants_repr.nonce_length\n\nlet init = \"Laissez-faire les proprietaires.\"\nlet zero_bytes = MBytes.of_string (String.make Nonce_hash.size '\\000')\n\nlet state_hash_encoding =\n  let open Data_encoding in\n  conv\n    State_hash.to_bytes\n    State_hash.of_bytes_exn\n    (Fixed.bytes Nonce_hash.size)\n\nlet seed_encoding =\n  let open Data_encoding in\n  conv\n    (fun (B b) -> b)\n    (fun b -> B b)\n    state_hash_encoding\n\nlet empty = B (State_hash.hash_bytes [MBytes.of_string init])\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\n       (State_hash.to_bytes state :: zero_bytes :: append ))\n\nlet xor_higher_bits i b =\n  let higher = MBytes.get_int32 b 0 in\n  let r = Int32.logxor higher i in\n  let res = MBytes.copy b in\n  MBytes.set_int32 res 0 r;\n  res\n\nlet sequence (T state) n =\n  State_hash.to_bytes state\n  |> xor_higher_bits n\n  |> (fun b -> 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)\n  then invalid_arg \"Seed_repr.take_int32\" (* FIXME *)\n  else\n    let rec loop s =\n      let bytes, s = take s in\n      let r = Int32.abs (MBytes.get_int32 bytes 0) in\n      let drop_if_over =\n        Int32.sub Int32.max_int (Int32.rem Int32.max_int bound) in\n      if Compare.Int32.(r >= drop_if_over)\n      then loop s\n      else\n        let v = Int32.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 ppf \"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.(MBytes.length nonce <> Constants_repr.nonce_length)\n  then 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.(MBytes.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 =\n  hash initial_nonce_0\n\nlet deterministic_seed seed = nonce seed zero_bytes\n\nlet initial_seeds n =\n  let rec loop acc elt i =\n    if Compare.Int.(i = 1) then\n      List.rev (elt :: acc)\n    else\n      loop\n        (elt :: acc)\n        (deterministic_seed elt)\n        (i-1) in\n  loop [] (B (State_hash.hash_bytes [])) n\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\ntype t =\n  | Unaccounted\n  | Limited of { remaining : Z.t }\n\nval encoding : t Data_encoding.encoding\nval pp : Format.formatter -> t -> unit\n\ntype cost\n\nval cost_encoding : cost Data_encoding.encoding\nval pp_cost : Format.formatter -> cost -> unit\n\ntype error += Block_quota_exceeded (* `Temporary *)\ntype error += Operation_quota_exceeded (* `Temporary *)\n\nval consume : Z.t -> t -> cost -> (Z.t * t) tzresult\nval check_enough : Z.t -> t -> cost -> unit tzresult\n\nval free : cost\nval step_cost : int -> cost\nval alloc_cost : int -> cost\nval alloc_bytes_cost : int -> cost\nval alloc_mbytes_cost : int -> cost\nval alloc_bits_cost : int -> cost\nval read_bytes_cost : Z.t -> cost\nval write_bytes_cost : Z.t -> cost\n\nval ( *@ ) : int -> cost -> cost\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\ntype t =\n  | Unaccounted\n  | Limited of { remaining : Z.t }\n\ntype cost =\n  { allocations : Z.t ;\n    steps : Z.t ;\n    reads : Z.t ;\n    writes : Z.t  ;\n    bytes_read : Z.t ;\n    bytes_written : Z.t }\n\nlet encoding =\n  let open Data_encoding in\n  union\n    [ case (Tag 0)\n        ~title:\"Limited\"\n        z\n        (function Limited { remaining } -> Some remaining | _ -> None)\n        (fun remaining -> Limited { remaining }) ;\n      case (Tag 1)\n        ~title:\"Unaccounted\"\n        (constant \"unaccounted\")\n        (function Unaccounted -> Some () | _ -> None)\n        (fun () -> Unaccounted) ]\n\nlet pp ppf = function\n  | Unaccounted ->\n      Format.fprintf ppf \"unaccounted\"\n  | Limited { remaining } ->\n      Format.fprintf ppf \"%s units remaining\" (Z.to_string remaining)\n\nlet cost_encoding =\n  let open Data_encoding in\n  conv\n    (fun { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written } ->\n       (allocations, steps, reads, writes, bytes_read, bytes_written))\n    (fun (allocations, steps, reads, writes, bytes_read, bytes_written) ->\n       { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written })\n    (obj6\n       (req \"allocations\" z)\n       (req \"steps\" z)\n       (req \"reads\" z)\n       (req \"writes\" z)\n       (req \"bytes_read\" z)\n       (req \"bytes_written\" z))\n\nlet pp_cost ppf { allocations ; steps ; reads ; writes ; bytes_read ; bytes_written } =\n  Format.fprintf ppf\n    \"(steps: %s, allocs: %s, reads: %s (%s bytes), writes: %s (%s bytes))\"\n    (Z.to_string steps)\n    (Z.to_string allocations)\n    (Z.to_string reads)\n    (Z.to_string bytes_read)\n    (Z.to_string writes)\n    (Z.to_string bytes_written)\n\ntype error += Block_quota_exceeded (* `Temporary *)\ntype error += Operation_quota_exceeded (* `Temporary *)\n\nlet allocation_weight = Z.of_int 2\nlet step_weight = Z.of_int 1\nlet read_base_weight = Z.of_int 50\nlet write_base_weight = Z.of_int 80\nlet byte_read_weight = Z.of_int 10\nlet byte_written_weight = Z.of_int 15\n\nlet consume block_gas operation_gas cost = match operation_gas with\n  | Unaccounted -> ok (block_gas, Unaccounted)\n  | Limited { remaining } ->\n      let weighted_cost =\n        Z.add\n          (Z.add\n             (Z.mul allocation_weight cost.allocations)\n             (Z.mul step_weight cost.steps))\n          (Z.add\n             (Z.add\n                (Z.mul read_base_weight cost.reads)\n                (Z.mul write_base_weight cost.writes))\n             (Z.add\n                (Z.mul byte_read_weight cost.bytes_read)\n                (Z.mul byte_written_weight cost.bytes_written))) in\n      let remaining =\n        Z.sub remaining weighted_cost in\n      let block_remaining =\n        Z.sub block_gas weighted_cost in\n      if Compare.Z.(remaining < Z.zero)\n      then error Operation_quota_exceeded\n      else if Compare.Z.(block_remaining < Z.zero)\n      then error Block_quota_exceeded\n      else ok (block_remaining, Limited { remaining })\n\nlet check_enough block_gas operation_gas cost =\n  consume block_gas operation_gas cost\n  >|? fun (_block_remainig, _remaining) -> ()\n\nlet alloc_cost n =\n  { allocations = Z.of_int (n + 1) ;\n    steps = Z.zero ;\n    reads = Z.zero ;\n    writes = Z.zero ;\n    bytes_read = Z.zero ;\n    bytes_written = Z.zero }\n\nlet alloc_bytes_cost n =\n  alloc_cost ((n + 7) / 8)\n\nlet alloc_bits_cost n =\n  alloc_cost ((n + 63) / 64)\n\nlet step_cost n =\n  { allocations = Z.zero ;\n    steps = Z.of_int n ;\n    reads = Z.zero ;\n    writes = Z.zero ;\n    bytes_read = Z.zero ;\n    bytes_written = Z.zero }\n\nlet free =\n  { allocations = Z.zero ;\n    steps = Z.zero ;\n    reads = Z.zero ;\n    writes = Z.zero ;\n    bytes_read = Z.zero ;\n    bytes_written = Z.zero }\n\nlet read_bytes_cost n =\n  { allocations = Z.zero ;\n    steps = Z.zero ;\n    reads = Z.one ;\n    writes = Z.zero ;\n    bytes_read = n ;\n    bytes_written = Z.zero }\n\nlet write_bytes_cost n =\n  { allocations = Z.zero ;\n    steps = Z.zero ;\n    reads = Z.zero ;\n    writes = Z.one ;\n    bytes_read = Z.zero ;\n    bytes_written = n }\n\nlet ( +@ ) x y =\n  { allocations = Z.add x.allocations y.allocations ;\n    steps = Z.add x.steps y.steps ;\n    reads = Z.add x.reads y.reads ;\n    writes = Z.add x.writes y.writes ;\n    bytes_read = Z.add x.bytes_read y.bytes_read ;\n    bytes_written = Z.add x.bytes_written y.bytes_written }\n\nlet ( *@ ) x y =\n  { allocations = Z.mul (Z.of_int x) y.allocations ;\n    steps = Z.mul (Z.of_int x) y.steps ;\n    reads = Z.mul (Z.of_int x) y.reads ;\n    writes = Z.mul (Z.of_int x) y.writes ;\n    bytes_read = Z.mul (Z.of_int x) y.bytes_read ;\n    bytes_written = Z.mul (Z.of_int x) y.bytes_written }\n\nlet alloc_mbytes_cost n =\n  alloc_cost 12 +@ alloc_bytes_cost n\n\nlet () =\n  let open Data_encoding in\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 \\\n       time than the operation said it 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 \\\n       exceeds the hard gas limit per block\"\n    empty\n    (function Block_quota_exceeded -> Some () | _ -> None)\n    (fun () -> Block_quota_exceeded) ;\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 arbitraty 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\n\n(** Flag for natural numbers. *)\nand n = Natural_tag\n\n(** Flag for relative numbers. *)\nand z = Integer_tag\n\n(** Natural zero. *)\nval zero_n : 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 to an OCaml [int64], returns [None] on overflow. *)\nval to_int64 : _ num -> int64 option\n\n(** Conversion from an OCaml [int]. *)\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 [int64]. *)\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 between naturals. *)\nval mul_n : n num -> n num -> n num\n\n(** Euclidean division between naturals.\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 -> n num -> (n 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 naturals 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 naturals 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" ;
                  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\ntype z = Integer_tag\ntype 't num = Z.t\n\nlet compare x y = Z.compare x y\n\nlet zero = Z.zero\nlet zero_n = Z.zero\n\nlet to_string x = Z.to_string x\nlet of_string s = try Some (Z.of_string s) with _ -> None\n\nlet to_int64 x = try Some (Z.to_int64 x) with _ -> None\nlet of_int64 n = Z.of_int64 n\n\nlet to_int x = try Some (Z.to_int x) with _ -> None\nlet of_int n = Z.of_int n\n\nlet of_zint x = x\nlet to_zint x = x\n\nlet add x y = Z.add x y\nlet sub x y = Z.sub x y\nlet mul x y = Z.mul x y\n\nlet ediv x y =\n  try\n    let (q, r) = Z.ediv_rem x y in\n    Some (q, r)\n  with _ -> None\n\nlet add_n = add\nlet mul_n = mul\nlet ediv_n = ediv\n\nlet abs x = Z.abs x\nlet is_nat x =\n  if Compare.Z.(x < Z.zero) then None else Some x\nlet neg x = Z.neg x\nlet int x = x\n\nlet shift_left x y =\n  if Compare.Int.(Z.compare y (Z.of_int 256) > 0) then\n    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\n    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\nlet shift_right_n = shift_right\n\nlet logor x y = Z.logor x y\nlet logxor x y = Z.logxor x y\nlet logand x y = Z.logand x y\nlet lognot x = Z.lognot x\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\nopen Script_int_repr\n\ntype t\n\nval of_int64 : int64 -> t\n\nval compare : t -> t -> int\n\n(* Convert a timestamp to a notation if possible *)\nval to_notation : t -> string option\n(* Convert a timestamp to a string representation of the seconds *)\nval to_num_str : t -> string\n(* Convert to a notation if possible, or num if not *)\nval to_string : t -> string\nval of_string : string -> t option\n\nval diff : t -> t -> z num\n\nval add_delta : t -> z num -> t\n\nval sub_delta : t -> z num -> t\n\nval to_zint : t -> Z.t\nval of_zint : Z.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 = 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 ->\n      begin try Some (Z.of_string x)\n        with _ -> None\n      end\n  | Some time ->\n      Some (of_int64 (Time_repr.to_seconds time))\n\nlet to_notation x =\n  try\n    let notation = Time_repr.to_notation (Time.of_seconds (Z.to_int64 x)) in\n    if String.equal notation \"out_of_range\"\n    then None\n    else Some notation\n  with _ -> None\n\nlet to_num_str = Z.to_string\n\nlet to_string x =\n  match to_notation x with\n  | None -> to_num_str x\n  | 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 =\n  Z.add t (Script_int_repr.to_zint delta)\n\nlet to_zint x = x\nlet of_zint x = x\n" ;
                } ;
                { name = "Michelson_v1_primitives" ;
                  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 += Unknown_primitive_name of string (* `Permanent *)\ntype error += Invalid_case of string (* `Permanent *)\ntype error += Invalid_primitive_name of string Micheline.canonical * Micheline.canonical_location (* `Permanent *)\n\ntype prim =\n  | K_parameter\n  | K_storage\n  | K_code\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_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_EDIV\n  | I_EMPTY_MAP\n  | I_EMPTY_SET\n  | I_EQ\n  | I_EXEC\n  | I_FAILWITH\n  | I_GE\n  | I_GET\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_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_PUSH\n  | I_RIGHT\n  | I_SIZE\n  | I_SOME\n  | I_SOURCE\n  | I_SENDER\n  | I_SELF\n  | I_STEPS_TO_QUOTA\n  | I_SUB\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  | 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\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 : string Micheline.canonical -> prim Micheline.canonical tzresult\n\nval strings_of_prims : prim Micheline.canonical -> string Micheline.canonical\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 Micheline\n\ntype error += Unknown_primitive_name of string\ntype error += Invalid_case of string\ntype error += Invalid_primitive_name of string Micheline.canonical * Micheline.canonical_location\n\ntype prim =\n  | K_parameter\n  | K_storage\n  | K_code\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_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_EDIV\n  | I_EMPTY_MAP\n  | I_EMPTY_SET\n  | I_EQ\n  | I_EXEC\n  | I_FAILWITH\n  | I_GE\n  | I_GET\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_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_PUSH\n  | I_RIGHT\n  | I_SIZE\n  | I_SOME\n  | I_SOURCE\n  | I_SENDER\n  | I_SELF\n  | I_STEPS_TO_QUOTA\n  | I_SUB\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  | 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\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 rec for_all a b f =\n    Compare.Int.(a > b) || f a && for_all (a + 1) b f in\n  let len = String.length name in\n  Compare.Int.(len <> 0)\n  &&\n  Compare.Char.(String.get name 0 <> '_')\n  &&\n  ((is_upper (String.get name 0)\n    && for_all 1 (len - 1) (fun i -> is_upper (String.get name i)))\n   ||\n   (is_upper (String.get name 0)\n    && for_all 1 (len - 1) (fun i -> is_lower (String.get name i)))\n   ||\n   (is_lower (String.get name 0)\n    && for_all 1 (len - 1) (fun i -> is_lower (String.get name i))))\n\nlet string_of_prim = function\n  | K_parameter -> \"parameter\"\n  | K_storage -> \"storage\"\n  | K_code -> \"code\"\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_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_MAP -> \"EMPTY_MAP\"\n  | I_EMPTY_SET -> \"EMPTY_SET\"\n  | I_EQ -> \"EQ\"\n  | I_EXEC -> \"EXEC\"\n  | I_FAILWITH -> \"FAILWITH\"\n  | I_GE -> \"GE\"\n  | I_GET -> \"GET\"\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_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_STEPS_TO_QUOTA -> \"STEPS_TO_QUOTA\"\n  | I_SUB -> \"SUB\"\n  | I_SWAP -> \"SWAP\"\n  | I_TRANSFER_TOKENS -> \"TRANSFER_TOKENS\"\n  | I_SET_DELEGATE -> \"SET_DELEGATE\"\n  | I_UNIT -> \"UNIT\"\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  | 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\nlet prim_of_string = function\n  | \"parameter\" -> ok K_parameter\n  | \"storage\" -> ok K_storage\n  | \"code\" -> ok K_code\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  | \"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  | \"EDIV\" -> ok I_EDIV\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  | \"FAILWITH\" -> ok I_FAILWITH\n  | \"GE\" -> ok I_GE\n  | \"GET\" -> ok I_GET\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  | \"LAMBDA\" -> ok I_LAMBDA\n  | \"LE\" -> ok I_LE\n  | \"LEFT\" -> ok I_LEFT\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  | \"PUSH\" -> ok I_PUSH\n  | \"RIGHT\" -> ok I_RIGHT\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  | \"STEPS_TO_QUOTA\" -> ok I_STEPS_TO_QUOTA\n  | \"SUB\" -> ok I_SUB\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  | \"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  | n ->\n      if valid_case n then\n        error (Unknown_primitive_name n)\n      else\n        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) >>? fun prim ->\n        List.fold_left\n          (fun acc arg ->\n             acc >>? fun args ->\n             convert arg >>? fun arg ->\n             ok (arg :: args))\n          (ok []) args >>? fun args ->\n        ok (Prim (0, prim, List.rev args, annot))\n    | Seq (_, args) ->\n        List.fold_left\n          (fun acc arg ->\n             acc >>? fun args ->\n             convert arg >>? fun arg ->\n             ok (arg :: args))\n          (ok []) args >>? fun args ->\n        ok (Seq (0, List.rev args)) in\n  convert (root expr) >>? fun expr ->\n  ok (strip_locations expr)\n\nlet strings_of_prims expr =\n  let rec convert = function\n    | Int _ | String _ | Bytes _ as expr -> expr\n    | Prim (_, prim, args, annot) ->\n        let prim = string_of_prim prim in\n        let args = List.map convert args in\n        Prim (0, prim, args, annot)\n    | Seq (_, args) ->\n        let args = List.map convert args in\n        Seq (0, args) in\n  strip_locations (convert (root expr))\n\nlet prim_encoding =\n  let open Data_encoding in\n  def \"michelson.v1.primitives\" @@\n  string_enum [\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    (\"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    (\"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    (\"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    (\"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    (\"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    (\"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    (\"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    (\"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    (\"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    (\"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    (\"address\", T_address) ]\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"unknownPrimitiveNameTypeError\"\n    ~title: \"Unknown primitive name (typechecking error)\"\n    ~description:\n      \"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 \"wrongPrimitiveName\" string))\n    (function\n      | Unknown_primitive_name got -> Some got\n      | _ -> None)\n    (fun got ->\n       Unknown_primitive_name got) ;\n  register_error_kind\n    `Permanent\n    ~id:\"invalidPrimitiveNameCaseTypeError\"\n    ~title: \"Invalid primitive name case (typechecking error)\"\n    ~description:\n      \"In a script or data expression, a primitive name is \\\n       neither uppercase, lowercase or capitalized.\"\n    ~pp:(fun ppf n -> Format.fprintf ppf \"Primitive %s has invalid case.\" n)\n    Data_encoding.(obj1 (req \"wrongPrimitiveName\" string))\n    (function\n      | Invalid_case name -> Some name\n      | _ -> None)\n    (fun name ->\n       Invalid_case name) ;\n  register_error_kind\n    `Permanent\n    ~id:\"invalidPrimitiveNameTypeErro\"\n    ~title: \"Invalid primitive name (typechecking error)\"\n    ~description:\n      \"In a script or data expression, a primitive name is \\\n       unknown or has a wrong case.\"\n    ~pp:(fun ppf _ -> Format.fprintf ppf \"Invalid primitive.\")\n    Data_encoding.(obj2\n                     (req \"expression\" (Micheline.canonical_encoding ~variant:\"generic\" string))\n                     (req \"location\" Micheline.canonical_location_encoding))\n    (function\n      | Invalid_primitive_name (expr, loc) -> Some (expr, loc)\n      | _ -> None)\n    (fun (expr, loc) ->\n       Invalid_primitive_name (expr, loc))\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\ntype location = Micheline.canonical_location\n\ntype annot = Micheline.annot\n\ntype expr = Michelson_v1_primitives.prim Micheline.canonical\n\ntype error += Lazy_script_decode (* `Permanent *)\n\ntype lazy_expr = expr Data_encoding.lazy_t\n\ntype node = (location, Michelson_v1_primitives.prim) Micheline.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\ntype t = { code : lazy_expr ; storage : lazy_expr }\n\nval encoding : t Data_encoding.encoding\n\nval deserialized_cost : expr -> Gas_limit_repr.cost\n\nval serialized_cost : MBytes.t -> Gas_limit_repr.cost\nval traversal_cost : node -> Gas_limit_repr.cost\nval node_cost : node -> Gas_limit_repr.cost\n\nval int_node_cost : Z.t -> Gas_limit_repr.cost\nval int_node_cost_of_numbits : int -> Gas_limit_repr.cost\nval string_node_cost : string -> Gas_limit_repr.cost\nval string_node_cost_of_length : int -> Gas_limit_repr.cost\nval bytes_node_cost : MBytes.t -> Gas_limit_repr.cost\nval bytes_node_cost_of_length : int -> Gas_limit_repr.cost\nval prim_node_cost_nonrec : expr list -> annot -> Gas_limit_repr.cost\nval prim_node_cost_nonrec_of_length : int -> annot -> Gas_limit_repr.cost\nval seq_node_cost_nonrec : expr list -> Gas_limit_repr.cost\nval seq_node_cost_nonrec_of_length : int -> Gas_limit_repr.cost\n\nval force_decode : lazy_expr -> (expr * Gas_limit_repr.cost) tzresult\n\nval force_bytes : lazy_expr -> (MBytes.t * Gas_limit_repr.cost) tzresult\n\nval minimal_deserialize_cost : lazy_expr -> Gas_limit_repr.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\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 node = (location, Michelson_v1_primitives.prim) Micheline.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 `Permanent\n    ~id:\"invalid_binary_format\"\n    ~title:\"Invalid binary format\"\n    ~description:\"Could not deserialize some piece of data \\\n                  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 =\n  Data_encoding.lazy_encoding expr_encoding\n\nlet lazy_expr expr =\n  Data_encoding.make_lazy expr_encoding expr\n\ntype t = {\n  code : lazy_expr ;\n  storage : lazy_expr\n}\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\n       (req \"code\" lazy_expr_encoding)\n       (req \"storage\" lazy_expr_encoding))\n\nlet int_node_size_of_numbits n =\n  (1, 1 + (n + 63) / 64)\nlet int_node_size n =\n  int_node_size_of_numbits (Z.numbits n)\nlet string_node_size_of_length s =\n  (1, 1 + (s + 7) / 8)\nlet string_node_size s =\n  string_node_size_of_length (String.length s)\nlet bytes_node_size_of_length s =\n  (* approx cost of indirection to the C heap *)\n  (2, 1 + (s + 7) / 8 + 12)\nlet bytes_node_size s =\n  bytes_node_size_of_length (MBytes.length s)\nlet prim_node_size_nonrec_of_lengths n_args annots =\n  let annots_length = List.fold_left (fun acc s -> acc + String.length s) 0 annots in\n  if Compare.Int.(annots_length = 0) then\n    (1 + n_args, 2 + 2 * n_args)\n  else\n    (2 + n_args, 4 + 2 * n_args + (annots_length + 7) / 8)\nlet prim_node_size_nonrec args annots =\n  let n_args = List.length args in\n  prim_node_size_nonrec_of_lengths n_args annots\nlet seq_node_size_nonrec_of_length n_args =\n  (1 + n_args, 2 + 2 * n_args)\nlet seq_node_size_nonrec args =\n  let n_args = List.length args in\n  seq_node_size_nonrec_of_length n_args\n\nlet rec node_size node =\n  let open Micheline in\n  match node with\n  | Int (_, n) -> int_node_size n\n  | String (_, s) -> string_node_size s\n  | Bytes (_, s) -> bytes_node_size s\n  | Prim (_, _, args, annot) ->\n      List.fold_left\n        (fun (blocks, words) node ->\n           let (nblocks, nwords) = node_size node in\n           (blocks + nblocks, words + nwords))\n        (prim_node_size_nonrec args annot)\n        args\n  | Seq (_, args) ->\n      List.fold_left\n        (fun (blocks, words) node ->\n           let (nblocks, nwords) = node_size node in\n           (blocks + nblocks, words + nwords))\n        (seq_node_size_nonrec args)\n        args\n\nlet expr_size expr =\n  node_size (Micheline.root expr)\n\nlet traversal_cost node =\n  let blocks, _words = node_size node in\n  Gas_limit_repr.step_cost blocks\n\nlet cost_of_size (blocks, words) =\n  let open Gas_limit_repr in\n  ((Compare.Int.max 0 (blocks - 1)) *@ alloc_cost 0) +@\n  alloc_cost words +@\n  step_cost blocks\n\nlet node_cost node =\n  cost_of_size (node_size node)\n\nlet int_node_cost n = cost_of_size (int_node_size n)\nlet int_node_cost_of_numbits n = cost_of_size (int_node_size_of_numbits n)\nlet string_node_cost s = cost_of_size (string_node_size s)\nlet string_node_cost_of_length s = cost_of_size (string_node_size_of_length s)\nlet bytes_node_cost s = cost_of_size (bytes_node_size s)\nlet bytes_node_cost_of_length s = cost_of_size (bytes_node_size_of_length s)\nlet prim_node_cost_nonrec args annot = cost_of_size (prim_node_size_nonrec args annot)\nlet prim_node_cost_nonrec_of_length n_args annot = cost_of_size (prim_node_size_nonrec_of_lengths n_args annot)\nlet seq_node_cost_nonrec args = cost_of_size (seq_node_size_nonrec args)\nlet seq_node_cost_nonrec_of_length n_args = cost_of_size (seq_node_size_nonrec_of_length n_args)\n\nlet deserialized_cost expr =\n  cost_of_size (expr_size expr)\n\nlet serialized_cost bytes =\n  let open Gas_limit_repr in\n  alloc_mbytes_cost (MBytes.length bytes)\n\nlet force_decode lexpr =\n  let account_deserialization_cost =\n    Data_encoding.apply_lazy\n      ~fun_value:(fun _ -> false)\n      ~fun_bytes:(fun _ -> true)\n      ~fun_combine:(fun _ _ -> false)\n      lexpr in\n  match Data_encoding.force_decode lexpr with\n  | Some v ->\n      if account_deserialization_cost then\n        ok (v, deserialized_cost v)\n      else\n        ok (v, Gas_limit_repr.free)\n  | None -> error Lazy_script_decode\n\nlet force_bytes expr =\n  let open Gas_limit_repr in\n  let account_serialization_cost =\n    Data_encoding.apply_lazy\n      ~fun_value:(fun v -> Some v)\n      ~fun_bytes:(fun _ -> None)\n      ~fun_combine:(fun _ _ -> None)\n      expr in\n  match Data_encoding.force_bytes expr with\n  | bytes ->\n      begin match account_serialization_cost with\n        | Some v -> ok (bytes, traversal_cost (Micheline.root v) +@ serialized_cost bytes)\n        | None -> ok (bytes, Gas_limit_repr.free)\n      end\n  | exception _ -> error Lazy_script_decode\n\nlet minimal_deserialize_cost lexpr =\n  Data_encoding.apply_lazy\n    ~fun_value:(fun _ -> Gas_limit_repr.free)\n    ~fun_bytes:(fun b -> serialized_cost b)\n    ~fun_combine:(fun c_free _ -> c_free)\n    lexpr\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\ntype t = private\n  | Implicit of Signature.Public_key_hash.t\n  | Originated of Contract_hash.t\ntype contract = t\n\ninclude Compare.S with type t := contract\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 : 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\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 : sig\n  include Storage_description.INDEX with type t = t\n  val contract_prefix: string -> string list\n  val pkh_prefix_ed25519: string -> string list\n  val pkh_prefix_secp256k1: string -> string list\n  val pkh_prefix_p256: string -> string list\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  | Implicit of Signature.Public_key_hash.t\n  | Originated of Contract_hash.t\n\ninclude Compare.Make(struct\n    type nonrec t = t\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 ->\n          Contract_hash.compare h1 h2\n      | Implicit _, Originated _ -> -1\n      | Originated _, Implicit _ -> 1\n  end)\n\ntype contract = t\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 (Ed25519.Public_key_hash.Data h) -> ok (Implicit (Signature.Ed25519 h))\n  | Some (Secp256k1.Public_key_hash.Data h) -> ok (Implicit (Signature.Secp256k1 h))\n  | Some (P256.Public_key_hash.Data h) -> ok (Implicit (Signature.P256 h))\n  | Some (Contract_hash.Data h) -> ok (Originated h)\n  | _ -> 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 \"contract_id\"\n    ~title:\n      \"A contract handle\"\n    ~description:\n      \"A contract notation as given to an RPC or inside scripts. \\\n       Can be a base58 implicit contract hash \\\n       or a base58 originated contract hash.\" @@\n  splitted\n    ~binary:\n      (union ~tag_size:`Uint8 [\n          case (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 (Tag 1) (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\n  | Implicit m -> Some m\n  | Originated _ -> None\n\nlet is_originated = function\n  | Implicit _ -> None\n  | Originated h -> Some h\n\ntype origination_nonce =\n  { operation_hash: Operation_hash.t ;\n    origination_index: int32 }\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\n    (req \"operation\" Operation_hash.encoding)\n    (dft \"index\" int32 0l)\n\nlet originated_contract nonce =\n  let data =\n    Data_encoding.Binary.to_bytes_exn origination_nonce_encoding nonce in\n  Originated (Contract_hash.hash_bytes [data])\n\nlet originated_contracts\n    ~since: { origination_index = first ; operation_hash = first_hash }\n    ~until: ({ origination_index = last ; operation_hash = last_hash } as origination_nonce) =\n  assert (Operation_hash.equal first_hash last_hash) ;\n  let rec contracts acc origination_index =\n    if Compare.Int32.(origination_index < first) then\n      acc\n    else\n      let origination_nonce =\n        { origination_nonce with origination_index } in\n      let acc = originated_contract origination_nonce :: acc in\n      contracts acc (Int32.pred origination_index) 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    match of_b58check hash with\n    | Error _ -> Error \"Cannot parse contract id\"\n    | Ok contract -> Ok contract 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  let path_length =\n\n    assert Compare.Int.(Signature.Public_key_hash.path_length =\n                        1 + Contract_hash.path_length) ;\n    Signature.Public_key_hash.path_length\n  let to_path c l =\n    match c with\n    | Implicit k ->\n        Signature.Public_key_hash.to_path k l\n    | Originated h ->\n        \"originated\" :: Contract_hash.to_path h l\n  let of_path = function\n    | \"originated\" :: key -> begin\n        match Contract_hash.of_path key with\n        | None -> None\n        | Some h -> Some (Originated h)\n      end\n    | key -> begin\n        match Signature.Public_key_hash.of_path key with\n        | None -> None\n        | Some h -> Some (Implicit h)\n      end\n  let contract_prefix s =\n    \"originated\" :: Contract_hash.prefix_path s\n  let pkh_prefix_ed25519 s =\n    Ed25519.Public_key_hash.prefix_path s\n  let pkh_prefix_secp256k1 s =\n    Secp256k1.Public_key_hash.prefix_path s\n  let pkh_prefix_p256 s =\n    P256.Public_key_hash.prefix_path s\n\n  let rpc_arg = rpc_arg\n  let encoding = encoding\n  let compare = compare\nend\n" ;
                } ;
                { name = "Roll_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 = private int32\ntype roll = t\n\nval encoding: roll Data_encoding.t\nval rpc_arg: roll RPC_arg.t\n\nval random:\n  Seed_repr.sequence -> bound:roll -> roll * Seed_repr.sequence\n\nval first: roll\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\ntype roll = t\n\nlet encoding = Data_encoding.int32\n\nlet first = 0l\nlet succ i = Int32.succ i\n\nlet random sequence ~bound =\n  Seed_repr.take_int32 sequence bound\n\nlet rpc_arg =\n  RPC_arg.like\n    RPC_arg.int32\n    \"roll\"\n\nlet to_int32 v = v\n\n\nmodule Index = struct\n  type t = roll\n  let path_length = 3\n  let to_path roll l =\n    (Int32.to_string @@ Int32.logand roll (Int32.of_int 0xff)) ::\n    (Int32.to_string @@ Int32.logand (Int32.shift_right_logical roll 8) (Int32.of_int 0xff)) ::\n    Int32.to_string roll :: l\n  let of_path = function\n    | _ :: _ :: s :: _ -> begin\n        try Some (Int32.of_string s)\n        with _ -> None\n      end\n    | _ -> None\n  let rpc_arg = rpc_arg\n  let encoding = encoding\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\ntype proposal = Protocol_hash.t\n\ntype ballot = Yay | Nay | Pass\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\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\nlet ballot_encoding =\n  let of_int8 = function\n    | 0 -> Yay\n    | 1 -> Nay\n    | 2 -> Pass\n    | _ -> invalid_arg \"ballot_of_int8\"\n  in\n  let to_int8 = function\n    | Yay -> 0\n    | Nay -> 1\n    | Pass -> 2\n  in\n  let open Data_encoding in\n  (* union *)\n  splitted\n    ~binary: (conv to_int8 of_int8 int8)\n    ~json: (string_enum [\n        \"yay\", Yay ;\n        \"nay\", Nay ;\n        \"pass\", Pass ;\n      ])\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\ntype t = {\n  shell: Block_header.shell_header ;\n  protocol_data: protocol_data ;\n}\n\nand protocol_data = {\n  contents: contents ;\n  signature: Signature.t ;\n}\n\nand contents = {\n  priority: int ;\n  seed_nonce_hash: Nonce_hash.t option ;\n  proof_of_work_nonce: MBytes.t ;\n}\n\ntype block_header = t\n\ntype raw = Block_header.t\ntype shell_header = Block_header.shell_header\n\nval raw: block_header -> raw\n\nval encoding: block_header Data_encoding.encoding\nval raw_encoding: raw Data_encoding.t\nval contents_encoding: contents Data_encoding.t\nval unsigned_encoding: (Block_header.shell_header * contents) Data_encoding.t\nval protocol_data_encoding: protocol_data Data_encoding.encoding\nval shell_header_encoding: shell_header Data_encoding.encoding\n\nval max_header_length: int\n(** The maximum size of block headers in bytes *)\n\nval hash: block_header -> Block_hash.t\nval hash_raw: raw -> Block_hash.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(** Block header *)\n\ntype t = {\n  shell: Block_header.shell_header ;\n  protocol_data: protocol_data ;\n}\n\nand protocol_data = {\n  contents: contents ;\n  signature: Signature.t ;\n}\n\nand contents = {\n  priority: int ;\n  seed_nonce_hash: Nonce_hash.t option ;\n  proof_of_work_nonce: MBytes.t ;\n}\n\ntype block_header = t\n\ntype raw = Block_header.t\ntype shell_header = Block_header.shell_header\n\nlet raw_encoding = Block_header.encoding\nlet shell_header_encoding = Block_header.shell_header_encoding\n\nlet contents_encoding =\n  let open Data_encoding in\n  def \"block_header.alpha.unsigned_contents\" @@\n  conv\n    (fun { priority ; seed_nonce_hash ; proof_of_work_nonce } ->\n       (priority, proof_of_work_nonce, seed_nonce_hash))\n    (fun (priority, proof_of_work_nonce, seed_nonce_hash) ->\n       { priority ; seed_nonce_hash ; proof_of_work_nonce })\n    (obj3\n       (req \"priority\" uint16)\n       (req \"proof_of_work_nonce\"\n          (Fixed.bytes Constants_repr.proof_of_work_nonce_size))\n       (opt \"seed_nonce_hash\" Nonce_hash.encoding))\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\n      protocol_data_encoding\n      protocol_data in\n  { Block_header.shell ; protocol_data }\n\nlet unsigned_encoding =\n  let open Data_encoding in\n  merge_objs\n    Block_header.shell_header_encoding\n    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 } ->\n       (shell, protocol_data))\n    (fun (shell, protocol_data) ->\n       { shell ; protocol_data })\n    (merge_objs\n       Block_header.shell_header_encoding\n       protocol_data_encoding)\n\n(** Constants *)\n\nlet max_header_length =\n  let fake_shell = {\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.from_int64 0L ;\n    context = Context_hash.zero ;\n  }\n  and fake_contents =\n    { priority = 0 ;\n      proof_of_work_nonce =\n        MBytes.create Constants_repr.proof_of_work_nonce_size ;\n      seed_nonce_hash = Some Nonce_hash.zero\n    } in\n  Data_encoding.Binary.length\n    encoding\n    { shell = fake_shell ;\n      protocol_data = {\n        contents = fake_contents ;\n        signature = Signature.zero ;\n      }\n    }\n\n(** Header parsing entry point  *)\n\nlet hash_raw = Block_header.hash\nlet hash { shell ; protocol_data } =\n  Block_header.hash\n    { shell ;\n      protocol_data =\n        Data_encoding.Binary.to_bytes_exn\n          protocol_data_encoding\n          protocol_data }\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\nmodule Kind : sig\n  type seed_nonce_revelation = Seed_nonce_revelation_kind\n  type double_endorsement_evidence = Double_endorsement_evidence_kind\n  type double_baking_evidence = Double_baking_evidence_kind\n  type activate_account = Activate_account_kind\n  type endorsement = Endorsement_kind\n  type proposals = Proposals_kind\n  type ballot = Ballot_kind\n  type reveal = Reveal_kind\n  type transaction = Transaction_kind\n  type origination = Origination_kind\n  type delegation = Delegation_kind\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\nend\n\ntype raw = Operation.t = {\n  shell: Operation.shell_header ;\n  proto: MBytes.t ;\n}\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 : 'kind Kind.manager contents * 'rest Kind.manager contents_list ->\n    (('kind * 'rest) Kind.manager ) contents_list\n\nand _ contents =\n  | Endorsement : {\n      level: Raw_level_repr.t ;\n    } -> Kind.endorsement contents\n  | Seed_nonce_revelation : {\n      level: Raw_level_repr.t ;\n      nonce: Seed_repr.nonce ;\n    } -> Kind.seed_nonce_revelation contents\n  | Double_endorsement_evidence : {\n      op1: Kind.endorsement operation ;\n      op2: Kind.endorsement operation ;\n    } -> Kind.double_endorsement_evidence contents\n  | Double_baking_evidence : {\n      bh1: Block_header_repr.t ;\n      bh2: Block_header_repr.t ;\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    } -> Kind.activate_account contents\n  | Proposals : {\n      source: Signature.Public_key_hash.t ;\n      period: Voting_period_repr.t ;\n      proposals: Protocol_hash.t list ;\n    } -> Kind.proposals contents\n  | Ballot : {\n      source: Signature.Public_key_hash.t ;\n      period: Voting_period_repr.t ;\n      proposal: Protocol_hash.t ;\n      ballot: Vote_repr.ballot ;\n    } -> Kind.ballot contents\n  | Manager_operation : {\n      source: Contract_repr.contract ;\n      fee: Tez_repr.tez ;\n      counter: counter ;\n      operation: 'kind manager_operation ;\n      gas_limit: Z.t;\n      storage_limit: Z.t;\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 option ;\n      destination: Contract_repr.contract ;\n    } -> Kind.transaction manager_operation\n  | Origination : {\n      manager: Signature.Public_key_hash.t ;\n      delegate: Signature.Public_key_hash.t option ;\n      script: Script_repr.t option ;\n      spendable: bool ;\n      delegatable: bool ;\n      credit: Tez_repr.tez ;\n      preorigination: Contract_repr.t option ;\n    } -> Kind.origination manager_operation\n  | Delegation :\n      Signature.Public_key_hash.t option -> Kind.delegation 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 =\n  | 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\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\nval contents_encoding: packed_contents Data_encoding.t\nval contents_list_encoding: packed_contents_list Data_encoding.t\nval protocol_data_encoding: packed_protocol_data Data_encoding.t\nval unsigned_operation_encoding: (Operation.shell_header * packed_contents_list) Data_encoding.t\n\nval raw: _ operation -> raw\n\nval hash_raw: raw -> Operation_hash.t\nval hash: _ operation -> Operation_hash.t\nval hash_packed: packed_operation -> Operation_hash.t\n\nval acceptable_passes: packed_operation -> int list\n\ntype error += Missing_signature (* `Permanent *)\ntype error += Invalid_signature (* `Permanent *)\n\nval check_signature:\n  Signature.Public_key.t -> Chain_id.t -> _ operation -> unit tzresult Lwt.t\nval check_signature_sync:\n  Signature.Public_key.t -> Chain_id.t -> _ operation -> unit tzresult\n\n\nval internal_operation_encoding:\n  packed_internal_operation Data_encoding.t\n\ntype ('a, 'b) eq = Eq : ('a, 'a) eq\nval equal: 'a operation -> 'b operation -> ('a, 'b) eq option\n\nmodule Encoding : sig\n\n  type 'b case =\n      Case : { 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 } -> 'b case\n\n  val endorsement_case: Kind.endorsement case\n  val seed_nonce_revelation_case: Kind.seed_nonce_revelation case\n  val double_endorsement_evidence_case: Kind.double_endorsement_evidence case\n  val double_baking_evidence_case: Kind.double_baking_evidence case\n  val activate_account_case: Kind.activate_account case\n  val proposals_case: Kind.proposals case\n  val ballot_case: Kind.ballot case\n  val reveal_case: Kind.reveal Kind.manager case\n  val transaction_case: Kind.transaction Kind.manager case\n  val origination_case: Kind.origination Kind.manager case\n  val delegation_case: Kind.delegation Kind.manager case\n\n  module Manager_operations : sig\n\n    type 'b case =\n        MCase : { 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 } -> 'kind case\n\n    val reveal_case: Kind.reveal case\n    val transaction_case: Kind.transaction case\n    val origination_case: Kind.origination case\n    val delegation_case: Kind.delegation case\n\n  end\n\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 seed_nonce_revelation = Seed_nonce_revelation_kind\n  type double_endorsement_evidence = Double_endorsement_evidence_kind\n  type double_baking_evidence = Double_baking_evidence_kind\n  type activate_account = Activate_account_kind\n  type endorsement = Endorsement_kind\n  type proposals = Proposals_kind\n  type ballot = Ballot_kind\n  type reveal = Reveal_kind\n  type transaction = Transaction_kind\n  type origination = Origination_kind\n  type delegation = Delegation_kind\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\nend\n\ntype raw = Operation.t = {\n  shell: Operation.shell_header ;\n  proto: MBytes.t ;\n}\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 : 'kind Kind.manager contents * 'rest Kind.manager contents_list ->\n    (('kind * 'rest) Kind.manager ) contents_list\n\nand _ contents =\n  | Endorsement : {\n      level: Raw_level_repr.t ;\n    } -> Kind.endorsement contents\n  | Seed_nonce_revelation : {\n      level: Raw_level_repr.t ;\n      nonce: Seed_repr.nonce ;\n    } -> Kind.seed_nonce_revelation contents\n  | Double_endorsement_evidence : {\n      op1: Kind.endorsement operation ;\n      op2: Kind.endorsement operation ;\n    } -> Kind.double_endorsement_evidence contents\n  | Double_baking_evidence : {\n      bh1: Block_header_repr.t ;\n      bh2: Block_header_repr.t ;\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    } -> Kind.activate_account contents\n  | Proposals : {\n      source: Signature.Public_key_hash.t ;\n      period: Voting_period_repr.t ;\n      proposals: Protocol_hash.t list ;\n    } -> Kind.proposals contents\n  | Ballot : {\n      source: Signature.Public_key_hash.t ;\n      period: Voting_period_repr.t ;\n      proposal: Protocol_hash.t ;\n      ballot: Vote_repr.ballot ;\n    } -> Kind.ballot contents\n  | Manager_operation : {\n      source: Contract_repr.contract ;\n      fee: Tez_repr.tez ;\n      counter: counter ;\n      operation: 'kind manager_operation ;\n      gas_limit: Z.t;\n      storage_limit: Z.t;\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 option ;\n      destination: Contract_repr.contract ;\n    } -> Kind.transaction manager_operation\n  | Origination : {\n      manager: Signature.Public_key_hash.t ;\n      delegate: Signature.Public_key_hash.t option ;\n      script: Script_repr.t option ;\n      spendable: bool ;\n      delegatable: bool ;\n      credit: Tez_repr.tez ;\n      preorigination: Contract_repr.t option ;\n    } -> Kind.origination manager_operation\n  | Delegation :\n      Signature.Public_key_hash.t option -> Kind.delegation 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\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 =\n  | 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 ;\n  protocol_data = Operation_data protocol_data ;\n}\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)) ->\n      Contents o :: to_list (Contents_list os)\n\nlet rec of_list = function\n  | [] -> assert false\n  | [Contents o] -> Contents_list (Single o)\n  | (Contents o) :: os ->\n      let Contents_list os = of_list os in\n      match o, os with\n      | Manager_operation _, Single (Manager_operation _) ->\n          Contents_list (Cons (o, os))\n      | Manager_operation _, Cons _ ->\n          Contents_list (Cons (o, os))\n      | _ ->\n          Pervasives.failwith \"Operation list of length > 1 \\\n                               should only contains manager operations.\"\n\nmodule Encoding = struct\n\n  open Data_encoding\n\n  let case tag name args proj inj =\n    let open Data_encoding in\n    case tag\n      ~title:(String.capitalize_ascii name)\n      (merge_objs\n         (obj1 (req \"kind\" (constant name)))\n         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\n    type 'kind case =\n        MCase : { 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 } -> 'kind case\n\n    let reveal_case =\n      MCase {\n        tag = 0 ;\n        name = \"reveal\" ;\n        encoding =\n          (obj1\n             (req \"public_key\" Signature.Public_key.encoding)) ;\n        select =\n          (function\n            | Manager (Reveal _ as op) -> Some op\n            | _ -> None) ;\n        proj =\n          (function Reveal pkh -> pkh) ;\n        inj =\n          (fun pkh -> Reveal pkh)\n      }\n\n    let transaction_case =\n      MCase {\n        tag = 1 ;\n        name = \"transaction\" ;\n        encoding =\n          (obj3\n             (req \"amount\" Tez_repr.encoding)\n             (req \"destination\" Contract_repr.encoding)\n             (opt \"parameters\" Script_repr.lazy_expr_encoding)) ;\n        select =\n          (function\n            | Manager (Transaction _ as op) -> Some op\n            | _ -> None) ;\n        proj =\n          (function\n            | Transaction { amount ; destination ; parameters } ->\n                (amount, destination, parameters)) ;\n        inj =\n          (fun (amount, destination, parameters) ->\n             Transaction { amount ; destination ; parameters })\n      }\n\n    let origination_case =\n      MCase {\n        tag = 2 ;\n        name = \"origination\" ;\n        encoding =\n          (obj6\n             (req \"managerPubkey\" Signature.Public_key_hash.encoding)\n             (req \"balance\" Tez_repr.encoding)\n             (dft \"spendable\" bool true)\n             (dft \"delegatable\" bool true)\n             (opt \"delegate\" Signature.Public_key_hash.encoding)\n             (opt \"script\" Script_repr.encoding)) ;\n        select =\n          (function\n            | Manager (Origination _ as op) -> Some op\n            | _ -> None) ;\n        proj =\n          (function\n            | Origination { manager ; credit ; spendable ;\n                            delegatable ; delegate ; script ;\n                            preorigination = _\n                            (* the hash is only used internally\n                               when originating from smart\n                               contracts, don't serialize it *) } ->\n                (manager, credit, spendable,\n                 delegatable, delegate, script)) ;\n        inj =\n          (fun (manager, credit, spendable, delegatable, delegate, script) ->\n             Origination\n               {manager ; credit ; spendable ; delegatable ;\n                delegate ; script ; preorigination = None })\n      }\n\n    let delegation_case =\n      MCase {\n        tag = 3 ;\n        name = \"delegation\" ;\n        encoding =\n          (obj1\n             (opt \"delegate\" Signature.Public_key_hash.encoding)) ;\n        select =\n          (function\n            | Manager (Delegation _ as op) -> Some op\n            | _ -> None) ;\n        proj =\n          (function Delegation key -> key) ;\n        inj =\n          (fun key -> Delegation key)\n      }\n\n    let encoding =\n      let make (MCase { tag ; name ; encoding ; select ; proj ; inj }) =\n        case (Tag tag) name encoding\n          (fun o -> match select o with None -> None | Some o -> Some (proj o))\n          (fun x -> Manager (inj x)) in\n      union ~tag_size:`Uint8 [\n        make reveal_case ;\n        make transaction_case ;\n        make origination_case ;\n        make delegation_case ;\n      ]\n\n  end\n\n  type 'b case =\n      Case : { 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 } -> 'b case\n\n  let endorsement_encoding =\n    obj1\n      (req \"level\" Raw_level_repr.encoding)\n\n  let endorsement_case =\n    Case {\n      tag = 0 ;\n      name = \"endorsement\" ;\n      encoding = endorsement_encoding ;\n      select =\n        (function\n          | Contents (Endorsement _ as op) -> Some op\n          | _ -> None) ;\n      proj =\n        (fun (Endorsement { level }) -> level) ;\n      inj =\n        (fun level -> Endorsement { level })\n    }\n\n  let endorsement_encoding =\n    let make (Case { tag ; name ; encoding ; select = _ ; proj ; inj }) =\n      case (Tag tag) name encoding\n        (fun o -> Some (proj o))\n        (fun x -> inj x) in\n    let to_list : Kind.endorsement contents_list -> _ = function\n      | Single o -> o in\n    let of_list : Kind.endorsement contents -> _ = function\n      | 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)) ->\n         ({ shell ; protocol_data = { contents ; signature }} : _ operation))\n      (merge_objs\n         Operation.shell_header_encoding\n         (obj2\n            (req \"operations\"\n               (conv to_list of_list  @@\n                def \"inlined.endorsement.contents\" @@\n                union [\n                  make endorsement_case ;\n                ]))\n            (varopt \"signature\" Signature.encoding)))\n\n  let seed_nonce_revelation_case =\n    Case {\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\n          | _ -> None) ;\n      proj =\n        (fun (Seed_nonce_revelation { level ; nonce }) -> (level, nonce)) ;\n      inj =\n        (fun (level, nonce) -> Seed_nonce_revelation { level ; nonce })\n    }\n\n  let double_endorsement_evidence_case : Kind.double_endorsement_evidence case =\n    Case {\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 =\n        (fun (Double_endorsement_evidence { op1 ; op2 }) -> (op1, op2)) ;\n      inj =\n        (fun (op1, op2) -> (Double_endorsement_evidence { op1 ; op2 }))\n    }\n\n  let double_baking_evidence_case =\n    Case {\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\n          | _ -> None) ;\n      proj =\n        (fun (Double_baking_evidence { bh1 ; bh2 }) -> (bh1, bh2)) ;\n      inj =\n        (fun (bh1, bh2) -> Double_baking_evidence { bh1 ; bh2 }) ;\n    }\n\n  let activate_account_case =\n    Case {\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\n          | _ -> None) ;\n      proj =\n        (fun (Activate_account { id ; activation_code }) -> (id, activation_code)) ;\n      inj =\n        (fun (id, activation_code) -> Activate_account { id ; activation_code })\n    }\n\n  let proposals_case =\n    Case {\n      tag = 5 ;\n      name = \"proposals\" ;\n      encoding =\n        (obj3\n           (req \"source\" Signature.Public_key_hash.encoding)\n           (req \"period\" Voting_period_repr.encoding)\n           (req \"proposals\" (list Protocol_hash.encoding))) ;\n      select =\n        (function\n          | Contents (Proposals _ as op) -> Some op\n          | _ -> 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 ballot_case =\n    Case {\n      tag = 6 ;\n      name = \"ballot\" ;\n      encoding =\n        (obj4\n           (req \"source\" Signature.Public_key_hash.encoding)\n           (req \"period\" Voting_period_repr.encoding)\n           (req \"proposal\" Protocol_hash.encoding)\n           (req \"ballot\" Vote_repr.ballot_encoding)) ;\n      select =\n        (function\n          | Contents (Ballot _ as op) -> Some op\n          | _ -> 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 manager_encoding =\n    (obj5\n       (req \"source\" Contract_repr.encoding)\n       (req \"fee\" Tez_repr.encoding)\n       (req \"counter\" (check_size 10 n))\n       (req \"gas_limit\" (check_size 10 n))\n       (req \"storage_limit\" (check_size 10 n)))\n\n  let extract\n      (type kind)\n      (Manager_operation { source ; fee ; counter ;\n                           gas_limit ; storage_limit ; operation = _ } : kind Kind.manager contents) =\n    (source, fee, counter, gas_limit, storage_limit)\n\n  let rebuild (source, fee, counter, gas_limit, storage_limit) operation =\n    Manager_operation { source ; fee ; counter ;\n                        gas_limit ; storage_limit ; operation }\n\n  let make_manager_case tag\n      (type kind)\n      (Manager_operations.MCase mcase : kind Manager_operations.case) =\n    Case {\n      tag ;\n      name = mcase.name ;\n      encoding =\n        merge_objs\n          manager_encoding\n          mcase.encoding ;\n      select =\n        (function\n          | Contents (Manager_operation ({ operation ; _ } as op)) -> begin\n              match mcase.select (Manager operation) with\n              | None -> None\n              | Some operation ->\n                  Some (Manager_operation { op with operation })\n            end\n          | _ -> None) ;\n      proj =\n        (function\n          | Manager_operation { operation ; _ } as op ->\n              (extract op, mcase.proj operation )) ;\n      inj =\n        (fun (op, contents) ->\n           (rebuild op (mcase.inj contents)))\n    }\n\n  let reveal_case = make_manager_case 7 Manager_operations.reveal_case\n  let transaction_case = make_manager_case 8 Manager_operations.transaction_case\n  let origination_case = make_manager_case 9 Manager_operations.origination_case\n  let delegation_case = make_manager_case 10 Manager_operations.delegation_case\n\n  let contents_encoding =\n    let make (Case { tag ; name ; encoding ; select ; proj ; inj }) =\n      case (Tag tag) name encoding\n        (fun o -> match select o with None -> None | Some o -> Some (proj o))\n        (fun x -> Contents (inj x)) in\n    def \"operation.alpha.contents\" @@\n    union [\n      make endorsement_case ;\n      make seed_nonce_revelation_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    ]\n\n  let contents_list_encoding =\n    conv to_list of_list (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 }) ->\n         (shell, protocol_data))\n      (fun (shell, protocol_data) ->\n         { shell ; protocol_data })\n      (merge_objs\n         Operation.shell_header_encoding\n         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\n            (req \"source\" Contract_repr.encoding)\n            (req \"nonce\" uint16))\n         Manager_operations.encoding)\n\nend\n\nlet encoding = Encoding.operation_encoding\nlet contents_encoding = Encoding.contents_encoding\nlet contents_list_encoding = Encoding.contents_list_encoding\nlet protocol_data_encoding = Encoding.protocol_data_encoding\nlet unsigned_operation_encoding = Encoding.unsigned_operation_encoding\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) 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\n  | Single (Endorsement _) -> [0]\n\n  | Single (Proposals _ ) -> [1]\n  | Single (Ballot _ ) -> [1]\n\n  | Single (Seed_nonce_revelation _) -> [2]\n  | Single (Double_endorsement_evidence _) -> [2]\n  | Single (Double_baking_evidence _) -> [2]\n  | Single (Activate_account _) -> [2]\n\n  | Single (Manager_operation _) -> [3]\n  | Cons _ -> [3]\n\ntype error += Invalid_signature (* `Permanent *)\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:\"The operation signature is ill-formed \\\n                  or has been made with the wrong public key\"\n    ~pp:(fun ppf () ->\n        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:\"The operation is of a kind that must be signed, \\\n                  but the signature is missing\"\n    ~pp:(fun ppf () ->\n        Format.fprintf ppf \"The operation requires a signature\")\n    Data_encoding.unit\n    (function Missing_signature -> Some () | _ -> None)\n    (fun () -> Missing_signature)\n\nlet check_signature_sync (type kind) key chain_id ({ 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 (shell, contents) in\n    if Signature.check ~watermark key signature unsigned_operation then\n      Ok ()\n    else\n      Error [Invalid_signature] in\n  match protocol_data.contents, protocol_data.signature with\n  | Single _, None ->\n      Error [Missing_signature]\n  | Cons _, None ->\n      Error [Missing_signature]\n  | Single (Endorsement _) as contents, Some signature ->\n      check ~watermark:(Endorsement chain_id) (Contents_list contents) signature\n  | Single _ as contents, Some signature ->\n      check ~watermark:Generic_operation (Contents_list contents) signature\n  | Cons _ as contents, Some signature ->\n      check ~watermark:Generic_operation (Contents_list contents) signature\n\nlet check_signature pk chain_id op =\n  Lwt.return (check_signature_sync pk chain_id op)\n\nlet hash_raw = Operation.hash\nlet hash (o : _ operation) =\n  let proto =\n    Data_encoding.Binary.to_bytes_exn\n      protocol_data_encoding\n      (Operation_data o.protocol_data) in\n  Operation.hash { shell = o.shell ; proto }\nlet hash_packed (o : packed_operation) =\n  let proto =\n    Data_encoding.Binary.to_bytes_exn\n      protocol_data_encoding\n      o.protocol_data in\n  Operation.hash { shell = o.shell ; proto }\n\ntype ('a, 'b) eq = Eq : ('a, 'a) eq\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\nlet equal_contents_kind\n  : type a b. a contents -> b contents -> (a, b) eq option\n  = fun op1 op2 ->\n    match op1, op2 with\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_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    | Manager_operation op1, Manager_operation op2 -> begin\n        match equal_manager_operation_kind op1.operation op2.operation with\n        | None -> None\n        | Some Eq -> Some Eq\n      end\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 ->\n        equal_contents_kind op1 op2\n    | Single _, Cons _ -> None\n    | Cons _, Single _ -> None\n    | Cons (op1, ops1), Cons (op2, ops2) -> begin\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      end\n\nlet equal\n  : 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\n      None\n    else\n      equal_contents_kind_list\n        op1.protocol_data.contents op2.protocol_data.contents\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 reveeld, 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 tag\n    ~title:\"Public_key_hash\"\n    Signature.Public_key_hash.encoding\n    (function\n      | Hash hash -> Some hash\n      | _ -> None)\n    (fun hash -> Hash hash)\n\nlet pubkey_case tag =\n  case tag\n    ~title:\"Public_key\"\n    Signature.Public_key.encoding\n    (function\n      | Public_key hash -> Some hash\n      | _ -> None)\n    (fun hash -> Public_key hash)\n\n\nlet encoding =\n  union [\n    hash_case (Tag 0) ;\n    pubkey_case (Tag 1) ;\n  ]\n\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 } ->\n       ( blinded_public_key_hash, amount ))\n    (fun ( blinded_public_key_hash, amount) ->\n       { blinded_public_key_hash ; amount })\n    (tup2\n       Blinded_public_key_hash.encoding\n       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(*                                                                           *)\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 ;\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\nval encoding: t Data_encoding.t\nval constants_encoding: Constants_repr.parametric 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 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 ;\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    [ case (Tag 0) ~title:\"Public_key_known\"\n        (tup2\n           Signature.Public_key.encoding\n           Tez_repr.encoding)\n        (function\n          | { public_key_hash ; public_key = Some public_key ; amount } ->\n              assert (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           { public_key = Some public_key ;\n             public_key_hash = Signature.Public_key.hash public_key ;\n             amount }) ;\n      case (Tag 1) ~title:\"Public_key_unknown\"\n        (tup2\n           Signature.Public_key_hash.encoding\n           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 ;\n             public_key_hash ;\n             amount }) ]\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       (req \"delegate\" Signature.Public_key_hash.encoding)\n       (req \"amount\" Tez_repr.encoding)\n       (req \"script\" Script_repr.encoding))\n\n(* This encoding is used to read configuration files (e.g. sandbox.json)\n   where some fields can be missing, in that case they are replaced by\n   the default. *)\nlet constants_encoding =\n  let open Data_encoding in\n  conv\n    (fun (c : Constants_repr.parametric) ->\n       let module Compare_time_between_blocks = Compare.List (Period_repr) in\n       let module Compare_keys = Compare.List (Ed25519.Public_key) in\n       let opt (=) def v = if def = v then None else Some v in\n       let default = Constants_repr.default in\n       let preserved_cycles =\n         opt Compare.Int.(=)\n           default.preserved_cycles c.preserved_cycles\n       and blocks_per_cycle =\n         opt Compare.Int32.(=)\n           default.blocks_per_cycle c.blocks_per_cycle\n       and blocks_per_commitment =\n         opt Compare.Int32.(=)\n           default.blocks_per_commitment c.blocks_per_commitment\n       and blocks_per_roll_snapshot =\n         opt Compare.Int32.(=)\n           default.blocks_per_roll_snapshot c.blocks_per_roll_snapshot\n       and blocks_per_voting_period =\n         opt Compare.Int32.(=)\n           default.blocks_per_voting_period c.blocks_per_voting_period\n       and time_between_blocks =\n         opt Compare_time_between_blocks.(=)\n           default.time_between_blocks c.time_between_blocks\n       and endorsers_per_block =\n         opt Compare.Int.(=)\n           default.endorsers_per_block c.endorsers_per_block\n       and hard_gas_limit_per_operation =\n         opt Compare.Z.(=)\n           default.hard_gas_limit_per_operation c.hard_gas_limit_per_operation\n       and hard_gas_limit_per_block =\n         opt Compare.Z.(=)\n           default.hard_gas_limit_per_block c.hard_gas_limit_per_block\n       and proof_of_work_threshold =\n         opt Compare.Int64.(=)\n           default.proof_of_work_threshold c.proof_of_work_threshold\n       and tokens_per_roll =\n         opt Tez_repr.(=)\n           default.tokens_per_roll c.tokens_per_roll\n       and michelson_maximum_type_size =\n         opt Compare.Int.(=)\n           default.michelson_maximum_type_size c.michelson_maximum_type_size\n       and seed_nonce_revelation_tip =\n         opt Tez_repr.(=)\n           default.seed_nonce_revelation_tip c.seed_nonce_revelation_tip\n       and origination_burn =\n         opt Tez_repr.(=)\n           default.origination_burn c.origination_burn\n       and block_security_deposit =\n         opt Tez_repr.(=)\n           default.block_security_deposit c.block_security_deposit\n       and endorsement_security_deposit =\n         opt Tez_repr.(=)\n           default.endorsement_security_deposit c.endorsement_security_deposit\n       and block_reward =\n         opt Tez_repr.(=)\n           default.block_reward c.block_reward\n       and endorsement_reward =\n         opt Tez_repr.(=)\n           default.endorsement_reward c.endorsement_reward\n       and cost_per_byte =\n         opt Tez_repr.(=)\n           default.cost_per_byte c.cost_per_byte\n       and hard_storage_limit_per_operation =\n         opt Compare.Z.(=)\n           default.hard_storage_limit_per_operation c.hard_storage_limit_per_operation\n       in\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          michelson_maximum_type_size,\n          seed_nonce_revelation_tip,\n          origination_burn,\n          block_security_deposit,\n          endorsement_security_deposit,\n          block_reward),\n         (endorsement_reward,\n          cost_per_byte,\n          hard_storage_limit_per_operation))))\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            michelson_maximum_type_size,\n            seed_nonce_revelation_tip,\n            origination_burn,\n            block_security_deposit,\n            endorsement_security_deposit,\n            block_reward),\n           (endorsement_reward,\n            cost_per_byte,\n            hard_storage_limit_per_operation))) ->\n      let unopt def = function None -> def | Some v -> v in\n      let default = Constants_repr.default in\n      { Constants_repr.preserved_cycles =\n          unopt default.preserved_cycles preserved_cycles ;\n        blocks_per_cycle =\n          unopt default.blocks_per_cycle blocks_per_cycle ;\n        blocks_per_commitment =\n          unopt default.blocks_per_commitment blocks_per_commitment ;\n        blocks_per_roll_snapshot =\n          unopt default.blocks_per_roll_snapshot blocks_per_roll_snapshot ;\n        blocks_per_voting_period =\n          unopt default.blocks_per_voting_period blocks_per_voting_period ;\n        time_between_blocks =\n          unopt default.time_between_blocks @@\n          time_between_blocks ;\n        endorsers_per_block =\n          unopt default.endorsers_per_block endorsers_per_block ;\n        hard_gas_limit_per_operation =\n          unopt default.hard_gas_limit_per_operation hard_gas_limit_per_operation ;\n        hard_gas_limit_per_block =\n          unopt default.hard_gas_limit_per_block hard_gas_limit_per_block ;\n        proof_of_work_threshold =\n          unopt default.proof_of_work_threshold proof_of_work_threshold ;\n        tokens_per_roll =\n          unopt default.tokens_per_roll tokens_per_roll ;\n        michelson_maximum_type_size =\n          unopt default.michelson_maximum_type_size michelson_maximum_type_size ;\n        seed_nonce_revelation_tip =\n          unopt default.seed_nonce_revelation_tip seed_nonce_revelation_tip ;\n        origination_burn =\n          unopt default.origination_burn origination_burn ;\n        block_security_deposit =\n          unopt default.block_security_deposit block_security_deposit ;\n        endorsement_security_deposit =\n          unopt default.endorsement_security_deposit endorsement_security_deposit ;\n        block_reward =\n          unopt default.block_reward block_reward ;\n        endorsement_reward =\n          unopt default.endorsement_reward endorsement_reward ;\n        cost_per_byte =\n          unopt default.cost_per_byte cost_per_byte ;\n        hard_storage_limit_per_operation =\n          unopt default.hard_storage_limit_per_operation hard_storage_limit_per_operation ;\n      } )\n    (merge_objs\n       (obj9\n          (opt \"preserved_cycles\" uint8)\n          (opt \"blocks_per_cycle\" int32)\n          (opt \"blocks_per_commitment\" int32)\n          (opt \"blocks_per_roll_snapshot\" int32)\n          (opt \"blocks_per_voting_period\" int32)\n          (opt \"time_between_blocks\" (list Period_repr.encoding))\n          (opt \"endorsers_per_block\" uint16)\n          (opt \"hard_gas_limit_per_operation\" z)\n          (opt \"hard_gas_limit_per_block\" z))\n       (merge_objs\n          (obj8\n             (opt \"proof_of_work_threshold\" int64)\n             (opt \"tokens_per_roll\" Tez_repr.encoding)\n             (opt \"michelson_maximum_type_size\" uint16)\n             (opt \"seed_nonce_revelation_tip\" Tez_repr.encoding)\n             (opt \"origination_burn\" Tez_repr.encoding)\n             (opt \"block_security_deposit\" Tez_repr.encoding)\n             (opt \"endorsement_security_deposit\" Tez_repr.encoding)\n             (opt \"block_reward\" Tez_repr.encoding))\n          (obj3\n             (opt \"endorsement_reward\" Tez_repr.encoding)\n             (opt \"cost_per_byte\" Tez_repr.encoding)\n             (opt \"hard_storage_limit_per_operation\" z))))\n\nlet encoding =\n  let open Data_encoding in\n  conv\n    (fun { bootstrap_accounts ; bootstrap_contracts ; commitments ; constants ;\n           security_deposit_ramp_up_cycles ; no_reward_cycles } ->\n      ((bootstrap_accounts, bootstrap_contracts, commitments,\n        security_deposit_ramp_up_cycles, no_reward_cycles),\n       constants))\n    (fun ( (bootstrap_accounts, bootstrap_contracts, commitments,\n            security_deposit_ramp_up_cycles, no_reward_cycles),\n           constants) ->\n      { bootstrap_accounts ; bootstrap_contracts ; commitments ; constants ;\n        security_deposit_ramp_up_cycles ; no_reward_cycles })\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_encoding)\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\n(** An internal storage error that should not happen *)\ntype storage_error =\n  | Incompatible_protocol_version of string\n  | Missing_key of string list * [`Get | `Set | `Del | `Copy]\n  | Existing_key of string list\n  | Corrupted_data of string list\n\ntype error += Storage_error of storage_error\ntype error += Failed_to_parse_parameter of MBytes.t\ntype error += Failed_to_decode_parameter of Data_encoding.json * string\n\nval storage_error: storage_error -> 'a tzresult Lwt.t\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\ntype context = t\ntype root_context = 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  timestamp: Time.t ->\n  fitness: Fitness.t ->\n  Context.t -> context tzresult Lwt.t\n\nval prepare_first_block:\n  level:int32 ->\n  timestamp:Time.t ->\n  fitness:Fitness.t ->\n  Context.t -> (Parameters_repr.t * context) tzresult Lwt.t\n\nval activate: context -> Protocol_hash.t -> t Lwt.t\nval fork_test_chain: context -> Protocol_hash.t -> Time.t -> t Lwt.t\n\nval register_resolvers:\n  'a Base58.encoding -> (context -> string -> 'a list Lwt.t) -> unit\n\n(** Returns the state of the database resulting of operations on its\n    abstract view *)\nval recover: context -> Context.t\n\nval current_level: context -> Level_repr.t\nval current_timestamp: context -> Time.t\n\nval current_fitness: context -> Int64.t\nval set_current_fitness: context -> Int64.t -> t\n\nval constants: context -> Constants_repr.parametric\nval patch_constants:\n  context ->\n  (Constants_repr.parametric -> Constants_repr.parametric) ->\n  context Lwt.t\nval first_level: context -> Raw_level_repr.t\n\n(** Increment the current block fee stash that will be credited to baker's\n    frozen_fees account at finalize_application *)\nval add_fees: context -> Tez_repr.t -> context tzresult Lwt.t\n\n(** Increment the current block reward stash that will be credited to baker's\n    frozen_fees account at finalize_application *)\nval add_rewards: context -> Tez_repr.t -> context tzresult Lwt.t\n\n(** Increment the current block deposit stash for a specific delegate. All the\n    delegates' frozen_deposit accounts are credited at finalize_application *)\nval add_deposit:\n  context -> Signature.Public_key_hash.t -> Tez_repr.t -> context tzresult Lwt.t\n\nval get_fees: context -> Tez_repr.t\nval get_rewards: context -> Tez_repr.t\nval get_deposits: context -> Tez_repr.t Signature.Public_key_hash.Map.t\n\ntype error += Gas_limit_too_high (* `Permanent *)\n\nval check_gas_limit: t -> Z.t -> unit tzresult\nval set_gas_limit: t -> Z.t -> t\nval set_gas_unlimited: t -> t\nval gas_level: t -> Gas_limit_repr.t\nval gas_consumed: since: t -> until: t -> Z.t\nval block_gas_level: t -> Z.t\n\nval init_storage_space_to_pay: t -> t\nval update_storage_space_to_pay: t -> Z.t -> t\nval clear_storage_space_to_pay: t -> t * Z.t\n\ntype error += Undefined_operation_nonce (* `Permanent *)\n\nval init_origination_nonce: t -> Operation_hash.t -> t\nval origination_nonce: t -> Contract_repr.origination_nonce tzresult\nval increment_origination_nonce: t -> (t * Contract_repr.origination_nonce) tzresult\nval unset_origination_nonce: t -> t\n\n(** {1 Generic accessors} *************************************************)\n\ntype key = string list\n\ntype value = MBytes.t\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. *)\nmodule type T = sig\n\n  type t\n  type context = t\n\n  (** Tells if the key is already defined as a value. *)\n  val mem: context -> key -> bool Lwt.t\n\n  (** Tells if the key is already defined as a directory. *)\n  val dir_mem: context -> key -> bool Lwt.t\n\n  (** Retrieve the value from the storage bucket ; returns a\n      {!Storage_error Missing_key} if the key is not set. *)\n  val get: context -> key -> value tzresult Lwt.t\n\n  (** Retrieves the value from the storage bucket ; returns [None] if\n      the data is not initialized. *)\n  val get_option: context -> key -> value option 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 -> key -> value -> context 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 set: context -> key -> value -> context tzresult Lwt.t\n\n  (** Allocates the data and initializes it with a value ; just\n      updates it if the bucket exists. *)\n  val init_set: context -> key -> value -> context 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      valus is [None], delete the storage bucket when the value ; does\n      nothing if the bucket does not exists. *)\n  val set_option: context -> key -> value option -> context Lwt.t\n\n  (** Delete the storage bucket ; returns a {!Storage_error\n      Missing_key} if the bucket does not exists. *)\n  val delete: context -> key -> context tzresult Lwt.t\n\n  (** Removes the storage bucket and its contents ; does nothing if the\n      bucket does not exists. *)\n  val remove: context -> key -> context Lwt.t\n\n  (** Recursively removes all the storage buckets and contents ; does\n      nothing if no bucket exists. *)\n  val remove_rec: context -> key -> context Lwt.t\n\n  val copy: context -> from:key -> to_:key -> context tzresult Lwt.t\n\n  (** Iterator on all the items of a given directory. *)\n  val fold:\n    context -> key -> init:'a ->\n    f:([ `Key of key | `Dir of key ] -> 'a -> 'a Lwt.t) ->\n    'a Lwt.t\n\n  (** Recursively list all subkeys of a given key. *)\n  val keys: context -> key -> key list Lwt.t\n\n  (** Recursive iterator on all the subkeys of a given key. *)\n  val fold_keys:\n    context -> key -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t\n\n  (** Internally used in {!Storage_functors} to escape from a view. *)\n  val project: context -> root_context\n\n  (** Internally used in {!Storage_functors} to retrieve a full key\n      from partial key relative a view. *)\n  val absolute_key: context -> key -> key\n\n  (** Internally used in {!Storage_functors} to consume gas from\n      within a view. *)\n  val consume_gas: context -> Gas_limit_repr.cost -> context tzresult\n\n  (** Check if consume_gas will fail *)\n  val check_enough_gas: context -> Gas_limit_repr.cost -> unit tzresult\n\n  val description: context Storage_description.t\n\nend\n\ninclude T with type t := t and type context := context\n\n(** Initialize the local nonce used for preventing a script to\n    duplicate an internal operation to replay it. *)\nval reset_internal_nonce: context -> context\n\n(** Increments the internal operation nonce. *)\nval fresh_internal_nonce: context -> (context * int) tzresult\n\n(** Mark an internal operation nonce as taken. *)\nval record_internal_nonce: context -> int -> context\n\n(** Check is the internal operation nonce has been taken. *)\nval internal_nonce_already_recorded: context -> int -> bool\n\n(** Returns a map where to each endorser's pkh is associated the list of its\n    endorsing slots (in decreasing order) for a given level. *)\nval allowed_endorsements:\n  context ->\n  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t\n\n(** Initializes the map of allowed endorsements, this function must only be\n    called once. *)\nval init_endorsements:\n  context ->\n  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t ->\n  context\n\n(** Marks an endorsment in the map as used. *)\nval record_endorsement:\n  context -> Signature.Public_key_hash.t -> context\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\ntype t = {\n  context: Context.t ;\n  constants: Constants_repr.parametric ;\n  first_level: Raw_level_repr.t ;\n  level: Level_repr.t ;\n  timestamp: Time.t ;\n  fitness: Int64.t ;\n  deposits: Tez_repr.t Signature.Public_key_hash.Map.t ;\n  allowed_endorsements:\n    (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t ;\n  fees: Tez_repr.t ;\n  rewards: Tez_repr.t ;\n  block_gas: Z.t ;\n  operation_gas: Gas_limit_repr.t ;\n  storage_space_to_pay: Z.t option ;\n  origination_nonce: Contract_repr.origination_nonce option ;\n  internal_nonce: int ;\n  internal_nonces_used: Int_set.t ;\n}\n\ntype context = t\ntype root_context = t\n\nlet current_level ctxt = ctxt.level\nlet current_timestamp ctxt = ctxt.timestamp\nlet current_fitness ctxt = ctxt.fitness\nlet first_level ctxt = ctxt.first_level\nlet constants ctxt = ctxt.constants\nlet recover ctxt = ctxt.context\n\nlet record_endorsement ctxt k =\n  match Signature.Public_key_hash.Map.find_opt k ctxt.allowed_endorsements with\n  | None -> assert false\n  | Some (_, _, true) -> assert false (* right already used *)\n  | Some (d, s, false) ->\n      { ctxt with\n        allowed_endorsements =\n          Signature.Public_key_hash.Map.add k (d,s,true) ctxt.allowed_endorsements }\n\nlet init_endorsements ctxt allowed_endorsements =\n  if Signature.Public_key_hash.Map.is_empty allowed_endorsements\n  then assert false (* can't initialize to empty *)\n  else begin\n    if Signature.Public_key_hash.Map.is_empty ctxt.allowed_endorsements\n    then { ctxt with allowed_endorsements }\n    else assert false (* can't initialize twice *)\n  end\n\nlet allowed_endorsements ctxt =\n  ctxt.allowed_endorsements\n\ntype error += Too_many_internal_operations (* `Permanent *)\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 \\\n       of internal operations it can emit\"\n    empty\n    (function Too_many_internal_operations -> Some () | _ -> None)\n    (fun () -> Too_many_internal_operations)\n\nlet fresh_internal_nonce ctxt =\n  if Compare.Int.(ctxt.internal_nonce >= 65_535) then\n    error Too_many_internal_operations\n  else\n    ok ({ ctxt with internal_nonce = ctxt.internal_nonce + 1 }, ctxt.internal_nonce)\nlet reset_internal_nonce ctxt =\n  { ctxt with internal_nonces_used = Int_set.empty ; internal_nonce = 0 }\nlet record_internal_nonce ctxt k =\n  { ctxt with internal_nonces_used = Int_set.add k ctxt.internal_nonces_used }\nlet internal_nonce_already_recorded ctxt k =\n  Int_set.mem k ctxt.internal_nonces_used\n\nlet set_current_fitness ctxt fitness = { ctxt with fitness }\n\nlet add_fees ctxt fees =\n  Lwt.return Tez_repr.(ctxt.fees +? fees) >>=? fun fees ->\n  return { ctxt with fees}\n\nlet add_rewards ctxt rewards =\n  Lwt.return Tez_repr.(ctxt.rewards +? rewards) >>=? fun rewards ->\n  return { ctxt with rewards}\n\nlet add_deposit ctxt delegate deposit =\n  let previous =\n    match Signature.Public_key_hash.Map.find_opt delegate ctxt.deposits with\n    | Some tz -> tz\n    | None -> Tez_repr.zero in\n  Lwt.return Tez_repr.(previous +? deposit) >>=? fun deposit ->\n  let deposits =\n    Signature.Public_key_hash.Map.add delegate deposit ctxt.deposits in\n  return { ctxt with deposits }\n\nlet get_deposits ctxt = ctxt.deposits\nlet get_rewards ctxt = ctxt.rewards\nlet get_fees ctxt = 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 attemped 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) in\n  { ctxt with origination_nonce }\n\nlet origination_nonce ctxt =\n  match ctxt.origination_nonce with\n  | None -> error Undefined_operation_nonce\n  | Some origination_nonce -> ok origination_nonce\n\nlet increment_origination_nonce ctxt =\n  match ctxt.origination_nonce 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) in\n      ok ({ ctxt with origination_nonce }, cur_origination_nonce)\n\nlet unset_origination_nonce ctxt =\n  { ctxt with origination_nonce = 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:\n      \"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 check_gas_limit ctxt remaining =\n  if Compare.Z.(remaining > ctxt.constants.hard_gas_limit_per_operation)\n  || Compare.Z.(remaining < Z.zero) then\n    error Gas_limit_too_high\n  else\n    ok ()\nlet set_gas_limit ctxt remaining =\n  { ctxt with operation_gas = Limited { remaining } }\nlet set_gas_unlimited ctxt =\n  { ctxt with operation_gas = Unaccounted }\nlet consume_gas ctxt cost =\n  Gas_limit_repr.consume ctxt.block_gas ctxt.operation_gas cost >>? fun (block_gas, operation_gas) ->\n  ok { ctxt with block_gas ; operation_gas }\nlet check_enough_gas ctxt cost =\n  Gas_limit_repr.check_enough ctxt.block_gas ctxt.operation_gas cost\nlet gas_level ctxt = ctxt.operation_gas\nlet block_gas_level ctxt = ctxt.block_gas\nlet gas_consumed ~since ~until =\n  match gas_level since, gas_level until with\n  | Limited { remaining = before }, Limited { remaining = after } -> Z.sub before after\n  | _, _ -> Z.zero\n\nlet init_storage_space_to_pay ctxt =\n  match ctxt.storage_space_to_pay with\n  | Some _ ->\n      assert false\n  | None ->\n      { ctxt with storage_space_to_pay = Some Z.zero }\n\nlet update_storage_space_to_pay ctxt n =\n  match ctxt.storage_space_to_pay with\n  | None ->\n      assert false\n  | Some storage_space_to_pay ->\n      { ctxt with storage_space_to_pay = Some (Z.add n storage_space_to_pay) }\n\nlet clear_storage_space_to_pay ctxt =\n  match ctxt.storage_space_to_pay with\n  | None ->\n      assert false\n  | Some storage_space_to_pay ->\n      { ctxt with storage_space_to_pay = None }, storage_space_to_pay\n\ntype storage_error =\n  | Incompatible_protocol_version of string\n  | Missing_key of string list * [`Get | `Set | `Del | `Copy]\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    case (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 (Tag 1)\n      ~title:\"Missing_key\"\n      (obj2\n         (req \"missing_key\" (list string))\n         (req \"function\" (string_enum [\"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 (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 (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 ppf\n        \"Found a context with an unexpected version '%s'.\"\n        version\n  | Missing_key (key, `Get) ->\n      Format.fprintf ppf\n        \"Missing key '%s'.\"\n        (String.concat \"/\" key)\n  | Missing_key (key, `Set) ->\n      Format.fprintf ppf\n        \"Cannot set undefined key '%s'.\"\n        (String.concat \"/\" key)\n  | Missing_key (key, `Del) ->\n      Format.fprintf ppf\n        \"Cannot delete undefined key '%s'.\"\n        (String.concat \"/\" key)\n  | Missing_key (key, `Copy) ->\n      Format.fprintf ppf\n        \"Cannot copy undefined key '%s'.\"\n        (String.concat \"/\" key)\n  | Existing_key key ->\n      Format.fprintf ppf\n        \"Cannot initialize defined key '%s'.\"\n        (String.concat \"/\" key)\n  | Corrupted_data key ->\n      Format.fprintf 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 \\\n       has been deleted or corrupted in the database.\"\n    ~pp:(fun ppf err ->\n        Format.fprintf ppf\n          \"@[<v 2>Storage error:@ %a@]\"\n          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 = fail (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\"]\nlet version_value = \"alpha\"\n\nlet version = \"v1\"\nlet first_level_key = [ version ; \"first_level\" ]\nlet constants_key = [ version ; \"constants\" ]\nlet protocol_param_key = [ \"protocol_parameters\" ]\n\nlet get_first_level ctxt =\n  Context.get ctxt first_level_key >>= function\n  | None -> storage_error (Missing_key (first_level_key, `Get))\n  | Some bytes ->\n      match\n        Data_encoding.Binary.of_bytes Raw_level_repr.encoding bytes\n      with\n      | None -> storage_error (Corrupted_data first_level_key)\n      | Some level -> return level\n\nlet set_first_level ctxt level =\n  let bytes =\n    Data_encoding.Binary.to_bytes_exn Raw_level_repr.encoding level in\n  Context.set ctxt first_level_key bytes >>= fun ctxt ->\n  return ctxt\n\ntype error += Failed_to_parse_parameter of MBytes.t\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:\n      \"The protocol parameters are not valid JSON.\"\n    ~pp:begin fun ppf bytes ->\n      Format.fprintf ppf\n        \"@[<v 2>Cannot parse the protocol parameter:@ %s@]\"\n        (MBytes.to_string bytes)\n    end\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:\n      \"Unexpected JSON object.\"\n    ~pp:begin fun ppf (json, msg) ->\n      Format.fprintf ppf\n        \"@[<v 2>Cannot decode the protocol parameter:@ %s@ %a@]\"\n        msg\n        Data_encoding.Json.pp json\n    end\n    Data_encoding.(obj2\n                     (req \"contents\" json)\n                     (req \"error\" string))\n    (function\n      | Failed_to_decode_parameter (json, msg) -> Some (json, msg)\n      | _ -> None)\n    (fun (json, msg) -> Failed_to_decode_parameter (json, msg))\n\nlet get_proto_param ctxt =\n  Context.get ctxt protocol_param_key >>= function\n  | None ->\n      failwith \"Missing protocol parameters.\"\n  | Some bytes ->\n      match Data_encoding.Binary.of_bytes Data_encoding.json bytes with\n      | None -> fail (Failed_to_parse_parameter bytes)\n      | Some json -> begin\n          Context.del 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 \"Invalid protocol_parameters: %a %a\"\n                (fun ppf -> Data_encoding.Json.print_error ppf) exn\n                Data_encoding.Json.pp json\n          | param -> return (param, ctxt)\n        end\n\nlet set_constants ctxt constants =\n  let bytes =\n    Data_encoding.Binary.to_bytes_exn\n      Parameters_repr.constants_encoding constants in\n  Context.set ctxt constants_key bytes\n\nlet get_constants ctxt =\n  Context.get ctxt constants_key >>= function\n  | None ->\n      failwith \"Internal error: cannot read constants in context.\"\n  | Some bytes ->\n      match\n        Data_encoding.Binary.of_bytes Parameters_repr.constants_encoding bytes\n      with\n      | None ->\n          failwith \"Internal error: cannot parse constants in context.\"\n      | Some constants -> return constants\n\nlet patch_constants ctxt f =\n  let constants = f ctxt.constants in\n  set_constants ctxt.context constants >>= fun context ->\n  Lwt.return { ctxt with context ; constants }\n\nlet check_inited ctxt =\n  Context.get ctxt version_key >>= function\n  | None ->\n      failwith \"Internal error: un-initialized context.\"\n  | Some bytes ->\n      let s = MBytes.to_string bytes in\n      if Compare.String.(s = version_value) then\n        return_unit\n      else\n        storage_error (Incompatible_protocol_version s)\n\nlet prepare ~level ~timestamp ~fitness ctxt =\n  Lwt.return (Raw_level_repr.of_int32 level) >>=? fun level ->\n  Lwt.return (Fitness_repr.to_int64 fitness) >>=? fun fitness ->\n  check_inited ctxt >>=? fun () ->\n  get_constants ctxt >>=? fun constants ->\n  get_first_level ctxt >>=? fun first_level ->\n  let level =\n    Level_repr.from_raw\n      ~first_level\n      ~blocks_per_cycle:constants.Constants_repr.blocks_per_cycle\n      ~blocks_per_voting_period:constants.Constants_repr.blocks_per_voting_period\n      ~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment\n      level in\n  return {\n    context = ctxt ; constants ; level ;\n    timestamp ; fitness ; first_level ;\n    allowed_endorsements = Signature.Public_key_hash.Map.empty ;\n    fees = Tez_repr.zero ;\n    rewards = Tez_repr.zero ;\n    deposits = Signature.Public_key_hash.Map.empty ;\n    operation_gas = Unaccounted ;\n    storage_space_to_pay = None ;\n    block_gas = constants.Constants_repr.hard_gas_limit_per_block ;\n    origination_nonce = None ;\n    internal_nonce = 0 ;\n    internal_nonces_used = Int_set.empty ;\n  }\n\nlet check_first_block ctxt =\n  Context.get ctxt version_key >>= function\n  | None -> return_unit\n  | Some bytes ->\n      let s = MBytes.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        return_unit\n      else\n        storage_error (Incompatible_protocol_version s)\n\nlet prepare_first_block ~level ~timestamp ~fitness ctxt =\n  check_first_block ctxt >>=? fun () ->\n  Lwt.return (Raw_level_repr.of_int32 level) >>=? fun first_level ->\n  get_proto_param ctxt >>=? fun (param, ctxt) ->\n  Context.set ctxt version_key\n    (MBytes.of_string version_value) >>= fun ctxt ->\n  set_first_level ctxt first_level >>=? fun ctxt ->\n  set_constants ctxt param.constants >>= fun ctxt ->\n  prepare ctxt ~level ~timestamp ~fitness >>=? fun ctxt ->\n  return (param, ctxt)\n\nlet activate ({ context = c ; _ } as s) h =\n  Updater.activate c h >>= fun c -> Lwt.return { s with context = c }\n\nlet fork_test_chain ({ context = c ; _ } as s) protocol expiration =\n  Updater.fork_test_chain c ~protocol ~expiration >>= fun c ->\n  Lwt.return { s with context = c }\n\nlet register_resolvers enc resolve =\n  let resolve context str =\n    let faked_context = {\n      context ;\n      constants = Constants_repr.default ;\n      first_level = Raw_level_repr.root ;\n      level =  Level_repr.root Raw_level_repr.root ;\n      timestamp = Time.of_seconds 0L ;\n      fitness = 0L ;\n      allowed_endorsements = Signature.Public_key_hash.Map.empty ;\n      storage_space_to_pay = None ;\n      fees = Tez_repr.zero ;\n      rewards = Tez_repr.zero ;\n      deposits = Signature.Public_key_hash.Map.empty ;\n      block_gas = Constants_repr.default.hard_gas_limit_per_block ;\n      operation_gas = Unaccounted ;\n      origination_nonce = None ;\n      internal_nonce = 0 ;\n      internal_nonces_used = Int_set.empty ;\n    } in\n    resolve faked_context str in\n  Context.register_resolver enc  resolve\n\n(* Generic context ********************************************************)\n\ntype key = string list\n\ntype value = MBytes.t\n\nmodule type T = sig\n\n  type t\n  type context = t\n\n  val mem: context -> key -> bool Lwt.t\n  val dir_mem: context -> key -> bool Lwt.t\n  val get: context -> key -> value tzresult Lwt.t\n  val get_option: context -> key -> value option Lwt.t\n  val init: context -> key -> value -> context tzresult Lwt.t\n  val set: context -> key -> value -> context tzresult Lwt.t\n  val init_set: context -> key -> value -> context Lwt.t\n  val set_option: context -> key -> value option -> context Lwt.t\n  val delete: context -> key -> context tzresult Lwt.t\n  val remove: context -> key -> context Lwt.t\n  val remove_rec: context -> key -> context Lwt.t\n  val copy: context -> from:key -> to_:key -> context tzresult Lwt.t\n\n  val fold:\n    context -> key -> init:'a ->\n    f:([ `Key of key | `Dir of key ] -> 'a -> 'a Lwt.t) ->\n    'a Lwt.t\n\n  val keys: context -> key -> key list Lwt.t\n\n  val fold_keys:\n    context -> key -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t\n\n  val project: context -> root_context\n\n  val absolute_key: context -> key -> key\n\n  val consume_gas: context -> Gas_limit_repr.cost -> context tzresult\n\n  val check_enough_gas: context -> Gas_limit_repr.cost -> unit tzresult\n\n  val description: context Storage_description.t\n\nend\n\nlet mem ctxt k = Context.mem ctxt.context k\nlet dir_mem ctxt k = Context.dir_mem ctxt.context k\n\nlet get ctxt k =\n  Context.get ctxt.context k >>= function\n  | None -> storage_error (Missing_key (k, `Get))\n  | Some v -> return v\n\nlet get_option ctxt k =\n  Context.get ctxt.context k\n\n(* Verify that the k is present before modifying *)\nlet set ctxt k v =\n  Context.mem ctxt.context k >>= function\n  | false -> storage_error (Missing_key (k, `Set))\n  | true ->\n      Context.set ctxt.context k v >>= fun context ->\n      return { ctxt with context }\n\n(* Verify that the k is not present before inserting *)\nlet init ctxt k v =\n  Context.mem ctxt.context k >>= function\n  | true -> storage_error (Existing_key k)\n  | false ->\n      Context.set ctxt.context k v >>= fun context ->\n      return { ctxt with context }\n\n(* Does not verify that the key is present or not *)\nlet init_set ctxt k v =\n  Context.set ctxt.context k v >>= fun context ->\n  Lwt.return { ctxt with context }\n\n(* Verify that the key is present before deleting *)\nlet delete ctxt k =\n  Context.mem ctxt.context k >>= function\n  | false -> storage_error (Missing_key (k, `Del))\n  | true ->\n      Context.del ctxt.context k >>= fun context ->\n      return { ctxt with context }\n\n(* Do not verify before deleting *)\nlet remove ctxt k =\n  Context.del ctxt.context k >>= fun context ->\n  Lwt.return { ctxt with context }\n\nlet set_option ctxt k = function\n  | None -> remove ctxt k\n  | Some v -> init_set ctxt k v\n\nlet remove_rec ctxt k =\n  Context.remove_rec ctxt.context k >>= fun context ->\n  Lwt.return { ctxt with context }\n\nlet copy ctxt ~from ~to_ =\n  Context.copy ctxt.context ~from ~to_ >>= function\n  | None -> storage_error (Missing_key (from, `Copy))\n  | Some context ->\n      return { ctxt with context }\n\nlet fold ctxt k ~init ~f =\n  Context.fold ctxt.context k ~init ~f\n\nlet keys ctxt k =\n  Context.keys ctxt.context k\n\nlet fold_keys ctxt k ~init ~f =\n  Context.fold_keys ctxt.context k ~init ~f\n\nlet project x = x\n\nlet absolute_key _ k = k\n\nlet description = Storage_description.create ()\n" ;
                } ;
                { name = "Storage_sigs" ;
                  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\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\n  type t\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 get_option: context -> value option tzresult Lwt.t\n\n  (** Allocates the storage bucket and initializes it ; returns a\n      {!Storage_error Missing_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      Existing_key} if the value does not exists *)\n  val set: 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 init_set: 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      valus is [None], delete the storage bucket when the value ; does\n      nothing if the bucket does not exists. *)\n  val set_option: 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 delete: 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\n\nend\n\n(** Variant of {!Single_data_storage} with gas accounting. *)\nmodule type Single_carbonated_data_storage = sig\n\n  type t\n  type context = t\n\n  (** The type of the value *)\n  type value\n\n  (** Tells if the data is already defined.\n      Consumes [Gas_repr.read_bytes_cost Z.zero]. *)\n  val mem: context -> (Raw_context.t * bool) tzresult 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      Consumes [Gas_repr.read_bytes_cost <size of the value>]. *)\n  val get: context -> (Raw_context.t * 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      Consumes [Gas_repr.read_bytes_cost <size of the value>] if present\n      or [Gas_repr.read_bytes_cost Z.zero]. *)\n  val get_option: context -> (Raw_context.t * value option) tzresult Lwt.t\n\n  (** Allocates the storage bucket and initializes it ; returns a\n      {!Storage_error Missing_key} if the bucket exists.\n      Consumes [Gas_repr.write_bytes_cost <size of the value>].\n      Returns the size. *)\n  val init: context -> value -> (Raw_context.t * int) tzresult Lwt.t\n\n  (** Updates the content of the bucket ; returns a {!Storage_Error\n      Existing_key} if the value does not exists.\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 set: context -> value -> (Raw_context.t * int) tzresult Lwt.t\n\n  (** Allocates the data and initializes it with a value ; just\n      updates it if the bucket exists.\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. *)\n  val init_set: context -> value -> (Raw_context.t * int) 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      valus is [None], delete the storage bucket when the value ; does\n      nothing if the bucket does not exists.\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. *)\n  val set_option: context -> value option -> (Raw_context.t * int) tzresult Lwt.t\n\n  (** Delete the storage bucket ; returns a {!Storage_error\n      Missing_key} if the bucket does not exists.\n      Consumes [Gas_repr.write_bytes_cost Z.zero].\n      Returns the freed size. *)\n  val delete: context -> (Raw_context.t * int) tzresult Lwt.t\n\n  (** Removes the storage bucket and its contents ; does nothing if\n      the bucket does not exists.\n      Consumes [Gas_repr.write_bytes_cost Z.zero].\n      Returns the freed size. *)\n  val remove: context -> (Raw_context.t * int) tzresult Lwt.t\n\nend\n\n(** Restricted version of {!Indexed_data_storage} w/o iterators. *)\nmodule type Non_iterable_indexed_data_storage = sig\n\n  type t\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 get_option: 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 set: 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 init_set: 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      valus is [None], delete the storage bucket when the value ; does\n      nothing if the bucket does not exists. *)\n  val set_option: 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 delete: 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\n\nend\n\n(** Variant of {!Non_iterable_indexed_data_storage} with gas accounting. *)\nmodule type Non_iterable_indexed_carbonated_data_storage = sig\n\n  type t\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 get_option: 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 set: 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. *)\n  val init_set: context -> key -> value -> (Raw_context.t * int) 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      valus 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. *)\n  val set_option: context -> key -> value option -> (Raw_context.t * int) 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 delete: 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. *)\n  val remove: context -> key -> (Raw_context.t * int) tzresult Lwt.t\n\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\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 -> init:'a -> f:(key -> value -> 'a -> 'a Lwt.t) -> 'a Lwt.t\n\n  (** Iterate over all the keys. *)\n  val fold_keys:\n    context -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t\n\nend\n\nmodule type Indexed_data_snapshotable_storage = sig\n  type snapshot\n  type key\n\n  include Indexed_data_storage with type key := key\n\n  module Snapshot : 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  val snapshot : context -> snapshot -> Raw_context.t tzresult Lwt.t\n  val delete_snapshot : context -> snapshot -> Raw_context.t Lwt.t\n\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\n  type t\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 del: context -> elt -> Raw_context.t Lwt.t\n\n  (** Adds/Removes a elt of the set *)\n  val set: context -> elt -> bool -> 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: context -> init:'a -> f:(elt -> 'a -> 'a Lwt.t) -> 'a Lwt.t\n\n  (** Removes all elements in the set *)\n  val clear: context -> Raw_context.t Lwt.t\n\nend\n\nmodule type NAME = sig\n  val name: Raw_context.key\nend\n\nmodule type VALUE = sig\n  type t\n  val encoding: t Data_encoding.t\nend\n\nmodule type Indexed_raw_context = sig\n\n  type t\n  type context = t\n  type key\n  type 'a ipath\n\n  val clear: context -> Raw_context.t Lwt.t\n\n  val fold_keys:\n    context -> init:'a -> f:(key -> 'a -> 'a Lwt.t) -> 'a Lwt.t\n  val keys: context -> key list Lwt.t\n\n  val resolve: context -> string list -> key list Lwt.t\n\n  module Make_set (N : NAME)\n    : Data_set_storage with type t = t\n                        and type elt = key\n\n  module Make_map (N : NAME) (V : VALUE)\n    : Indexed_data_storage with type t = t\n                            and type key = key\n                            and type value = V.t\n\n  module Make_carbonated_map (N : NAME) (V : VALUE)\n    : Non_iterable_indexed_carbonated_data_storage 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\n\nend\n" ;
                } ;
                { name = "Storage_functors" ;
                  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 builders. *)\n\nopen Storage_sigs\n\nmodule Make_subcontext (C : Raw_context.T) (N : NAME)\n  : Raw_context.T with type t = C.t\n\nmodule Make_single_data_storage\n    (C : Raw_context.T) (N : NAME) (V : VALUE)\n  : Single_data_storage with type t = C.t\n                         and type value = V.t\n\nmodule type INDEX = sig\n  type t\n  val path_length: int\n  val to_path: t -> string list -> string list\n  val of_path: string list -> t option\n  type 'a ipath\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\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\nmodule Make_indexed_data_storage\n    (C : Raw_context.T) (I : INDEX) (V : VALUE)\n  : Indexed_data_storage with type t = C.t\n                          and type key = I.t\n                          and type value = V.t\n\nmodule Make_indexed_carbonated_data_storage\n    (C : Raw_context.T) (I : INDEX) (V : VALUE)\n  : Non_iterable_indexed_carbonated_data_storage with type t = C.t\n                                                  and type key = I.t\n                                                  and type value = V.t\n\nmodule Make_indexed_data_snapshotable_storage (C : Raw_context.T)\n    (Snapshot : INDEX) (I : INDEX) (V : VALUE)\n  : Indexed_data_snapshotable_storage 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 with type t = C.t\n                         and type key = I.t\n                         and type 'a ipath = 'a I.ipath\n\nmodule Wrap_indexed_data_storage\n    (C : Indexed_data_storage)\n    (K : sig\n       type t\n       val wrap: t -> C.key\n       val unwrap: C.key -> t option\n     end)\n  : Indexed_data_storage 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(*                                                                           *)\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 Make_encoder (V : VALUE) = struct\n  let of_bytes ~key b =\n    match Data_encoding.Binary.of_bytes V.encoding b with\n    | None -> Error [Raw_context.Storage_error (Corrupted_data key)]\n    | Some v -> Ok v\n  let to_bytes v =\n    match Data_encoding.Binary.to_bytes V.encoding v with\n    | Some b -> b\n    | None -> MBytes.create 0\nend\n\nlet len_name = \"len\"\nlet data_name = \"data\"\n\nlet encode_len_value bytes =\n  let length = MBytes.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 int31) len with\n  | None ->\n      fail (Raw_context.Storage_error (Corrupted_data key))\n  | Some len ->\n      return len\n\nlet map_key f = function\n  | `Key k -> `Key (f k)\n  | `Dir k -> `Dir (f k)\n\nmodule Make_subcontext (C : Raw_context.T) (N : NAME)\n  : Raw_context.T with type t = C.t = struct\n  type t = C.t\n  type context = t\n  let name_length = List.length N.name\n  let to_key k = N.name @ k\n  let of_key k = Misc.remove_elem_from_list name_length k\n  let mem t k = C.mem t (to_key k)\n  let dir_mem t k = C.dir_mem t (to_key k)\n  let get t k = C.get t (to_key k)\n  let get_option t k = C.get_option t (to_key k)\n  let init t k v = C.init t (to_key k) v\n  let set t k v = C.set t (to_key k) v\n  let init_set t k v = C.init_set t (to_key k) v\n  let set_option t k v = C.set_option t (to_key k) v\n  let delete t k = C.delete t (to_key k)\n  let remove t k = C.remove t (to_key k)\n  let remove_rec t k = C.remove_rec t (to_key k)\n  let copy t ~from ~to_ = C.copy t ~from:(to_key from) ~to_:(to_key to_)\n  let fold t k ~init ~f =\n    C.fold t (to_key k) ~init\n      ~f:(fun k acc -> f (map_key of_key k) acc)\n  let keys t k = C.keys t (to_key k) >|= fun keys -> List.map of_key keys\n  let fold_keys t k ~init ~f =\n    C.fold_keys t (to_key k) ~init ~f:(fun k acc -> f (of_key k) acc)\n  let project = C.project\n  let absolute_key c k = C.absolute_key c (to_key k)\n  let consume_gas = C.consume_gas\n  let check_enough_gas = C.check_enough_gas\n  let description =\n    Storage_description.register_named_subcontext C.description N.name\nend\n\nmodule Make_single_data_storage (C : Raw_context.T) (N : NAME) (V : VALUE)\n  : Single_data_storage with type t = C.t\n                         and type value = V.t = struct\n  type t = C.t\n  type context = t\n  type value = V.t\n  let mem t =\n    C.mem t N.name\n  include Make_encoder(V)\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  let get_option t =\n    C.get_option t N.name >>= function\n    | None -> return_none\n    | Some b ->\n        let key = C.absolute_key t N.name in\n        match of_bytes ~key b with\n        | Ok v -> return_some v\n        | Error _ as err -> Lwt.return err\n  let init t v =\n    C.init t N.name (to_bytes v) >>=? fun t ->\n    return (C.project t)\n  let set t v =\n    C.set t N.name (to_bytes v) >>=? fun t ->\n    return (C.project t)\n  let init_set t v =\n    C.init_set t N.name (to_bytes v) >>= fun t ->\n    Lwt.return (C.project t)\n  let set_option t v =\n    C.set_option t N.name (Option.map ~f:to_bytes v) >>= fun t ->\n    Lwt.return (C.project t)\n  let remove t =\n    C.remove t N.name >>= fun t ->\n    Lwt.return (C.project t)\n  let delete t =\n    C.delete t N.name >>=? fun t ->\n    return (C.project t)\n\n  let () =\n    let open Storage_description in\n    register_value\n      ~get:get_option\n      (register_named_subcontext C.description N.name)\n      V.encoding\n\nend\n\nmodule type INDEX = sig\n  type t\n  val path_length: int\n  val to_path: t -> string list -> string list\n  val of_path: string list -> t option\n  type 'a ipath\n  val args: ('a, t, 'a ipath) Storage_description.args\nend\n\nmodule Pair(I1 : INDEX)(I2 : INDEX)\n  : INDEX with type t = I1.t * I2.t = struct\n  type t = I1.t * I2.t\n  let path_length = I1.path_length + I2.path_length\n  let to_path (x, y) l = I1.to_path x (I2.to_path y l)\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  type 'a ipath = 'a I1.ipath I2.ipath\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\n  type t = C.t\n  type context = t\n  type elt = I.t\n\n  let inited = MBytes.of_string \"inited\"\n\n  let mem s i =\n    C.mem s (I.to_path i [])\n  let add s i =\n    C.init_set s (I.to_path i []) inited >>= fun t ->\n    Lwt.return (C.project t)\n  let del s i =\n    C.remove s (I.to_path i []) >>= fun t ->\n    Lwt.return (C.project t)\n  let set s i = function\n    | true -> add s i\n    | false -> del s i\n  let clear s =\n    C.remove_rec s [] >>= fun t ->\n    Lwt.return (C.project t)\n\n  let fold s ~init ~f =\n    let rec dig i path acc =\n      if Compare.Int.(i <= 1) then\n        C.fold s path ~init:acc ~f:begin fun k acc ->\n          match k with\n          | `Dir _ -> Lwt.return acc\n          | `Key file ->\n              match I.of_path file with\n              | None -> assert false\n              | Some p -> f p acc\n        end\n      else\n        C.fold s path ~init:acc ~f:begin fun k acc ->\n          match k with\n          | `Dir k ->\n              dig (i-1) k acc\n          | `Key _ ->\n              Lwt.return acc\n        end in\n    dig I.path_length [] init\n\n  let elements s =\n    fold s ~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      (* TODO fixme 'elements...' *)\n      ~get:(fun c ->\n          let (c, k) = unpack c in\n          mem c k >>= function\n          | true -> return_some true\n          | false -> return_none)\n      (register_indexed_subcontext\n         ~list:(fun c -> elements c >>= return)\n         C.description I.args)\n      Data_encoding.bool\n\nend\n\nmodule Make_indexed_data_storage\n    (C : Raw_context.T) (I : INDEX) (V : VALUE)\n  : Indexed_data_storage with type t = C.t\n                          and type key = I.t\n                          and type value = V.t = struct\n  type t = C.t\n  type context = t\n  type key = I.t\n  type value = V.t\n  include Make_encoder(V)\n  let mem s i =\n    C.mem s (I.to_path i [])\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  let get_option s i =\n    C.get_option s (I.to_path i []) >>= function\n    | None -> return_none\n    | Some b ->\n        let key = C.absolute_key s (I.to_path i []) in\n        match of_bytes ~key b with\n        | Ok v -> return_some v\n        | Error _ as err -> Lwt.return err\n  let set s i v =\n    C.set s (I.to_path i []) (to_bytes v) >>=? fun t ->\n    return (C.project t)\n  let init s i v =\n    C.init s (I.to_path i []) (to_bytes v) >>=? fun t ->\n    return (C.project t)\n  let init_set s i v =\n    C.init_set s (I.to_path i []) (to_bytes v) >>= fun t ->\n    Lwt.return (C.project t)\n  let set_option s i v =\n    C.set_option s (I.to_path i []) (Option.map ~f:to_bytes v) >>= fun t ->\n    Lwt.return (C.project t)\n  let remove s i =\n    C.remove s (I.to_path i []) >>= fun t ->\n    Lwt.return (C.project t)\n  let delete s i =\n    C.delete s (I.to_path i []) >>=? fun t ->\n    return (C.project t)\n  let clear s =\n    C.remove_rec s [] >>= fun t ->\n    Lwt.return (C.project t)\n\n  let fold_keys s ~init ~f =\n    let rec dig i path acc =\n      if Compare.Int.(i <= 1) then\n        C.fold s path ~init:acc ~f:begin fun k acc ->\n          match k with\n          | `Dir _ -> Lwt.return acc\n          | `Key file ->\n              match I.of_path file with\n              | None -> assert false\n              | Some path -> f path acc\n        end\n      else\n        C.fold s path ~init:acc ~f:begin fun k acc ->\n          match k with\n          | `Dir k -> dig (i-1) k acc\n          | `Key _ -> Lwt.return acc\n        end in\n    dig I.path_length [] init\n\n  let fold s ~init ~f =\n    let f path acc =\n      get s path >>= function\n      | Error _ ->\n          (* FIXME: silently ignore unparsable data *)\n          Lwt.return acc\n      | Ok v ->\n          f path v acc in\n    fold_keys s ~init ~f\n  let bindings s =\n    fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p,v) :: acc))\n  let keys s =\n    fold_keys s ~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          get_option c k)\n      (register_indexed_subcontext\n         ~list:(fun c -> keys c >>= return)\n         C.description I.args)\n      V.encoding\n\nend\n\nmodule Make_indexed_carbonated_data_storage\n    (C : Raw_context.T) (I : INDEX) (V : VALUE)\n  : Non_iterable_indexed_carbonated_data_storage with type t = C.t\n                                                  and type key = I.t\n                                                  and type value = V.t = struct\n  type t = C.t\n  type context = t\n  type key = I.t\n  type value = V.t\n  include Make_encoder(V)\n  let name i =\n    I.to_path i [data_name]\n  let len_name i =\n    I.to_path i [len_name]\n  let consume_mem_gas c =\n    Lwt.return (C.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero))\n  let existing_size c i =\n    C.get_option c (len_name i) >>= function\n    | None -> return 0\n    | Some len -> decode_len_value (len_name i) len\n  let consume_read_gas get c i =\n    get c (len_name i) >>=? fun len ->\n    decode_len_value (len_name i) len >>=? fun len ->\n    Lwt.return (C.consume_gas c (Gas_limit_repr.read_bytes_cost (Z.of_int len)))\n  let consume_serialize_write_gas set c i v =\n    let bytes = to_bytes v in\n    let len = MBytes.length bytes in\n    Lwt.return (C.consume_gas c (Gas_limit_repr.alloc_mbytes_cost len)) >>=? fun c ->\n    Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int len))) >>=? fun c ->\n    set c (len_name i) (encode_len_value bytes) >>=? fun c ->\n    return (c, bytes)\n  let consume_remove_gas del c i =\n    Lwt.return (C.consume_gas c (Gas_limit_repr.write_bytes_cost Z.zero)) >>=? fun c ->\n    del c (len_name i)\n  let mem s i =\n    consume_mem_gas s >>=? fun s ->\n    C.mem s (name i) >>= fun exists ->\n    return (C.project s, exists)\n  let get s i =\n    consume_read_gas C.get s i >>=? fun s ->\n    C.get s (name i) >>=? fun b ->\n    let key = C.absolute_key s (name i) in\n    Lwt.return (of_bytes ~key b) >>=? fun v ->\n    return (C.project s, v)\n  let get_option s i =\n    consume_mem_gas s >>=? fun s ->\n    C.mem s (name i) >>= fun exists ->\n    if exists then\n      get s i >>=? fun (s, v) ->\n      return (s, Some v)\n    else\n      return (C.project s, None)\n  let set s i v =\n    existing_size s i >>=? fun prev_size ->\n    consume_serialize_write_gas C.set s i v >>=? fun (s, bytes) ->\n    C.set s (name i) bytes >>=? fun t ->\n    let size_diff = MBytes.length bytes - prev_size in\n    return (C.project t, size_diff)\n  let init s i v =\n    consume_serialize_write_gas C.init s i v >>=? fun (s, bytes) ->\n    C.init s (name i) bytes >>=? fun t ->\n    let size = MBytes.length bytes in\n    return (C.project t, size)\n  let init_set s i v =\n    let init_set s i v = C.init_set s i v >>= return in\n    existing_size s i >>=? fun prev_size ->\n    consume_serialize_write_gas init_set s i v >>=? fun (s, bytes) ->\n    init_set s (name i) bytes >>=? fun t ->\n    let size_diff = MBytes.length bytes - prev_size in\n    return (C.project t, size_diff)\n  let remove s i =\n    let remove s i = C.remove s i >>= return in\n    existing_size s i >>=? fun prev_size ->\n    consume_remove_gas remove s i >>=? fun s ->\n    remove s (name i) >>=? fun t ->\n    return (C.project t, prev_size)\n  let delete s i =\n    existing_size s i >>=? fun prev_size ->\n    consume_remove_gas C.delete s i >>=? fun s ->\n    C.delete s (name i) >>=? fun t ->\n    return (C.project t, prev_size)\n  let set_option s i v =\n    match v with\n    | None -> remove s i\n    | Some v -> init_set s i v\n\n  let fold_keys_unaccounted s ~init ~f =\n    let rec dig i path acc =\n      if Compare.Int.(i <= 1) then\n        C.fold s path ~init:acc ~f:begin fun k acc ->\n          match k with\n          | `Dir _ -> Lwt.return acc\n          | `Key file ->\n              match I.of_path file with\n              | None -> assert false\n              | Some path -> f path acc\n        end\n      else\n        C.fold s path ~init:acc ~f:begin fun k acc ->\n          match k with\n          | `Dir k -> dig (i-1) k acc\n          | `Key _ -> Lwt.return acc\n        end in\n    dig I.path_length [data_name] init\n\n  let keys_unaccounted s =\n    fold_keys_unaccounted s ~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      (* TODO export consumed gas ?? *)\n      ~get:(fun c ->\n          let (c, k) = unpack c in\n          get_option c k >>=? fun (_, v) ->\n          return v)\n      (register_indexed_subcontext\n         ~list:(fun c -> keys_unaccounted c >>= return)\n         C.description I.args)\n      V.encoding\n\nend\n\n\nmodule Make_indexed_data_snapshotable_storage (C : Raw_context.T)\n    (Snapshot_index : INDEX) (I : INDEX) (V : VALUE)\n  : Indexed_data_snapshotable_storage 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  let snapshot_name = [\"snapshot\"]\n\n  module C_data = Make_subcontext(C)(struct let name = data_name end)\n  module C_snapshot = Make_subcontext(C)(struct let name = snapshot_name end)\n\n  include Make_indexed_data_storage(C_data)(I) (V)\n  module Snapshot = 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 =\n    C.dir_mem s (snapshot_path id)\n\n  let snapshot s id =\n    C.copy s ~from:data_name ~to_:(snapshot_path id) >>=? fun t ->\n    return (C.project t)\n\n  let delete_snapshot s id =\n    C.remove_rec s (snapshot_path id) >>= fun t ->\n    Lwt.return (C.project t)\n\nend\n\n\nmodule Make_indexed_subcontext (C : Raw_context.T) (I : INDEX)\n  : Indexed_raw_context with type t = C.t\n                         and type key = I.t\n                         and type 'a ipath = 'a I.ipath = struct\n\n  type t = C.t\n  type context = t\n  type key = I.t\n  type 'a ipath = 'a I.ipath\n\n  let clear t =\n    C.remove_rec t [] >>= fun t ->\n    Lwt.return (C.project t)\n\n  let fold_keys t ~init ~f =\n    let rec dig i path acc =\n      if Compare.Int.(i <= 0) then\n        match I.of_path path with\n        | None -> assert false\n        | Some path -> f path acc\n      else\n        C.fold t path ~init:acc ~f:begin fun k acc ->\n          match k with\n          | `Dir k -> dig (i-1) k acc\n          | `Key _ -> Lwt.return acc\n        end in\n    dig I.path_length [] init\n\n  let keys t =\n    fold_keys t ~init:[] ~f:(fun i acc -> Lwt.return (i :: acc))\n\n  let list t k = C.fold t k ~init:[] ~f:(fun k acc -> Lwt.return (k :: acc))\n\n  let description =\n    Storage_description.register_indexed_subcontext\n      ~list:(fun c -> keys c >>= return)\n      C.description\n      I.args\n\n  let unpack = Storage_description.unpack I.args\n  let pack = Storage_description.pack I.args\n\n  module Raw_context = struct\n    type t = C.t I.ipath\n    type context = t\n    let to_key i k = I.to_path i k\n    let of_key k = Misc.remove_elem_from_list I.path_length k\n    let mem c k = let (t, i) = unpack c in C.mem t (to_key i k)\n    let dir_mem c k = let (t, i) = unpack c in C.dir_mem t (to_key i k)\n    let get c k = let (t, i) = unpack c in C.get t (to_key i k)\n    let get_option c k = let (t, i) = unpack c in C.get_option t (to_key i k)\n    let init c k v =\n      let (t, i) = unpack c in\n      C.init t (to_key i k) v >>=? fun t -> return (pack t i)\n    let set c k v =\n      let (t, i) = unpack c in\n      C.set t (to_key i k) v >>=? fun t -> return (pack t i)\n    let init_set c k v =\n      let (t, i) = unpack c in\n      C.init_set t (to_key i k) v >>= fun t -> Lwt.return (pack t i)\n    let set_option c k v =\n      let (t, i) = unpack c in\n      C.set_option t (to_key i k) v >>= fun t -> Lwt.return (pack t i)\n    let delete c k =\n      let (t, i) = unpack c in\n      C.delete t (to_key i k) >>=? fun t -> return (pack t i)\n    let remove c k =\n      let (t, i) = unpack c in\n      C.remove t (to_key i k) >>= fun t -> Lwt.return (pack t i)\n    let remove_rec c k =\n      let (t, i) = unpack c in\n      C.remove_rec t (to_key i k) >>= fun t -> Lwt.return (pack t i)\n    let copy c ~from ~to_ =\n      let (t, i) = unpack c in\n      C.copy t ~from:(to_key i from) ~to_:(to_key i to_) >>=? fun t ->\n      return (pack t i)\n    let fold c k ~init ~f =\n      let (t, i) = unpack c in\n      C.fold t (to_key i k) ~init\n        ~f:(fun k acc -> f (map_key of_key k) acc)\n    let keys c k =\n      let (t, i) = unpack c in\n      C.keys t (to_key i k) >|= fun keys -> List.map of_key keys\n    let fold_keys c k ~init ~f =\n      let (t, i) = unpack c in\n      C.fold_keys t (to_key i k) ~init ~f:(fun k acc -> f (of_key k) acc)\n    let project c =\n      let (t, _) = unpack c in\n      C.project t\n    let absolute_key c k =\n      let (t, i) = unpack c in\n      C.absolute_key t (to_key i k)\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    let check_enough_gas c g =\n      let (t, _i) = unpack c in\n      C.check_enough_gas t g\n    let description = description\n  end\n\n  let resolve t prefix =\n    let rec loop i prefix = function\n      | [] when Compare.Int.(i = I.path_length) -> begin\n          match I.of_path prefix with\n          | None -> assert false\n          | Some path -> Lwt.return [path]\n        end\n      | [] ->\n          list t prefix >>= fun prefixes ->\n          Lwt_list.map_p (function\n              | `Key prefix | `Dir prefix -> loop (i+1) prefix []) prefixes\n          >|= List.flatten\n      | [d] when Compare.Int.(i = I.path_length - 1) ->\n          if Compare.Int.(i >= I.path_length) then invalid_arg \"IO.resolve\" ;\n          list t prefix >>= fun prefixes ->\n          Lwt_list.map_p (function\n              | `Key prefix | `Dir prefix ->\n                  match Misc.remove_prefix ~prefix:d (List.hd (List.rev prefix)) with\n                  | None -> Lwt.return_nil\n                  | Some _ -> loop (i+1) prefix [])\n            prefixes\n          >|= List.flatten\n      | \"\" :: ds ->\n          list t prefix >>= fun prefixes ->\n          Lwt_list.map_p (function\n              | `Key prefix | `Dir prefix -> loop (i+1) prefix ds) prefixes\n          >|= List.flatten\n      | d :: ds ->\n          if Compare.Int.(i >= I.path_length) then invalid_arg \"IO.resolve\" ;\n          C.dir_mem t (prefix @ [d]) >>= function\n          | true -> loop (i+1) (prefix @ [d]) ds\n          | false -> Lwt.return_nil in\n    loop 0 [] prefix\n\n  module Make_set (N : NAME) = struct\n    type t = C.t\n    type context = t\n    type elt = I.t\n    let inited = MBytes.of_string \"inited\"\n    let mem s i = Raw_context.mem (pack s i) N.name\n    let add s i =\n      Raw_context.init_set (pack s i) N.name inited >>= fun c ->\n      let (s, _) = unpack c in\n      Lwt.return (C.project s)\n    let del s i =\n      Raw_context.remove (pack s i) N.name >>= fun c ->\n      let (s, _) = unpack c in\n      Lwt.return (C.project s)\n    let set s i = function\n      | true -> add s i\n      | false -> del s i\n    let clear s =\n      fold_keys s\n        ~init:s\n        ~f:begin fun i s ->\n          Raw_context.remove (pack s i) N.name >>= fun c ->\n          let (s, _) = unpack c in\n          Lwt.return s\n        end >>= fun t ->\n      Lwt.return (C.project t)\n    let fold s ~init ~f =\n      fold_keys s ~init\n        ~f:(fun i acc ->\n            mem s i >>= function\n            | true -> f i acc\n            | false -> Lwt.return acc)\n    let elements s =\n      fold s ~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            mem c k >>= function\n            | true -> return_some true\n            | false -> return_none)\n        (register_named_subcontext Raw_context.description N.name)\n        Data_encoding.bool\n\n  end\n\n  module Make_map (N : NAME) (V : VALUE) = struct\n    type t = C.t\n    type context = t\n    type key = I.t\n    type value = V.t\n    include Make_encoder(V)\n    let mem s i =\n      Raw_context.mem (pack s i) N.name\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    let get_option s i =\n      Raw_context.get_option (pack s i) N.name >>= function\n      | None -> return_none\n      | Some b ->\n          let key = Raw_context.absolute_key (pack s i) N.name in\n          match of_bytes ~key b with\n          | Ok v -> return_some v\n          | Error _ as err -> Lwt.return err\n    let set s i v =\n      Raw_context.set (pack s i) N.name (to_bytes v) >>=? fun c ->\n      let (s, _) = unpack c in\n      return (C.project s)\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      return (C.project s)\n    let init_set s i v =\n      Raw_context.init_set (pack s i) N.name (to_bytes v) >>= fun c ->\n      let (s, _) = unpack c in\n      Lwt.return (C.project s)\n    let set_option s i v =\n      Raw_context.set_option (pack s i)\n        N.name (Option.map ~f:to_bytes v) >>= fun c ->\n      let (s, _) = unpack c in\n      Lwt.return (C.project s)\n    let remove s i =\n      Raw_context.remove (pack s i) N.name >>= fun c ->\n      let (s, _) = unpack c in\n      Lwt.return (C.project s)\n    let delete s i =\n      Raw_context.delete (pack s i) N.name >>=? fun c ->\n      let (s, _) = unpack c in\n      return (C.project s)\n    let clear s =\n      fold_keys s ~init:s\n        ~f:begin fun i s ->\n          Raw_context.remove (pack s i) N.name >>= fun c ->\n          let (s, _) = unpack c in\n          Lwt.return s\n        end >>= fun t ->\n      Lwt.return (C.project t)\n    let fold s ~init ~f =\n      fold_keys s ~init\n        ~f:(fun i acc ->\n            get s i >>= function\n            | Error _ -> Lwt.return acc\n            | Ok v -> f i v acc)\n    let bindings s =\n      fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p,v) :: acc))\n    let fold_keys s ~init ~f =\n      fold_keys s ~init\n        ~f:(fun i acc ->\n            mem s i >>= function\n            | false -> Lwt.return acc\n            | true -> f i acc)\n    let keys s =\n      fold_keys s ~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            get_option c k)\n        (register_named_subcontext Raw_context.description N.name)\n        V.encoding\n\n  end\n\n  module Make_carbonated_map (N : NAME) (V : VALUE) = struct\n    type t = C.t\n    type context = t\n    type key = I.t\n    type value = V.t\n    include Make_encoder(V)\n    let len_name = len_name :: N.name\n    let data_name = data_name :: N.name\n    let consume_mem_gas c =\n      Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost Z.zero))\n    let existing_size c =\n      Raw_context.get_option c len_name >>= function\n      | None -> return 0\n      | Some len -> decode_len_value len_name len\n    let consume_read_gas get c =\n      get c (len_name) >>=? fun len ->\n      decode_len_value len_name len >>=? fun len ->\n      Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.read_bytes_cost (Z.of_int len)))\n    let consume_write_gas set c v =\n      let bytes = to_bytes v in\n      let len = MBytes.length bytes in\n      Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.write_bytes_cost (Z.of_int len))) >>=? fun c ->\n      set c len_name (encode_len_value bytes) >>=? fun c ->\n      return (c, bytes)\n    let consume_remove_gas del c =\n      Lwt.return (Raw_context.consume_gas c (Gas_limit_repr.write_bytes_cost Z.zero)) >>=? fun c ->\n      del c len_name\n    let mem s i =\n      consume_mem_gas (pack s i) >>=? fun c ->\n      Raw_context.mem c data_name >>= fun res ->\n      return (Raw_context.project c, res)\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 ->\n      return (Raw_context.project c, v)\n    let get_option 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\n        get s i >>=? fun (s, v) ->\n        return (s, Some v)\n      else\n        return (C.project s, None)\n    let set s i v =\n      existing_size (pack s i) >>=? fun prev_size ->\n      consume_write_gas Raw_context.set (pack s i) v >>=? fun (c, bytes) ->\n      Raw_context.set c data_name bytes >>=? fun c ->\n      let size_diff = MBytes.length bytes - prev_size in\n      return (Raw_context.project c, size_diff)\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 = MBytes.length bytes in\n      return (Raw_context.project c, size)\n    let init_set s i v =\n      let init_set c k v = Raw_context.init_set c k v >>= return in\n      existing_size (pack s i) >>=? fun prev_size ->\n      consume_write_gas init_set (pack s i) v >>=? fun (c, bytes) ->\n      init_set c data_name bytes >>=? fun c ->\n      let size_diff = MBytes.length bytes - prev_size in\n      return (Raw_context.project c, size_diff)\n    let remove s i =\n      let remove c k = Raw_context.remove c k >>= return in\n      existing_size (pack s i) >>=? fun prev_size ->\n      consume_remove_gas remove (pack s i) >>=? fun c ->\n      remove c data_name >>=? fun c ->\n      return (Raw_context.project c, prev_size)\n    let delete s i =\n      existing_size (pack s i) >>=? fun prev_size ->\n      consume_remove_gas Raw_context.delete (pack s i) >>=? fun c ->\n      Raw_context.delete c data_name >>=? fun c ->\n      return (Raw_context.project c, prev_size)\n    let set_option s i v =\n      match v with\n      | None -> remove s i\n      | Some v -> init_set 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            get_option c k >>=? fun (_, v) ->\n            return v)\n        (register_named_subcontext Raw_context.description N.name)\n        V.encoding\n\n  end\n\nend\n\nmodule Wrap_indexed_data_storage\n    (C : Indexed_data_storage)\n    (K : sig\n       type t\n       val wrap: t -> C.key\n       val unwrap: C.key -> t option\n     end) = struct\n  type t = C.t\n  type context = C.t\n  type key = K.t\n  type value = C.value\n  let mem ctxt k = C.mem ctxt (K.wrap k)\n  let get ctxt k = C.get ctxt (K.wrap k)\n  let get_option ctxt k = C.get_option ctxt (K.wrap k)\n  let set ctxt k v = C.set ctxt (K.wrap k) v\n  let init ctxt k v = C.init ctxt (K.wrap k) v\n  let init_set ctxt k v = C.init_set ctxt (K.wrap k) v\n  let set_option ctxt k v = C.set_option ctxt (K.wrap k) v\n  let delete ctxt k = C.delete ctxt (K.wrap k)\n  let remove ctxt k = C.remove ctxt (K.wrap k)\n  let clear ctxt = C.clear ctxt\n  let fold ctxt ~init ~f =\n    C.fold ctxt ~init ~f:(fun k v acc ->\n        match K.unwrap k with\n        | None -> Lwt.return acc\n        | Some k -> f k v acc)\n  let bindings s =\n    fold s ~init:[] ~f:(fun p v acc -> Lwt.return ((p,v) :: acc))\n  let fold_keys s ~init ~f =\n    C.fold_keys s ~init\n      ~f:(fun k acc ->\n          match K.unwrap k with\n          | None -> Lwt.return acc\n          | Some k -> f k acc)\n  let keys s =\n    fold_keys s ~init:[] ~f:(fun p acc -> Lwt.return (p :: acc))\n\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 Last_block_priority : sig\n  val get : Raw_context.t -> int tzresult Lwt.t\n  val set : Raw_context.t -> int -> Raw_context.t tzresult Lwt.t\n  val init : Raw_context.t -> int -> Raw_context.t tzresult Lwt.t\nend\n\nmodule Roll : sig\n\n  (** Storage from this submodule must only be accessed through the\n      module `Roll`. *)\n\n  module Owner : Indexed_data_snapshotable_storage\n    with type key = Roll_repr.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 : Single_data_storage\n    with type value = Roll_repr.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 : Single_data_storage\n    with type value = Roll_repr.t\n     and type t := Raw_context.t\n\n  (** Rolls associated to contracts, a linked list per contract *)\n  module Delegate_roll_list : Indexed_data_storage\n    with type key = Signature.Public_key_hash.t\n     and type value = Roll_repr.t\n     and type t := Raw_context.t\n\n  (** Use this to iter on a linked list of rolls *)\n  module Successor : Indexed_data_storage\n    with type key = Roll_repr.t\n     and type value = Roll_repr.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 : 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 : 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 : Indexed_data_storage\n    with type key = int\n     and type value = Roll_repr.t\n     and type t = Raw_context.t * Cycle_repr.t\n\nend\n\nmodule Contract : sig\n\n  (** Storage from this submodule must only be accessed through the\n      module `Contract`. *)\n\n  module Global_counter : sig\n    val get : Raw_context.t -> Z.t tzresult Lwt.t\n    val set : Raw_context.t -> Z.t -> Raw_context.t tzresult Lwt.t\n    val init : Raw_context.t -> Z.t -> Raw_context.t tzresult Lwt.t\n  end\n\n  (** The domain of alive contracts *)\n  val fold :\n    Raw_context.t ->\n    init:'a -> f:(Contract_repr.t -> 'a -> 'a Lwt.t) -> 'a Lwt.t\n  val list : Raw_context.t -> Contract_repr.t list Lwt.t\n\n  (** All the tez possesed by a contract, including rolls and change *)\n  module Balance : 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  (** Frozen balance, see 'delegate_storage.mli' for more explanation *)\n  module Frozen_deposits : 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  module Frozen_fees : 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  module Frozen_rewards : 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 : 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 : 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  module Delegated : Data_set_storage\n    with type elt = Contract_hash.t\n     and type t = Raw_context.t * Contract_repr.t\n\n  module Inactive_delegate : Data_set_storage\n    with type elt = Contract_repr.t\n     and type t = Raw_context.t\n\n  (** The cycle where the delegate should be desactivated. *)\n  module Delegate_desactivation : 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 Spendable : Data_set_storage\n    with type elt = Contract_repr.t\n     and type t := Raw_context.t\n\n  module Delegatable : Data_set_storage\n    with type elt = Contract_repr.t\n     and type t := Raw_context.t\n\n  module Counter : 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 : 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 : 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 : 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 : 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  type bigmap_key = Raw_context.t * Contract_repr.t\n\n  module Big_map : 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 := bigmap_key\n\nend\n\n(** Set of all registered delegates. *)\nmodule Delegates : Data_set_storage\n  with type t := Raw_context.t\n   and type elt = Signature.Public_key_hash.t\n\n(** Votes *)\n\nmodule Vote : sig\n\n  module Current_period_kind : Single_data_storage\n    with type value = Voting_period_repr.kind\n     and type t := Raw_context.t\n\n  module Current_quorum : Single_data_storage\n    with type value = int32 (* in centile of percentage *)\n     and type t := Raw_context.t\n\n  module Current_proposal : Single_data_storage\n    with type value = Protocol_hash.t\n     and type t := Raw_context.t\n\n  module Listings_size : Single_data_storage\n    with type value = int32 (* total number of rolls in the listing. *)\n     and type t := Raw_context.t\n\n  module Listings : Indexed_data_storage\n    with type key = Signature.Public_key_hash.t\n     and type value = int32 (* number of rolls for the key. *)\n     and type t := Raw_context.t\n\n  module Proposals : Data_set_storage\n    with type elt = Protocol_hash.t * Signature.Public_key_hash.t\n     and type t := Raw_context.t\n\n  module Ballots : 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\n\nend\n\n(** Seed *)\n\nmodule Seed : sig\n\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    rewards: Tez_repr.t ;\n    fees: Tez_repr.t ;\n  }\n\n  type nonce_status =\n    | Unrevealed of unrevealed_nonce\n    | Revealed of Seed_repr.nonce\n\n  module Nonce : 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 : sig\n    val init : Raw_context.t -> Cycle_repr.t -> Seed_repr.seed -> Raw_context.t tzresult Lwt.t\n    val get : Raw_context.t -> Cycle_repr.t -> Seed_repr.seed tzresult Lwt.t\n    val delete : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t\n  end\n\nend\n\n(** Commitments *)\n\nmodule Commitments : 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 security deposits... *)\n\nmodule Ramp_up : sig\n\n  module Rewards :\n    Indexed_data_storage\n    with type key = Cycle_repr.t\n     and type value = Tez_repr.t * Tez_repr.t (* baking * endorsement *)\n     and type t := Raw_context.t\n\n  module Security_deposits :\n    Indexed_data_storage\n    with type key = Cycle_repr.t\n     and type value = Tez_repr.t * Tez_repr.t (* baking * endorsement *)\n     and type t := Raw_context.t\n\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\n\nmodule Int = struct\n  type t = int\n  let encoding = Data_encoding.uint16\nend\n\nmodule Int32 = struct\n  type t = Int32.t\n  let encoding = Data_encoding.int32\nend\n\nmodule Z = struct\n  type t = Z.t\n  let encoding = Data_encoding.z\nend\n\nmodule Int_index = struct\n  type t = int\n  let path_length = 1\n  let to_path c l = string_of_int c :: l\n  let of_path = function\n    | [] | _ :: _ :: _ -> None\n    | [ c ] -> int_of_string_opt c\n  type 'a ipath = 'a * t\n  let args = Storage_description.One {\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  type 'a ipath = 'a * t\n  let args = Storage_description.One {\n      rpc_arg ;\n      encoding ;\n      compare ;\n    }\nend\n\nmodule Last_block_priority =\n  Make_single_data_storage\n    (Raw_context)\n    (struct let name = [\"last_block_priority\"] end)\n    (Int)\n\n(** Contracts handling *)\n\nmodule Contract = struct\n\n  module Raw_context =\n    Make_subcontext(Raw_context)(struct let name = [\"contracts\"] end)\n\n  module Global_counter =\n    Make_single_data_storage\n      (Raw_context)\n      (struct let name = [\"global_counter\"] end)\n      (Z)\n\n  module Indexed_context =\n    Make_indexed_subcontext\n      (Make_subcontext(Raw_context)(struct let name = [\"index\"] end))\n      (Make_index(Contract_repr.Index))\n\n  let fold = Indexed_context.fold_keys\n  let list = Indexed_context.keys\n\n  module Balance =\n    Indexed_context.Make_map\n      (struct let name = [\"balance\"] end)\n      (Tez_repr)\n\n  module Frozen_balance_index =\n    Make_indexed_subcontext\n      (Make_subcontext\n         (Indexed_context.Raw_context)\n         (struct let name = [\"frozen_balance\"] end))\n      (Make_index(Cycle_repr.Index))\n\n  module Frozen_deposits =\n    Frozen_balance_index.Make_map\n      (struct let name = [\"deposits\"] end)\n      (Tez_repr)\n\n  module Frozen_fees =\n    Frozen_balance_index.Make_map\n      (struct let name = [\"fees\"] end)\n      (Tez_repr)\n\n  module Frozen_rewards =\n    Frozen_balance_index.Make_map\n      (struct let name = [\"rewards\"] end)\n      (Tez_repr)\n\n  module Manager =\n    Indexed_context.Make_map\n      (struct let name = [\"manager\"] end)\n      (Manager_repr)\n\n  module Spendable =\n    Indexed_context.Make_set\n      (struct let name = [\"spendable\"] end)\n\n  module Delegatable =\n    Indexed_context.Make_set\n      (struct let name = [\"delegatable\"] end)\n\n  module Delegate =\n    Indexed_context.Make_map\n      (struct let name = [\"delegate\"] end)\n      (Signature.Public_key_hash)\n\n  module Inactive_delegate =\n    Indexed_context.Make_set\n      (struct let name = [\"inactive_delegate\"] end)\n\n  module Delegate_desactivation =\n    Indexed_context.Make_map\n      (struct let name = [\"delegate_desactivation\"] end)\n      (Cycle_repr)\n\n  module Delegated =\n    Make_data_set_storage\n      (Make_subcontext\n         (Indexed_context.Raw_context)\n         (struct let name = [\"delegated\"] end))\n      (Make_index(Contract_hash))\n\n  module Counter =\n    Indexed_context.Make_map\n      (struct let name = [\"counter\"] end)\n      (Z)\n\n  (* Consume gas for serilization and deserialization of expr in this\n     module *)\n  module Make_carbonated_map_expr (N : Storage_sigs.NAME) = struct\n    module I = Indexed_context.Make_carbonated_map\n        (N)\n        (struct\n          type t = Script_repr.lazy_expr\n          let encoding = Script_repr.lazy_expr_encoding\n        end)\n\n    type context = I.context\n    type key = I.key\n    type value = I.value\n\n    let mem = I.mem\n    let delete = I.delete\n    let remove = I.remove\n\n    let consume_deserialize_gas ctxt value =\n      Lwt.return @@\n      (Raw_context.check_enough_gas ctxt (Script_repr.minimal_deserialize_cost value) >>? fun () ->\n       Script_repr.force_decode value >>? fun (_value, value_cost) ->\n       Raw_context.consume_gas ctxt value_cost)\n\n    let consume_serialize_gas ctxt value =\n      Lwt.return @@\n      (Script_repr.force_bytes value >>? fun (_value, value_cost) ->\n       Raw_context.consume_gas ctxt value_cost)\n\n    let get ctxt contract =\n      I.get ctxt contract >>=? fun (ctxt, value) ->\n      consume_deserialize_gas ctxt value >>|? fun ctxt ->\n      (ctxt, value)\n\n    let get_option ctxt contract =\n      I.get_option ctxt contract >>=? fun (ctxt, value_opt) ->\n      match value_opt with\n      | None -> return (ctxt, None)\n      | Some value ->\n          consume_deserialize_gas ctxt value >>|? fun ctxt ->\n          (ctxt, value_opt)\n\n    let set ctxt contract value =\n      consume_serialize_gas ctxt value >>=? fun ctxt ->\n      I.set ctxt contract value\n\n    let set_option ctxt contract value_opt =\n      match value_opt with\n      | None -> I.set_option ctxt contract None\n      | Some value ->\n          consume_serialize_gas ctxt value >>=? fun ctxt ->\n          I.set_option 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 init_set ctxt contract value =\n      consume_serialize_gas ctxt value >>=? fun ctxt ->\n      I.init_set ctxt contract value\n  end\n\n  module Code =\n    Make_carbonated_map_expr\n      (struct let name = [\"code\"] end)\n\n  module Storage =\n    Make_carbonated_map_expr\n      (struct let name = [\"storage\"] end)\n\n  type bigmap_key = Raw_context.t * Contract_repr.t\n\n  (* Consume gas for serilization and deserialization of expr in this\n     module *)\n  module Big_map = struct\n    module I = Storage_functors.Make_indexed_carbonated_data_storage\n        (Make_subcontext\n           (Indexed_context.Raw_context)\n           (struct let name = [\"big_map\"] end))\n        (Make_index(Script_expr_hash))\n        (struct\n          type t = Script_repr.expr\n          let encoding = Script_repr.expr_encoding\n        end)\n\n    type context = I.context\n    type key = I.key\n    type value = I.value\n\n    let mem = I.mem\n    let delete = I.delete\n    let remove = I.remove\n    let set = I.set\n    let set_option = I.set_option\n    let init = I.init\n    let init_set = I.init_set\n\n    let consume_deserialize_gas ctxt value =\n      Lwt.return @@\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      consume_deserialize_gas ctxt value >>|? fun ctxt ->\n      (ctxt, value)\n\n    let get_option ctxt contract =\n      I.get_option ctxt contract >>=? fun (ctxt, value_opt) ->\n      match value_opt with\n      | None -> return (ctxt, None)\n      | Some value ->\n          consume_deserialize_gas ctxt value >>|? fun ctxt ->\n          (ctxt, value_opt)\n  end\n\n  module Paid_storage_space =\n    Indexed_context.Make_map\n      (struct let name = [\"paid_bytes\"] end)\n      (Z)\n\n  module Used_storage_space =\n    Indexed_context.Make_map\n      (struct let name = [\"used_bytes\"] end)\n      (Z)\n\n  module Roll_list =\n    Indexed_context.Make_map\n      (struct let name = [\"roll_list\"] end)\n      (Roll_repr)\n\n  module Change =\n    Indexed_context.Make_map\n      (struct let name = [\"change\"] end)\n      (Tez_repr)\n\nend\n\nmodule Delegates =\n  Make_data_set_storage\n    (Make_subcontext(Raw_context)(struct let name = [\"delegates\"] end))\n    (Make_index(Signature.Public_key_hash))\n\n(** Rolls *)\n\nmodule Cycle = struct\n\n  module Indexed_context =\n    Make_indexed_subcontext\n      (Make_subcontext(Raw_context)(struct let name = [\"cycle\"] end))\n      (Make_index(Cycle_repr.Index))\n\n  module Last_roll =\n    Make_indexed_data_storage\n      (Make_subcontext\n         (Indexed_context.Raw_context)\n         (struct let name = [\"last_roll\"] end))\n      (Int_index)\n      (Roll_repr)\n\n  module Roll_snapshot =\n    Indexed_context.Make_map\n      (struct let name = [\"roll_snapshot\"] end)\n      (Int)\n\n  type unrevealed_nonce = {\n    nonce_hash: Nonce_hash.t ;\n    delegate: Signature.Public_key_hash.t ;\n    rewards: Tez_repr.t ;\n    fees: Tez_repr.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      case (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 { nonce_hash ; delegate ; rewards ; fees } ->\n              Some (nonce_hash, delegate, rewards, fees)\n          | _ -> None)\n        (fun (nonce_hash, delegate, rewards, fees) ->\n           Unrevealed { nonce_hash ; delegate ; rewards ; fees }) ;\n      case (Tag 1)\n        ~title:\"Revealed\"\n        Seed_repr.nonce_encoding\n        (function\n          | Revealed nonce -> Some nonce\n          | _ -> None)\n        (fun nonce -> Revealed nonce)\n    ]\n\n  module Nonce =\n    Make_indexed_data_storage\n      (Make_subcontext\n         (Indexed_context.Raw_context)\n         (struct let name = [\"nonces\"] end))\n      (Make_index(Raw_level_repr.Index))\n      (struct\n        type t = nonce_status\n        let encoding = nonce_status_encoding\n      end)\n\n  module Seed =\n    Indexed_context.Make_map\n      (struct let name = [\"random_seed\"] end)\n      (struct\n        type t = Seed_repr.seed\n        let encoding = Seed_repr.seed_encoding\n      end)\n\nend\n\nmodule Roll = struct\n\n  module Raw_context =\n    Make_subcontext(Raw_context)(struct let name = [\"rolls\"] end)\n\n  module Indexed_context =\n    Make_indexed_subcontext\n      (Make_subcontext(Raw_context)(struct let name = [\"index\"] end))\n      (Make_index(Roll_repr.Index))\n\n  module Next =\n    Make_single_data_storage\n      (Raw_context)\n      (struct let name = [\"next\"] end)\n      (Roll_repr)\n\n  module Limbo =\n    Make_single_data_storage\n      (Raw_context)\n      (struct let name = [\"limbo\"] end)\n      (Roll_repr)\n\n  module Delegate_roll_list =\n    Wrap_indexed_data_storage(Contract.Roll_list)(struct\n      type t = Signature.Public_key_hash.t\n      let wrap = Contract_repr.implicit_contract\n      let unwrap = Contract_repr.is_implicit\n    end)\n\n  module Successor =\n    Indexed_context.Make_map\n      (struct let name = [\"successor\"] end)\n      (Roll_repr)\n\n  module Delegate_change =\n    Wrap_indexed_data_storage(Contract.Change)(struct\n      type t = Signature.Public_key_hash.t\n      let wrap = Contract_repr.implicit_contract\n      let unwrap = Contract_repr.is_implicit\n    end)\n\n  module Snapshoted_owner_index = struct\n    type t = Cycle_repr.t * int\n    let path_length = Cycle_repr.Index.path_length + 1\n    let to_path (c, n) s =\n      Cycle_repr.Index.to_path c (string_of_int n :: s)\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    let left_args =\n      Storage_description.One {\n        rpc_arg = Cycle_repr.rpc_arg ;\n        encoding = Cycle_repr.encoding ;\n        compare = Cycle_repr.compare\n      }\n    let right_args =\n      Storage_description.One {\n        rpc_arg = RPC_arg.int ;\n        encoding = Data_encoding.int31 ;\n        compare = Compare.Int.compare ;\n      }\n    let args =\n      Storage_description.(Pair (left_args, right_args))\n  end\n\n  module Owner =\n    Make_indexed_data_snapshotable_storage\n      (Make_subcontext(Raw_context)(struct let name = [\"owner\"] end))\n      (Snapshoted_owner_index)\n      (Make_index(Roll_repr.Index))\n      (Signature.Public_key)\n\n  module Snapshot_for_cycle = Cycle.Roll_snapshot\n  module Last_for_snapshot = Cycle.Last_roll\n\n  let clear = Indexed_context.clear\n\nend\n\n(** Votes **)\n\nmodule Vote = struct\n\n  module Raw_context =\n    Make_subcontext(Raw_context)(struct let name = [\"votes\"] end)\n\n  module Current_period_kind =\n    Make_single_data_storage\n      (Raw_context)\n      (struct let name = [\"current_period_kind\"] end)\n      (struct\n        type t = Voting_period_repr.kind\n        let encoding = Voting_period_repr.kind_encoding\n      end)\n\n  module Current_quorum =\n    Make_single_data_storage\n      (Raw_context)\n      (struct let name = [\"current_quorum\"] end)\n      (Int32)\n\n  module Current_proposal =\n    Make_single_data_storage\n      (Raw_context)\n      (struct let name = [\"current_proposal\"] end)\n      (Protocol_hash)\n\n  module Listings_size =\n    Make_single_data_storage\n      (Raw_context)\n      (struct let name = [\"listings_size\"] end)\n      (Int32)\n\n  module Listings =\n    Make_indexed_data_storage\n      (Make_subcontext(Raw_context)(struct let name = [\"listings\"] end))\n      (Make_index(Signature.Public_key_hash))\n      (Int32)\n\n  module Proposals =\n    Make_data_set_storage\n      (Make_subcontext(Raw_context)(struct let name = [\"proposals\"] end))\n      (Pair(Make_index(Protocol_hash))(Make_index(Signature.Public_key_hash)))\n\n  module Ballots =\n    Make_indexed_data_storage\n      (Make_subcontext(Raw_context)(struct let name = [\"ballots\"] end))\n      (Make_index(Signature.Public_key_hash))\n      (struct\n        type t = Vote_repr.ballot\n        let encoding = Vote_repr.ballot_encoding\n      end)\n\nend\n\n(** Seed *)\n\nmodule Seed = struct\n\n  type unrevealed_nonce = Cycle.unrevealed_nonce = {\n    nonce_hash: Nonce_hash.t ;\n    delegate: Signature.Public_key_hash.t ;\n    rewards: Tez_repr.t ;\n    fees: Tez_repr.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 = struct\n    open Level_repr\n    type context = Raw_context.t\n    let mem ctxt l = Cycle.Nonce.mem (ctxt, l.cycle) l.level\n    let get ctxt l = Cycle.Nonce.get (ctxt, l.cycle) l.level\n    let get_option ctxt l = Cycle.Nonce.get_option (ctxt, l.cycle) l.level\n    let set ctxt l v = Cycle.Nonce.set (ctxt, l.cycle) l.level v\n    let init ctxt l v = Cycle.Nonce.init (ctxt, l.cycle) l.level v\n    let init_set ctxt l v = Cycle.Nonce.init_set (ctxt, l.cycle) l.level v\n    let set_option ctxt l v = Cycle.Nonce.set_option (ctxt, l.cycle) l.level v\n    let delete ctxt l = Cycle.Nonce.delete (ctxt, l.cycle) l.level\n    let remove ctxt l = Cycle.Nonce.remove (ctxt, l.cycle) l.level\n  end\n  module For_cycle = Cycle.Seed\n\nend\n\n(** Commitments *)\n\nmodule Commitments =\n  Make_indexed_data_storage\n    (Make_subcontext(Raw_context)(struct let name = [\"commitments\"] end))\n    (Make_index(Blinded_public_key_hash.Index))\n    (Tez_repr)\n\n(** Ramp up security deposits... *)\n\nmodule Ramp_up = struct\n\n  module Rewards =\n    Make_indexed_data_storage\n      (Make_subcontext(Raw_context)(struct let name = [\"ramp_up\"; \"rewards\"] end))\n      (Make_index(Cycle_repr.Index))\n      (struct\n        type t = Tez_repr.t * Tez_repr.t\n        let encoding = Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding\n      end)\n\n  module Security_deposits =\n    Make_indexed_data_storage\n      (Make_subcontext(Raw_context)(struct let name = [\"ramp_up\"; \"deposits\"] end))\n      (Make_index(Cycle_repr.Index))\n      (struct\n        type t = Tez_repr.t * Tez_repr.t\n        let encoding = Data_encoding.tup2 Tez_repr.encoding Tez_repr.encoding\n      end)\n\nend\n\n(** Resolver *)\n\nlet () =\n  Raw_context.register_resolvers\n    Contract_hash.b58check_encoding\n    (fun ctxt p ->\n       let p = Contract_repr.Index.contract_prefix p in\n       Contract.Indexed_context.resolve ctxt p >|= fun l ->\n       List.map\n         (function\n           | Contract_repr.Implicit _ -> assert false\n           | Contract_repr.Originated s -> s)\n         l) ;\n  Raw_context.register_resolvers\n    Ed25519.Public_key_hash.b58check_encoding\n    (fun ctxt p ->\n       let p = Contract_repr.Index.pkh_prefix_ed25519 p in\n       Contract.Indexed_context.resolve ctxt p >|= fun l ->\n       List.map\n         (function\n           | Contract_repr.Implicit (Ed25519 pkh) -> pkh\n           | Contract_repr.Implicit _ -> assert false\n           | Contract_repr.Originated _ -> assert false)\n         l) ;\n  Raw_context.register_resolvers\n    Secp256k1.Public_key_hash.b58check_encoding\n    (fun ctxt p ->\n       let p = Contract_repr.Index.pkh_prefix_secp256k1 p in\n       Contract.Indexed_context.resolve ctxt p >|= fun l ->\n       List.map\n         (function\n           | Contract_repr.Implicit (Secp256k1 pkh) -> pkh\n           | Contract_repr.Implicit _ -> assert false\n           | Contract_repr.Originated _ -> assert false)\n         l) ;\n  Raw_context.register_resolvers\n    P256.Public_key_hash.b58check_encoding\n    (fun ctxt p ->\n       let p = Contract_repr.Index.pkh_prefix_p256 p in\n       Contract.Indexed_context.resolve ctxt p >|= fun l ->\n       List.map\n         (function\n           | Contract_repr.Implicit (P256 pkh) -> pkh\n           | Contract_repr.Implicit _ -> assert false\n           | Contract_repr.Originated _ -> assert false)\n         l)\n" ;
                } ;
                { name = "Constants_storage" ;
                  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\nlet preserved_cycles c =\n  let constants = Raw_context.constants c in\n  constants.preserved_cycles\nlet blocks_per_cycle c =\n  let constants = Raw_context.constants c in\n  constants.blocks_per_cycle\nlet blocks_per_commitment c =\n  let constants = Raw_context.constants c in\n  constants.blocks_per_commitment\nlet blocks_per_roll_snapshot c =\n  let constants = Raw_context.constants c in\n  constants.blocks_per_roll_snapshot\nlet blocks_per_voting_period c =\n  let constants = Raw_context.constants c in\n  constants.blocks_per_voting_period\nlet time_between_blocks c =\n  let constants = Raw_context.constants c in\n  constants.time_between_blocks\nlet endorsers_per_block c =\n  let constants = Raw_context.constants c in\n  constants.endorsers_per_block\nlet hard_gas_limit_per_operation c =\n  let constants = Raw_context.constants c in\n  constants.hard_gas_limit_per_operation\nlet hard_gas_limit_per_block c =\n  let constants = Raw_context.constants c in\n  constants.hard_gas_limit_per_block\nlet cost_per_byte c =\n  let constants = Raw_context.constants c in\n  constants.cost_per_byte\nlet hard_storage_limit_per_operation c =\n  let constants = Raw_context.constants c in\n  constants.hard_storage_limit_per_operation\nlet proof_of_work_threshold c =\n  let constants = Raw_context.constants c in\n  constants.proof_of_work_threshold\nlet tokens_per_roll c =\n  let constants = Raw_context.constants c in\n  constants.tokens_per_roll\nlet michelson_maximum_type_size c =\n  let constants = Raw_context.constants c in\n  constants.michelson_maximum_type_size\nlet seed_nonce_revelation_tip c =\n  let constants = Raw_context.constants c in\n  constants.seed_nonce_revelation_tip\nlet origination_burn c =\n  let constants = Raw_context.constants c in\n  constants.origination_burn\nlet block_security_deposit c =\n  let constants = Raw_context.constants c in\n  constants.block_security_deposit\nlet endorsement_security_deposit c =\n  let constants = Raw_context.constants c in\n  constants.endorsement_security_deposit\nlet block_reward c =\n  let constants = Raw_context.constants c in\n  constants.block_reward\nlet endorsement_reward c =\n  let constants = Raw_context.constants c in\n  constants.endorsement_reward\nlet parametric c =\n  Raw_context.constants c\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\nval previous: Raw_context.t -> Level_repr.t\n\nval root: Raw_context.t -> Level_repr.t\n\nval from_raw: Raw_context.t -> ?offset:int32 -> Raw_level_repr.t -> Level_repr.t\nval pred: Raw_context.t -> Level_repr.t -> Level_repr.t option\nval succ: Raw_context.t -> Level_repr.t -> Level_repr.t\n\nval first_level_in_cycle: Raw_context.t -> Cycle_repr.t -> Level_repr.t\nval last_level_in_cycle: Raw_context.t -> Cycle_repr.t -> Level_repr.t\nval levels_in_cycle: Raw_context.t -> Cycle_repr.t -> Level_repr.t list\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" ;
                  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 ?offset l =\n  let l =\n    match offset with\n    | None -> l\n    | Some o -> Raw_level_repr.(of_int32_exn (Int32.add (to_int32 l) o)) in\n  let constants = Raw_context.constants c in\n  let first_level = Raw_context.first_level c in\n  Level_repr.from_raw\n    ~first_level\n    ~blocks_per_cycle:constants.Constants_repr.blocks_per_cycle\n    ~blocks_per_voting_period:constants.Constants_repr.blocks_per_voting_period\n    ~blocks_per_commitment:constants.Constants_repr.blocks_per_commitment\n    l\n\nlet root c =\n  Level_repr.root (Raw_context.first_level c)\n\nlet succ c l = from_raw c (Raw_level_repr.succ l.level)\nlet pred c l =\n  match Raw_level_repr.pred l.Level_repr.level with\n  | None -> None\n  | Some l -> Some (from_raw c l)\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 c =\n  let constants = Raw_context.constants ctxt in\n  let first_level = Raw_context.first_level ctxt in\n  from_raw ctxt\n    (Raw_level_repr.of_int32_exn\n       (Int32.add\n          (Raw_level_repr.to_int32 first_level)\n          (Int32.mul\n             constants.Constants_repr.blocks_per_cycle\n             (Cycle_repr.to_int32 c))))\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 rec loop n acc =\n    if Cycle_repr.(n.cycle = first.cycle)\n    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    []\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 rec loop n acc =\n    if Cycle_repr.(n.cycle = first.cycle)\n    then\n      if n.expected_commitment then\n        loop (succ ctxt n) (n :: acc)\n      else\n        loop (succ ctxt n) acc\n    else acc\n  in\n  loop first []\n\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" ;
                } ;
                { 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  | Unexpected_nonce\n\ntype t = Seed_repr.nonce\ntype nonce = t\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  rewards: Tez_repr.t ;\n  fees: Tez_repr.t ;\n}\n\ntype status =\n  | Unrevealed of unrevealed\n  | Revealed of Seed_repr.nonce\n\nval get: Raw_context.t -> Level_repr.t -> status tzresult Lwt.t\n\nval record_hash:\n  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: MBytes.t -> nonce tzresult\nval hash: nonce -> Nonce_hash.t\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\ntype nonce = t\nlet encoding = Seed_repr.nonce_encoding\n\ntype error +=\n  | Too_late_revelation\n  | Too_early_revelation\n  | Previously_revealed_nonce\n  | Unexpected_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 () ->\n        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.unexpected\"\n    ~title:\"Unexpected nonce\"\n    ~description:\"The provided nonce is inconsistent with the committed nonce hash.\"\n    ~pp: (fun ppf () ->\n        Format.fprintf ppf \"This nonce revelation is invalid (inconsistent with the committed hash)\")\n    Data_encoding.unit\n    (function Unexpected_nonce -> Some () | _ -> None)\n    (fun () -> Unexpected_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 =\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  fail_unless\n    (Seed_repr.check_hash nonce unrevealed.nonce_hash)\n    Unexpected_nonce >>=? fun () ->\n  Storage.Seed.Nonce.set ctxt level (Revealed nonce) >>=? fun ctxt ->\n  return ctxt\n\ntype unrevealed = Storage.Seed.unrevealed_nonce = {\n  nonce_hash: Nonce_hash.t ;\n  delegate: Signature.Public_key_hash.t ;\n  rewards: Tez_repr.t ;\n  fees: Tez_repr.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\nlet of_bytes = Seed_repr.make_nonce\nlet hash = Seed_repr.hash\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 { oldest : Cycle_repr.t ;\n                 cycle : Cycle_repr.t ;\n                 latest : Cycle_repr.t } (* `Permanent *)\n\n(** Generates the first [preserved_cycles+2] seeds for which\n    there are no nonces. *)\nval init:\n  Raw_context.t -> Raw_context.t tzresult Lwt.t\n\nval for_cycle:\n  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 -> 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\nopen Misc\n\ntype error +=\n  | Unknown of { oldest : Cycle_repr.t ;\n                 cycle : Cycle_repr.t ;\n                 latest : Cycle_repr.t } (* `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 ppf\n            \"The seed for cycle %a has been cleared from the context \\\n            \\ (oldest known seed is for cycle %a)\"\n            Cycle_repr.pp cycle\n            Cycle_repr.pp oldest\n        else\n          Format.fprintf ppf\n            \"The seed for cycle %a has not been computed yet \\\n            \\ (latest known seed is for cycle %a)\"\n            Cycle_repr.pp cycle\n            Cycle_repr.pp latest)\n    Data_encoding.(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.delete c level >>=? fun c ->\n            return (c, Seed_repr.nonce random_seed nonce, unrevealed)\n        | Unrevealed u ->\n            Storage.Seed.Nonce.delete c level >>=? fun c ->\n            return (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      fold_left_s combine (c, seed, []) levels >>=? fun (c, seed, unrevealed) ->\n      Storage.Seed.For_cycle.init c cycle seed >>=? fun c ->\n      return (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\n      Cycle_repr.add current_cycle preserved in\n  let oldest =\n    match Cycle_repr.sub current_cycle preserved with\n    | None -> Cycle_repr.root\n    | Some oldest -> oldest in\n  fail_unless Cycle_repr.(oldest <= cycle && cycle <= latest)\n    (Unknown { oldest ; cycle ; latest }) >>=? fun () ->\n  Storage.Seed.For_cycle.get ctxt cycle\n\nlet clear_cycle c cycle =\n  Storage.Seed.For_cycle.delete c cycle\n\nlet init ctxt =\n  let preserved = Constants_storage.preserved_cycles ctxt in\n  List.fold_left2\n    (fun ctxt c seed ->\n       ctxt >>=? fun ctxt ->\n       let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in\n       Storage.Seed.For_cycle.init ctxt cycle seed)\n    (return ctxt)\n    (0 --> (preserved+1))\n    (Seed_repr.initial_seeds (preserved+2))\n\nlet cycle_end ctxt last_cycle =\n  let preserved = Constants_storage.preserved_cycles ctxt in\n  begin\n    match Cycle_repr.sub last_cycle preserved with\n    | None -> return ctxt\n    | Some cleared_cycle ->\n        clear_cycle ctxt cleared_cycle\n  end >>=? fun ctxt ->\n  match Cycle_repr.pred last_cycle with\n  | None -> return (ctxt, [])\n  | Some revealed -> (* 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" ;
                  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(**\n\n   Basic roll manipulation.\n\n   If storage related to roll (a.k.a. `Storage.Roll`) are not used\n   outside of this module, this interface enforces the invariant that a\n   roll is always either in the limbo list or in a contract list.\n\n*)\n\ntype error +=\n  | Consume_roll_change\n  | No_roll_for_delegate\n  | No_roll_snapshot_for_cycle of Cycle_repr.t\n  | Unregistered_delegate of Signature.Public_key_hash.t (* `Permanent *)\n\nval init : Raw_context.t -> Raw_context.t tzresult Lwt.t\nval init_first_cycles : Raw_context.t -> Raw_context.t tzresult Lwt.t\n\nval cycle_end : Raw_context.t -> Cycle_repr.t -> Raw_context.t tzresult Lwt.t\nval snapshot_rolls : Raw_context.t -> Raw_context.t tzresult Lwt.t\n\n\nval fold :\n  Raw_context.t ->\n  f:(Roll_repr.roll -> Signature.Public_key.t -> 'a -> 'a tzresult Lwt.t) ->\n  'a -> 'a tzresult Lwt.t\n\nval baking_rights_owner :\n  Raw_context.t -> Level_repr.t -> priority:int ->\n  Signature.Public_key.t tzresult Lwt.t\n\nval endorsement_rights_owner :\n  Raw_context.t -> Level_repr.t -> slot:int ->\n  Signature.Public_key.t tzresult Lwt.t\n\nmodule Delegate : sig\n\n  val add_amount :\n    Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t\n\n  val remove_amount :\n    Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t\n\n  val set_inactive : Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t\n\n  val set_active : Raw_context.t -> Signature.Public_key_hash.t -> Raw_context.t tzresult Lwt.t\n\nend\n\nmodule Contract : sig\n\n  val add_amount :\n    Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t\n\n  val remove_amount :\n    Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Raw_context.t tzresult Lwt.t\n\nend\n\nval delegate_pubkey:\n  Raw_context.t -> Signature.Public_key_hash.t ->\n  Signature.Public_key.t tzresult Lwt.t\n\nval get_rolls:\n  Raw_context.t -> Signature.Public_key_hash.t -> Roll_repr.t list tzresult Lwt.t\nval get_change:\n  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t tzresult Lwt.t\n\n(**/**)\n\nval get_contract_delegate:\n  Raw_context.t -> Contract_repr.t -> 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(*                                                                           *)\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\ntype error +=\n  | Consume_roll_change (* `Permanent *)\n  | No_roll_for_delegate (* `Permanent *)\n  | No_roll_snapshot_for_cycle of Cycle_repr.t (* `Permanent *)\n  | Unregistered_delegate of Signature.Public_key_hash.t (* `Permanent *)\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_roll_snapshot_for_cycle\"\n    ~title:\"No roll snapshot for cycle\"\n    ~description:\"A snapshot of the rolls distribution does not exist for this cycle.\"\n    ~pp:(fun ppf c ->\n        Format.fprintf ppf\n          \"A snapshot of the rolls distribution does not exist for cycle %a\" Cycle_repr.pp c)\n    (obj1 (req \"cycle\" Cycle_repr.encoding))\n    (function No_roll_snapshot_for_cycle c-> Some c | _ -> None)\n    (fun c -> No_roll_snapshot_for_cycle 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 ppf \"The provided public key (with hash %a) is \\\n                           \\ not registered as valid delegate key.\"\n          Signature.Public_key_hash.pp 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 c contract =\n  Storage.Contract.Delegate.get_option c contract\n\nlet delegate_pubkey ctxt delegate =\n  Storage.Contract.Manager.get_option ctxt\n    (Contract_repr.implicit_contract delegate) >>=? function\n  | None | Some (Manager_repr.Hash _) ->\n      fail (Unregistered_delegate delegate)\n  | Some (Manager_repr.Public_key pk) ->\n      return pk\n\nlet clear_cycle c cycle =\n  Storage.Roll.Snapshot_for_cycle.get c cycle >>=? fun index ->\n  Storage.Roll.Snapshot_for_cycle.delete c cycle >>=? fun c ->\n  Storage.Roll.Last_for_snapshot.delete (c, cycle) index >>=? fun c ->\n  Storage.Roll.Owner.delete_snapshot c (cycle, index) >>= fun c ->\n  return c\n\nlet fold ctxt ~f init =\n  Storage.Roll.Next.get ctxt >>=? fun last ->\n  let rec loop ctxt roll acc =\n    acc >>=? fun acc ->\n    if Roll_repr.(roll = last) then\n      return acc\n    else\n      Storage.Roll.Owner.get_option ctxt roll >>=? function\n      | None ->\n          loop ctxt (Roll_repr.succ roll) (return acc)\n      | Some delegate ->\n          loop ctxt (Roll_repr.succ roll) (f roll delegate acc) in\n  loop ctxt Roll_repr.first (return init)\n\nlet snapshot_rolls_for_cycle ctxt cycle =\n  Storage.Roll.Snapshot_for_cycle.get ctxt cycle >>=? fun index ->\n  Storage.Roll.Snapshot_for_cycle.set ctxt cycle (index + 1) >>=? fun ctxt ->\n  Storage.Roll.Owner.snapshot ctxt (cycle, index) >>=? fun ctxt ->\n  Storage.Roll.Next.get ctxt >>=? fun last ->\n  Storage.Roll.Last_for_snapshot.init (ctxt, cycle) index last >>=? fun ctxt ->\n  return ctxt\n\nlet freeze_rolls_for_cycle ctxt cycle =\n  Storage.Roll.Snapshot_for_cycle.get ctxt cycle >>=? fun max_index ->\n  Storage.Seed.For_cycle.get ctxt cycle >>=? fun seed ->\n  let rd = Seed_repr.initialize_new seed [MBytes.of_string \"roll_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 in\n  Storage.Roll.Snapshot_for_cycle.set ctxt cycle selected_index >>=? fun ctxt ->\n  fold_left_s\n    (fun ctxt index ->\n       if Compare.Int.(index = selected_index) then\n         return ctxt\n       else\n         Storage.Roll.Owner.delete_snapshot ctxt (cycle, index) >>= fun ctxt ->\n         Storage.Roll.Last_for_snapshot.delete (ctxt, cycle) index >>=? fun ctxt ->\n         return ctxt\n    )\n    ctxt\n    Misc.(0 --> (max_index - 1)) >>=? fun ctxt ->\n  return ctxt\n\n(* Roll selection *)\n\nmodule Random = struct\n\n  let int32_to_bytes i =\n    let b = MBytes.create 4 in\n    MBytes.set_int32 b 0 i;\n    b\n\n  let level_random seed use level =\n    let position = level.Level_repr.cycle_position in\n    Seed_repr.initialize_new seed\n      [MBytes.of_string (\"level \"^use^\":\");\n       int32_to_bytes position]\n\n  let owner c kind level offset =\n    let cycle = level.Level_repr.cycle in\n    Seed_storage.for_cycle c cycle >>=? fun random_seed ->\n    let rd = level_random random_seed kind level in\n    let sequence = Seed_repr.sequence rd (Int32.of_int offset) in\n    Storage.Roll.Snapshot_for_cycle.get c cycle >>=? fun index ->\n    Storage.Roll.Last_for_snapshot.get (c, cycle) index >>=? fun bound ->\n    let rec loop sequence =\n      let roll, sequence = Roll_repr.random sequence ~bound in\n      Storage.Roll.Owner.Snapshot.get_option c ((cycle, index), roll) >>=? function\n      | None ->\n          loop sequence\n      | Some delegate ->\n          return delegate in\n    Storage.Roll.Owner.snapshot_exists c (cycle, index) >>= fun snapshot_exists ->\n    fail_unless snapshot_exists (No_roll_snapshot_for_cycle cycle) >>=? fun () ->\n    loop sequence\n\nend\n\nlet baking_rights_owner c level ~priority =\n  Random.owner c \"baking\" level priority\n\nlet endorsement_rights_owner c level ~slot =\n  Random.owner c \"endorsement\" level slot\n\nlet traverse_rolls ctxt head =\n  let rec loop acc roll =\n    Storage.Roll.Successor.get_option ctxt roll >>=? function\n    | None -> return (List.rev acc)\n    | Some next -> loop (next :: acc) next in\n  loop [head] head\n\nlet get_rolls ctxt delegate =\n  Storage.Roll.Delegate_roll_list.get_option ctxt delegate >>=? function\n  | None -> return_nil\n  | Some head_roll -> traverse_rolls ctxt head_roll\n\nlet get_change c delegate =\n  Storage.Roll.Delegate_change.get_option c delegate >>=? function\n  | None -> return Tez_repr.zero\n  | Some change -> return change\n\nmodule Delegate = struct\n\n  let fresh_roll c =\n    Storage.Roll.Next.get c >>=? fun roll ->\n    Storage.Roll.Next.set c (Roll_repr.succ roll) >>=? fun c ->\n    return (roll, c)\n\n  let get_limbo_roll c =\n    Storage.Roll.Limbo.get_option c >>=? function\n    | None ->\n        fresh_roll c >>=? fun (roll, c) ->\n        Storage.Roll.Limbo.init c roll >>=? fun c ->\n        return (roll, c)\n    | Some roll ->\n        return (roll, c)\n\n  let consume_roll_change c delegate =\n    let tokens_per_roll = Constants_storage.tokens_per_roll c in\n    Storage.Roll.Delegate_change.get c delegate >>=? fun change ->\n    trace Consume_roll_change\n      (Lwt.return Tez_repr.(change -? tokens_per_roll)) >>=? fun new_change ->\n    Storage.Roll.Delegate_change.set c delegate new_change\n\n  let recover_roll_change c delegate =\n    let tokens_per_roll = Constants_storage.tokens_per_roll c in\n    Storage.Roll.Delegate_change.get c delegate >>=? fun change ->\n    Lwt.return Tez_repr.(change +? tokens_per_roll) >>=? fun new_change ->\n    Storage.Roll.Delegate_change.set c delegate new_change\n\n  let pop_roll_from_delegate c delegate =\n    recover_roll_change c delegate >>=? fun c ->\n    (* beginning:\n       delegate : roll -> successor_roll -> ...\n       limbo : limbo_head -> ...\n    *)\n    Storage.Roll.Limbo.get_option c >>=? fun limbo_head ->\n    Storage.Roll.Delegate_roll_list.get_option c delegate >>=? function\n    | None -> fail No_roll_for_delegate\n    | Some roll ->\n        Storage.Roll.Owner.delete c roll >>=? fun c ->\n        Storage.Roll.Successor.get_option c roll >>=? fun successor_roll ->\n        Storage.Roll.Delegate_roll_list.set_option c delegate successor_roll >>= fun c ->\n        (* delegate : successor_roll -> ...\n           roll ------^\n           limbo : limbo_head -> ... *)\n        Storage.Roll.Successor.set_option c roll limbo_head >>= fun c ->\n        (* delegate : successor_roll -> ...\n           roll ------v\n           limbo : limbo_head -> ... *)\n        Storage.Roll.Limbo.init_set c roll >>= fun c ->\n        (* delegate : successor_roll -> ...\n           limbo : roll -> limbo_head -> ... *)\n        return (roll, c)\n\n  let create_roll_in_delegate c delegate delegate_pk =\n    consume_roll_change c delegate >>=? fun c ->\n\n    (* beginning:\n       delegate : delegate_head -> ...\n       limbo : roll -> limbo_successor -> ...\n    *)\n    Storage.Roll.Delegate_roll_list.get_option c delegate >>=? fun delegate_head ->\n    get_limbo_roll c >>=? fun (roll, c) ->\n    Storage.Roll.Owner.init c roll delegate_pk >>=? fun c ->\n    Storage.Roll.Successor.get_option c roll >>=? fun limbo_successor ->\n    Storage.Roll.Limbo.set_option c limbo_successor >>= fun c ->\n    (* delegate : delegate_head -> ...\n       roll ------v\n       limbo : limbo_successor -> ... *)\n    Storage.Roll.Successor.set_option c roll delegate_head >>= fun c ->\n    (* delegate : delegate_head -> ...\n       roll ------^\n       limbo : limbo_successor -> ... *)\n    Storage.Roll.Delegate_roll_list.init_set c delegate roll >>= fun c ->\n    (* delegate : roll -> delegate_head -> ...\n       limbo : limbo_successor -> ... *)\n    return c\n\n  let ensure_inited c delegate =\n    Storage.Roll.Delegate_change.mem c delegate >>= function\n    | true -> return c\n    | false ->\n        Storage.Roll.Delegate_change.init c delegate Tez_repr.zero\n\n  let add_amount c delegate amount =\n    ensure_inited c delegate >>=? fun c ->\n    let tokens_per_roll = Constants_storage.tokens_per_roll c in\n    Storage.Roll.Delegate_change.get c delegate >>=? fun change ->\n    Lwt.return Tez_repr.(amount +? change) >>=? fun change ->\n    Storage.Roll.Delegate_change.set c delegate change >>=? fun c ->\n    delegate_pubkey c delegate >>=? fun delegate_pk ->\n    let rec loop c change =\n      if Tez_repr.(change < tokens_per_roll) then\n        return c\n      else\n        Lwt.return Tez_repr.(change -? tokens_per_roll) >>=? fun  change ->\n        create_roll_in_delegate c delegate delegate_pk >>=? fun c ->\n        loop c change in\n    Storage.Contract.Inactive_delegate.mem c\n      (Contract_repr.implicit_contract delegate) >>= fun inactive ->\n    if inactive then return c else loop c change\n\n  let remove_amount c delegate amount =\n    let tokens_per_roll = Constants_storage.tokens_per_roll c in\n    let rec loop c change =\n      if Tez_repr.(amount <= change)\n      then return (c, change)\n      else\n        pop_roll_from_delegate c delegate >>=? fun (_, c) ->\n        Lwt.return Tez_repr.(change +? tokens_per_roll) >>=? fun change ->\n        loop c change in\n    Storage.Roll.Delegate_change.get c delegate >>=? fun change ->\n    Storage.Contract.Inactive_delegate.mem c\n      (Contract_repr.implicit_contract delegate) >>= fun inactive ->\n    begin\n      if inactive then return (c, change) else loop c change\n    end >>=? fun (c, change) ->\n    Lwt.return Tez_repr.(change -? amount) >>=? fun change ->\n    Storage.Roll.Delegate_change.set c 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.Delegate_change.get ctxt delegate >>=? fun change ->\n    Storage.Contract.Inactive_delegate.add ctxt\n      (Contract_repr.implicit_contract delegate) >>= fun ctxt ->\n    let rec loop ctxt change =\n      Storage.Roll.Delegate_roll_list.get_option ctxt delegate >>=? function\n      | None -> return (ctxt, change)\n      | Some _roll ->\n          pop_roll_from_delegate ctxt delegate >>=? fun (_, ctxt) ->\n          Lwt.return Tez_repr.(change +? tokens_per_roll) >>=? fun change ->\n          loop ctxt change in\n    loop ctxt change >>=? fun (ctxt, change) ->\n    Storage.Roll.Delegate_change.set ctxt delegate change >>=? fun ctxt ->\n    return ctxt\n\n  let set_active ctxt delegate =\n    Storage.Contract.Inactive_delegate.mem ctxt\n      (Contract_repr.implicit_contract 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.get_option ctxt\n      (Contract_repr.implicit_contract delegate) >>=? fun current_expiration ->\n    let expiration = match current_expiration with\n      | None ->\n          Cycle_repr.add current_cycle (1+2*preserved_cycles)\n      | Some current_expiration ->\n          let delay =\n            if inactive then (1+2*preserved_cycles) else 1+preserved_cycles in\n          let updated =\n            Cycle_repr.add current_cycle delay in\n          Cycle_repr.max current_expiration updated in\n    Storage.Contract.Delegate_desactivation.init_set ctxt\n      (Contract_repr.implicit_contract delegate)\n      expiration >>= fun ctxt ->\n    if not inactive then\n      return ctxt\n    else begin\n      ensure_inited ctxt delegate >>=? fun ctxt ->\n      let tokens_per_roll = Constants_storage.tokens_per_roll ctxt in\n      Storage.Roll.Delegate_change.get ctxt delegate >>=? fun change ->\n      Storage.Contract.Inactive_delegate.del ctxt\n        (Contract_repr.implicit_contract delegate) >>= fun ctxt ->\n      delegate_pubkey ctxt delegate >>=? fun delegate_pk ->\n      let rec loop ctxt change =\n        if Tez_repr.(change < tokens_per_roll) then\n          return ctxt\n        else\n          Lwt.return Tez_repr.(change -? tokens_per_roll) >>=? fun  change ->\n          create_roll_in_delegate ctxt delegate delegate_pk >>=? fun ctxt ->\n          loop ctxt change in\n      loop ctxt change >>=? fun ctxt ->\n      return ctxt\n    end\n\nend\n\nmodule Contract = struct\n\n  let add_amount c contract amount =\n    get_contract_delegate c contract >>=? function\n    | None -> return c\n    | Some delegate ->\n        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 ->\n        Delegate.remove_amount c delegate amount\n\nend\n\nlet init ctxt =\n  Storage.Roll.Next.init ctxt Roll_repr.first\n\nlet init_first_cycles ctxt =\n  let preserved = Constants_storage.preserved_cycles ctxt in\n  (* Precompute rolls for cycle (0 --> preserved_cycles) *)\n  List.fold_left\n    (fun ctxt c ->\n       ctxt >>=? fun ctxt ->\n       let cycle = Cycle_repr.of_int32_exn (Int32.of_int c) in\n       Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0 >>=? fun ctxt ->\n       snapshot_rolls_for_cycle ctxt cycle >>=? fun ctxt ->\n       freeze_rolls_for_cycle ctxt cycle)\n    (return ctxt) (0 --> preserved) >>=? fun ctxt ->\n  let cycle = Cycle_repr.of_int32_exn (Int32.of_int (preserved + 1)) in\n  (* Precomputed a snapshot for cycle (preserved_cycles + 1) *)\n  Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0 >>=? fun ctxt ->\n  snapshot_rolls_for_cycle ctxt cycle >>=? fun ctxt ->\n  (* Prepare storage for storing snapshots for cycle (preserved_cycles+2) *)\n  let cycle = Cycle_repr.of_int32_exn (Int32.of_int (preserved + 2)) in\n  Storage.Roll.Snapshot_for_cycle.init ctxt cycle 0 >>=? fun ctxt ->\n  return ctxt\n\nlet snapshot_rolls ctxt =\n  let current_level = Raw_context.current_level ctxt in\n  let preserved = Constants_storage.preserved_cycles ctxt in\n  let cycle = Cycle_repr.add current_level.cycle (preserved+2) in\n  snapshot_rolls_for_cycle ctxt cycle\n\nlet cycle_end ctxt last_cycle =\n  let preserved = Constants_storage.preserved_cycles ctxt in\n  begin\n    match Cycle_repr.sub last_cycle preserved with\n    | None -> return ctxt\n    | Some cleared_cycle ->\n        clear_cycle ctxt cleared_cycle\n  end >>=? fun ctxt ->\n  let frozen_roll_cycle = Cycle_repr.add last_cycle (preserved+1) in\n  freeze_rolls_for_cycle ctxt frozen_roll_cycle >>=? fun ctxt ->\n  Storage.Roll.Snapshot_for_cycle.init\n    ctxt (Cycle_repr.succ (Cycle_repr.succ frozen_roll_cycle)) 0 >>=? fun ctxt ->\n  return ctxt\n" ;
                } ;
                { name = "Delegate_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(** Places where tezzies can be found in the ledger's state. *)\ntype balance =\n  | Contract of Contract_repr.t\n  | Rewards of Signature.Public_key_hash.t * Cycle_repr.t\n  | Fees of Signature.Public_key_hash.t * Cycle_repr.t\n  | Deposits of Signature.Public_key_hash.t * Cycle_repr.t\n\n(** A credit or debit of tezzies to a balance. *)\ntype balance_update =\n  | Debited of Tez_repr.t\n  | Credited of Tez_repr.t\n\n(** A list of balance updates. Duplicates may happen. *)\ntype balance_updates = (balance * balance_update) list\n\nval balance_updates_encoding : balance_updates Data_encoding.t\n\n(** Remove zero-valued balances from a list of updates. *)\nval cleanup_balance_updates : balance_updates -> balance_updates\n\ntype frozen_balance = {\n  deposit : Tez_repr.t ;\n  fees : Tez_repr.t ;\n  rewards : Tez_repr.t ;\n}\n\n(** Is the contract eligible to delegation ? *)\nval is_delegatable:\n  Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t\n\n(** Allow to register a delegate when creating an account. *)\nval init:\n  Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t ->\n  Raw_context.t tzresult Lwt.t\n\n(** Cleanup delegation when deleting a contract. *)\nval remove:\n  Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t\n\n(** Reading the current delegate of a contract. *)\nval get:\n  Raw_context.t -> Contract_repr.t ->\n  Signature.Public_key_hash.t option tzresult Lwt.t\n\nval registered: Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t\n\n(** Updating the delegate of a contract.\n\n    When calling this function on an \"implicit contract\" this function\n    fails, unless when the registered delegate is the contract manager.\n    In the that case, the manager is now registered as a delegate. One\n    cannot unregister a delegate for now. The associate contract is\n    now 'undeletable'. *)\nval set:\n  Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t option ->\n  Raw_context.t tzresult Lwt.t\n\n(** Same as {!set} ignoring the [delegatable] flag. *)\nval set_from_script:\n  Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t option ->\n  Raw_context.t tzresult Lwt.t\n\ntype error +=\n  | Non_delegatable_contract of Contract_repr.contract (* `Permanent *)\n  | No_deletion of Signature.Public_key_hash.t (* `Permanent *)\n  | Active_delegate (* `Temporary *)\n  | Current_delegate (* `Temporary *)\n  | Empty_delegate_account of Signature.Public_key_hash.t (* `Temporary *)\n  | Balance_too_low_for_deposit of\n      { delegate : Signature.Public_key_hash.t ;\n        deposit : Tez_repr.t ;\n        balance : Tez_repr.t } (* `Temporary *)\n\n(** Iterate on all registered delegates. *)\nval fold:\n  Raw_context.t ->\n  init:'a ->\n  f:(Signature.Public_key_hash.t -> 'a -> 'a Lwt.t) -> 'a Lwt.t\n\n(** List all registered delegates. *)\nval list: Raw_context.t -> Signature.Public_key_hash.t list Lwt.t\n\n(** Various functions to 'freeze' tokens.  A frozen 'deposit' keeps its\n    associated rolls. When frozen, 'fees' may trigger new rolls\n    allocation. Rewards won't trigger new rolls allocation until\n    unfrozen. *)\nval freeze_deposit:\n  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t ->\n  Raw_context.t tzresult Lwt.t\n\nval freeze_fees:\n  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t ->\n  Raw_context.t tzresult Lwt.t\n\nval freeze_rewards:\n  Raw_context.t -> Signature.Public_key_hash.t -> Tez_repr.t ->\n  Raw_context.t tzresult Lwt.t\n\n(** Trigger the context maintenance at the end of cycle 'n', i.e.:\n    unfreeze deposit/fees/rewards from 'n - preserved_cycle' ; punish the\n    provided unrevealed seeds (tipically seed from cycle 'n - 1').\n    Returns a list of account with the amount that was unfrozen for each\n    and the list of deactivated delegates. *)\nval cycle_end:\n  Raw_context.t -> Cycle_repr.t -> Nonce_storage.unrevealed list ->\n  (Raw_context.t * balance_updates * Signature.Public_key_hash.t list) tzresult Lwt.t\n\n(** Burn all then frozen deposit/fees/rewards for a delegate at a given\n    cycle. Returns the burned amounts. *)\nval punish:\n  Raw_context.t -> Signature.Public_key_hash.t -> Cycle_repr.t ->\n  (Raw_context.t * frozen_balance) tzresult Lwt.t\n\n(** Has the given key some frozen tokens in its implicit contract? *)\nval has_frozen_balance:\n  Raw_context.t -> Signature.Public_key_hash.t -> Cycle_repr.t ->\n  bool tzresult Lwt.t\n\n(** Returns the amount of frozen deposit, fees and rewards associated\n    to a given delegate. *)\nval frozen_balance:\n  Raw_context.t -> Signature.Public_key_hash.t ->\n  Tez_repr.t tzresult Lwt.t\n\nval frozen_balance_encoding: frozen_balance Data_encoding.t\nval frozen_balance_by_cycle_encoding:\n  frozen_balance Cycle_repr.Map.t Data_encoding.t\n\n(** Returns the amount of frozen deposit, fees and rewards associated\n    to a given delegate, indexed by the cycle by which at the end the\n    balance will be unfrozen. *)\nval frozen_balance_by_cycle:\n  Raw_context.t -> Signature.Public_key_hash.t ->\n  frozen_balance Cycle_repr.Map.t 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. *)\nval full_balance:\n  Raw_context.t -> Signature.Public_key_hash.t ->\n  Tez_repr.t tzresult Lwt.t\n\nval staking_balance:\n  Raw_context.t -> Signature.Public_key_hash.t ->\n  Tez_repr.t tzresult Lwt.t\n\n(** Returns the list of contract that delegated towards a given delegate *)\nval delegated_contracts:\n  Raw_context.t -> Signature.Public_key_hash.t ->\n  Contract_hash.t list Lwt.t\n\nval delegated_balance:\n  Raw_context.t -> Signature.Public_key_hash.t ->\n  Tez_repr.t tzresult Lwt.t\n\nval deactivated:\n  Raw_context.t -> Signature.Public_key_hash.t ->\n  bool Lwt.t\n\nval grace_period:\n  Raw_context.t -> Signature.Public_key_hash.t ->\n  Cycle_repr.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\ntype balance =\n  | Contract of Contract_repr.t\n  | Rewards of Signature.Public_key_hash.t * Cycle_repr.t\n  | Fees of Signature.Public_key_hash.t * Cycle_repr.t\n  | Deposits of Signature.Public_key_hash.t * Cycle_repr.t\n\nlet balance_encoding =\n  let open Data_encoding in\n  def \"operation_metadata.alpha.balance\" @@\n  union\n    [ case (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 (Tag 1)\n        ~title:\"Rewards\"\n        (obj4\n           (req \"kind\" (constant \"freezer\"))\n           (req \"category\" (constant \"rewards\"))\n           (req \"delegate\" Signature.Public_key_hash.encoding)\n           (req \"level\" Cycle_repr.encoding))\n        (function Rewards (d, l) -> Some ((), (), d, l) | _ -> None)\n        (fun ((), (), d, l) -> Rewards (d, l)) ;\n      case (Tag 2)\n        ~title:\"Fees\"\n        (obj4\n           (req \"kind\" (constant \"freezer\"))\n           (req \"category\" (constant \"fees\"))\n           (req \"delegate\" Signature.Public_key_hash.encoding)\n           (req \"level\" Cycle_repr.encoding))\n        (function Fees (d, l) -> Some ((), (), d, l) | _ -> None)\n        (fun ((), (), d, l) -> Fees (d, l)) ;\n      case (Tag 3)\n        ~title:\"Deposits\"\n        (obj4\n           (req \"kind\" (constant \"freezer\"))\n           (req \"category\" (constant \"deposits\"))\n           (req \"delegate\" Signature.Public_key_hash.encoding)\n           (req \"level\" Cycle_repr.encoding))\n        (function Deposits (d, l) -> Some ((), (), d, l) | _ -> None)\n        (fun ((), (), d, l) -> Deposits (d, l)) ]\n\ntype balance_update =\n  | Debited of Tez_repr.t\n  | 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 \"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 @@\n           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 -> failwith \"Qty.of_mutez\"\n           else\n             match Tez_repr.of_mutez v with\n             | Some v -> Credited v\n             | None -> failwith \"Qty.of_mutez\")\n          int64))\n\ntype balance_updates = (balance * balance_update) list\n\nlet balance_updates_encoding =\n  let open Data_encoding in\n  def \"operation_metadata.alpha.balance_updates\" @@\n  list (merge_objs balance_encoding balance_update_encoding)\n\nlet cleanup_balance_updates balance_updates =\n  List.filter\n    (fun (_, (Credited update | Debited update)) ->\n       not (Tez_repr.equal update Tez_repr.zero))\n    balance_updates\n\ntype frozen_balance = {\n  deposit : Tez_repr.t ;\n  fees : Tez_repr.t ;\n  rewards : Tez_repr.t ;\n}\n\nlet frozen_balance_encoding =\n  let open Data_encoding in\n  conv\n    (fun { deposit ; fees ; rewards } -> (deposit, fees, rewards))\n    (fun (deposit, fees, rewards) -> { deposit ; fees ; rewards })\n    (obj3\n       (req \"deposit\" Tez_repr.encoding)\n       (req \"fees\" Tez_repr.encoding)\n       (req \"rewards\" Tez_repr.encoding))\n\ntype error +=\n  | Non_delegatable_contract of Contract_repr.contract (* `Permanent *)\n  | No_deletion of Signature.Public_key_hash.t (* `Permanent *)\n  | Active_delegate (* `Temporary *)\n  | Current_delegate (* `Temporary *)\n  | Empty_delegate_account of Signature.Public_key_hash.t (* `Temporary *)\n  | Balance_too_low_for_deposit of\n      { delegate : Signature.Public_key_hash.t ;\n        deposit : Tez_repr.t ;\n        balance : Tez_repr.t } (* `Temporary *)\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"contract.undelegatable_contract\"\n    ~title:\"Non delegatable contract\"\n    ~description:\"Tried to delegate an implicit contract \\\n                  or a non delegatable originated contract\"\n    ~pp:(fun ppf contract ->\n        Format.fprintf ppf \"Contract %a is not delegatable\"\n          Contract_repr.pp contract)\n    Data_encoding.(obj1 (req \"contract\" Contract_repr.encoding))\n    (function Non_delegatable_contract c -> Some c | _ -> None)\n    (fun c -> Non_delegatable_contract c) ;\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 ppf \"Delegate deletion is forbidden (%a)\"\n          Signature.Public_key_hash.pp 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\n          \"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 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 ppf\n          \"Delegate registration is forbidden when the delegate\n           implicit account is empty (%a)\"\n          Signature.Public_key_hash.pp 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  register_error_kind\n    `Temporary\n    ~id:\"delegate.balance_too_low_for_deposit\"\n    ~title:\"Balance too low for deposit\"\n    ~description:\"Cannot freeze deposit when the balance is too low\"\n    ~pp:(fun ppf (delegate, balance, deposit) ->\n        Format.fprintf ppf\n          \"Delegate %a has a too low balance (%a) to deposit %a\"\n          Signature.Public_key_hash.pp delegate\n          Tez_repr.pp balance\n          Tez_repr.pp deposit)\n    Data_encoding.\n      (obj3\n         (req \"delegate\" Signature.Public_key_hash.encoding)\n         (req \"balance\" Tez_repr.encoding)\n         (req \"deposit\" Tez_repr.encoding))\n    (function Balance_too_low_for_deposit { delegate ; balance ; deposit } ->\n       Some (delegate, balance, deposit) | _ -> None)\n    (fun (delegate, balance, deposit) -> Balance_too_low_for_deposit { delegate ; balance ; deposit } )\n\nlet is_delegatable c contract =\n  match Contract_repr.is_implicit contract with\n  | Some _ ->\n      return_false\n  | None ->\n      Storage.Contract.Delegatable.mem c contract >>= return\n\nlet link c contract delegate balance =\n  Roll_storage.Delegate.add_amount c delegate balance >>=? fun c ->\n  match Contract_repr.is_originated contract with\n  | None -> return c\n  | Some h ->\n      Storage.Contract.Delegated.add\n        (c, Contract_repr.implicit_contract delegate) h >>= fun c ->\n      return c\n\nlet unlink c contract balance =\n  Storage.Contract.Delegate.get_option c contract >>=? function\n  | None -> return c\n  | Some delegate ->\n      Roll_storage.Delegate.remove_amount c delegate balance >>=? fun c ->\n      match Contract_repr.is_originated contract with\n      | None -> return c\n      | Some h ->\n          Storage.Contract.Delegated.del\n            (c, Contract_repr.implicit_contract delegate) h >>= fun c ->\n          return c\n\nlet known c delegate =\n  Storage.Contract.Manager.get_option\n    c (Contract_repr.implicit_contract delegate) >>=? function\n  | None | Some (Manager_repr.Hash _) -> return_false\n  | Some (Manager_repr.Public_key _) -> return_true\n\n(* A delegate is registered if its \"implicit account\"\n   delegates to itself. *)\nlet registered c delegate =\n  Storage.Contract.Delegate.mem\n    c (Contract_repr.implicit_contract delegate)\n\nlet init ctxt contract delegate =\n  Storage.Contract.Delegate.init ctxt contract delegate >>=? fun ctxt ->\n  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->\n  link ctxt contract delegate balance\n\nlet get = Roll_storage.get_contract_delegate\n\nlet set_base c is_delegatable contract delegate =\n  match delegate with\n  | None -> begin\n      match Contract_repr.is_implicit contract with\n      | Some pkh ->\n          fail (No_deletion pkh)\n      | None ->\n          is_delegatable c contract >>=? fun delegatable ->\n          if delegatable then\n            Storage.Contract.Balance.get c contract >>=? fun balance ->\n            unlink c contract balance >>=? fun c ->\n            Storage.Contract.Delegate.remove c contract >>= fun c ->\n            return c\n          else\n            fail (Non_delegatable_contract contract)\n    end\n  | Some delegate ->\n      known c delegate >>=? fun known_delegate ->\n      registered c delegate >>= fun registered_delegate ->\n      is_delegatable c contract >>=? fun delegatable ->\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 in\n      if not known_delegate || not (registered_delegate || self_delegation) then\n        fail (Roll_storage.Unregistered_delegate delegate)\n      else if not (delegatable || self_delegation) then\n        fail (Non_delegatable_contract contract)\n      else\n        begin\n          Storage.Contract.Delegate.get_option c contract >>=? function\n          | Some current_delegate\n            when Signature.Public_key_hash.equal delegate current_delegate ->\n              if self_delegation then\n                Storage.Contract.Inactive_delegate.mem c contract >>= function\n                | true -> return_unit\n                | false -> fail Active_delegate\n              else\n                fail Current_delegate\n          | None | Some _ -> return_unit\n        end >>=? fun () ->\n        Storage.Contract.Balance.mem c contract >>= fun exists ->\n        fail_when\n          (self_delegation && not exists)\n          (Empty_delegate_account delegate) >>=? fun () ->\n        Storage.Contract.Balance.get c contract >>=? fun balance ->\n        unlink c contract balance >>=? fun c ->\n        Storage.Contract.Delegate.init_set c contract delegate >>= fun c ->\n        link c contract delegate balance >>=? fun c ->\n        begin\n          if self_delegation then\n            Storage.Delegates.add c delegate >>= fun c ->\n            Roll_storage.Delegate.set_active c delegate >>=? fun c ->\n            return c\n          else\n            return c\n        end >>=? fun c ->\n        return c\n\nlet set c contract delegate =\n  set_base c is_delegatable contract delegate\n\nlet set_from_script c contract delegate =\n  set_base c (fun _ _ -> return_true) contract delegate\n\nlet remove ctxt contract =\n  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->\n  unlink ctxt contract balance\n\nlet fold = Storage.Delegates.fold\nlet list = Storage.Delegates.elements\n\nlet delegated_contracts ctxt delegate =\n  let contract = Contract_repr.implicit_contract delegate in\n  Storage.Contract.Delegated.elements (ctxt, contract)\n\nlet get_frozen_deposit ctxt contract cycle =\n  Storage.Contract.Frozen_deposits.get_option (ctxt, contract) cycle >>=? function\n  | None -> return Tez_repr.zero\n  | Some frozen -> return frozen\n\nlet credit_frozen_deposit ctxt contract cycle amount =\n  get_frozen_deposit ctxt contract cycle >>=? fun old_amount ->\n  Lwt.return Tez_repr.(old_amount +? amount) >>=? fun new_amount ->\n  Storage.Contract.Frozen_deposits.init_set\n    (ctxt, contract) cycle new_amount >>= fun ctxt ->\n  return ctxt\n\nlet freeze_deposit ctxt delegate amount =\n  let { Level_repr.cycle ; _ } = Level_storage.current ctxt in\n  Roll_storage.Delegate.set_active ctxt delegate >>=? fun ctxt ->\n  let contract = Contract_repr.implicit_contract delegate in\n  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->\n  Lwt.return\n    (record_trace (Balance_too_low_for_deposit { delegate; deposit = amount; balance })\n       Tez_repr.(balance -? amount)) >>=? fun new_balance ->\n  Storage.Contract.Balance.set ctxt contract new_balance >>=? fun ctxt ->\n  credit_frozen_deposit ctxt contract cycle amount\n\nlet get_frozen_fees ctxt contract cycle =\n  Storage.Contract.Frozen_fees.get_option (ctxt, contract) cycle >>=? function\n  | None -> return Tez_repr.zero\n  | Some frozen -> return frozen\n\nlet credit_frozen_fees ctxt contract cycle amount =\n  get_frozen_fees ctxt contract cycle >>=? fun old_amount ->\n  Lwt.return Tez_repr.(old_amount +? amount) >>=? fun new_amount ->\n  Storage.Contract.Frozen_fees.init_set\n    (ctxt, contract) cycle new_amount >>= fun ctxt ->\n  return ctxt\n\nlet freeze_fees ctxt delegate amount =\n  let { Level_repr.cycle ; _ } = Level_storage.current ctxt in\n  let contract = Contract_repr.implicit_contract delegate in\n  Roll_storage.Delegate.add_amount ctxt delegate amount >>=? fun ctxt ->\n  credit_frozen_fees ctxt contract cycle amount\n\nlet burn_fees ctxt delegate cycle amount =\n  let contract = Contract_repr.implicit_contract delegate in\n  get_frozen_fees ctxt contract cycle >>=? fun old_amount ->\n  begin\n    match Tez_repr.(old_amount -? amount) with\n    | Ok new_amount ->\n        Roll_storage.Delegate.remove_amount\n          ctxt delegate amount >>=? fun ctxt ->\n        return (new_amount, ctxt)\n    | Error _ ->\n        Roll_storage.Delegate.remove_amount\n          ctxt delegate old_amount >>=? fun ctxt ->\n        return (Tez_repr.zero, ctxt)\n  end >>=? fun (new_amount, ctxt) ->\n  Storage.Contract.Frozen_fees.set (ctxt, contract) cycle new_amount\n\n\nlet get_frozen_rewards ctxt contract cycle =\n  Storage.Contract.Frozen_rewards.get_option (ctxt, contract) cycle >>=? function\n  | None -> return Tez_repr.zero\n  | Some frozen -> return frozen\n\nlet credit_frozen_rewards ctxt contract cycle amount =\n  get_frozen_rewards ctxt contract cycle >>=? fun old_amount ->\n  Lwt.return Tez_repr.(old_amount +? amount) >>=? fun new_amount ->\n  Storage.Contract.Frozen_rewards.init_set\n    (ctxt, contract) cycle new_amount >>= fun ctxt ->\n  return ctxt\n\nlet freeze_rewards ctxt delegate amount =\n  let { Level_repr.cycle ; _ } = Level_storage.current ctxt in\n  let contract = Contract_repr.implicit_contract delegate in\n  credit_frozen_rewards ctxt contract cycle amount\n\nlet burn_rewards ctxt delegate cycle amount =\n  let contract = Contract_repr.implicit_contract delegate in\n  get_frozen_rewards ctxt contract cycle >>=? fun old_amount ->\n  let new_amount =\n    match Tez_repr.(old_amount -? amount) with\n    | Error _ -> Tez_repr.zero\n    | Ok new_amount -> new_amount in\n  Storage.Contract.Frozen_rewards.set (ctxt, contract) cycle new_amount\n\n\n\nlet unfreeze ctxt delegate cycle =\n  let contract = Contract_repr.implicit_contract delegate in\n  get_frozen_deposit ctxt contract cycle >>=? fun deposit ->\n  get_frozen_fees ctxt contract cycle >>=? fun fees ->\n  get_frozen_rewards ctxt contract cycle >>=? fun rewards ->\n  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->\n  Lwt.return Tez_repr.(deposit +? fees) >>=? fun unfrozen_amount ->\n  Lwt.return Tez_repr.(unfrozen_amount +? rewards) >>=? fun unfrozen_amount ->\n  Lwt.return Tez_repr.(balance +? unfrozen_amount) >>=? fun balance ->\n  Storage.Contract.Balance.set ctxt contract balance >>=? fun ctxt ->\n  Roll_storage.Delegate.add_amount ctxt delegate rewards >>=? fun ctxt ->\n  Storage.Contract.Frozen_deposits.remove (ctxt, contract) cycle >>= fun ctxt ->\n  Storage.Contract.Frozen_fees.remove (ctxt, contract) cycle >>= fun ctxt ->\n  Storage.Contract.Frozen_rewards.remove (ctxt, contract) cycle >>= fun ctxt ->\n  return (ctxt, (cleanup_balance_updates\n                   [(Deposits (delegate, cycle), Debited deposit) ;\n                    (Fees (delegate, cycle), Debited fees) ;\n                    (Rewards (delegate, cycle), Debited rewards) ;\n                    (Contract (Contract_repr.implicit_contract delegate), Credited unfrozen_amount)]))\n\nlet cycle_end ctxt last_cycle unrevealed =\n  let preserved = Constants_storage.preserved_cycles ctxt in\n  begin\n    match Cycle_repr.pred last_cycle with\n    | None -> return (ctxt,[])\n    | Some revealed_cycle ->\n        List.fold_left\n          (fun acc (u : Nonce_storage.unrevealed) ->\n             acc >>=? fun (ctxt, balance_updates) ->\n             burn_fees\n               ctxt u.delegate revealed_cycle u.fees >>=? fun ctxt ->\n             burn_rewards\n               ctxt u.delegate revealed_cycle u.rewards >>=? fun ctxt ->\n             let bus = [(Fees (u.delegate, revealed_cycle), Debited u.fees);\n                        (Rewards (u.delegate, revealed_cycle), Debited u.rewards)] in\n             return (ctxt, bus @ balance_updates))\n          (return (ctxt,[])) unrevealed\n  end >>=? fun (ctxt, balance_updates) ->\n  match Cycle_repr.sub last_cycle preserved with\n  | None -> return (ctxt, balance_updates, [])\n  | Some unfrozen_cycle ->\n      fold ctxt\n        ~init:(Ok (ctxt, balance_updates, []))\n        ~f:(fun delegate acc ->\n            Lwt.return acc >>=? fun (ctxt, bus, deactivated) ->\n            unfreeze ctxt delegate unfrozen_cycle >>=? fun (ctxt, balance_updates) ->\n            Storage.Contract.Delegate_desactivation.get ctxt\n              (Contract_repr.implicit_contract delegate) >>=? fun cycle ->\n            if Cycle_repr.(cycle <= last_cycle) then\n              Roll_storage.Delegate.set_inactive ctxt delegate >>=? fun ctxt ->\n              return (ctxt, balance_updates @ bus, delegate::deactivated)\n            else\n              return (ctxt, balance_updates @ bus, deactivated))\n\nlet punish ctxt delegate cycle =\n  let contract = Contract_repr.implicit_contract delegate in\n  get_frozen_deposit ctxt contract cycle >>=? fun deposit ->\n  get_frozen_fees ctxt contract cycle >>=? fun fees ->\n  get_frozen_rewards ctxt contract cycle >>=? fun rewards ->\n  Roll_storage.Delegate.remove_amount ctxt delegate deposit >>=? fun ctxt ->\n  Roll_storage.Delegate.remove_amount ctxt delegate fees >>=? fun ctxt ->\n  (* Rewards are not accounted in the delegate's rolls yet... *)\n  Storage.Contract.Frozen_deposits.remove (ctxt, contract) cycle >>= fun ctxt ->\n  Storage.Contract.Frozen_fees.remove (ctxt, contract) cycle >>= fun ctxt ->\n  Storage.Contract.Frozen_rewards.remove (ctxt, contract) cycle >>= fun ctxt ->\n  return (ctxt, { deposit ; fees ; rewards })\n\n\nlet has_frozen_balance ctxt delegate cycle =\n  let contract = Contract_repr.implicit_contract delegate in\n  get_frozen_deposit ctxt contract cycle >>=? fun deposit ->\n  if Tez_repr.(deposit <> zero) then return_true\n  else\n    get_frozen_fees ctxt contract cycle >>=? fun fees ->\n    if Tez_repr.(fees <> zero) then return_true\n    else\n      get_frozen_rewards ctxt contract cycle >>=? fun rewards ->\n      return Tez_repr.(rewards <> zero)\n\nlet frozen_balance_by_cycle_encoding =\n  let open Data_encoding in\n  conv\n    (Cycle_repr.Map.bindings)\n    (List.fold_left\n       (fun m (c, b) -> Cycle_repr.Map.add c b m)\n       Cycle_repr.Map.empty)\n    (list (merge_objs\n             (obj1 (req \"cycle\" Cycle_repr.encoding))\n             frozen_balance_encoding))\n\nlet empty_frozen_balance =\n  { deposit = Tez_repr.zero ;\n    fees = Tez_repr.zero ;\n    rewards = Tez_repr.zero }\n\nlet frozen_balance_by_cycle ctxt delegate =\n  let contract = Contract_repr.implicit_contract delegate in\n  let map = Cycle_repr.Map.empty in\n  Storage.Contract.Frozen_deposits.fold\n    (ctxt, contract) ~init:map\n    ~f:(fun cycle amount map ->\n        Lwt.return\n          (Cycle_repr.Map.add cycle\n             { empty_frozen_balance with deposit = amount } map)) >>= fun map ->\n  Storage.Contract.Frozen_fees.fold\n    (ctxt, contract) ~init:map\n    ~f:(fun cycle amount map ->\n        let balance =\n          match Cycle_repr.Map.find_opt cycle map with\n          | None -> empty_frozen_balance\n          | Some balance -> balance in\n        Lwt.return\n          (Cycle_repr.Map.add cycle\n             { balance with fees = amount } map)) >>= fun map ->\n  Storage.Contract.Frozen_rewards.fold\n    (ctxt, contract) ~init:map\n    ~f:(fun cycle amount map ->\n        let balance =\n          match Cycle_repr.Map.find_opt cycle map with\n          | None -> empty_frozen_balance\n          | Some balance -> balance in\n        Lwt.return\n          (Cycle_repr.Map.add cycle\n             { balance with rewards = amount } map)) >>= fun map ->\n  Lwt.return map\n\nlet frozen_balance ctxt delegate =\n  let contract = Contract_repr.implicit_contract delegate in\n  let balance = Ok Tez_repr.zero in\n  Storage.Contract.Frozen_deposits.fold\n    (ctxt, contract) ~init:balance\n    ~f:(fun _cycle amount acc ->\n        Lwt.return acc >>=? fun acc ->\n        Lwt.return (Tez_repr.(acc +? amount))) >>= fun balance ->\n  Storage.Contract.Frozen_fees.fold\n    (ctxt, contract) ~init:balance\n    ~f:(fun _cycle amount acc ->\n        Lwt.return acc >>=? fun acc ->\n        Lwt.return (Tez_repr.(acc +? amount))) >>= fun balance ->\n  Storage.Contract.Frozen_rewards.fold\n    (ctxt, contract) ~init:balance\n    ~f:(fun _cycle amount acc ->\n        Lwt.return acc >>=? fun acc ->\n        Lwt.return (Tez_repr.(acc +? amount))) >>= fun balance ->\n  Lwt.return balance\n\nlet full_balance ctxt delegate =\n  let contract = Contract_repr.implicit_contract delegate in\n  frozen_balance ctxt delegate >>=? fun frozen_balance ->\n  Storage.Contract.Balance.get ctxt contract >>=? fun balance ->\n  Lwt.return Tez_repr.(frozen_balance +? balance)\n\nlet deactivated ctxt delegate =\n  let contract = Contract_repr.implicit_contract delegate in\n  Storage.Contract.Inactive_delegate.mem ctxt contract\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 staking_balance ctxt delegate =\n  let token_per_rolls = Constants_storage.tokens_per_roll ctxt in\n  Roll_storage.get_rolls ctxt delegate >>=? fun rolls ->\n  Roll_storage.get_change ctxt delegate >>=? fun change ->\n  let rolls = Int64.of_int (List.length rolls) in\n  Lwt.return Tez_repr.(token_per_rolls *? rolls) >>=? fun balance ->\n  Lwt.return Tez_repr.(balance +? change)\n\nlet delegated_balance ctxt delegate =\n  let contract = Contract_repr.implicit_contract delegate in\n  staking_balance ctxt delegate >>=? fun staking_balance ->\n  Storage.Contract.Balance.get ctxt contract >>= fun self_staking_balance ->\n  Storage.Contract.Frozen_deposits.fold\n    (ctxt, contract) ~init:self_staking_balance\n    ~f:(fun _cycle amount acc ->\n        Lwt.return acc >>=? fun acc ->\n        Lwt.return (Tez_repr.(acc +? amount))) >>= fun self_staking_balance ->\n  Storage.Contract.Frozen_fees.fold\n    (ctxt, contract) ~init:self_staking_balance\n    ~f:(fun _cycle amount acc ->\n        Lwt.return acc >>=? fun acc ->\n        Lwt.return (Tez_repr.(acc +? amount))) >>=? fun self_staking_balance ->\n  Lwt.return Tez_repr.(staking_balance -? self_staking_balance)\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  | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Temporary *)\n  | Counter_in_the_past of Contract_repr.contract * Z.t * Z.t (* `Branch *)\n  | Counter_in_the_future of Contract_repr.contract * Z.t * Z.t (* `Temporary *)\n  | Unspendable_contract of Contract_repr.contract (* `Permanent *)\n  | Non_existing_contract of Contract_repr.contract (* `Temporary *)\n  | Empty_implicit_contract of Signature.Public_key_hash.t (* `Temporary *)\n  | Empty_transaction of Contract_repr.t (* `Temporary *)\n  | Inconsistent_hash of Signature.Public_key.t * Signature.Public_key_hash.t * Signature.Public_key_hash.t (* `Permanent *)\n  | Inconsistent_public_key of Signature.Public_key.t * Signature.Public_key.t (* `Permanent *)\n  | Failure of string (* `Permanent *)\n  | Previously_revealed_key of Contract_repr.t (* `Permanent *)\n  | Unrevealed_manager_key of Contract_repr.t (* `Permanent *)\n\nval exists: Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t\nval must_exist: Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t\n\nval allocated: Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t\nval must_be_allocated: Raw_context.t -> Contract_repr.t -> unit tzresult Lwt.t\n\n\nval list: Raw_context.t -> Contract_repr.t list Lwt.t\n\nval check_counter_increment:\n  Raw_context.t -> Contract_repr.t -> Z.t -> unit tzresult Lwt.t\n\nval increment_counter:\n  Raw_context.t -> Contract_repr.t -> Raw_context.t tzresult Lwt.t\n\nval is_delegatable:\n  Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t\n\nval is_spendable: Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t\n\nval get_manager:\n  Raw_context.t -> Contract_repr.t -> Signature.Public_key_hash.t tzresult Lwt.t\n\nval get_manager_key:\n  Raw_context.t -> Contract_repr.t -> Signature.Public_key.t tzresult Lwt.t\nval is_manager_key_revealed:\n  Raw_context.t -> Contract_repr.t -> bool tzresult Lwt.t\n\nval reveal_manager_key:\n  Raw_context.t -> Contract_repr.t -> Signature.Public_key.t  ->\n  Raw_context.t tzresult Lwt.t\n\nval get_balance: Raw_context.t -> Contract_repr.t -> Tez_repr.t tzresult Lwt.t\nval get_counter: Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t\n\nval get_script:\n  Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.t option) tzresult Lwt.t\nval get_storage:\n  Raw_context.t -> Contract_repr.t -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.t\n\ntype big_map_diff = (Script_expr_hash.t * Script_repr.expr option) list\n\nval update_script_storage:\n  Raw_context.t -> Contract_repr.t ->\n  Script_repr.expr -> big_map_diff option ->\n  Raw_context.t tzresult Lwt.t\n\nval credit:\n  Raw_context.t -> Contract_repr.t -> Tez_repr.t ->\n  Raw_context.t tzresult Lwt.t\n\n(** checks that the contract is spendable and decrease_balance *)\nval spend:\n  Raw_context.t -> Contract_repr.t -> Tez_repr.t ->\n  Raw_context.t tzresult Lwt.t\n\n(** decrease_balance even if the contract is not spendable *)\nval spend_from_script:\n  Raw_context.t -> Contract_repr.t -> Tez_repr.t ->\n  Raw_context.t tzresult Lwt.t\n\nval originate:\n  Raw_context.t ->\n  ?prepaid_bootstrap_storage:bool ->\n  Contract_repr.t ->\n  balance:Tez_repr.t ->\n  manager:Signature.Public_key_hash.t ->\n  ?script:(Script_repr.t * big_map_diff option) ->\n  delegate:Signature.Public_key_hash.t option ->\n  spendable:bool ->\n  delegatable:bool ->\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 Lwt.t\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:\n  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\nval paid_storage_space: Raw_context.t -> Contract_repr.t -> Z.t tzresult Lwt.t\nval set_paid_storage_space_and_return_fees_to_pay: Raw_context.t -> Contract_repr.t -> Z.t -> (Z.t * Raw_context.t) tzresult Lwt.t\n\nmodule Big_map : sig\n  val mem :\n    Raw_context.t -> Contract_repr.t -> Script_expr_hash.t -> (Raw_context.t * bool) tzresult Lwt.t\n  val get_opt :\n    Raw_context.t -> Contract_repr.t -> Script_expr_hash.t -> (Raw_context.t * Script_repr.expr option) tzresult Lwt.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\ntype error +=\n  | Balance_too_low of Contract_repr.contract * Tez_repr.t * Tez_repr.t (* `Temporary *)\n  | Counter_in_the_past of Contract_repr.contract * Z.t * Z.t (* `Branch *)\n  | Counter_in_the_future of Contract_repr.contract * Z.t * Z.t (* `Temporary *)\n  | Unspendable_contract of Contract_repr.contract (* `Permanent *)\n  | Non_existing_contract of Contract_repr.contract (* `Temporary *)\n  | Empty_implicit_contract of Signature.Public_key_hash.t (* `Temporary *)\n  | Empty_transaction of Contract_repr.t (* `Temporary *)\n  | Inconsistent_hash of Signature.Public_key.t * Signature.Public_key_hash.t * Signature.Public_key_hash.t (* `Permanent *)\n  | Inconsistent_public_key of Signature.Public_key.t * Signature.Public_key.t (* `Permanent *)\n  | Failure of string (* `Permanent *)\n  | Previously_revealed_key of Contract_repr.t (* `Permanent *)\n  | Unrevealed_manager_key of Contract_repr.t (* `Permanent *)\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"contract.unspendable_contract\"\n    ~title:\"Unspendable contract\"\n    ~description:\"An operation tried to spend tokens from an unspendable contract\"\n    ~pp:(fun ppf c ->\n        Format.fprintf ppf \"The tokens of contract %a can only be spent by its script\"\n          Contract_repr.pp c)\n    Data_encoding.(obj1 (req \"contract\" Contract_repr.encoding))\n    (function Unspendable_contract c   -> Some c | _ -> None)\n    (fun c -> Unspendable_contract c) ;\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 ppf \"Balance of contract %a too low (%a) to spend %a\"\n          Contract_repr.pp c Tez_repr.pp b Tez_repr.pp a)\n    Data_encoding.(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 ppf\n          \"Counter %s not yet reached for contract %a (expected %s)\"\n          (Z.to_string found)\n          Contract_repr.pp contract\n          (Z.to_string 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 ppf\n          \"Counter %s already used for contract %a (expected %s)\"\n          (Z.to_string found)\n          Contract_repr.pp contract\n          (Z.to_string 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:\"A contract handle is not present in the context \\\n                  (either it never was or it has been destroyed)\"\n    ~pp:(fun ppf contract ->\n        Format.fprintf ppf \"Contract %a does not exist\"\n          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_hash\"\n    ~title:\"Inconsistent public key hash\"\n    ~description:\"A revealed manager public key is inconsistent with the announced hash\"\n    ~pp:(fun ppf (k, eh, ph) ->\n        Format.fprintf ppf \"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 ph\n          Signature.Public_key_hash.pp eh)\n    Data_encoding.(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 Inconsistent_hash (k, eh, ph) -> Some (k, eh, ph) | _ -> None)\n    (fun (k, eh, ph) -> Inconsistent_hash (k, eh, ph)) ;\n  register_error_kind\n    `Permanent\n    ~id:\"contract.manager.inconsistent_public_key\"\n    ~title:\"Inconsistent public key\"\n    ~description:\"A provided manager public key is different with the public key stored in the contract\"\n    ~pp:(fun ppf (eh, ph) ->\n        Format.fprintf ppf \"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.(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:\"contract.unrevealed_key\"\n    ~title:\"Manager operation precedes key revelation\"\n    ~description:\n      \"One tried to apply a manager operation \\\n       without revealing the manager public key\"\n    ~pp:(fun ppf s ->\n        Format.fprintf ppf \"Unrevealed manager key for contract %a.\"\n          Contract_repr.pp 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    `Branch\n    ~id:\"contract.previously_revealed_key\"\n    ~title:\"Manager operation already revealed\"\n    ~description:\n      \"One tried to revealed twice a manager public key\"\n    ~pp:(fun ppf s ->\n        Format.fprintf ppf \"Previously revealed manager key for contract %a.\"\n          Contract_repr.pp 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  register_error_kind\n    `Branch\n    ~id:\"implicit.empty_implicit_contract\"\n    ~title:\"Empty implicit contract\"\n    ~description:\"No manager operations are allowed on an empty implicit contract.\"\n    ~pp:(fun ppf implicit ->\n        Format.fprintf ppf\n          \"Empty implicit contract (%a)\"\n          Signature.Public_key_hash.pp 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:\"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 ppf\n          \"Transaction of 0\234\156\169 towards a contract without code are forbidden (%a).\"\n          Contract_repr.pp contract)\n    Data_encoding.(obj1 (req \"contract\" Contract_repr.encoding))\n    (function Empty_transaction c -> Some c | _ -> None)\n    (fun c -> Empty_transaction c)\n\nlet failwith msg = fail (Failure msg)\n\ntype big_map_diff = (Script_expr_hash.t * Script_repr.expr option) list\n\nlet update_script_big_map c contract = function\n  | None -> return (c, Z.zero)\n  | Some diff ->\n      fold_left_s (fun (c, total) (key, value) ->\n          match value with\n          | None ->\n              Storage.Contract.Big_map.remove (c, contract) key >>=? fun (c, freed) ->\n              return (c, Z.sub total (Z.of_int freed))\n          | Some v ->\n              Storage.Contract.Big_map.init_set (c, contract) key v >>=? fun (c, size_diff) ->\n              return (c, Z.add total (Z.of_int size_diff)))\n        (c, Z.zero) diff\n\nlet create_base c\n    ?(prepaid_bootstrap_storage=false) (* Free space for bootstrap contracts *)\n    contract\n    ~balance ~manager ~delegate ?script ~spendable ~delegatable =\n  (match Contract_repr.is_implicit contract with\n   | None -> return Z.zero\n   | Some _ -> Storage.Contract.Global_counter.get c) >>=? fun counter ->\n  Storage.Contract.Balance.init c contract balance >>=? fun c ->\n  Storage.Contract.Manager.init c contract (Manager_repr.Hash manager) >>=? fun c ->\n  begin\n    match delegate with\n    | None -> return c\n    | Some delegate ->\n        Delegate_storage.init c contract delegate\n  end >>=? fun c ->\n  Storage.Contract.Spendable.set c contract spendable >>= fun c ->\n  Storage.Contract.Delegatable.set c contract delegatable >>= fun c ->\n  Storage.Contract.Counter.init c contract counter >>=? fun c ->\n  (match script with\n   | Some ({ Script_repr.code ; storage }, big_map_diff) ->\n       Storage.Contract.Code.init c contract code >>=? fun (c, code_size) ->\n       Storage.Contract.Storage.init c contract storage >>=? fun (c, storage_size) ->\n       update_script_big_map c contract big_map_diff >>=? fun (c, big_map_size) ->\n       let total_size = Z.add (Z.add (Z.of_int code_size) (Z.of_int storage_size)) big_map_size in\n       assert Compare.Z.(total_size >= Z.zero) ;\n       let prepaid_bootstrap_storage =\n         if prepaid_bootstrap_storage then\n           total_size\n         else\n           Z.zero\n       in\n       Storage.Contract.Paid_storage_space.init c contract prepaid_bootstrap_storage >>=? fun c ->\n       Storage.Contract.Used_storage_space.init c contract total_size\n   | None -> begin\n       match Contract_repr.is_implicit contract with\n       | None ->\n           Storage.Contract.Paid_storage_space.init c contract Z.zero >>=? fun c ->\n           Storage.Contract.Used_storage_space.init c contract Z.zero\n       | Some _ ->\n           return c\n     end >>=? fun c ->\n       return c) >>=? fun c ->\n  return c\n\nlet originate c ?prepaid_bootstrap_storage contract\n    ~balance ~manager ?script ~delegate ~spendable ~delegatable =\n  create_base c ?prepaid_bootstrap_storage contract ~balance ~manager\n    ~delegate ?script ~spendable ~delegatable\n\nlet create_implicit c manager ~balance =\n  create_base c (Contract_repr.implicit_contract manager)\n    ~balance ~manager ?script:None ~delegate:None\n    ~spendable:true ~delegatable:false\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      Delegate_storage.remove c contract >>=? fun c ->\n      Storage.Contract.Balance.delete c contract >>=? fun c ->\n      Storage.Contract.Manager.delete c contract >>=? fun c ->\n      Storage.Contract.Spendable.del c contract >>= fun c ->\n      Storage.Contract.Delegatable.del c contract >>= fun c ->\n      Storage.Contract.Counter.delete 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 >>= fun c ->\n      return c\n\nlet allocated c contract =\n  Storage.Contract.Counter.get_option 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  Lwt.return (Raw_context.increment_origination_nonce c) >>=? fun (c, nonce) ->\n  return (c, Contract_repr.originated_contract nonce)\n\nlet originated_from_current_nonce ~since: ctxt_since ~until: ctxt_until =\n  Lwt.return (Raw_context.origination_nonce ctxt_since) >>=? fun since ->\n  Lwt.return (Raw_context.origination_nonce ctxt_until) >>=? fun until ->\n  filter_map_s\n    (fun contract -> exists ctxt_until contract >>=? function\n       | true -> return_some contract\n       | false -> return_none)\n    (Contract_repr.originated_contracts ~since ~until)\n\nlet check_counter_increment c contract counter =\n  Storage.Contract.Counter.get c contract >>=? fun contract_counter ->\n  let expected = Z.succ contract_counter in\n  if Compare.Z.(expected = counter)\n  then return_unit\n  else if Compare.Z.(expected > counter) then\n    fail (Counter_in_the_past (contract, expected, counter))\n  else\n    fail (Counter_in_the_future (contract, expected, counter))\n\nlet increment_counter c contract =\n  Storage.Contract.Global_counter.get c >>=? fun global_counter ->\n  Storage.Contract.Global_counter.set c (Z.succ global_counter) >>=? fun c ->\n  Storage.Contract.Counter.get c contract >>=? fun contract_counter ->\n  Storage.Contract.Counter.set c contract (Z.succ contract_counter)\n\nlet get_script c contract =\n  Storage.Contract.Code.get_option c contract >>=? fun (c, code) ->\n  Storage.Contract.Storage.get_option 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.get_option ctxt contract >>=? function\n  | (ctxt, None) -> return (ctxt, None)\n  | (ctxt, Some storage) ->\n      Lwt.return (Script_repr.force_decode storage) >>=? fun (storage, cost) ->\n      Lwt.return (Raw_context.consume_gas ctxt cost) >>=? fun ctxt ->\n      return (ctxt, Some storage)\n\nlet get_counter c contract =\n  Storage.Contract.Counter.get_option c contract >>=? function\n  | None -> begin\n      match Contract_repr.is_implicit contract with\n      | Some _ -> Storage.Contract.Global_counter.get c\n      | None -> failwith \"get_counter\"\n    end\n  | Some v -> return v\n\nlet get_manager c contract =\n  Storage.Contract.Manager.get_option c contract >>=? function\n  | None -> begin\n      match Contract_repr.is_implicit contract with\n      | Some manager -> return manager\n      | None -> failwith \"get_manager\"\n    end\n  | Some (Manager_repr.Hash v) -> return v\n  | Some (Manager_repr.Public_key v) -> return (Signature.Public_key.hash v)\n\nlet get_manager_key c contract =\n  Storage.Contract.Manager.get_option c contract >>=? function\n  | None -> failwith \"get_manager_key\"\n  | Some (Manager_repr.Hash _) -> fail (Unrevealed_manager_key contract)\n  | Some (Manager_repr.Public_key v) -> return v\n\nlet is_manager_key_revealed c contract =\n  Storage.Contract.Manager.get_option 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 contract public_key =\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.set c contract v >>=? fun c ->\n        return c\n      else fail (Inconsistent_hash (public_key,v,actual_hash))\n\nlet get_balance c contract =\n  Storage.Contract.Balance.get_option c contract >>=? function\n  | None -> begin\n      match Contract_repr.is_implicit contract with\n      | Some _ -> return Tez_repr.zero\n      | None -> failwith \"get_balance\"\n    end\n  | Some v -> return v\n\nlet is_delegatable = Delegate_storage.is_delegatable\nlet is_spendable c contract =\n  match Contract_repr.is_implicit contract with\n  | Some _ -> return_true\n  | None ->\n      Storage.Contract.Spendable.mem c contract >>= return\n\nlet update_script_storage c contract storage big_map_diff =\n  let storage = Script_repr.lazy_expr storage in\n  update_script_big_map c contract big_map_diff >>=? fun (c, big_map_size_diff) ->\n  Storage.Contract.Storage.set c contract storage >>=? fun (c, size_diff) ->\n  Storage.Contract.Used_storage_space.get c contract >>=? fun previous_size ->\n  let new_size = Z.add previous_size (Z.add big_map_size_diff (Z.of_int size_diff)) in\n  Storage.Contract.Used_storage_space.set c contract new_size\n\nlet spend_from_script c contract amount =\n  Storage.Contract.Balance.get c contract >>=? fun balance ->\n  match Tez_repr.(balance -? amount) with\n  | Error _ ->\n      fail (Balance_too_low (contract, balance, amount))\n  | Ok new_balance ->\n      Storage.Contract.Balance.set c contract new_balance >>=? fun c ->\n      Roll_storage.Contract.remove_amount c contract amount >>=? fun c ->\n      if Tez_repr.(new_balance > Tez_repr.zero) then\n        return c\n      else match Contract_repr.is_implicit contract with\n        | None -> return c (* Never delete originated contracts *)\n        | Some pkh ->\n            Delegate_storage.get c contract >>=? function\n            | Some pkh' ->\n                (* Don't delete \"delegate\" contract *)\n                assert (Signature.Public_key_hash.equal pkh pkh') ;\n                return c\n            | None ->\n                (* Delete empty implicit contract *)\n                delete c contract\n\nlet credit c contract amount =\n  begin\n    if Tez_repr.(amount <> Tez_repr.zero) then\n      return c\n    else\n      Storage.Contract.Code.mem c contract >>=? fun (c, target_has_code) ->\n      fail_unless target_has_code (Empty_transaction contract) >>=? fun () ->\n      return c\n  end >>=? fun c ->\n  Storage.Contract.Balance.get_option c contract >>=? function\n  | None -> begin\n      match Contract_repr.is_implicit contract with\n      | None -> fail (Non_existing_contract contract)\n      | Some manager ->\n          create_implicit c manager ~balance:amount\n    end\n  | Some balance ->\n      Lwt.return Tez_repr.(amount +? balance) >>=? fun balance ->\n      Storage.Contract.Balance.set c contract balance >>=? fun c ->\n      Roll_storage.Contract.add_amount c contract amount >>=? fun c ->\n      begin\n        match contract with\n        | Implicit delegate ->\n            Delegate_storage.registered c delegate >>= fun registered ->\n            if registered then\n              Roll_storage.Delegate.set_active c delegate >>=? fun c ->\n              return c\n            else\n              return c\n        | Originated _ ->\n            return c\n      end >>=? fun c ->\n      return c\n\nlet spend c contract amount =\n  is_spendable c contract >>=? fun spendable ->\n  if not spendable\n  then fail (Unspendable_contract contract)\n  else spend_from_script c contract amount\n\nlet init c =\n  Storage.Contract.Global_counter.init c Z.zero\n\nlet used_storage_space c contract =\n  Storage.Contract.Used_storage_space.get_option c contract >>=? function\n  | None -> return Z.zero\n  | Some fees -> return fees\n\nlet paid_storage_space c contract =\n  Storage.Contract.Paid_storage_space.get_option c contract >>=? function\n  | None -> return Z.zero\n  | Some paid_space -> return paid_space\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 >>=? fun already_paid_space ->\n  if Compare.Z.(already_paid_space >= new_storage_space) then\n    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.set c contract new_storage_space >>=? fun c ->\n    return (to_pay, c)\n\nmodule Big_map = struct\n  let mem ctxt contract key =\n    Storage.Contract.Big_map.mem (ctxt, contract) key\n  let get_opt ctxt contract key =\n    Storage.Contract.Big_map.get_option (ctxt, contract) key\nend\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:(Raw_context.t -> Script_repr.t -> Raw_context.t tzresult Lwt.t) ->\n  ?ramp_up_cycles:int ->\n  ?no_reward_cycles:int ->\n  Parameters_repr.bootstrap_account list ->\n  Parameters_repr.bootstrap_contract list ->\n  Raw_context.t tzresult Lwt.t\n\nval cycle_end:\n  Raw_context.t ->\n  Cycle_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\nopen Misc\n\nlet init_account ctxt\n    ({ public_key_hash ; public_key ; amount }: Parameters_repr.bootstrap_account) =\n  let contract = Contract_repr.implicit_contract public_key_hash in\n  Contract_storage.credit ctxt contract amount >>=? fun ctxt ->\n  match public_key with\n  | Some public_key ->\n      Contract_storage.reveal_manager_key ctxt contract public_key >>=? fun ctxt ->\n      Delegate_storage.set ctxt contract (Some public_key_hash) >>=? fun ctxt ->\n      return ctxt\n  | None -> return ctxt\n\nlet init_contract ~typecheck ctxt\n    ({ delegate ; amount ; script }: Parameters_repr.bootstrap_contract) =\n  Contract_storage.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) ->\n  typecheck ctxt script >>=? fun ctxt ->\n  Contract_storage.originate ctxt contract\n    ~balance:amount\n    ~prepaid_bootstrap_storage:true\n    ~manager:Signature.Public_key_hash.zero\n    ~script:(script, None)\n    ~delegate:(Some delegate)\n    ~spendable:false\n    ~delegatable:false >>=? fun ctxt ->\n  return ctxt\n\nlet init ctxt ~typecheck ?ramp_up_cycles ?no_reward_cycles accounts contracts =\n  let nonce =\n    Operation_hash.hash_bytes\n      [ MBytes.of_string \"Un festival de GADT.\" ] in\n  let ctxt = Raw_context.init_origination_nonce ctxt nonce in\n  fold_left_s init_account ctxt accounts >>=? fun ctxt ->\n  fold_left_s (init_contract ~typecheck) ctxt contracts >>=? fun ctxt ->\n  begin\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 reward *)\n        Raw_context.patch_constants ctxt\n          (fun c ->\n             { c with\n               block_reward = Tez_repr.zero ;\n               endorsement_reward = Tez_repr.zero  }) >>= fun ctxt ->\n        (* Store the final reward. *)\n        Storage.Ramp_up.Rewards.init ctxt\n          (Cycle_repr.of_int32_exn (Int32.of_int cycles))\n          (constants.block_reward,\n           constants.endorsement_reward)\n  end >>=? fun ctxt ->\n  match ramp_up_cycles with\n  | None -> return ctxt\n  | Some cycles ->\n      (* Store pending ramp ups. *)\n      let constants = Raw_context.constants ctxt in\n      Lwt.return Tez_repr.(constants.block_security_deposit /? Int64.of_int cycles) >>=? fun block_step ->\n      Lwt.return Tez_repr.(constants.endorsement_security_deposit /? Int64.of_int cycles) >>=? fun endorsement_step ->\n      (* Start without security_deposit *)\n      Raw_context.patch_constants ctxt\n        (fun c ->\n           { c with\n             block_security_deposit = Tez_repr.zero ;\n             endorsement_security_deposit = Tez_repr.zero  }) >>= fun ctxt ->\n      fold_left_s\n        (fun ctxt cycle ->\n           Lwt.return Tez_repr.(block_step *? Int64.of_int cycle) >>=? fun block_security_deposit ->\n           Lwt.return Tez_repr.(endorsement_step *? Int64.of_int cycle) >>=? fun endorsement_security_deposit ->\n           let cycle = Cycle_repr.of_int32_exn (Int32.of_int cycle) in\n           Storage.Ramp_up.Security_deposits.init ctxt cycle\n             (block_security_deposit, endorsement_security_deposit))\n        ctxt\n        (1 --> (cycles - 1)) >>=? fun ctxt ->\n      (* Store the final security deposits. *)\n      Storage.Ramp_up.Security_deposits.init ctxt\n        (Cycle_repr.of_int32_exn (Int32.of_int cycles))\n        (constants.block_security_deposit,\n         constants.endorsement_security_deposit) >>=? fun ctxt ->\n      return ctxt\n\nlet cycle_end ctxt last_cycle =\n  let next_cycle = Cycle_repr.succ last_cycle in\n  begin\n    Storage.Ramp_up.Rewards.get_option ctxt next_cycle >>=? function\n    | None -> return ctxt\n    | Some (block_reward, endorsement_reward) ->\n        Storage.Ramp_up.Rewards.delete ctxt next_cycle >>=? fun ctxt ->\n        Raw_context.patch_constants ctxt\n          (fun c ->\n             { c with block_reward ;\n                      endorsement_reward }) >>= fun ctxt ->\n        return ctxt\n  end >>=? fun ctxt ->\n  Storage.Ramp_up.Security_deposits.get_option ctxt next_cycle >>=? function\n  | None -> return ctxt\n  | Some (block_security_deposit, endorsement_security_deposit) ->\n      Storage.Ramp_up.Security_deposits.delete ctxt next_cycle >>=? fun ctxt ->\n      Raw_context.patch_constants ctxt\n        (fun c ->\n           { c with block_security_deposit ;\n                    endorsement_security_deposit }) >>= fun ctxt ->\n      return ctxt\n" ;
                } ;
                { name = "Fitness_storage" ;
                  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\nlet current = Raw_context.current_fitness\nlet increase ?(gap = 1) ctxt =\n  let fitness = current ctxt in\n  Raw_context.set_current_fitness ctxt (Int64.add (Int64.of_int gap) fitness)\n" ;
                } ;
                { name = "Vote_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 record_proposal:\n  Raw_context.t -> Protocol_hash.t -> Signature.Public_key_hash.t ->\n  Raw_context.t Lwt.t\n\nval get_proposals:\n  Raw_context.t -> int32 Protocol_hash.Map.t Lwt.t\n\nval clear_proposals: Raw_context.t -> Raw_context.t Lwt.t\n\ntype ballots = {\n  yay: int32 ;\n  nay: int32 ;\n  pass: int32 ;\n}\n\nval record_ballot:\n  Raw_context.t -> Signature.Public_key_hash.t -> Vote_repr.ballot ->\n  Raw_context.t Lwt.t\nval get_ballots: Raw_context.t -> ballots tzresult Lwt.t\nval clear_ballots: Raw_context.t -> Raw_context.t Lwt.t\n\nval freeze_listings: Raw_context.t -> Raw_context.t tzresult Lwt.t\nval clear_listings: Raw_context.t -> Raw_context.t tzresult Lwt.t\n\nval listing_size: Raw_context.t -> int32 tzresult Lwt.t\nval in_listings:\n  Raw_context.t -> Signature.Public_key_hash.t -> bool Lwt.t\n\nval get_current_quorum: Raw_context.t -> int32 tzresult Lwt.t\nval set_current_quorum: Raw_context.t -> int32 -> Raw_context.t tzresult Lwt.t\n\nval get_current_period_kind:\n  Raw_context.t -> Voting_period_repr.kind tzresult Lwt.t\nval set_current_period_kind:\n  Raw_context.t -> Voting_period_repr.kind -> Raw_context.t tzresult Lwt.t\n\nval get_current_proposal:\n  Raw_context.t -> Protocol_hash.t tzresult Lwt.t\nval init_current_proposal:\n  Raw_context.t -> Protocol_hash.t -> Raw_context.t tzresult Lwt.t\nval clear_current_proposal: Raw_context.t -> Raw_context.t tzresult Lwt.t\n\nval init: Raw_context.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 record_proposal ctxt delegate proposal =\n  Storage.Vote.Proposals.add ctxt (delegate, proposal)\n\nlet get_proposals ctxt =\n  Storage.Vote.Proposals.fold ctxt\n    ~init:Protocol_hash.Map.empty\n    ~f:(fun (proposal, _delegate) acc ->\n        let previous =\n          match Protocol_hash.Map.find_opt proposal acc with\n          | None -> 0l\n          | Some x -> x in\n        Lwt.return (Protocol_hash.Map.add proposal (Int32.succ previous) acc))\n\nlet clear_proposals ctxt =\n  Storage.Vote.Proposals.clear ctxt\n\ntype ballots = {\n  yay: int32 ;\n  nay: int32 ;\n  pass: int32 ;\n}\n\nlet record_ballot = Storage.Vote.Ballots.init_set\n\nlet get_ballots ctxt =\n  Storage.Vote.Ballots.fold ctxt\n    ~f:(fun delegate ballot (ballots: ballots tzresult) ->\n        Storage.Vote.Listings.get ctxt delegate >>=? fun weight ->\n        let count = Int32.add weight in\n        Lwt.return begin\n          ballots >>? fun ballots ->\n          match ballot with\n          | Yay  -> ok { ballots with yay = count ballots.yay }\n          | Nay  -> ok { ballots with nay = count ballots.nay }\n          | Pass  -> ok { ballots with pass = count ballots.pass }\n        end)\n    ~init:(ok { yay = 0l ; nay = 0l; pass = 0l })\n\nlet clear_ballots = Storage.Vote.Ballots.clear\n\nlet freeze_listings ctxt =\n  Roll_storage.fold ctxt (ctxt, 0l)\n    ~f:(fun _roll delegate (ctxt, total) ->\n        (* TODO use snapshots *)\n        let delegate = Signature.Public_key.hash delegate in\n        begin\n          Storage.Vote.Listings.get_option ctxt delegate >>=? function\n          | None -> return 0l\n          | Some count -> return count\n        end >>=? fun count ->\n        Storage.Vote.Listings.init_set\n          ctxt delegate (Int32.succ count) >>= fun ctxt ->\n        return (ctxt, Int32.succ total)) >>=? fun (ctxt, total) ->\n  Storage.Vote.Listings_size.init ctxt total >>=? fun ctxt ->\n  return ctxt\n\nlet listing_size = Storage.Vote.Listings_size.get\nlet in_listings = Storage.Vote.Listings.mem\n\nlet clear_listings ctxt =\n  Storage.Vote.Listings.clear ctxt >>= fun ctxt ->\n  Storage.Vote.Listings_size.remove ctxt >>= fun ctxt ->\n  return ctxt\n\nlet get_current_period_kind = Storage.Vote.Current_period_kind.get\nlet set_current_period_kind = Storage.Vote.Current_period_kind.set\n\nlet get_current_quorum = Storage.Vote.Current_quorum.get\nlet set_current_quorum = Storage.Vote.Current_quorum.set\n\nlet get_current_proposal = Storage.Vote.Current_proposal.get\nlet init_current_proposal = Storage.Vote.Current_proposal.init\nlet clear_current_proposal = Storage.Vote.Current_proposal.delete\n\nlet init ctxt =\n  Storage.Vote.Current_quorum.init ctxt 80_00l >>=? fun ctxt ->\n  Storage.Vote.Current_period_kind.init ctxt Proposal >>=? fun ctxt ->\n  return ctxt\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\nval init:\n  Raw_context.t ->\n  Commitment_repr.t list ->\n  Raw_context.t tzresult Lwt.t\n\nval get_opt:\n  Raw_context.t -> Blinded_public_key_hash.t ->\n  Tez_repr.t option tzresult Lwt.t\n\nval delete:\n  Raw_context.t -> Blinded_public_key_hash.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 get_opt = Storage.Commitments.get_option\nlet delete = Storage.Commitments.delete\n\nlet init ctxt commitments  =\n  let init_commitment ctxt Commitment_repr.{ blinded_public_key_hash ; amount } =\n    Storage.Commitments.init ctxt blinded_public_key_hash amount in\n  fold_left_s init_commitment ctxt commitments >>=? fun ctxt ->\n  return ctxt\n" ;
                } ;
                { name = "Init_storage" ;
                  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\n(* This is the genesis protocol: initialise the state *)\nlet prepare_first_block ctxt ~typecheck ~level ~timestamp ~fitness =\n  Raw_context.prepare_first_block\n    ~level ~timestamp ~fitness ctxt >>=? fun (param, ctxt) ->\n  Commitment_storage.init ctxt param.commitments >>=? fun ctxt ->\n  Roll_storage.init ctxt >>=? fun ctxt ->\n  Seed_storage.init ctxt >>=? fun ctxt ->\n  Contract_storage.init ctxt >>=? fun ctxt ->\n  Bootstrap_storage.init ctxt\n    ~typecheck\n    ?ramp_up_cycles:param.security_deposit_ramp_up_cycles\n    ?no_reward_cycles:param.no_reward_cycles\n    param.bootstrap_accounts\n    param.bootstrap_contracts >>=? fun ctxt ->\n  Roll_storage.init_first_cycles ctxt >>=? fun ctxt ->\n  Vote_storage.init ctxt >>=? fun ctxt ->\n  Storage.Last_block_priority.init ctxt 0 >>=? fun ctxt ->\n  return ctxt\n\nlet prepare ctxt ~level ~timestamp ~fitness =\n  Raw_context.prepare ~level ~timestamp ~fitness ctxt\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 *)\ntype error += Operation_quota_exceeded (* `Temporary *)\ntype error += Storage_limit_too_high (* `Permanent *)\n\nval origination_burn:\n  Raw_context.t -> payer:Contract_repr.t -> (Raw_context.t * Tez_repr.t) tzresult Lwt.t\n\n(** The returned Tez quantity is for logging purpose only *)\nval record_paid_storage_space:\n  Raw_context.t -> Contract_repr.t ->\n  (Raw_context.t * Z.t * Z.t * Tez_repr.t) tzresult Lwt.t\n\nval check_storage_limit:\n  Raw_context.t -> storage_limit:Z.t -> unit tzresult\n\nval start_counting_storage_fees :\n  Raw_context.t -> Raw_context.t\n\nval burn_storage_fees:\n  Raw_context.t -> storage_limit:Z.t -> payer:Contract_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\ntype error += Cannot_pay_storage_fee (* `Temporary *)\ntype error += Operation_quota_exceeded (* `Temporary *)\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 \\\n       bytes than the operation said 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:\n      \"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 origination_burn c ~payer =\n  let origination_burn = Constants_storage.origination_burn c in\n  Contract_storage.spend_from_script c payer origination_burn >>=? fun c ->\n  return (c, origination_burn)\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 >>=? fun (to_be_paid, c) ->\n  let c = Raw_context.update_storage_space_to_pay c to_be_paid in\n  let cost_per_byte = Constants_storage.cost_per_byte c in\n  Lwt.return (Tez_repr.(cost_per_byte *? (Z.to_int64 to_be_paid))) >>=? fun to_burn ->\n  return (c, size, to_be_paid, to_burn)\n\nlet burn_storage_fees c ~storage_limit ~payer =\n  let c, storage_space_to_pay = Raw_context.clear_storage_space_to_pay c in\n  let remaining = Z.sub storage_limit storage_space_to_pay in\n  if Compare.Z.(remaining < Z.zero) then\n    fail Operation_quota_exceeded\n  else\n    let cost_per_byte = Constants_storage.cost_per_byte c in\n    Lwt.return (Tez_repr.(cost_per_byte *? (Z.to_int64 storage_space_to_pay))) >>=? fun to_burn ->\n    (* Burning the fees... *)\n    if Tez_repr.(to_burn = Tez_repr.zero) then\n      (* If the payer was was deleted by transfering all its balance, and no space was used,\n         burning zero would fail *)\n      return c\n    else\n      trace Cannot_pay_storage_fee\n        (Contract_storage.must_exist c payer >>=? fun () ->\n         Contract_storage.spend_from_script c payer to_burn) >>=? fun c ->\n      return c\n\nlet check_storage_limit c ~storage_limit =\n  if Compare.Z.(storage_limit > (Raw_context.constants c).hard_storage_limit_per_operation)\n  || Compare.Z.(storage_limit < Z.zero)then\n    error Storage_limit_too_high\n  else\n    ok ()\n\nlet start_counting_storage_fees c =\n  Raw_context.init_storage_space_to_pay c\n" ;
                } ;
                { name = "Alpha_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\nmodule type BASIC_DATA = sig\n  type t\n  include Compare.S with type t := t\n  val encoding: t Data_encoding.t\n  val pp: Format.formatter -> t -> unit\nend\n\ntype t\ntype context = t\n\ntype public_key = Signature.Public_key.t\ntype public_key_hash = Signature.Public_key_hash.t\ntype signature = Signature.t\n\nmodule Tez : sig\n\n  include BASIC_DATA\n  type tez = t\n\n  val zero: tez\n  val one_mutez: tez\n  val one_cent: tez\n  val fifty_cents: tez\n  val one: tez\n\n  val ( -? ) : tez -> tez -> tez tzresult\n  val ( +? ) : tez -> tez -> tez tzresult\n  val ( *? ) : tez -> int64 -> tez tzresult\n  val ( /? ) : tez -> int64 -> tez tzresult\n\n  val of_string: string -> tez option\n  val to_string: tez -> string\n\n  val of_mutez: int64 -> tez option\n  val to_mutez: tez -> int64\n\nend\n\nmodule Period : sig\n\n  include BASIC_DATA\n  type period = t\n\n  val of_seconds: int64 -> period tzresult\n  val mult: int32 -> period -> period tzresult\n\n  val one_second: period\n  val one_minute: period\n  val one_hour: period\n\nend\n\nmodule Timestamp : sig\n\n  include BASIC_DATA with type t = Time.t\n  type time = t\n  val (+?) : time -> Period.t -> time tzresult\n\n  val of_notation: string -> time option\n  val to_notation: time -> string\n\n  val of_seconds: string -> time option\n  val to_seconds_string: time -> string\n\n  val current: context -> time\n\nend\n\nmodule Raw_level : sig\n\n  include BASIC_DATA\n  type raw_level = t\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  val succ: raw_level -> raw_level\n  val pred: raw_level -> raw_level option\n  val to_int32: raw_level -> int32\n  val of_int32: int32 -> raw_level tzresult\n\nend\n\nmodule Cycle : sig\n\n  include BASIC_DATA\n  type cycle = t\n  val rpc_arg: cycle RPC_arg.arg\n\n  val root: cycle\n  val succ: cycle -> cycle\n  val pred: cycle -> cycle option\n  val add: cycle -> int -> cycle\n  val sub: cycle -> int -> cycle option\n  val to_int32: cycle -> int32\n\n  module Map : S.MAP with type key = cycle\n\nend\n\nmodule Gas : sig\n  type t = private\n    | Unaccounted\n    | Limited of { remaining : Z.t }\n\n  val encoding : t Data_encoding.encoding\n  val pp : Format.formatter -> t -> unit\n\n  type cost\n\n  val cost_encoding : cost Data_encoding.encoding\n  val pp_cost : Format.formatter -> cost -> unit\n\n  type error += Block_quota_exceeded (* `Temporary *)\n  type error += Operation_quota_exceeded (* `Temporary *)\n  type error += Gas_limit_too_high (* `Permanent *)\n\n  val free : cost\n  val step_cost : int -> cost\n  val alloc_cost : int -> cost\n  val alloc_bytes_cost : int -> cost\n  val alloc_mbytes_cost : int -> cost\n  val alloc_bits_cost : int -> cost\n  val read_bytes_cost : Z.t -> cost\n  val write_bytes_cost : Z.t -> cost\n\n  val ( *@ ) : int -> cost -> cost\n  val ( +@ ) : cost -> cost -> cost\n\n  val check_limit: context -> Z.t -> unit tzresult\n  val set_limit: context -> Z.t -> context\n  val set_unlimited: context -> context\n  val consume: context -> cost -> context tzresult\n  val check_enough: context -> cost -> unit tzresult\n  val level: context -> t\n  val consumed: since: context -> until: context -> Z.t\n  val block_level: context -> Z.t\nend\n\nmodule Script_int : module type of Script_int_repr\n\nmodule Script_timestamp : sig\n  open Script_int\n  type t\n  val compare: t -> t -> int\n  val to_string: t -> string\n  val to_notation: t -> string option\n  val to_num_str: t -> string\n  val of_string: string -> t option\n  val diff: t -> t -> z num\n  val add_delta: t -> z num -> t\n  val sub_delta: t -> z num -> t\n  val now: context -> t\n  val to_zint: t -> Z.t\n  val of_zint: Z.t -> t\nend\n\nmodule Script : sig\n\n  type prim = Michelson_v1_primitives.prim =\n    | K_parameter\n    | K_storage\n    | K_code\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_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_EDIV\n    | I_EMPTY_MAP\n    | I_EMPTY_SET\n    | I_EQ\n    | I_EXEC\n    | I_FAILWITH\n    | I_GE\n    | I_GET\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_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_PUSH\n    | I_RIGHT\n    | I_SIZE\n    | I_SOME\n    | I_SOURCE\n    | I_SENDER\n    | I_SELF\n    | I_STEPS_TO_QUOTA\n    | I_SUB\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    | 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\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 node = (location, prim) Micheline.node\n\n  type t =\n    { code: lazy_expr ;\n      storage: lazy_expr }\n\n  val location_encoding: location Data_encoding.t\n  val expr_encoding: expr Data_encoding.t\n  val prim_encoding: prim Data_encoding.t\n  val encoding: t Data_encoding.t\n  val lazy_expr_encoding: lazy_expr Data_encoding.t\n  val deserialized_cost : expr -> Gas.cost\n  val serialized_cost : MBytes.t -> Gas.cost\n  val traversal_cost : node -> Gas.cost\n  val node_cost : node -> Gas.cost\n  val int_node_cost : Z.t -> Gas.cost\n  val int_node_cost_of_numbits : int -> Gas.cost\n  val string_node_cost : string -> Gas.cost\n  val string_node_cost_of_length : int -> Gas.cost\n  val bytes_node_cost : MBytes.t -> Gas.cost\n  val bytes_node_cost_of_length : int -> Gas.cost\n  val prim_node_cost_nonrec : expr list -> annot  -> Gas.cost\n  val prim_node_cost_nonrec_of_length : int -> annot -> Gas.cost\n  val seq_node_cost_nonrec : expr list -> Gas.cost\n  val seq_node_cost_nonrec_of_length : int -> Gas.cost\n  val minimal_deserialize_cost : lazy_expr -> Gas.cost\n  val force_decode : context -> lazy_expr -> (expr * context) tzresult Lwt.t\n  val force_bytes : context -> lazy_expr -> (MBytes.t * context) tzresult Lwt.t\nend\n\nmodule Constants : sig\n\n  (** Fixed constants *)\n  type fixed = {\n    proof_of_work_nonce_size : int ;\n    nonce_length : int ;\n    max_revelations_per_block : int ;\n    max_operation_data_length : int ;\n  }\n  val fixed_encoding: fixed Data_encoding.t\n  val fixed: fixed\n\n  val proof_of_work_nonce_size: int\n  val nonce_length: int\n  val max_revelations_per_block: int\n  val max_operation_data_length: int\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_roll_snapshot: int32 ;\n    blocks_per_voting_period: int32 ;\n    time_between_blocks: Period.t list ;\n    endorsers_per_block: int ;\n    hard_gas_limit_per_operation: Z.t ;\n    hard_gas_limit_per_block: Z.t ;\n    proof_of_work_threshold: int64 ;\n    tokens_per_roll: Tez.t ;\n    michelson_maximum_type_size: int;\n    seed_nonce_revelation_tip: Tez.t ;\n    origination_burn: Tez.t ;\n    block_security_deposit: Tez.t ;\n    endorsement_security_deposit: Tez.t ;\n    block_reward: Tez.t ;\n    endorsement_reward: Tez.t ;\n    cost_per_byte: Tez.t ;\n    hard_storage_limit_per_operation: Z.t ;\n  }\n  val parametric_encoding: parametric Data_encoding.t\n  val parametric: context -> parametric\n  val preserved_cycles: context -> int\n  val blocks_per_cycle: context -> int32\n  val blocks_per_commitment: context -> int32\n  val blocks_per_roll_snapshot: context -> int32\n  val blocks_per_voting_period: context -> int32\n  val time_between_blocks: context -> Period.t list\n  val endorsers_per_block: context -> int\n  val hard_gas_limit_per_operation: context -> Z.t\n  val hard_gas_limit_per_block: context -> Z.t\n  val cost_per_byte: context -> Tez.t\n  val hard_storage_limit_per_operation: context -> Z.t\n  val proof_of_work_threshold: context -> int64\n  val tokens_per_roll: context -> Tez.t\n  val michelson_maximum_type_size: context -> int\n  val block_reward: context -> Tez.t\n  val endorsement_reward: context -> Tez.t\n  val seed_nonce_revelation_tip: context -> Tez.t\n  val origination_burn: context -> Tez.t\n  val block_security_deposit: context -> Tez.t\n  val endorsement_security_deposit: context -> Tez.t\n\n  (** All constants: fixed and parametric *)\n  type t = {\n    fixed : fixed ;\n    parametric : parametric ;\n  }\n  val encoding: t Data_encoding.t\n\nend\n\nmodule Voting_period : sig\n\n  include BASIC_DATA\n  type voting_period = t\n  val rpc_arg: voting_period RPC_arg.arg\n\n  val root: voting_period\n  val succ: voting_period -> voting_period\n\n  type kind =\n    | Proposal\n    | Testing_vote\n    | Testing\n    | Promotion_vote\n  val kind_encoding: kind Data_encoding.encoding\n  val to_int32: voting_period -> int32\n\nend\n\nmodule Level : sig\n\n  type t = private {\n    level: Raw_level.t ;\n    level_position: int32 ;\n    cycle: Cycle.t ;\n    cycle_position: int32 ;\n    voting_period: Voting_period.t ;\n    voting_period_position: int32 ;\n    expected_commitment: bool ;\n  }\n  include BASIC_DATA with type t := t\n  val pp_full: Format.formatter -> t -> unit\n  type level = t\n\n  val root: context -> level\n\n  val succ: context -> level -> level\n  val pred: context -> level -> level option\n\n  val from_raw: context -> ?offset:int32 -> Raw_level.t -> level\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  val levels_in_cycle: context -> Cycle.t -> level list\n  val levels_in_current_cycle: context -> ?offset:int32 -> unit -> level list\n\n  val last_allowed_fork_level: context -> Raw_level.t\n\nend\n\nmodule Fitness : sig\n\n  include (module type of Fitness)\n  type fitness = t\n\n  val increase: ?gap:int -> context -> context\n\n  val current: context -> int64\n\n  val to_int64: fitness -> int64 tzresult\n\nend\n\nmodule Nonce : sig\n\n  type t\n  type nonce = t\n  val encoding: nonce Data_encoding.t\n\n  type unrevealed = {\n    nonce_hash: Nonce_hash.t ;\n    delegate: public_key_hash ;\n    rewards: Tez.t ;\n    fees: Tez.t ;\n  }\n\n  val record_hash:\n    context -> unrevealed -> context tzresult Lwt.t\n\n  val reveal:\n    context -> Level.t -> nonce ->\n    context tzresult Lwt.t\n\n  type status =\n    | Unrevealed of unrevealed\n    | Revealed of nonce\n\n  val get: context -> Level.t -> status tzresult Lwt.t\n\n  val of_bytes: MBytes.t -> nonce tzresult\n  val hash: nonce -> Nonce_hash.t\n  val check_hash: nonce -> Nonce_hash.t -> bool\n\nend\n\nmodule Seed : sig\n\n  type seed\n\n  type error +=\n    | Unknown of { oldest : Cycle.t ;\n                   cycle : Cycle.t ;\n                   latest : Cycle.t }\n\n  val for_cycle:\n    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\n\nend\n\nmodule Contract : sig\n\n  include BASIC_DATA\n  type contract = t\n  val rpc_arg: contract RPC_arg.arg\n\n  val to_b58check: contract -> string\n  val of_b58check: string -> contract tzresult\n\n  val implicit_contract: public_key_hash -> contract\n  val is_implicit: contract -> public_key_hash option\n\n  val exists: context -> contract -> bool tzresult Lwt.t\n  val must_exist: context -> contract -> unit tzresult Lwt.t\n\n  val allocated: context -> contract -> bool tzresult Lwt.t\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:\n    context -> contract -> public_key_hash tzresult Lwt.t\n\n  val get_manager_key:\n    context -> contract -> public_key tzresult Lwt.t\n  val is_manager_key_revealed:\n    context -> contract -> bool tzresult Lwt.t\n\n  val reveal_manager_key:\n    context -> contract -> public_key -> context tzresult Lwt.t\n\n  val is_delegatable:\n    context -> contract -> bool tzresult Lwt.t\n  val is_spendable:\n    context -> contract -> bool tzresult Lwt.t\n  val get_script:\n    context -> contract -> (context * Script.t option) tzresult Lwt.t\n  val get_storage:\n    context -> contract -> (context * Script.expr option) tzresult Lwt.t\n\n  val get_counter: context -> contract -> Z.t tzresult Lwt.t\n  val get_balance:\n    context -> contract -> Tez.t tzresult Lwt.t\n\n  val init_origination_nonce: context -> Operation_hash.t -> context\n  val unset_origination_nonce: context -> context\n  val fresh_contract_from_current_nonce : context -> (context * t) tzresult Lwt.t\n  val originated_from_current_nonce: since: context -> until:context -> contract list tzresult Lwt.t\n\n  type big_map_diff = (Script_expr_hash.t * Script.expr option) list\n\n  val originate:\n    context -> contract ->\n    balance: Tez.t ->\n    manager: public_key_hash ->\n    ?script: (Script.t * big_map_diff option) ->\n    delegate: public_key_hash option ->\n    spendable: bool ->\n    delegatable: bool -> context tzresult Lwt.t\n\n  type error += Balance_too_low of contract * Tez.t * Tez.t\n\n  val spend:\n    context -> contract -> Tez.t -> context tzresult Lwt.t\n  val spend_from_script:\n    context -> contract -> Tez.t -> context tzresult Lwt.t\n\n  val credit:\n    context -> contract -> Tez.t -> context tzresult Lwt.t\n\n  val update_script_storage:\n    context -> contract ->\n    Script.expr -> big_map_diff option ->\n    context tzresult Lwt.t\n\n  val used_storage_space: context -> t -> Z.t tzresult Lwt.t\n\n  val increment_counter:\n    context -> contract -> context tzresult Lwt.t\n\n  val check_counter_increment:\n    context -> contract -> Z.t -> unit tzresult Lwt.t\n\n  module Big_map : sig\n    val mem:\n      context -> contract -> Script_expr_hash.t -> (context * bool) tzresult Lwt.t\n    val get_opt:\n      context -> contract -> Script_expr_hash.t -> (context * Script_repr.expr option) tzresult Lwt.t\n  end\n\n  (**/**)\n  (* Only for testing *)\n  type origination_nonce\n  val initial_origination_nonce  : Operation_hash.t -> origination_nonce\n  val originated_contract : origination_nonce -> contract\n\nend\n\nmodule Delegate : sig\n\n  type balance =\n    | Contract of Contract.t\n    | Rewards of Signature.Public_key_hash.t * Cycle.t\n    | Fees of Signature.Public_key_hash.t * Cycle.t\n    | Deposits of Signature.Public_key_hash.t * Cycle.t\n\n  type balance_update =\n    | Debited of Tez.t\n    | Credited of Tez.t\n\n  type balance_updates = (balance * balance_update) list\n\n  val balance_updates_encoding : balance_updates Data_encoding.t\n\n  val cleanup_balance_updates : balance_updates -> balance_updates\n\n  val get: 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 set_from_script:\n    context -> Contract.t -> public_key_hash option -> context tzresult Lwt.t\n\n  val fold:\n    context ->\n    init:'a -> f:(public_key_hash -> 'a -> 'a Lwt.t) -> 'a Lwt.t\n\n  val list: context -> public_key_hash list Lwt.t\n\n  val freeze_deposit:\n    context -> public_key_hash -> Tez.t -> context tzresult Lwt.t\n\n  val freeze_rewards:\n    context -> public_key_hash -> Tez.t -> context tzresult Lwt.t\n\n  val freeze_fees:\n    context -> public_key_hash -> Tez.t -> context tzresult Lwt.t\n\n  val cycle_end:\n    context -> Cycle.t -> Nonce.unrevealed list ->\n    (context * balance_updates * Signature.Public_key_hash.t list) tzresult Lwt.t\n\n  type frozen_balance = {\n    deposit : Tez.t ;\n    fees : Tez.t ;\n    rewards : Tez.t ;\n  }\n\n  val punish:\n    context -> public_key_hash -> Cycle.t ->\n    (context * frozen_balance) tzresult Lwt.t\n\n  val full_balance:\n    context -> public_key_hash -> Tez.t tzresult Lwt.t\n\n  val has_frozen_balance:\n    context -> public_key_hash -> Cycle.t ->\n    bool tzresult Lwt.t\n\n  val frozen_balance:\n    context -> public_key_hash -> Tez.t tzresult Lwt.t\n\n  val frozen_balance_encoding: frozen_balance Data_encoding.t\n  val frozen_balance_by_cycle_encoding: frozen_balance Cycle.Map.t Data_encoding.t\n\n  val frozen_balance_by_cycle:\n    context -> Signature.Public_key_hash.t ->\n    frozen_balance Cycle.Map.t Lwt.t\n\n  val staking_balance:\n    context -> Signature.Public_key_hash.t ->\n    Tez.t tzresult Lwt.t\n\n  val delegated_contracts:\n    context -> Signature.Public_key_hash.t ->\n    Contract_hash.t list Lwt.t\n\n  val delegated_balance:\n    context -> Signature.Public_key_hash.t ->\n    Tez.t tzresult Lwt.t\n\n  val deactivated:\n    context -> Signature.Public_key_hash.t ->\n    bool Lwt.t\n\n  val grace_period:\n    context -> Signature.Public_key_hash.t ->\n    Cycle.t tzresult Lwt.t\n\nend\n\nmodule Vote : sig\n\n  type proposal = Protocol_hash.t\n\n  val record_proposal:\n    context -> Protocol_hash.t -> public_key_hash ->\n    context Lwt.t\n  val get_proposals:\n    context -> int32 Protocol_hash.Map.t Lwt.t\n  val clear_proposals: context -> context Lwt.t\n\n  val freeze_listings: context -> context tzresult Lwt.t\n  val clear_listings: context -> context tzresult Lwt.t\n  val listing_size: context -> int32 tzresult Lwt.t\n  val in_listings: context -> public_key_hash -> bool Lwt.t\n\n  type ballot = Yay | Nay | Pass\n\n  type ballots = {\n    yay: int32 ;\n    nay: int32 ;\n    pass: int32 ;\n  }\n\n  val record_ballot:\n    context -> public_key_hash -> ballot -> context Lwt.t\n  val get_ballots: context -> ballots tzresult Lwt.t\n  val clear_ballots: context -> context Lwt.t\n\n  val get_current_period_kind:\n    context -> Voting_period.kind tzresult Lwt.t\n  val set_current_period_kind:\n    context -> Voting_period.kind -> context tzresult Lwt.t\n\n  val get_current_quorum: context -> int32 tzresult Lwt.t\n  val set_current_quorum: context -> int32 -> context tzresult Lwt.t\n\n  val get_current_proposal:\n    context -> proposal tzresult Lwt.t\n  val init_current_proposal:\n    context -> proposal -> context tzresult Lwt.t\n  val clear_current_proposal:\n    context -> context tzresult Lwt.t\n\nend\n\nmodule Block_header : sig\n\n  type t = {\n    shell: Block_header.shell_header ;\n    protocol_data: protocol_data ;\n  }\n\n  and protocol_data = {\n    contents: contents ;\n    signature: Signature.t ;\n  }\n\n  and contents = {\n    priority: int ;\n    seed_nonce_hash: Nonce_hash.t option ;\n    proof_of_work_nonce: MBytes.t ;\n  }\n\n  type block_header = t\n\n  type raw = Block_header.t\n  type shell_header = Block_header.shell_header\n\n  val raw: block_header -> raw\n\n  val hash: block_header -> Block_hash.t\n  val hash_raw: raw -> Block_hash.t\n\n  val encoding: block_header Data_encoding.encoding\n  val raw_encoding: raw Data_encoding.t\n  val contents_encoding: contents Data_encoding.t\n  val unsigned_encoding: (shell_header * contents) Data_encoding.t\n  val protocol_data_encoding: protocol_data Data_encoding.encoding\n  val shell_header_encoding: shell_header Data_encoding.encoding\n\n  val max_header_length: int\n  (** The maximum size of block headers in bytes *)\n\nend\n\nmodule Kind : sig\n  type seed_nonce_revelation = Seed_nonce_revelation_kind\n  type double_endorsement_evidence = Double_endorsement_evidence_kind\n  type double_baking_evidence = Double_baking_evidence_kind\n  type activate_account = Activate_account_kind\n  type endorsement = Endorsement_kind\n  type proposals = Proposals_kind\n  type ballot = Ballot_kind\n  type reveal = Reveal_kind\n  type transaction = Transaction_kind\n  type origination = Origination_kind\n  type delegation = Delegation_kind\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\nend\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 : 'kind Kind.manager contents * 'rest Kind.manager contents_list ->\n    (('kind * 'rest) Kind.manager ) contents_list\n\nand _ contents =\n  | Endorsement : {\n      level: Raw_level.t ;\n    } -> Kind.endorsement contents\n  | Seed_nonce_revelation : {\n      level: Raw_level.t ;\n      nonce: Nonce.t ;\n    } -> Kind.seed_nonce_revelation contents\n  | Double_endorsement_evidence : {\n      op1: Kind.endorsement operation ;\n      op2: Kind.endorsement operation ;\n    } -> Kind.double_endorsement_evidence contents\n  | Double_baking_evidence : {\n      bh1: Block_header.t ;\n      bh2: Block_header.t ;\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    } -> Kind.activate_account contents\n  | Proposals : {\n      source: Signature.Public_key_hash.t ;\n      period: Voting_period.t ;\n      proposals: Protocol_hash.t list ;\n    } -> Kind.proposals contents\n  | Ballot : {\n      source: Signature.Public_key_hash.t ;\n      period: Voting_period.t ;\n      proposal: Protocol_hash.t ;\n      ballot: Vote.ballot ;\n    } -> Kind.ballot contents\n  | Manager_operation : {\n      source: Contract.contract ;\n      fee: Tez.tez ;\n      counter: counter ;\n      operation: 'kind manager_operation ;\n      gas_limit: Z.t;\n      storage_limit: Z.t;\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 option ;\n      destination: Contract.contract ;\n    } -> Kind.transaction manager_operation\n  | Origination : {\n      manager: Signature.Public_key_hash.t ;\n      delegate: Signature.Public_key_hash.t option ;\n      script: Script.t option ;\n      spendable: bool ;\n      delegatable: bool ;\n      credit: Tez.tez ;\n      preorigination: Contract.t option ;\n    } -> Kind.origination manager_operation\n  | Delegation :\n      Signature.Public_key_hash.t option -> Kind.delegation 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 =\n  | 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 Fees : sig\n\n  val origination_burn:\n    context -> payer:Contract.t -> (context * Tez.t) tzresult Lwt.t\n\n  val record_paid_storage_space:\n    context -> Contract.t -> (context * Z.t * Z.t * Tez.t) tzresult Lwt.t\n\n  val start_counting_storage_fees :\n    context -> context\n\n  val burn_storage_fees:\n    context -> storage_limit:Z.t -> payer:Contract.t -> context tzresult Lwt.t\n\n  type error += Cannot_pay_storage_fee (* `Temporary *)\n  type error += Operation_quota_exceeded (* `Temporary *)\n  type error += Storage_limit_too_high (* `Permanent *)\n\n  val check_storage_limit: context -> storage_limit:Z.t -> unit tzresult\n\nend\n\nmodule Operation : sig\n\n  type nonrec 'kind contents = 'kind contents\n  type nonrec packed_contents = packed_contents\n  val contents_encoding: packed_contents Data_encoding.t\n\n  type nonrec 'kind protocol_data = 'kind protocol_data\n  type nonrec packed_protocol_data = packed_protocol_data\n  val protocol_data_encoding: packed_protocol_data Data_encoding.t\n  val unsigned_encoding: (Operation.shell_header * packed_contents_list) Data_encoding.t\n\n  type raw = Operation.t = {\n    shell: Operation.shell_header ;\n    proto: MBytes.t ;\n  }\n  val raw_encoding: raw Data_encoding.t\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  type nonrec packed = packed_operation\n  val encoding: packed Data_encoding.t\n\n  val raw: _ operation -> raw\n\n  val hash: _ operation -> Operation_hash.t\n  val hash_raw: raw -> Operation_hash.t\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  type error += Invalid_signature (* `Permanent *)\n\n  val check_signature: public_key -> Chain_id.t -> _ operation -> unit tzresult Lwt.t\n  val check_signature_sync: public_key -> Chain_id.t -> _ operation -> unit tzresult\n\n  val internal_operation_encoding: packed_internal_operation Data_encoding.t\n\n  val pack: 'kind operation -> packed_operation\n\n  type ('a, 'b) eq = Eq : ('a, 'a) eq\n  val equal: 'a operation -> 'b operation -> ('a, 'b) eq option\n\n  module Encoding : sig\n\n    type 'b case =\n        Case : { 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 } -> 'b case\n\n    val endorsement_case: Kind.endorsement case\n    val seed_nonce_revelation_case: Kind.seed_nonce_revelation case\n    val double_endorsement_evidence_case: Kind.double_endorsement_evidence case\n    val double_baking_evidence_case: Kind.double_baking_evidence case\n    val activate_account_case: Kind.activate_account case\n    val proposals_case: Kind.proposals case\n    val ballot_case: Kind.ballot case\n    val reveal_case: Kind.reveal Kind.manager case\n    val transaction_case: Kind.transaction Kind.manager case\n    val origination_case: Kind.origination Kind.manager case\n    val delegation_case: Kind.delegation Kind.manager case\n\n    module Manager_operations : sig\n\n      type 'b case =\n          MCase : { 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 } -> 'kind case\n\n      val reveal_case: Kind.reveal case\n      val transaction_case: Kind.transaction case\n      val origination_case: Kind.origination case\n      val delegation_case: Kind.delegation case\n\n    end\n\n  end\n\n  val of_list: packed_contents list -> packed_contents_list\n  val to_list: packed_contents_list -> packed_contents list\n\nend\n\nmodule Roll : sig\n\n  type t = private int32\n  type roll = t\n\n  val encoding: roll Data_encoding.t\n\n  val snapshot_rolls: context -> context tzresult Lwt.t\n  val cycle_end: context -> Cycle.t -> context tzresult Lwt.t\n\n  val baking_rights_owner:\n    context -> Level.t -> priority:int -> public_key tzresult Lwt.t\n\n  val endorsement_rights_owner:\n    context -> Level.t -> slot:int -> public_key tzresult Lwt.t\n\n  val delegate_pubkey:\n    context -> public_key_hash -> public_key tzresult Lwt.t\n\n  val get_rolls:\n    context -> Signature.Public_key_hash.t -> roll list tzresult Lwt.t\n  val get_change:\n    context -> Signature.Public_key_hash.t -> Tez.t tzresult Lwt.t\n\nend\n\nmodule Commitment : sig\n\n  type t =\n    { blinded_public_key_hash : Blinded_public_key_hash.t ;\n      amount : Tez.tez }\n\n  val get_opt:\n    context -> Blinded_public_key_hash.t -> Tez.t option tzresult Lwt.t\n  val delete:\n    context ->  Blinded_public_key_hash.t -> context tzresult Lwt.t\n\nend\n\nmodule Bootstrap : sig\n\n  val cycle_end:\n    context -> Cycle.t -> context tzresult Lwt.t\n\nend\n\nmodule Global : sig\n\n  val get_last_block_priority: context -> int tzresult Lwt.t\n  val set_last_block_priority: context -> int -> context tzresult Lwt.t\n\nend\n\nval prepare_first_block:\n  Context.t ->\n  typecheck:(context -> Script.t -> context tzresult Lwt.t) ->\n  level:Int32.t ->\n  timestamp:Time.t ->\n  fitness:Fitness.t ->\n  context tzresult Lwt.t\n\nval prepare:\n  Context.t ->\n  level:Int32.t ->\n  timestamp:Time.t ->\n  fitness:Fitness.t ->\n  context tzresult Lwt.t\n\nval finalize: ?commit_message:string -> context -> Updater.validation_result\n\nval activate: context -> Protocol_hash.t -> context Lwt.t\nval fork_test_chain: context -> Protocol_hash.t -> Time.t -> context Lwt.t\n\nval record_endorsement:\n  context -> Signature.Public_key_hash.t -> context\nval allowed_endorsements:\n  context ->\n  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t\nval init_endorsements:\n  context ->\n  (Signature.Public_key.t * int list * bool) Signature.Public_key_hash.Map.t ->\n  context\n\nval reset_internal_nonce: context -> context\nval fresh_internal_nonce: context -> (context * int) tzresult\nval record_internal_nonce: context -> int -> context\nval internal_nonce_already_recorded: context -> int -> bool\n\nval add_fees: context -> Tez.t -> context tzresult Lwt.t\nval add_rewards: context -> Tez.t -> context tzresult Lwt.t\nval add_deposit:\n  context -> Signature.Public_key_hash.t -> Tez.t -> context tzresult Lwt.t\n\nval get_fees: context -> Tez.t\nval get_rewards: context -> Tez.t\nval get_deposits: context -> Tez.t Signature.Public_key_hash.Map.t\n\nval description: context Storage_description.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 = Raw_context.t\ntype context = t\n\nmodule type BASIC_DATA = sig\n  type t\n  include Compare.S with type t := t\n  val encoding: t Data_encoding.t\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  let current = Raw_context.current_timestamp\nend\n\ninclude Operation_repr\nmodule Operation = struct\n  type 'kind t = 'kind operation = {\n    shell: Operation.shell_header ;\n    protocol_data: 'kind protocol_data ;\n  }\n  type packed = packed_operation\n  let unsigned_encoding = unsigned_operation_encoding\n  include Operation_repr\nend\nmodule Block_header = Block_header_repr\nmodule Vote = struct\n  include Vote_repr\n  include Vote_storage\nend\nmodule Raw_level = Raw_level_repr\nmodule Cycle = Cycle_repr\nmodule Script_int = Script_int_repr\nmodule Script_timestamp = struct\n  include Script_timestamp_repr\n  let now ctxt =\n    Raw_context.current_timestamp ctxt\n    |> Timestamp.to_seconds\n    |> of_int64\nend\nmodule Script = struct\n  include Michelson_v1_primitives\n  include Script_repr\n  let force_decode ctxt lexpr =\n    Lwt.return\n      (Script_repr.force_decode lexpr >>? fun (v, cost) ->\n       Raw_context.consume_gas ctxt cost >|? fun ctxt ->\n       (v, ctxt))\n  let force_bytes ctxt lexpr =\n    Lwt.return\n      (Script_repr.force_bytes lexpr >>? fun (b, cost) ->\n       Raw_context.consume_gas ctxt cost >|? fun ctxt ->\n       (b, ctxt))\nend\nmodule Fees = Fees_storage\n\ntype public_key = Signature.Public_key.t\ntype public_key_hash = Signature.Public_key_hash.t\ntype signature  = Signature.t\n\nmodule Constants = struct\n  include Constants_repr\n  include Constants_storage\nend\n\nmodule Voting_period = Voting_period_repr\n\nmodule Gas = struct\n  include Gas_limit_repr\n  type error += Gas_limit_too_high = Raw_context.Gas_limit_too_high\n  let check_limit = Raw_context.check_gas_limit\n  let set_limit = Raw_context.set_gas_limit\n  let set_unlimited = Raw_context.set_gas_unlimited\n  let consume = Raw_context.consume_gas\n  let check_enough = Raw_context.check_enough_gas\n  let level = Raw_context.gas_level\n  let consumed = Raw_context.gas_consumed\n  let block_level = Raw_context.block_gas_level\nend\nmodule Level = struct\n  include Level_repr\n  include Level_storage\nend\nmodule Contract = struct\n  include Contract_repr\n  include Contract_storage\n\n  let originate c contract ~balance ~manager ?script ~delegate\n      ~spendable ~delegatable =\n    originate c contract ~balance ~manager ?script ~delegate\n      ~spendable ~delegatable\n  let init_origination_nonce = Raw_context.init_origination_nonce\n  let unset_origination_nonce = Raw_context.unset_origination_nonce\nend\nmodule Delegate = Delegate_storage\nmodule Roll = struct\n  include Roll_repr\n  include Roll_storage\nend\nmodule Nonce = Nonce_storage\nmodule Seed = struct\n  include Seed_repr\n  include Seed_storage\nend\n\nmodule Fitness = struct\n\n  include Fitness_repr\n  include Fitness\n  type fitness = t\n  include Fitness_storage\n\nend\n\nmodule Bootstrap = Bootstrap_storage\n\nmodule Commitment = struct\n  include Commitment_repr\n  include Commitment_storage\nend\n\nmodule Global = struct\n  let get_last_block_priority = Storage.Last_block_priority.get\n  let set_last_block_priority = Storage.Last_block_priority.set\nend\n\nlet prepare_first_block = Init_storage.prepare_first_block\nlet prepare = Init_storage.prepare\n\nlet finalize ?commit_message:message c =\n  let fitness = Fitness.from_int64 (Fitness.current c) in\n  let context = Raw_context.recover c in\n  { Updater.context ; fitness ; message ; max_operations_ttl = 60 ;\n    last_allowed_fork_level =\n      Raw_level.to_int32 @@ Level.last_allowed_fork_level c;\n  }\n\nlet activate = Raw_context.activate\nlet fork_test_chain = Raw_context.fork_test_chain\n\nlet record_endorsement = Raw_context.record_endorsement\nlet allowed_endorsements = Raw_context.allowed_endorsements\nlet init_endorsements = Raw_context.init_endorsements\n\nlet reset_internal_nonce = Raw_context.reset_internal_nonce\nlet fresh_internal_nonce = Raw_context.fresh_internal_nonce\nlet record_internal_nonce = Raw_context.record_internal_nonce\nlet internal_nonce_already_recorded = Raw_context.internal_nonce_already_recorded\n\nlet add_deposit = Raw_context.add_deposit\nlet add_fees = Raw_context.add_fees\nlet add_rewards = Raw_context.add_rewards\n\nlet get_deposits = Raw_context.get_deposits\nlet get_fees = Raw_context.get_fees\nlet get_rewards = Raw_context.get_rewards\n\nlet description = Raw_context.description\n" ;
                } ;
                { name = "Script_typed_ir" ;
                  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_int\n\n(* ---- Auxiliary types -----------------------------------------------------*)\n\ntype var_annot = [ `Var_annot of string ]\ntype type_annot = [ `Type_annot of string ]\ntype field_annot = [ `Field_annot of string ]\n\ntype annot = [ var_annot | type_annot | field_annot ]\n\ntype 'ty comparable_ty =\n  | Int_key : type_annot option -> (z num) comparable_ty\n  | Nat_key : type_annot option -> (n num) comparable_ty\n  | String_key : type_annot option -> string comparable_ty\n  | Bytes_key : type_annot option -> MBytes.t comparable_ty\n  | Mutez_key : type_annot option -> Tez.t comparable_ty\n  | Bool_key : type_annot option -> bool comparable_ty\n  | Key_hash_key : type_annot option -> public_key_hash comparable_ty\n  | Timestamp_key : type_annot option -> Script_timestamp.t comparable_ty\n  | Address_key : type_annot option -> Contract.t comparable_ty\n\n\nmodule type Boxed_set = sig\n  type elt\n  module OPS : S.SET with type elt = elt\n  val boxed : OPS.t\n  val size : int\nend\n\ntype 'elt set = (module Boxed_set with type elt = 'elt)\n\nmodule type Boxed_map = sig\n  type key\n  type value\n  val key_ty : key comparable_ty\n  module OPS : S.MAP with type key = key\n  val boxed : value OPS.t * int\nend\n\ntype ('key, 'value) map = (module Boxed_map with type key = 'key and type value = 'value)\n\ntype ('arg, 'storage) script =\n  { code : (('arg, 'storage) pair, (packed_internal_operation list, 'storage) pair) lambda ;\n    arg_type : 'arg ty ;\n    storage : 'storage ;\n    storage_type : 'storage ty }\n\nand ('a, 'b) pair = 'a * 'b\n\nand ('a, 'b) union = L of 'a | R of 'b\n\nand end_of_stack = unit\n\nand ('arg, 'ret) lambda =\n    Lam of ('arg * end_of_stack, 'ret * end_of_stack) descr * Script.expr\n\nand 'arg typed_contract =\n  'arg ty * Contract.t\n\nand 'ty ty =\n  | Unit_t : type_annot option -> unit ty\n  | Int_t : type_annot option -> z num ty\n  | Nat_t : type_annot option -> n num ty\n  | Signature_t : type_annot option -> signature ty\n  | String_t : type_annot option -> string ty\n  | Bytes_t : type_annot option -> MBytes.t ty\n  | Mutez_t : type_annot option -> Tez.t ty\n  | Key_hash_t : type_annot option -> public_key_hash ty\n  | Key_t : type_annot option -> public_key ty\n  | Timestamp_t : type_annot option -> Script_timestamp.t ty\n  | Address_t : type_annot option -> Contract.t ty\n  | Bool_t : type_annot option -> bool ty\n  | Pair_t :\n      ('a ty * field_annot option * var_annot option) *\n      ('b ty * field_annot option * var_annot option) *\n      type_annot option -> ('a, 'b) pair ty\n  | Union_t : ('a ty * field_annot option) * ('b ty * field_annot option) * type_annot option  -> ('a, 'b) union ty\n  | Lambda_t : 'arg ty * 'ret ty * type_annot option  -> ('arg, 'ret) lambda ty\n  | Option_t : ('v ty * field_annot option) * field_annot option * type_annot option  -> 'v option ty\n  | List_t : 'v ty * type_annot option -> 'v list ty\n  | Set_t : 'v comparable_ty * type_annot option -> 'v set ty\n  | Map_t : 'k comparable_ty * 'v ty * type_annot option -> ('k, 'v) map ty\n  | Big_map_t : 'k comparable_ty * 'v ty * type_annot option -> ('k, 'v) big_map ty\n  | Contract_t : 'arg ty * type_annot option -> 'arg typed_contract ty\n  | Operation_t : type_annot option -> packed_internal_operation ty\n\nand 'ty stack_ty =\n  | Item_t : 'ty ty * 'rest stack_ty * var_annot option -> ('ty * 'rest) stack_ty\n  | Empty_t : end_of_stack stack_ty\n\nand ('key, 'value) big_map = { diff : ('key, 'value option) map ;\n                               key_type : 'key ty ;\n                               value_type : 'value ty }\n\n(* ---- Instructions --------------------------------------------------------*)\n\n(* The low-level, typed instructions, as a GADT whose parameters\n   encode the typing rules. The left parameter is the typed shape of\n   the stack before the instruction, the right one the shape\n   after. Any program whose construction is accepted by OCaml's\n   type-checker is guaranteed to be type-safe.  Overloadings of the\n   concrete syntax are already resolved in this representation, either\n   by using different constructors or type witness parameters. *)\nand ('bef, 'aft) instr =\n  (* stack ops *)\n  | Drop :\n      (_ * 'rest, 'rest) instr\n  | Dup :\n      ('top * 'rest, 'top * ('top * 'rest)) instr\n  | Swap :\n      ('tip * ('top * 'rest), 'top * ('tip * 'rest)) instr\n  | Const : 'ty ->\n    ('rest, ('ty * 'rest)) instr\n  (* pairs *)\n  | Cons_pair :\n      (('car * ('cdr * 'rest)), (('car, 'cdr) pair * 'rest)) instr\n  | Car :\n      (('car, _) pair * 'rest, 'car * 'rest) instr\n  | Cdr :\n      ((_, 'cdr) pair * 'rest, 'cdr * 'rest) instr\n  (* options *)\n  | Cons_some :\n      ('v * 'rest, 'v option * 'rest) instr\n  | Cons_none : 'a ty ->\n    ('rest, 'a option * 'rest) instr\n  | If_none : ('bef, 'aft) descr * ('a * 'bef, 'aft) descr ->\n    ('a option * 'bef, 'aft) instr\n  (* unions *)\n  | Left :\n      ('l * 'rest, (('l, 'r) union * 'rest)) instr\n  | Right :\n      ('r * 'rest, (('l, 'r) union * 'rest)) instr\n  | If_left : ('l * 'bef, 'aft) descr * ('r * 'bef, 'aft) descr ->\n    (('l, 'r) union * 'bef, 'aft) instr\n  (* lists *)\n  | Cons_list :\n      ('a * ('a list * 'rest), ('a list * 'rest)) instr\n  | Nil :\n      ('rest, ('a list * 'rest)) instr\n  | If_cons : ('a * ('a list * 'bef), 'aft) descr * ('bef, 'aft) descr ->\n    ('a list * 'bef, 'aft) instr\n  | List_map : ('a * 'rest, 'b * 'rest) descr ->\n    ('a list * 'rest, 'b list * 'rest) instr\n  | List_iter : ('a * 'rest, 'rest) descr ->\n    ('a list * 'rest, 'rest) instr\n  | List_size : ('a list * 'rest, n num * 'rest) instr\n  (* sets *)\n  | Empty_set : 'a comparable_ty ->\n    ('rest, 'a set * 'rest) instr\n  | Set_iter : ('a * 'rest, 'rest) descr ->\n    ('a set * 'rest, 'rest) instr\n  | Set_mem :\n      ('elt * ('elt set * 'rest), bool * 'rest) instr\n  | Set_update :\n      ('elt * (bool * ('elt set * 'rest)), 'elt set * 'rest) instr\n  | Set_size : ('a set * 'rest, n num * 'rest) instr\n  (* maps *)\n  | Empty_map : 'a comparable_ty * 'v ty ->\n    ('rest, ('a, 'v) map * 'rest) instr\n  | Map_map : (('a * 'v) * 'rest, 'r * 'rest) descr ->\n    (('a, 'v) map * 'rest, ('a, 'r) map * 'rest) instr\n  | Map_iter : (('a * 'v) * 'rest, 'rest) descr ->\n    (('a, 'v) map * 'rest, 'rest) instr\n  | Map_mem :\n      ('a * (('a, 'v) map * 'rest), bool * 'rest) instr\n  | Map_get :\n      ('a * (('a, 'v) map * 'rest), 'v option * 'rest) instr\n  | Map_update :\n      ('a * ('v option * (('a, 'v) map * 'rest)), ('a, 'v) map * 'rest) instr\n  | Map_size : (('a, 'b) map * 'rest, n num * 'rest) instr\n  (* big maps *)\n  | Big_map_mem :\n      ('a * (('a, 'v) big_map * 'rest), bool * 'rest) instr\n  | Big_map_get :\n      ('a * (('a, 'v) big_map * 'rest), 'v option * 'rest) instr\n  | Big_map_update :\n      ('key * ('value option * (('key, 'value) big_map * 'rest)), ('key, 'value) big_map * 'rest) instr\n  (* string operations *)\n  | Concat :\n      (string * (string * 'rest), string * 'rest) instr\n  (* timestamp operations *)\n  | Add_seconds_to_timestamp :\n      (z num * (Script_timestamp.t * 'rest),\n       Script_timestamp.t * 'rest) instr\n  | Add_timestamp_to_seconds :\n      (Script_timestamp.t * (z num * 'rest),\n       Script_timestamp.t * 'rest) instr\n  | Sub_timestamp_seconds :\n      (Script_timestamp.t * (z num * 'rest),\n       Script_timestamp.t * 'rest) instr\n  | Diff_timestamps :\n      (Script_timestamp.t * (Script_timestamp.t * 'rest),\n       z num * 'rest) instr\n  (* currency operations *)\n  (* TODO: we can either just have conversions to/from integers and\n     do all operations on integers, or we need more operations on\n     Tez. Also Sub_tez should return Tez.t option (if negative) and *)\n  | Add_tez :\n      (Tez.t * (Tez.t * 'rest), Tez.t * 'rest) instr\n  | Sub_tez :\n      (Tez.t * (Tez.t * 'rest), Tez.t * 'rest) instr\n  | Mul_teznat :\n      (Tez.t * (n num * 'rest), Tez.t * 'rest) instr\n  | Mul_nattez :\n      (n num * (Tez.t * 'rest), Tez.t * 'rest) instr\n  | Ediv_teznat :\n      (Tez.t * (n num * 'rest), ((Tez.t, Tez.t) pair) option * 'rest) instr\n  | Ediv_tez :\n      (Tez.t * (Tez.t * 'rest), ((n num, Tez.t) pair) option * 'rest) instr\n  (* boolean operations *)\n  | Or :\n      (bool * (bool * 'rest), bool * 'rest) instr\n  | And :\n      (bool * (bool * 'rest), bool * 'rest) instr\n  | Xor :\n      (bool * (bool * 'rest), bool * 'rest) instr\n  | Not :\n      (bool * 'rest, bool * 'rest) instr\n  (* integer operations *)\n  | Is_nat :\n      (z num * 'rest, n num option * 'rest) instr\n  | Neg_nat :\n      (n num * 'rest, z num * 'rest) instr\n  | Neg_int :\n      (z num * 'rest, z num * 'rest) instr\n  | Abs_int :\n      (z num * 'rest, n num * 'rest) instr\n  | Int_nat :\n      (n num * 'rest, z num * 'rest) instr\n  | Add_intint :\n      (z num * (z num * 'rest), z num * 'rest) instr\n  | Add_intnat :\n      (z num * (n num * 'rest), z num * 'rest) instr\n  | Add_natint :\n      (n num * (z num * 'rest), z num * 'rest) instr\n  | Add_natnat :\n      (n num * (n num * 'rest), n num * 'rest) instr\n  | Sub_int :\n      ('s num * ('t num * 'rest), z num * 'rest) instr\n  | Mul_intint :\n      (z num * (z num * 'rest), z num * 'rest) instr\n  | Mul_intnat :\n      (z num * (n num * 'rest), z num * 'rest) instr\n  | Mul_natint :\n      (n num * (z num * 'rest), z num * 'rest) instr\n  | Mul_natnat :\n      (n num * (n num * 'rest), n num * 'rest) instr\n  | Ediv_intint :\n      (z num * (z num * 'rest), ((z num, n num) pair) option * 'rest) instr\n  | Ediv_intnat :\n      (z num * (n num * 'rest), ((z num, n num) pair) option * 'rest) instr\n  | Ediv_natint :\n      (n num * (z num * 'rest), ((z num, n num) pair) option * 'rest) instr\n  | Ediv_natnat :\n      (n num * (n num * 'rest), ((n num, n num) pair) option * 'rest) instr\n  | Lsl_nat :\n      (n num * (n num * 'rest), n num * 'rest) instr\n  | Lsr_nat :\n      (n num * (n num * 'rest), n num * 'rest) instr\n  | Or_nat :\n      (n num * (n num * 'rest), n num * 'rest) instr\n  | And_nat :\n      (n num * (n num * 'rest), n num * 'rest) instr\n  | And_int_nat :\n      (z num * (n num * 'rest), n num * 'rest) instr\n  | Xor_nat :\n      (n num * (n num * 'rest), n num * 'rest) instr\n  | Not_nat :\n      (n num * 'rest, z num * 'rest) instr\n  | Not_int :\n      (z num * 'rest, z num * 'rest) instr\n  (* control *)\n  | Seq : ('bef, 'trans) descr * ('trans, 'aft) descr ->\n    ('bef, 'aft) instr\n  | If : ('bef, 'aft) descr * ('bef, 'aft) descr ->\n    (bool * 'bef, 'aft) instr\n  | Loop : ('rest, bool * 'rest) descr ->\n    (bool * 'rest, 'rest) instr\n  | Loop_left : ('a * 'rest, ('a, 'b) union * 'rest) descr ->\n    (('a, 'b) union * 'rest, 'b * 'rest) instr\n  | Dip : ('bef, 'aft) descr ->\n    ('top * 'bef, 'top * 'aft) instr\n  | Exec :\n      ('arg * (('arg, 'ret) lambda * 'rest), 'ret * 'rest) instr\n  | Lambda : ('arg, 'ret) lambda ->\n    ('rest, ('arg, 'ret) lambda * 'rest) instr\n  | Failwith :\n      'a ty -> ('a * 'rest, 'aft) instr\n  | Nop :\n      ('rest, 'rest) instr\n  (* comparison *)\n  | Compare : 'a comparable_ty ->\n    ('a * ('a * 'rest), z num * 'rest) instr\n  (* comparators *)\n  | Eq :\n      (z num * 'rest, bool * 'rest) instr\n  | Neq :\n      (z num * 'rest, bool * 'rest) instr\n  | Lt :\n      (z num * 'rest, bool * 'rest) instr\n  | Gt :\n      (z num * 'rest, bool * 'rest) instr\n  | Le :\n      (z num * 'rest, bool * 'rest) instr\n  | Ge :\n      (z num * 'rest, bool * 'rest) instr\n\n  (* protocol *)\n  | Address :\n      (_ typed_contract * 'rest, Contract.t * 'rest) instr\n  | Contract : 'p ty ->\n    (Contract.t * 'rest, 'p typed_contract option * 'rest) instr\n  | Transfer_tokens :\n      ('arg * (Tez.t * ('arg typed_contract * 'rest)), packed_internal_operation * 'rest) instr\n  | Create_account :\n      (public_key_hash * (public_key_hash option * (bool * (Tez.t * 'rest))),\n       packed_internal_operation * (Contract.t * 'rest)) instr\n  | Implicit_account :\n      (public_key_hash * 'rest, unit typed_contract * 'rest) instr\n  | Create_contract : 'g ty * 'p ty * ('p * 'g, packed_internal_operation list * 'g) lambda  ->\n    (public_key_hash * (public_key_hash option * (bool * (bool * (Tez.t * ('g * 'rest))))),\n     packed_internal_operation * (Contract.t * 'rest)) instr\n  | Set_delegate :\n      (public_key_hash option * 'rest, packed_internal_operation * 'rest) instr\n  | Now :\n      ('rest, Script_timestamp.t * 'rest) instr\n  | Balance :\n      ('rest, Tez.t * 'rest) instr\n  | Check_signature :\n      (public_key * (signature * (MBytes.t * 'rest)), bool * 'rest) instr\n  | Hash_key :\n      (public_key * 'rest, public_key_hash * 'rest) instr\n  | Pack : 'a ty ->\n    ('a * 'rest, MBytes.t * 'rest) instr\n  | Unpack : 'a ty ->\n    (MBytes.t * 'rest, 'a option * 'rest) instr\n  | Blake2b :\n      (MBytes.t * 'rest, MBytes.t * 'rest) instr\n  | Sha256 :\n      (MBytes.t * 'rest, MBytes.t * 'rest) instr\n  | Sha512 :\n      (MBytes.t * 'rest, MBytes.t * 'rest) instr\n  | Steps_to_quota : (* TODO: check that it always returns a nat *)\n      ('rest, n num * 'rest) instr\n  | Source :\n      ('rest, Contract.t * 'rest) instr\n  | Sender :\n      ('rest, Contract.t * 'rest) instr\n  | Self : 'p ty ->\n    ('rest, 'p typed_contract * 'rest) instr\n  | Amount :\n      ('rest, Tez.t * 'rest) instr\n\nand ('bef, 'aft) descr =\n  { loc : Script.location ;\n    bef : 'bef stack_ty ;\n    aft : 'aft stack_ty ;\n    instr : ('bef, 'aft)  instr }\n\ntype ex_big_map = Ex_bm : ('key, 'value) big_map -> ex_big_map\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\n(* ---- Error definitions ---------------------------------------------------*)\n\n(* Auxiliary types for error documentation *)\ntype namespace = Type_namespace | Constant_namespace | Instr_namespace | Keyword_namespace\ntype kind = Int_kind | String_kind | Bytes_kind | Prim_kind | Seq_kind\ntype unparsed_stack_ty = (Script.expr * Script.annot) list\ntype type_map = (int * (unparsed_stack_ty * unparsed_stack_ty)) list\n\n(* Structure errors *)\ntype error += Invalid_arity of Script.location * prim * int * int\ntype error += Invalid_namespace of Script.location * prim * namespace * namespace\ntype error += Invalid_primitive of Script.location * prim list * prim\ntype error += Invalid_kind of Script.location * kind list * kind\ntype error += Missing_field of prim\ntype error += Duplicate_field of Script.location * prim\ntype error += Unexpected_big_map of Script.location\ntype error += Unexpected_operation of Script.location\n\n(* Instruction typing errors *)\ntype error += Fail_not_in_tail_position of Script.location\ntype error += Undefined_binop : Script.location * prim * Script.expr * Script.expr -> error\ntype error += Undefined_unop : Script.location * prim * Script.expr -> error\ntype error += Bad_return : Script.location * unparsed_stack_ty * Script.expr -> error\ntype error += Bad_stack : Script.location * prim * int * unparsed_stack_ty -> error\ntype error += Unmatched_branches : Script.location * unparsed_stack_ty * unparsed_stack_ty -> error\ntype error += Self_in_lambda of Script.location\ntype error += Bad_stack_length\ntype error += Bad_stack_item of int\ntype error += Inconsistent_annotations of string * string\ntype error += Inconsistent_type_annotations : Script.location * Script.expr * Script.expr -> error\ntype error += Inconsistent_field_annotations of string * string\ntype error += Unexpected_annotation of Script.location\ntype error += Ungrouped_annotations of Script.location\ntype error += Invalid_map_body : Script.location * unparsed_stack_ty -> error\ntype error += Invalid_map_block_fail of Script.location\ntype error += Invalid_iter_body : Script.location * unparsed_stack_ty * unparsed_stack_ty -> error\ntype error += Type_too_large : Script.location * int * int -> error\n\n(* Value typing errors *)\ntype error += Invalid_constant : Script.location * Script.expr * Script.expr -> error\ntype error += Invalid_contract of Script.location * Contract.t\ntype error += Comparable_type_expected : Script.location * Script.expr -> error\ntype error += Inconsistent_types : Script.expr * Script.expr -> error\ntype error += Unordered_map_keys of Script.location * Script.expr\ntype error += Unordered_set_values of Script.location * Script.expr\ntype error += Duplicate_map_keys of Script.location * Script.expr\ntype error += Duplicate_set_values of Script.location * Script.expr\n\n(* Toplevel errors *)\ntype error += Ill_typed_data : string option * Script.expr * Script.expr -> error\ntype error += Ill_formed_type of string option * Script.expr * Script.location\ntype error += Ill_typed_contract : Script.expr * type_map -> error\n\n(* Gas related errors *)\ntype error += Cannot_serialize_error\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 cycle : Gas.cost\n  val loop_cycle : Gas.cost\n  val list_size : Gas.cost\n  val nop : Gas.cost\n  val stack_op : Gas.cost\n  val bool_binop : 'a -> 'b -> Gas.cost\n  val bool_unop : 'a -> Gas.cost\n  val pair : Gas.cost\n  val pair_access : Gas.cost\n  val cons : Gas.cost\n  val variant_no_data : Gas.cost\n  val branch : Gas.cost\n  val concat : string -> string -> Gas.cost\n  val map_mem :\n    'a -> ('b, 'c) Script_typed_ir.map -> Gas.cost\n  val map_to_list :\n    ('b, 'c) Script_typed_ir.map -> Gas.cost\n  val map_get :\n    'a -> ('b, 'c) Script_typed_ir.map -> Gas.cost\n  val map_update :\n    'a -> 'b -> ('c, 'd) Script_typed_ir.map -> Gas.cost\n  val map_size : Gas.cost\n  val big_map_mem : 'key -> ('key, 'value) Script_typed_ir.big_map -> Gas.cost\n  val big_map_get : 'key -> ('key, 'value) Script_typed_ir.big_map -> Gas.cost\n  val big_map_update : 'key -> 'value option -> ('key, 'value) Script_typed_ir.big_map -> Gas.cost\n  val set_to_list : 'a Script_typed_ir.set -> Gas.cost\n  val set_update : 'a -> bool -> 'a Script_typed_ir.set -> Gas.cost\n  val set_mem : 'a -> 'a Script_typed_ir.set -> Gas.cost\n  val mul : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n  val div : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n  val add : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n  val sub : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n  val abs : 'a Script_int.num -> Gas.cost\n  val neg : 'a Script_int.num -> Gas.cost\n  val int : 'a -> Gas.cost\n  val add_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost\n  val sub_timestamp : Script_timestamp.t -> 'a Script_int.num -> Gas.cost\n  val diff_timestamps : Script_timestamp.t -> Script_timestamp.t -> Gas.cost\n  val empty_set : Gas.cost\n  val set_size : Gas.cost\n  val empty_map : Gas.cost\n  val int64_op : Gas.cost\n  val z_to_int64 : Gas.cost\n  val int64_to_z : Gas.cost\n  val bitwise_binop : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n  val logor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n  val logand : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n  val logxor : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n  val lognot : 'a Script_int.num -> Gas.cost\n  val shift_left : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n  val shift_right : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n  val exec : Gas.cost\n  val push : Gas.cost\n  val compare_res : Gas.cost\n  val unpack_failed : MBytes.t -> Gas.cost\n  val address : Gas.cost\n  val contract : Gas.cost\n  val transfer : Gas.cost\n  val create_account : Gas.cost\n  val create_contract : Gas.cost\n  val implicit_account : Gas.cost\n  val set_delegate : Gas.cost\n  val balance : Gas.cost\n  val now : Gas.cost\n  val check_signature : Gas.cost\n  val hash_key : Gas.cost\n  val hash : MBytes.t -> int -> Gas.cost\n  val steps_to_quota : Gas.cost\n  val source : Gas.cost\n  val self : Gas.cost\n  val amount : Gas.cost\n  val wrap : Gas.cost\n  val compare_bool : 'a -> 'b -> Gas.cost\n  val compare_string : string -> string -> Gas.cost\n  val compare_bytes : MBytes.t -> MBytes.t -> Gas.cost\n  val compare_tez : 'a -> 'b -> Gas.cost\n  val compare_int : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n  val compare_nat : 'a Script_int.num -> 'b Script_int.num -> Gas.cost\n  val compare_key_hash : 'a -> 'b -> Gas.cost\n  val compare_timestamp : Script_timestamp.t -> Script_timestamp.t -> Gas.cost\n  val compare_address : Contract.t -> Contract.t -> Gas.cost\n\n  module Typechecking : sig\n    val cycle : Gas.cost\n    val unit : Gas.cost\n    val bool : Gas.cost\n    val tez : Gas.cost\n    val z : Z.t -> Gas.cost\n    val string : int -> Gas.cost\n    val bytes : int -> Gas.cost\n    val int_of_string : string -> Gas.cost\n    val string_timestamp : Gas.cost\n    val key : Gas.cost\n    val key_hash : Gas.cost\n    val signature : Gas.cost\n\n    val contract : Gas.cost\n\n    (** Gas.Cost of getting the code for a contract *)\n    val get_script : Gas.cost\n\n    val contract_exists : Gas.cost\n\n    (** Additional Gas.cost of parsing a pair over the Gas.cost of parsing each type  *)\n    val pair : Gas.cost\n\n    val union : Gas.cost\n\n    val lambda : Gas.cost\n\n    val some : Gas.cost\n    val none : Gas.cost\n\n    val list_element : Gas.cost\n    val set_element : int -> Gas.cost\n    val map_element : int -> Gas.cost\n\n    val primitive_type : Gas.cost\n    val one_arg_type : Gas.cost\n    val two_arg_type : Gas.cost\n\n    val operation : int -> Gas.cost\n\n    (** Cost of parsing a type *)\n    val type_ : int -> Gas.cost\n\n    (** Cost of parsing an instruction *)\n    val instr : ('a, 'b) Script_typed_ir.instr -> Gas.cost\n  end\n\n  module Unparse : sig\n    val prim_cost : int -> Script.annot -> Gas.cost\n    val seq_cost : int -> Gas.cost\n    val cycle : Gas.cost\n    val unit : Gas.cost\n    val bool : Gas.cost\n    val z : Z.t -> Gas.cost\n    val int : 'a Script_int.num -> Gas.cost\n    val tez : Gas.cost\n    val string : string -> Gas.cost\n    val bytes : MBytes.t -> Gas.cost\n    val timestamp : Script_timestamp.t -> Gas.cost\n    val key : Gas.cost\n    val key_hash : Gas.cost\n    val signature : Gas.cost\n    val operation : MBytes.t -> Gas.cost\n\n    val contract : Gas.cost\n\n    (** Additional Gas.cost of parsing a pair over the Gas.cost of parsing each type  *)\n    val pair : Gas.cost\n\n    val union : Gas.cost\n\n    val some : Gas.cost\n    val none : Gas.cost\n\n    val list_element : Gas.cost\n    val set_element : Gas.cost\n    val map_element : Gas.cost\n\n    val one_arg_type : Script.annot -> Gas.cost\n    val two_arg_type : Script.annot -> Gas.cost\n    val set_to_list : 'a Script_typed_ir.set -> Gas.cost\n    val map_to_list : ('a, 'b) Script_typed_ir.map -> Gas.cost\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\nopen Alpha_context\nopen Gas\n\nmodule Cost_of = struct\n  let cycle = step_cost 1\n  let nop = free\n\n  let stack_op = step_cost 1\n\n  let bool_binop _ _ = step_cost 1\n  let bool_unop _ = step_cost 1\n\n  let pair = alloc_cost 2\n  let pair_access = step_cost 1\n\n  let cons = alloc_cost 2\n\n  let variant_no_data = alloc_cost 1\n\n  let branch = step_cost 2\n\n  let string length =\n    alloc_bytes_cost length\n\n  let bytes length =\n    alloc_mbytes_cost length\n\n  let zint z =\n    alloc_bits_cost (Z.numbits z)\n\n  let concat s1 s2 =\n    string (String.length s1 + String.length s2)\n\n  (* Cost per cycle of a loop, fold, etc *)\n  let loop_cycle = step_cost 2\n\n  let list_size = step_cost 1\n\n  let log2 =\n    let rec help acc = function\n      | 0 -> acc\n      | n -> help (acc + 1) (n / 2)\n    in help 1\n\n  let module_cost = alloc_cost 10\n\n  let map_access : type key value. (key, value) Script_typed_ir.map -> int\n    = fun (module Box) ->\n      log2 (snd Box.boxed)\n\n  let map_to_list : type key value. (key, value) Script_typed_ir.map -> cost\n    = fun (module Box) ->\n      let size = snd Box.boxed in\n      3 *@ alloc_cost size\n\n  let map_mem _key map = step_cost (map_access map)\n\n  let map_get = map_mem\n\n  let map_update _ _ map =\n    map_access map *@ alloc_cost 3\n\n  let map_size = step_cost 2\n\n  let big_map_mem _key _map = step_cost 50\n  let big_map_get _key _map = step_cost 50\n  let big_map_update _key _value _map = step_cost 10\n\n  let set_access : type elt. elt -> elt Script_typed_ir.set -> int\n    = fun _key (module Box) ->\n      log2 @@ Box.size\n\n  let set_mem key set = step_cost (set_access key set)\n\n  let set_update key _presence set =\n    set_access key set *@ alloc_cost 3\n\n  (* for LEFT, RIGHT, SOME *)\n  let wrap = alloc_cost 1\n\n  let mul n1 n2 =\n    let steps =\n      (Z.numbits (Script_int.to_zint n1))\n      * (Z.numbits (Script_int.to_zint n2)) in\n    let bits =\n      (Z.numbits (Script_int.to_zint n1))\n      + (Z.numbits (Script_int.to_zint n2)) in\n    step_cost steps +@ alloc_bits_cost bits\n\n  let div n1 n2 =\n    mul n1 n2 +@ alloc_cost 2\n\n  let add_sub_z n1 n2 =\n    let bits =\n      Compare.Int.max (Z.numbits n1) (Z.numbits n2) in\n    step_cost bits +@ alloc_cost bits\n\n  let add n1 n2 =\n    add_sub_z (Script_int.to_zint n1) (Script_int.to_zint n2)\n\n  let sub = add\n\n  let abs n =\n    alloc_bits_cost (Z.numbits @@ Script_int.to_zint n)\n\n  let neg = abs\n  let int _ = step_cost 1\n\n  let add_timestamp t n =\n    add_sub_z (Script_timestamp.to_zint t) (Script_int.to_zint n)\n\n  let sub_timestamp t n =\n    add_sub_z (Script_timestamp.to_zint t) (Script_int.to_zint n)\n\n  let diff_timestamps t1 t2 =\n    add_sub_z (Script_timestamp.to_zint t1) (Script_timestamp.to_zint t2)\n\n  let empty_set = module_cost\n\n  let set_size = step_cost 2\n\n  let set_to_list : type item. item Script_typed_ir.set -> cost\n    = fun (module Box) ->\n      alloc_cost @@ Pervasives.(Box.size * 2)\n\n  let empty_map = module_cost\n\n  let int64_op = step_cost 1 +@ alloc_cost 1\n\n  let z_to_int64 = step_cost 2 +@ alloc_cost 1\n\n  let int64_to_z = step_cost 2 +@ alloc_cost 1\n\n  let bitwise_binop n1 n2 =\n    let bits = Compare.Int.max (Z.numbits (Script_int.to_zint n1)) (Z.numbits (Script_int.to_zint n2)) in\n    step_cost bits +@ alloc_bits_cost bits\n\n  let logor = bitwise_binop\n  let logand = bitwise_binop\n  let logxor = bitwise_binop\n  let lognot n =\n    let bits = Z.numbits @@ Script_int.to_zint n in\n    step_cost bits +@ alloc_cost bits\n\n  let unopt ~default = function\n    | None -> default\n    | Some x -> x\n\n  let max_int = 1073741823\n\n  let shift_left x y =\n    alloc_bits_cost\n      (Z.numbits (Script_int.to_zint x) +\n       (unopt (Script_int.to_int y) ~default:max_int))\n\n  let shift_right x y =\n    alloc_bits_cost\n      (Compare.Int.max 1\n         (Z.numbits (Script_int.to_zint x) -\n          unopt (Script_int.to_int y) ~default:max_int))\n\n  let exec = step_cost 1\n\n  let push = step_cost 1\n\n  let compare_res = step_cost 1\n\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 len = MBytes.length bytes in\n    (len *@ alloc_mbytes_cost 1) +@\n    (len *@ (log2 len *@ (alloc_cost 3 +@ step_cost 1)))\n\n  let address = step_cost 1\n  let contract = Gas.read_bytes_cost Z.zero +@ step_cost 100\n  let transfer = step_cost 10\n  let create_account = step_cost 10\n  let create_contract = step_cost 10\n  let implicit_account = step_cost 10\n  let set_delegate = step_cost 10 +@ write_bytes_cost (Z.of_int 32)\n  let balance = step_cost 1 +@ read_bytes_cost (Z.of_int 8)\n  let now = step_cost 5\n  let check_signature = step_cost 1000\n  let hash_key = step_cost 3 +@ bytes 20\n  let hash data len = 10 *@ step_cost (MBytes.length data) +@ bytes len\n  let steps_to_quota = step_cost 1\n  let source = step_cost 1\n  let self = step_cost 1\n  let amount = step_cost 1\n  let compare_bool _ _ = step_cost 1\n  let compare_string s1 s2 =\n    step_cost ((7 + Compare.Int.max (String.length s1) (String.length s2)) / 8) +@ step_cost 1\n  let compare_bytes s1 s2 =\n    step_cost ((7 + Compare.Int.max (MBytes.length s1) (MBytes.length s2)) / 8) +@ step_cost 1\n  let compare_tez _ _ = step_cost 1\n  let compare_zint n1 n2 = step_cost ((7 + Compare.Int.max (Z.numbits n1) (Z.numbits n2)) / 8) +@ step_cost 1\n  let compare_int n1 n2 = compare_zint (Script_int.to_zint n1) (Script_int.to_zint n2)\n  let compare_nat = compare_int\n  let compare_key_hash _ _ = alloc_bytes_cost 36\n  let compare_timestamp t1 t2 = compare_zint (Script_timestamp.to_zint t1) (Script_timestamp.to_zint t2)\n  let compare_address _ _ = step_cost 20\n\n  module Typechecking = struct\n    let cycle = step_cost 1\n    let bool = free\n    let unit = free\n    let string = string\n    let bytes = bytes\n    let z = zint\n    let int_of_string str =\n      alloc_cost @@ (Pervasives.(/) (String.length str) 5)\n    let tez = step_cost 1 +@ alloc_cost 1\n    let string_timestamp = step_cost 3 +@ alloc_cost 3\n    let key = step_cost 3 +@ alloc_cost 3\n    let key_hash = step_cost 1 +@ alloc_cost 1\n    let signature = step_cost 1 +@ alloc_cost 1\n    let contract = step_cost 5\n    let get_script = step_cost 20 +@ alloc_cost 5\n    let contract_exists = step_cost 15 +@ alloc_cost 5\n    let pair = alloc_cost 2\n    let union = alloc_cost 1\n    let lambda = alloc_cost 5 +@ step_cost 3\n    let some = alloc_cost 1\n    let none = alloc_cost 0\n    let list_element = alloc_cost 2 +@ step_cost 1\n    let set_element size = log2 size *@ (alloc_cost 3 +@ step_cost 2)\n    let map_element size = log2 size *@ (alloc_cost 4 +@ step_cost 2)\n    let primitive_type = alloc_cost 1\n    let one_arg_type = alloc_cost 2\n    let two_arg_type = alloc_cost 3\n    let operation b = bytes b\n    let type_ nb_args = alloc_cost (nb_args + 1)\n\n    (* Cost of parsing instruction, is cost of allocation of\n       constructor + cost of contructor parameters + cost of\n       allocation on the stack type *)\n    let instr\n      : type b a. (b, a) Script_typed_ir.instr -> cost\n      = fun i ->\n        let open Script_typed_ir in\n        alloc_cost 1 +@ (* cost of allocation of constructor *)\n        match i with\n        | Drop -> alloc_cost 0\n        | Dup -> alloc_cost 1\n        | Swap -> alloc_cost 0\n        | Const _ -> alloc_cost 1\n        | Cons_pair -> alloc_cost 2\n        | Car -> alloc_cost 1\n        | Cdr -> alloc_cost 1\n        | Cons_some -> alloc_cost 2\n        | Cons_none _ -> alloc_cost 3\n        | If_none _ -> alloc_cost 2\n        | Left -> alloc_cost 3\n        | Right -> alloc_cost 3\n        | If_left _ -> alloc_cost 2\n        | Cons_list -> alloc_cost 1\n        | Nil -> alloc_cost 1\n        | If_cons _ -> alloc_cost 2\n        | List_map _ -> alloc_cost 5\n        | List_iter _ -> alloc_cost 4\n        | List_size -> alloc_cost 1\n        | Empty_set _ -> alloc_cost 1\n        | Set_iter _ -> alloc_cost 4\n        | Set_mem -> alloc_cost 1\n        | Set_update -> alloc_cost 1\n        | Set_size -> alloc_cost 1\n        | Empty_map _ -> alloc_cost 2\n        | Map_map _ -> alloc_cost 5\n        | Map_iter _ -> alloc_cost 4\n        | Map_mem -> alloc_cost 1\n        | Map_get -> alloc_cost 1\n        | Map_update -> alloc_cost 1\n        | Map_size -> alloc_cost 1\n        | Big_map_mem -> alloc_cost 1\n        | Big_map_get -> alloc_cost 1\n        | Big_map_update -> alloc_cost 1\n        | Concat -> alloc_cost 1\n        | Add_seconds_to_timestamp -> alloc_cost 1\n        | Add_timestamp_to_seconds -> alloc_cost 1\n        | Sub_timestamp_seconds -> alloc_cost 1\n        | Diff_timestamps -> alloc_cost 1\n        | Add_tez -> alloc_cost 1\n        | Sub_tez -> alloc_cost 1\n        | Mul_teznat -> alloc_cost 1\n        | Mul_nattez -> alloc_cost 1\n        | Ediv_teznat -> alloc_cost 1\n        | Ediv_tez -> alloc_cost 1\n        | Or -> alloc_cost 1\n        | And -> alloc_cost 1\n        | Xor -> alloc_cost 1\n        | Not -> alloc_cost 1\n        | Is_nat -> alloc_cost 1\n        | Neg_nat -> alloc_cost 1\n        | Neg_int -> alloc_cost 1\n        | Abs_int -> alloc_cost 1\n        | Int_nat -> alloc_cost 1\n        | Add_intint -> alloc_cost 1\n        | Add_intnat -> alloc_cost 1\n        | Add_natint -> alloc_cost 1\n        | Add_natnat -> alloc_cost 1\n        | Sub_int -> alloc_cost 1\n        | Mul_intint -> alloc_cost 1\n        | Mul_intnat -> alloc_cost 1\n        | Mul_natint -> alloc_cost 1\n        | Mul_natnat -> alloc_cost 1\n        | Ediv_intint -> alloc_cost 1\n        | Ediv_intnat -> alloc_cost 1\n        | Ediv_natint -> alloc_cost 1\n        | Ediv_natnat -> alloc_cost 1\n        | Lsl_nat -> alloc_cost 1\n        | Lsr_nat -> alloc_cost 1\n        | Or_nat -> alloc_cost 1\n        | And_nat -> alloc_cost 1\n        | And_int_nat -> alloc_cost 1\n        | Xor_nat -> alloc_cost 1\n        | Not_nat -> alloc_cost 1\n        | Not_int -> alloc_cost 1\n        | Seq _ -> alloc_cost 8\n        | If _ -> alloc_cost 8\n        | Loop _ -> alloc_cost 4\n        | Loop_left _ -> alloc_cost 5\n        | Dip _ -> alloc_cost 4\n        | Exec -> alloc_cost 1\n        | Lambda _ -> alloc_cost 2\n        | Failwith _ -> alloc_cost 1\n        | Nop -> alloc_cost 0\n        | Compare _ -> alloc_cost 1\n        | Eq -> alloc_cost 1\n        | Neq -> alloc_cost 1\n        | Lt -> alloc_cost 1\n        | Gt -> alloc_cost 1\n        | Le -> alloc_cost 1\n        | Ge -> alloc_cost 1\n        | Address -> alloc_cost 1\n        | Contract _ -> alloc_cost 2\n        | Transfer_tokens -> alloc_cost 1\n        | Create_account -> alloc_cost 2\n        | Implicit_account -> alloc_cost 1\n        | Create_contract _ -> alloc_cost 8\n        | Set_delegate -> alloc_cost 1\n        | Now -> alloc_cost 1\n        | Balance -> alloc_cost 1\n        | Check_signature -> alloc_cost 1\n        | Hash_key -> alloc_cost 1\n        | Pack _ -> alloc_cost 2\n        | Unpack _ -> alloc_cost 2\n        | Blake2b -> alloc_cost 1\n        | Sha256 -> alloc_cost 1\n        | Sha512 -> alloc_cost 1\n        | Steps_to_quota -> alloc_cost 1\n        | Source -> alloc_cost 1\n        | Sender -> alloc_cost 1\n        | Self _ -> alloc_cost 2\n        | Amount -> alloc_cost 1\n  end\n\n  module Unparse = struct\n    let prim_cost l annot = Script.prim_node_cost_nonrec_of_length l annot\n    let seq_cost = Script.seq_node_cost_nonrec_of_length\n    let string_cost length = Script.string_node_cost_of_length length\n\n    let cycle = step_cost 1\n    let bool = prim_cost 0 []\n    let unit = prim_cost 0 []\n    (* We count the length of strings and bytes to prevent hidden\n       miscalculations due to non detectable expansion of sharing. *)\n    let string s = Script.string_node_cost s\n    let bytes s = Script.bytes_node_cost s\n    let z i = Script.int_node_cost i\n    let int i = Script.int_node_cost (Script_int.to_zint i)\n    let tez = Script.int_node_cost_of_numbits 60 (* int64 bound *)\n    let timestamp x = Script_timestamp.to_zint x |> Script_int.of_zint |> int\n    let operation bytes = Script.bytes_node_cost bytes\n    let key = string_cost 54\n    let key_hash = string_cost 36\n    let signature = string_cost 128\n    let contract = string_cost 36\n    let pair = prim_cost 2 []\n    let union = prim_cost 1 []\n    let some = prim_cost 1 []\n    let none = prim_cost 0 []\n    let list_element = alloc_cost 2\n    let set_element = alloc_cost 2\n    let map_element = alloc_cost 2\n    let one_arg_type = prim_cost 1\n    let two_arg_type = prim_cost 2\n\n    let set_to_list = set_to_list\n    let map_to_list = map_to_list\n  end\n\nend\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\nopen Script_typed_ir\n\n(** Default annotations *)\n\nval default_now_annot : var_annot option\nval default_amount_annot : var_annot option\nval default_balance_annot : var_annot option\nval default_steps_annot : var_annot option\nval default_source_annot : var_annot option\nval default_sender_annot : var_annot option\nval default_self_annot : var_annot option\nval default_arg_annot : var_annot option\nval default_param_annot : var_annot option\nval default_storage_annot : var_annot option\n\nval default_car_annot : field_annot option\nval default_cdr_annot : field_annot option\nval default_contract_annot : field_annot option\nval default_addr_annot : field_annot option\nval default_manager_annot : field_annot option\nval default_pack_annot : field_annot option\nval default_unpack_annot : field_annot option\n\nval default_elt_annot : field_annot option\nval default_key_annot : field_annot option\nval default_hd_annot : field_annot option\nval default_tl_annot : field_annot option\nval default_some_annot : field_annot option\nval default_left_annot : field_annot option\nval default_right_annot : field_annot option\nval default_binding_annot : field_annot option\n\n(** Unparse annotations to their string representation *)\n\nval unparse_type_annot : type_annot option -> string list\nval unparse_var_annot : var_annot option -> string list\nval unparse_field_annot : field_annot option -> string list\n\n(** Convertions functions between different annotation kinds *)\n\nval field_to_var_annot : field_annot option -> var_annot option\nval type_to_var_annot : type_annot option -> var_annot option\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 -> field_annot option -> var_annot option\n\n(** Merge type annotations.\n    @returns an error {!Inconsistent_type_annotations} if they are both present\n    and different *)\nval merge_type_annot :\n  type_annot option -> type_annot option -> type_annot option tzresult\n\n(** Merge field annotations.\n    @returns an error {!Inconsistent_type_annotations} if they are both present\n    and different *)\nval merge_field_annot :\n  field_annot option -> field_annot option -> field_annot option tzresult\n\n(** Merge variable annotations, does not fail ([None] if different). *)\nval merge_var_annot :\n  var_annot option -> var_annot option -> var_annot option\n\n(** @returns an error {!Unexpected_annotation} in the monad the list is not empty. *)\nval error_unexpected_annot : int -> 'a list -> unit tzresult\n\n(** Same as {!error_unexpected_annot} in Lwt. *)\nval fail_unexpected_annot : int -> 'a list -> unit tzresult Lwt.t\n\n(** Parse a type annotation only. *)\nval parse_type_annot : int -> string list -> type_annot option tzresult\n\n(** Parse a field annotation only. *)\nval parse_field_annot :\n  int -> string list -> field_annot option tzresult\n\n(** Parse an annotation for composed types, of the form\n    [:ty_name %field] in any order. *)\nval parse_type_field_annot :\n  int -> string list -> (type_annot option * 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  int -> string list ->\n  (type_annot option * field_annot option * field_annot option) tzresult\n\n(** Check that type annotations on constants are consistent *)\nval check_const_type_annot :\n  int -> string list -> type_annot option -> field_annot option list ->\n  unit tzresult Lwt.t\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  int ->\n  ?default:var_annot option ->\n  string list -> var_annot option tzresult\n\nval parse_constr_annot :\n  int ->\n  ?if_special_first:field_annot option ->\n  ?if_special_second:field_annot option ->\n  string list ->\n  (var_annot option * type_annot option *\n   field_annot option * field_annot option) tzresult\n\nval parse_two_var_annot :\n  int -> string list -> (var_annot option * var_annot option) tzresult\n\nval parse_destr_annot :\n  int -> 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_var_type_annot :\n  int -> string list -> (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\nopen Script_typed_ir\n\nlet default_now_annot = Some (`Var_annot \"now\")\nlet default_amount_annot = Some (`Var_annot \"amount\")\nlet default_balance_annot = Some (`Var_annot \"balance\")\nlet default_steps_annot = Some (`Var_annot \"steps\")\nlet default_source_annot = Some (`Var_annot \"source\")\nlet default_sender_annot = Some (`Var_annot \"sender\")\nlet default_self_annot = Some (`Var_annot \"self\")\nlet default_arg_annot = Some (`Var_annot \"arg\")\nlet default_param_annot = Some (`Var_annot \"parameter\")\nlet default_storage_annot = Some (`Var_annot \"storage\")\n\nlet default_car_annot = Some (`Field_annot \"car\")\nlet default_cdr_annot = Some (`Field_annot \"cdr\")\nlet default_contract_annot = Some (`Field_annot \"contract\")\nlet default_addr_annot = Some (`Field_annot \"address\")\nlet default_manager_annot = Some (`Field_annot \"manager\")\nlet default_pack_annot = Some (`Field_annot \"packed\")\nlet default_unpack_annot = Some (`Field_annot \"unpacked\")\n\nlet default_elt_annot = Some (`Field_annot \"elt\")\nlet default_key_annot = Some (`Field_annot \"key\")\nlet default_hd_annot = Some (`Field_annot \"hd\")\nlet default_tl_annot = Some (`Field_annot \"tl\")\nlet default_some_annot = Some (`Field_annot \"some\")\nlet default_left_annot = Some (`Field_annot \"left\")\nlet default_right_annot = Some (`Field_annot \"right\")\nlet default_binding_annot = Some (`Field_annot \"bnd\")\n\nlet unparse_type_annot : type_annot option -> string list = function\n  | None -> []\n  | Some `Type_annot a -> [ \":\" ^ a ]\n\nlet unparse_var_annot : var_annot option -> string list = function\n  | None -> []\n  | Some `Var_annot a -> [ \"@\" ^ a ]\n\nlet unparse_field_annot : field_annot option -> string list = function\n  | None -> []\n  | Some `Field_annot a -> [ \"%\" ^ a ]\n\nlet field_to_var_annot : field_annot option -> var_annot option =\n  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 =\n  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 =\n  function\n  | None -> None\n  | Some (`Var_annot s) -> Some (`Field_annot s)\n\nlet default_annot ~default = function\n  | None -> default\n  | annot -> annot\n\nlet gen_access_annot\n  : var_annot option -> ?default:field_annot option -> field_annot option -> 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, Some `Field_annot \"\", _ -> None\n    | None, Some `Field_annot f, _ ->\n        Some (`Var_annot f)\n    | Some `Var_annot v, (None | Some `Field_annot \"\"), Some `Field_annot f ->\n        Some (`Var_annot (String.concat \".\" [v; f]))\n    | Some `Var_annot v, Some `Field_annot f, _ ->\n        Some (`Var_annot (String.concat \".\" [v; f]))\n\nlet merge_type_annot\n  : type_annot option -> type_annot option -> type_annot option tzresult\n  = fun annot1 annot2 ->\n    match annot1, annot2 with\n    | None, None\n    | Some _, None\n    | None, Some _ -> ok None\n    | Some `Type_annot a1, Some `Type_annot a2 ->\n        if String.equal a1 a2\n        then ok annot1\n        else error (Inconsistent_annotations (\":\" ^ a1, \":\" ^ a2))\n\nlet merge_field_annot\n  : field_annot option -> field_annot option -> field_annot option tzresult\n  = fun annot1 annot2 ->\n    match annot1, annot2 with\n    | None, None\n    | Some _, None\n    | None, Some _ -> ok None\n    | Some `Field_annot a1, Some `Field_annot a2 ->\n        if String.equal a1 a2\n        then ok annot1\n        else error (Inconsistent_annotations (\"%\" ^ a1, \"%\" ^ a2))\n\nlet merge_var_annot\n  : var_annot option -> var_annot option -> var_annot option\n  = fun annot1 annot2 ->\n    match annot1, annot2 with\n    | None, None\n    | Some _, None\n    | None, Some _ -> None\n    | Some `Var_annot a1, Some `Var_annot a2 ->\n        if String.equal a1 a2 then annot1 else None\n\nlet error_unexpected_annot loc annot =\n  match annot with\n  | [] -> ok ()\n  | _ :: _ -> error (Unexpected_annotation loc)\n\nlet fail_unexpected_annot loc annot =\n  Lwt.return (error_unexpected_annot loc annot)\n\nlet parse_annots loc ?(allow_special_var = false) ?(allow_special_field = false) l =\n  (* allow emtpty annotations as wildcards but otherwise only accept\n     annotations that start with [a-zA-Z_] *)\n  let sub_or_wildcard ~specials wrap s acc =\n    let len = String.length s in\n    if Compare.Int.(len = 1) then ok @@ wrap None :: acc\n    else match s.[1] with\n      | 'a' .. 'z' | 'A' .. 'Z' | '_' ->\n          ok @@ wrap (Some (String.sub s 1 (len - 1))) :: acc\n      | '@' when Compare.Int.(len = 2) && List.mem '@' specials ->\n          ok @@ wrap (Some \"@\") :: acc\n      | '%' when List.mem '%' specials ->\n          if Compare.Int.(len = 2)\n          then ok @@ wrap (Some \"%\") :: acc\n          else if Compare.Int.(len = 3) && Compare.Char.(s.[2] = '%')\n          then ok @@ wrap (Some \"%%\") :: acc\n          else error (Unexpected_annotation loc)\n      | _ -> error (Unexpected_annotation loc) in\n  List.fold_left (fun acc s ->\n      acc >>? fun acc ->\n      if Compare.Int.(String.length s = 0) then\n        error (Unexpected_annotation loc)\n      else match s.[0] with\n        | ':' -> sub_or_wildcard ~specials:[] (fun a -> `Type_annot a) s acc\n        | '@' ->\n            sub_or_wildcard\n              ~specials:(if allow_special_var then ['%'] else [])\n              (fun a -> `Var_annot a) s acc\n        | '%' -> sub_or_wildcard\n                   ~specials:(if allow_special_field then ['@'] else [])\n                   (fun a -> `Field_annot a) s acc\n        | _ -> error (Unexpected_annotation loc)\n    ) (ok []) l\n  >|? List.rev\n\nlet opt_var_of_var_opt = function\n  | `Var_annot None -> None\n  | `Var_annot Some a -> Some (`Var_annot a)\n\nlet opt_field_of_field_opt = function\n  | `Field_annot None -> None\n  | `Field_annot Some a -> Some (`Field_annot a)\n\nlet opt_type_of_type_opt = function\n  | `Type_annot None -> None\n  | `Type_annot 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) tzresult\n  =\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 _ as a), true, _, _, _, _, _\n           | (`Var_annot _ as a), false, [], _, _, _, _ ->\n               true, opt_var_of_var_opt a :: rv,\n               false, rt,\n               false, rf\n           | (`Type_annot _ as a), _, _, true, _, _, _\n           | (`Type_annot _ as a), _, _, false, [], _, _ ->\n               false, rv,\n               true, opt_type_of_type_opt a :: rt,\n               false, rf\n           | (`Field_annot _ as a), _, _, _, _, true, _\n           | (`Field_annot _ as a), _, _, _, _, false, [] ->\n               false, rv,\n               false, rt,\n               true, opt_field_of_field_opt a :: rf\n           | _ -> raise Exit\n        ) (false, [], false, [], false, []) l 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  | [] -> ok 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  : int -> string list -> type_annot option tzresult\n  = fun loc annot ->\n    parse_annots loc annot >>?\n    classify_annot loc >>? fun (vars, types, fields) ->\n    error_unexpected_annot loc vars >>? fun () ->\n    error_unexpected_annot loc fields >>? fun () ->\n    get_one_annot loc types\n\nlet parse_type_field_annot\n  : int -> string list -> (type_annot option * field_annot option) tzresult\n  = fun loc annot ->\n    parse_annots loc annot >>?\n    classify_annot loc >>? fun (vars, types, fields) ->\n    error_unexpected_annot loc vars >>? fun () ->\n    get_one_annot loc types >>? fun t ->\n    get_one_annot loc fields >|? fun f ->\n    (t, f)\n\nlet parse_composed_type_annot\n  : int -> string list -> (type_annot option * field_annot option * field_annot option) tzresult\n  = fun loc annot ->\n    parse_annots loc annot >>?\n    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) ->\n    (t, f1, f2)\n\nlet check_const_type_annot\n  : int -> string list -> type_annot option -> field_annot option list -> unit tzresult Lwt.t\n  = fun loc annot expected_name expected_fields ->\n    Lwt.return\n      (parse_composed_type_annot loc annot >>? fun (ty_name, field1, field2) ->\n       merge_type_annot expected_name ty_name >>? fun _ ->\n       match expected_fields, field1, field2 with\n       | [], Some _, _ | [], _, Some _ | [_], Some _, Some _ ->\n           (* Too many annotations *)\n           error (Unexpected_annotation loc)\n       | _ :: _ :: _ :: _, _, _ | [_], None, Some _ ->\n           error (Unexpected_annotation loc)\n       | [], None, None -> ok ()\n       | [ f1; f2 ], _,  _ ->\n           merge_field_annot f1 field1 >>? fun _ ->\n           merge_field_annot f2 field2 >|? fun _ -> ()\n       | [ f1 ], _,  None ->\n           merge_field_annot f1 field1 >|? fun _ -> ()\n      )\n\nlet parse_field_annot\n  : int -> string list -> field_annot option tzresult\n  = fun loc annot ->\n    parse_annots loc annot >>?\n    classify_annot loc >>? fun (vars, types, fields) ->\n    error_unexpected_annot loc vars >>? fun () ->\n    error_unexpected_annot loc types >>? fun () ->\n    get_one_annot loc fields\n\nlet extract_field_annot\n  : Script.node -> (Script.node * field_annot option) tzresult\n  = function\n    | Prim (loc, prim, args, annot) ->\n        let field_annots, annot = List.partition (fun s ->\n            Compare.Int.(String.length s > 0) &&\n            Compare.Char.(s.[0] = '%')\n          ) annot in\n        parse_field_annot loc field_annots >|? fun field_annot ->\n        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 -> ok ()\n    | Some `Field_annot s1, Some `Field_annot s2 ->\n        if String.equal s1 s2 then ok ()\n        else error (Inconsistent_field_annotations (\"%\" ^ s1, \"%\" ^ s2))\n\n\nlet parse_var_annot\n  : int -> ?default:var_annot option -> string list ->\n    var_annot option tzresult\n  = fun loc ?default annot ->\n    parse_annots loc annot >>?\n    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\n      | Some a -> a\n      | None -> None\n\nlet split_last_dot = function\n  | None -> None, None\n  | Some `Field_annot s ->\n      match String.rindex_opt s '.' with\n      | None -> None, Some (`Field_annot s)\n      | Some i ->\n          let s1 = String.sub s 0 i in\n          let s2 = String.sub s (i + 1) (String.length s - i - 1) in\n          let f =\n            if Compare.String.equal s2 \"car\"\n            || Compare.String.equal s2 \"cdr\" then\n              None\n            else\n              Some (`Field_annot s2) in\n          Some (`Var_annot s1), f\n\nlet common_prefix v1 v2 =\n  match v1, v2 with\n  | Some (`Var_annot s1), Some (`Var_annot s2) when Compare.String.equal s1 s2 -> v1\n  | Some _, None -> v1\n  | None, Some _ -> v2\n  | _, _ -> None\n\nlet parse_constr_annot\n  : int ->\n    ?if_special_first:field_annot option ->\n    ?if_special_second:field_annot option ->\n    string list ->\n    (var_annot option * type_annot option * field_annot option * field_annot option) tzresult\n  = fun loc ?if_special_first ?if_special_second annot ->\n    parse_annots ~allow_special_field:true loc annot >>?\n    classify_annot loc >>? 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    begin match if_special_first, f1 with\n      | Some special_var, Some `Field_annot \"@\" ->\n          ok (split_last_dot special_var)\n      | None, Some `Field_annot \"@\" -> error (Unexpected_annotation loc)\n      | _, _ -> ok (v, f1)\n    end >>? fun (v1, f1) ->\n    begin match if_special_second, f2 with\n      | Some special_var, Some `Field_annot \"@\" ->\n          ok (split_last_dot special_var)\n      | None, Some `Field_annot \"@\" -> error (Unexpected_annotation loc)\n      | _, _ -> ok (v, f2)\n    end >|? fun (v2, f2) ->\n    let v = match v with\n      | None -> common_prefix v1 v2\n      | Some _ -> v in\n    (v, t, f1, f2)\n\nlet parse_two_var_annot\n  : int -> string list -> (var_annot option * var_annot option) tzresult\n  = fun loc annot ->\n    parse_annots loc annot >>?\n    classify_annot loc >>? fun (vars, types, fields) ->\n    error_unexpected_annot loc types >>? fun () ->\n    error_unexpected_annot loc fields >>? fun () ->\n    get_two_annot loc vars\n\nlet parse_destr_annot\n  : int -> string list -> default_accessor:field_annot option ->\n  field_name:field_annot option ->\n  pair_annot:var_annot option -> 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 >>?\n    classify_annot loc >>? 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 = gen_access_annot pair_annot field_name ~default:default_accessor in\n    let v = match v with\n      | Some `Var_annot \"%\" -> field_to_var_annot field_name\n      | Some `Var_annot \"%%\" -> default\n      | Some _ -> v\n      | None -> value_annot in\n    (v, f)\n\nlet parse_var_type_annot\n  : int -> string list -> (var_annot option * type_annot option) tzresult\n  = fun loc annot ->\n    parse_annots loc annot >>?\n    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 ->\n    (v, t)\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\nopen Alpha_context\nopen Script_tc_errors\n\ntype ('ta, 'tb) eq = Eq : ('same, 'same) eq\n\ntype ex_comparable_ty = Ex_comparable_ty : 'a Script_typed_ir.comparable_ty -> ex_comparable_ty\ntype ex_ty = Ex_ty : 'a Script_typed_ir.ty -> ex_ty\ntype ex_stack_ty = Ex_stack_ty : 'a Script_typed_ir.stack_ty -> ex_stack_ty\ntype ex_script = Ex_script : ('a, 'b) Script_typed_ir.script -> ex_script\n\ntype unparsing_mode = Optimized | Readable\n\ntype type_logger =\n  int -> (Script.expr * Script.annot) list -> (Script.expr * Script.annot)  list -> unit\n\n(* ---- Sets and Maps -------------------------------------------------------*)\n\nval empty_set : 'a Script_typed_ir.comparable_ty -> 'a Script_typed_ir.set\nval set_fold :\n  ('elt -> 'acc -> 'acc) ->\n  'elt Script_typed_ir.set -> 'acc -> 'acc\nval set_update : 'a -> bool -> 'a Script_typed_ir.set -> 'a Script_typed_ir.set\nval set_mem : 'elt -> 'elt Script_typed_ir.set -> bool\nval set_size : 'elt Script_typed_ir.set -> Script_int.n Script_int.num\n\nval empty_map : 'a Script_typed_ir.comparable_ty -> ('a, 'b) Script_typed_ir.map\nval map_fold :\n  ('key -> 'value -> 'acc -> 'acc) ->\n  ('key, 'value) Script_typed_ir.map -> 'acc -> 'acc\nval map_update :\n  'a -> 'b option -> ('a, 'b) Script_typed_ir.map -> ('a, 'b) Script_typed_ir.map\nval map_mem : 'key -> ('key, 'value) Script_typed_ir.map -> bool\nval map_get : 'key -> ('key, 'value) Script_typed_ir.map -> 'value option\nval map_key_ty : ('a, 'b) Script_typed_ir.map -> 'a Script_typed_ir.comparable_ty\nval map_size : ('a, 'b) Script_typed_ir.map -> Script_int.n Script_int.num\n\nval big_map_mem :\n  context -> Contract.t -> 'key ->\n  ('key, 'value) Script_typed_ir.big_map ->\n  (bool * context) tzresult Lwt.t\nval big_map_get :\n  context ->\n  Contract.t -> 'key ->\n  ('key, 'value) Script_typed_ir.big_map ->\n  ('value option * context) tzresult Lwt.t\nval big_map_update :\n  'key -> 'value option -> ('key, 'value) Script_typed_ir.big_map ->\n  ('key, 'value) Script_typed_ir.big_map\n\nval ty_eq :\n  context ->\n  'ta Script_typed_ir.ty -> 'tb Script_typed_ir.ty ->\n  (('ta Script_typed_ir.ty, 'tb Script_typed_ir.ty) eq * context) tzresult\n\nval parse_data :\n  ?type_logger: type_logger ->\n  context ->\n  'a Script_typed_ir.ty -> Script.node -> ('a * context) tzresult Lwt.t\nval unparse_data :\n  context -> unparsing_mode -> 'a Script_typed_ir.ty -> 'a ->\n  (Script.node * context) tzresult Lwt.t\n\nval parse_ty :\n  context ->\n  allow_big_map: bool ->\n  allow_operation: bool ->\n  Script.node -> (ex_ty * context) tzresult\n\nval unparse_ty :\n  context -> 'a Script_typed_ir.ty -> (Script.node * context) tzresult Lwt.t\n\nval parse_toplevel :\n  Script.expr -> (Script.node * Script.node * Script.node) tzresult\n\nval typecheck_code :\n  context -> Script.expr -> (type_map * context) tzresult Lwt.t\n\nval typecheck_data :\n  ?type_logger: type_logger ->\n  context -> Script.expr * Script.expr -> context tzresult Lwt.t\n\nval parse_script :\n  ?type_logger: type_logger ->\n  context -> Script.t -> (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 -> unparsing_mode ->\n  ('a, 'b) Script_typed_ir.script -> (Script.t * context) tzresult Lwt.t\n\nval parse_contract :\n  context -> Script.location -> 'a Script_typed_ir.ty -> Contract.t ->\n  (context * 'a Script_typed_ir.typed_contract) tzresult Lwt.t\n\nval parse_contract_for_script :\n  context -> Script.location -> 'a Script_typed_ir.ty -> Contract.t ->\n  (context * 'a Script_typed_ir.typed_contract option) tzresult Lwt.t\n\nval pack_data : context -> 'a Script_typed_ir.ty -> 'a -> (MBytes.t * context) tzresult Lwt.t\nval hash_data : context -> 'a Script_typed_ir.ty -> 'a -> (Script_expr_hash.t * context) tzresult Lwt.t\n\nval extract_big_map :\n  'a Script_typed_ir.ty -> 'a -> Script_typed_ir.ex_big_map option\n\nval diff_of_big_map :\n  context -> unparsing_mode -> Script_typed_ir.ex_big_map ->\n  (Contract.big_map_diff * context) tzresult Lwt.t\n\nval erase_big_map_initialization :\n  context -> unparsing_mode -> Script.t ->\n  (Script.t * Contract.big_map_diff option * 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\nopen Micheline\nopen Script\nopen Script_typed_ir\nopen Script_tc_errors\nopen Script_ir_annot\n\nmodule Typecheck_costs = Michelson_v1_gas.Cost_of.Typechecking\nmodule Unparse_costs = Michelson_v1_gas.Cost_of.Unparse\n\ntype ex_comparable_ty = Ex_comparable_ty : 'a comparable_ty -> ex_comparable_ty\ntype ex_ty = Ex_ty : 'a ty -> ex_ty\ntype ex_stack_ty = Ex_stack_ty : 'a stack_ty -> ex_stack_ty\n\ntype tc_context =\n  | Lambda : tc_context\n  | Dip : 'a stack_ty * tc_context -> tc_context\n  | Toplevel : { storage_type : 'sto ty ; param_type : 'param ty } -> tc_context\n\ntype unparsing_mode = Optimized | Readable\n\ntype type_logger =\n  int -> (Script.expr * Script.annot) list -> (Script.expr * Script.annot)  list -> unit\n\nlet add_dip ty annot prev =\n  match prev with\n  | Lambda | Toplevel _ -> Dip (Item_t (ty, Empty_t, annot), prev)\n  | Dip (stack, _) -> Dip (Item_t (ty, stack, annot), prev)\n\n(* ---- Type size accounting ------------------------------------------------*)\n\n(* TODO include annot in size ? *)\nlet comparable_type_size : type t. t comparable_ty -> int = fun ty ->\n  (* No wildcard to force the update when comparable_ty chages. *)\n  match ty with\n  | Int_key _ -> 1\n  | Nat_key _ -> 1\n  | String_key _ -> 1\n  | Bytes_key _ -> 1\n  | Mutez_key _ -> 1\n  | Bool_key _ -> 1\n  | Key_hash_key _ -> 1\n  | Timestamp_key _ -> 1\n  | Address_key _ -> 1\n\n(* TODO include annot in size ? *)\nlet rec type_size : type t. t ty -> int =\n  fun ty -> match ty with\n    | Unit_t _ -> 1\n    | Int_t _ -> 1\n    | Nat_t _ -> 1\n    | Signature_t _ -> 1\n    | Bytes_t _ -> 1\n    | String_t _ -> 1\n    | Mutez_t _ -> 1\n    | Key_hash_t _ -> 1\n    | Key_t _ -> 1\n    | Timestamp_t _ -> 1\n    | Address_t _ -> 1\n    | Bool_t _ -> 1\n    | Operation_t _ -> 1\n    | Pair_t ((l, _, _), (r, _, _), _) ->\n        1 + type_size l + type_size r\n    | Union_t ((l, _), (r, _), _) ->\n        1 + type_size l + type_size r\n    | Lambda_t (arg, ret, _) ->\n        1 + type_size arg + type_size ret\n    | Option_t ((t,_), _, _) ->\n        1 + type_size t\n    | List_t (t, _) ->\n        1 + type_size t\n    | Set_t (k, _) ->\n        1 + comparable_type_size k\n    | Map_t (k, v, _) ->\n        1 + comparable_type_size k + type_size v\n    | Big_map_t (k, v, _) ->\n        1 + comparable_type_size k + type_size v\n    | Contract_t (arg, _) ->\n        1 + type_size arg\n\nlet rec type_size_of_stack_head\n  : type st. st stack_ty -> up_to:int -> int\n  = fun stack ~up_to ->\n    match stack with\n    | Empty_t -> 0\n    | Item_t (head, tail, _annot) ->\n        if Compare.Int.(up_to > 0) then\n          Compare.Int.max (type_size head)\n            (type_size_of_stack_head tail ~up_to:(up_to - 1))\n        else\n          0\n\n(* This is the depth of the stack to inspect for sizes overflow. We\n   only need to check the produced types that can be larger than the\n   arguments. That's why Swap is 0 for instance as no type grows.\n   Constant sized types are not checked: it is assumed they are lower\n   than the bound (otherwise every program would be rejected). *)\nlet number_of_generated_growing_types : type b a. (b, a) instr -> int = function\n  | Drop -> 0\n  | Dup -> 0\n  | Swap -> 0\n  | Const _ -> 1\n  | Cons_pair -> 1\n  | Car -> 0\n  | Cdr -> 0\n  | Cons_some -> 1\n  | Cons_none _ -> 1\n  | If_none _ -> 0\n  | Left -> 0\n  | Right -> 0\n  | If_left _ -> 0\n  | Cons_list -> 1\n  | Nil -> 1\n  | If_cons _ -> 0\n  | List_map _ -> 1\n  | List_size -> 0\n  | List_iter _ -> 1\n  | Empty_set _ -> 1\n  | Set_iter _ -> 0\n  | Set_mem -> 0\n  | Set_update -> 0\n  | Set_size -> 0\n  | Empty_map _ -> 1\n  | Map_map _ -> 1\n  | Map_iter _ -> 1\n  | Map_mem -> 0\n  | Map_get -> 0\n  | Map_update -> 0\n  | Map_size -> 0\n  | Big_map_get -> 0\n  | Big_map_update -> 0\n  | Big_map_mem -> 0\n  | Concat -> 0\n  | Add_seconds_to_timestamp -> 0\n  | Add_timestamp_to_seconds -> 0\n  | Sub_timestamp_seconds -> 0\n  | Diff_timestamps -> 0\n  | Add_tez -> 0\n  | Sub_tez -> 0\n  | Mul_teznat -> 0\n  | Mul_nattez -> 0\n  | Ediv_teznat -> 0\n  | Ediv_tez -> 0\n  | Or -> 0\n  | And -> 0\n  | Xor -> 0\n  | Not -> 0\n  | Is_nat -> 0\n  | Neg_nat -> 0\n  | Neg_int -> 0\n  | Abs_int -> 0\n  | Int_nat -> 0\n  | Add_intint -> 0\n  | Add_intnat -> 0\n  | Add_natint -> 0\n  | Add_natnat -> 0\n  | Sub_int -> 0\n  | Mul_intint -> 0\n  | Mul_intnat -> 0\n  | Mul_natint -> 0\n  | Mul_natnat -> 0\n  | Ediv_intint -> 0\n  | Ediv_intnat -> 0\n  | Ediv_natint -> 0\n  | Ediv_natnat -> 0\n  | Lsl_nat -> 0\n  | Lsr_nat -> 0\n  | Or_nat -> 0\n  | And_nat -> 0\n  | And_int_nat -> 0\n  | Xor_nat -> 0\n  | Not_nat -> 0\n  | Not_int -> 0\n  | Seq _ -> 0\n  | If _ -> 0\n  | Loop _ -> 0\n  | Loop_left _ -> 0\n  | Dip _ -> 0\n  | Exec -> 0\n  | Lambda _ -> 1\n  | Failwith _ -> 1\n  | Nop -> 0\n  | Compare _ -> 1\n  | Eq -> 0\n  | Neq -> 0\n  | Lt -> 0\n  | Gt -> 0\n  | Le -> 0\n  | Ge -> 0\n  | Address -> 0\n  | Contract _ -> 1\n  | Transfer_tokens -> 1\n  | Create_account -> 0\n  | Implicit_account -> 0\n  | Create_contract _ -> 1\n  | Now -> 0\n  | Balance -> 0\n  | Check_signature -> 0\n  | Hash_key -> 0\n  | Blake2b -> 0\n  | Sha256 -> 0\n  | Sha512 -> 0\n  | Steps_to_quota -> 0\n  | Source -> 0\n  | Sender -> 0\n  | Self _ -> 1\n  | Amount -> 0\n  | Set_delegate -> 0\n  | Pack _ -> 0\n  | Unpack _ -> 1\n\n(* ---- Error helpers -------------------------------------------------------*)\n\nlet location = function\n  | Prim (loc, _, _, _)\n  | Int (loc, _)\n  | String (loc, _)\n  | Bytes (loc, _)\n  | Seq (loc, _) -> loc\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 namespace = function\n  | K_parameter\n  | K_storage\n  | K_code -> Keyword_namespace\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 -> Constant_namespace\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_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_EDIV\n  | I_EMPTY_MAP\n  | I_EMPTY_SET\n  | I_EQ\n  | I_EXEC\n  | I_FAILWITH\n  | I_GE\n  | I_GET\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_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_PUSH\n  | I_RIGHT\n  | I_SIZE\n  | I_SOME\n  | I_SOURCE\n  | I_SENDER\n  | I_SELF\n  | I_STEPS_TO_QUOTA\n  | I_SUB\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 -> Instr_namespace\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 -> Type_namespace\n\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      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, _ ->\n          Invalid_namespace (loc, name, exp_ns, ns)\n\nlet check_kind kinds expr =\n  let kind = kind expr in\n  if List.mem kind kinds then\n    return_unit\n  else\n    let loc = location expr in\n    fail (Invalid_kind (loc, kinds, kind))\n\n(* ---- Sets and Maps -------------------------------------------------------*)\n\nlet compare_comparable\n  : type a. a comparable_ty -> a -> a -> int\n  = fun kind x y -> match kind with\n    | String_key _ -> Compare.String.compare x y\n    | Bool_key _ -> Compare.Bool.compare x y\n    | Mutez_key _ -> Tez.compare x y\n    | Key_hash_key _ -> Signature.Public_key_hash.compare x y\n    | Int_key _ ->\n        let res = (Script_int.compare x y) in\n        if Compare.Int.(res = 0) then 0\n        else if Compare.Int.(res > 0) then 1\n        else -1\n    | Nat_key _ ->\n        let res = (Script_int.compare x y) in\n        if Compare.Int.(res = 0) then 0\n        else if Compare.Int.(res > 0) then 1\n        else -1\n    | Timestamp_key _ -> Script_timestamp.compare x y\n    | Address_key _ -> Contract.compare x y\n    | Bytes_key _ -> MBytes.compare x y\n\nlet empty_set\n  : type a. a comparable_ty -> a set\n  = fun ty ->\n    let module OPS = Set.Make (struct\n        type t = a\n        let compare = compare_comparable ty\n      end) in\n    (module struct\n      type elt = a\n      module OPS = OPS\n      let boxed = OPS.empty\n      let size = 0\n    end)\n\nlet set_update\n  : type a. a -> bool -> a set -> a set\n  = fun v b (module Box) ->\n    (module struct\n      type elt = a\n      module OPS = Box.OPS\n      let boxed =\n        if b\n        then Box.OPS.add v Box.boxed\n        else Box.OPS.remove v Box.boxed\n      let size =\n        let mem = Box.OPS.mem v Box.boxed in\n        if mem\n        then if b then Box.size else Box.size - 1\n        else if b then Box.size + 1 else Box.size\n    end)\n\nlet set_mem\n  : type elt. elt -> elt set -> bool\n  = fun v (module Box) ->\n    Box.OPS.mem v Box.boxed\n\nlet set_fold\n  : type elt acc. (elt -> acc -> acc) -> elt set -> acc -> acc\n  = fun f (module Box) ->\n    Box.OPS.fold f Box.boxed\n\nlet set_size\n  : type elt. elt set -> Script_int.n Script_int.num =\n  fun (module Box) ->\n    Script_int.(abs (of_int Box.size))\n\nlet map_key_ty\n  : type a b. (a, b) map -> a comparable_ty\n  = fun (module Box) -> Box.key_ty\n\nlet empty_map\n  : type a b. a comparable_ty -> (a, b) map\n  = fun ty ->\n    let module OPS = Map.Make (struct\n        type t = a\n        let compare = compare_comparable ty\n      end) in\n    (module struct\n      type key = a\n      type value = b\n      let key_ty = ty\n      module OPS = OPS\n      let boxed = (OPS.empty, 0)\n    end)\n\nlet map_get\n  : type key value. key -> (key, value) map -> value option\n  = fun k (module Box) ->\n    Box.OPS.find_opt k (fst Box.boxed)\n\nlet map_update\n  : type a b. a -> b option -> (a, b) map -> (a, b) map\n  = fun k v (module Box) ->\n    (module struct\n      type key = a\n      type value = b\n      let key_ty = Box.key_ty\n      module OPS = Box.OPS\n      let boxed =\n        let (map, size) = Box.boxed in\n        let contains = Box.OPS.mem k map in\n        match v with\n        | Some v -> (Box.OPS.add k v map, size + if contains then 0 else 1)\n        | None -> (Box.OPS.remove k map, size - if contains then 1 else 0)\n    end)\n\nlet map_set\n  : type a b. a -> b -> (a, b) map -> (a, b) map\n  = fun k v (module Box) ->\n    (module struct\n      type key = a\n      type value = b\n      let key_ty = Box.key_ty\n      module OPS = Box.OPS\n      let boxed =\n        let (map, size) = Box.boxed in\n        (Box.OPS.add k v map, if Box.OPS.mem k map then size else size + 1)\n    end)\n\nlet map_mem\n  : type key value. key -> (key, value) map -> bool\n  = fun k (module Box) ->\n    Box.OPS.mem k (fst Box.boxed)\n\nlet map_fold\n  : type key value acc. (key -> value -> acc -> acc) -> (key, value) map -> acc -> acc\n  = fun f (module Box) ->\n    Box.OPS.fold f (fst Box.boxed)\n\nlet map_size\n  : type key value. (key, value) map -> Script_int.n Script_int.num =\n  fun (module Box) ->\n    Script_int.(abs (of_int (snd Box.boxed)))\n\n(* ---- Unparsing (Typed IR -> Untyped expressions) of types -----------------*)\n\nlet ty_of_comparable_ty\n  : type a. a comparable_ty -> a ty\n  = function\n    | Int_key tname -> Int_t tname\n    | Nat_key tname -> Nat_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    | Timestamp_key tname -> Timestamp_t tname\n    | Address_key tname -> Address_t tname\n\nlet unparse_comparable_ty\n  : type a. a comparable_ty -> Script.node\n  = function\n    | Int_key tname -> Prim (-1, T_int, [], unparse_type_annot tname)\n    | Nat_key tname -> Prim (-1, T_nat, [], unparse_type_annot tname)\n    | String_key tname -> Prim (-1, T_string, [], unparse_type_annot tname)\n    | Bytes_key tname -> Prim (-1, T_bytes, [], unparse_type_annot tname)\n    | Mutez_key tname -> Prim (-1, T_mutez, [], unparse_type_annot tname)\n    | Bool_key tname -> Prim (-1, T_bool, [], unparse_type_annot tname)\n    | Key_hash_key tname -> Prim (-1, T_key_hash, [], unparse_type_annot tname)\n    | Timestamp_key tname -> Prim (-1, T_timestamp, [], unparse_type_annot tname)\n    | Address_key tname -> Prim (-1, T_address, [], unparse_type_annot tname)\n\nlet add_field_annot a var = function\n  | Prim (loc, prim, args, annots) ->\n      Prim (loc, prim, args, annots @ unparse_field_annot a @ unparse_var_annot var )\n  | expr -> expr\n\nlet rec unparse_ty_no_lwt\n  : type a. context -> a ty -> (Script.node * context) tzresult\n  = fun ctxt ty ->\n    Gas.consume ctxt Unparse_costs.cycle >>? fun ctxt ->\n    let return ctxt (name, args, annot) =\n      let result = Prim (-1, name, args, annot) in\n      Gas.consume ctxt (Unparse_costs.prim_cost (List.length args) annot) >>? fun ctxt ->\n      ok (result, ctxt) in\n    match ty with\n    | Unit_t tname -> return ctxt (T_unit, [], unparse_type_annot tname)\n    | Int_t tname -> return ctxt (T_int, [], unparse_type_annot tname)\n    | Nat_t tname -> return ctxt (T_nat, [], unparse_type_annot tname)\n    | String_t tname -> return ctxt (T_string, [], unparse_type_annot tname)\n    | Bytes_t tname -> return ctxt (T_bytes, [], unparse_type_annot tname)\n    | Mutez_t tname -> return ctxt (T_mutez, [], unparse_type_annot tname)\n    | Bool_t tname -> return ctxt (T_bool, [], unparse_type_annot tname)\n    | Key_hash_t tname -> return ctxt (T_key_hash, [], unparse_type_annot tname)\n    | Key_t tname -> return ctxt (T_key, [], unparse_type_annot tname)\n    | Timestamp_t tname -> return ctxt (T_timestamp, [], unparse_type_annot tname)\n    | Address_t tname -> return ctxt (T_address, [], unparse_type_annot tname)\n    | Signature_t tname -> return ctxt (T_signature, [], unparse_type_annot tname)\n    | Operation_t tname -> return ctxt (T_operation, [], unparse_type_annot tname)\n    | Contract_t (ut, tname) ->\n        unparse_ty_no_lwt ctxt ut >>? fun (t, ctxt) ->\n        return ctxt (T_contract, [ t ], unparse_type_annot tname)\n    | Pair_t ((utl, l_field, l_var), (utr, r_field, r_var), tname) ->\n        let annot = unparse_type_annot tname in\n        unparse_ty_no_lwt ctxt utl >>? fun (utl, ctxt) ->\n        let tl = add_field_annot l_field l_var utl in\n        unparse_ty_no_lwt ctxt utr >>? fun (utr, ctxt) ->\n        let tr = add_field_annot r_field r_var utr in\n        return ctxt (T_pair, [ tl; tr ], annot)\n    | Union_t ((utl, l_field), (utr, r_field), tname) ->\n        let annot = unparse_type_annot tname in\n        unparse_ty_no_lwt ctxt utl >>? fun (utl, ctxt) ->\n        let tl = add_field_annot l_field None utl in\n        unparse_ty_no_lwt ctxt utr >>? fun (utr, ctxt) ->\n        let tr = add_field_annot r_field None utr in\n        return ctxt (T_or, [ tl; tr ], annot)\n    | Lambda_t (uta, utr, tname) ->\n        unparse_ty_no_lwt ctxt uta >>? fun (ta, ctxt) ->\n        unparse_ty_no_lwt ctxt utr >>? fun (tr, ctxt) ->\n        return ctxt (T_lambda, [ ta; tr ], unparse_type_annot tname)\n    | Option_t ((ut, some_field), _none_field, tname) ->\n        let annot = unparse_type_annot tname in\n        unparse_ty_no_lwt ctxt ut >>? fun (ut, ctxt) ->\n        let t = add_field_annot some_field None ut in\n        return ctxt (T_option, [ t ], annot)\n    | List_t (ut, tname) ->\n        unparse_ty_no_lwt ctxt ut >>? fun (t, ctxt) ->\n        return ctxt (T_list, [ t ], unparse_type_annot tname)\n    | Set_t (ut, tname) ->\n        let t = unparse_comparable_ty ut in\n        return ctxt (T_set, [ t ], unparse_type_annot tname)\n    | Map_t (uta, utr, tname) ->\n        let ta = unparse_comparable_ty uta in\n        unparse_ty_no_lwt ctxt utr >>? fun (tr, ctxt) ->\n        return ctxt (T_map, [ ta; tr ], unparse_type_annot tname)\n    | Big_map_t (uta, utr, tname) ->\n        let ta = unparse_comparable_ty uta in\n        unparse_ty_no_lwt ctxt utr >>? fun (tr, ctxt) ->\n        return ctxt (T_big_map, [ ta; tr ], unparse_type_annot tname)\n\nlet unparse_ty ctxt ty = Lwt.return (unparse_ty_no_lwt ctxt ty)\n\nlet 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.(String.get 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 ctxt ty =\n  unparse_ty_no_lwt ctxt ty |>\n  record_trace Cannot_serialize_error >|? fun (ty, ctxt) ->\n  strip_locations (strip_var_annots ty), ctxt\n\nlet rec unparse_stack\n  : type a. context -> a stack_ty -> ((Script.expr * Script.annot) list * context) tzresult Lwt.t\n  = fun ctxt -> function\n    | Empty_t -> return ([], ctxt)\n    | Item_t (ty, rest, annot) ->\n        unparse_ty ctxt ty >>=? fun (uty, ctxt) ->\n        unparse_stack ctxt rest >>=? fun (urest, ctxt) ->\n        return ((strip_locations uty, unparse_var_annot annot) :: urest, ctxt)\n\nlet serialize_stack_for_error ctxt stack_ty =\n  trace Cannot_serialize_error (unparse_stack ctxt stack_ty)\n\nlet name_of_ty\n  : type a. a ty -> type_annot option\n  = function\n    | Unit_t tname -> tname\n    | Int_t tname -> tname\n    | Nat_t tname -> tname\n    | String_t tname -> tname\n    | Bytes_t tname -> tname\n    | Mutez_t tname -> tname\n    | Bool_t tname -> tname\n    | Key_hash_t tname -> tname\n    | Key_t tname -> tname\n    | Timestamp_t tname -> tname\n    | Address_t tname -> tname\n    | Signature_t tname -> tname\n    | Operation_t tname -> tname\n    | Contract_t (_, tname) -> tname\n    | Pair_t (_, _, tname) -> tname\n    | Union_t (_, _, tname) -> tname\n    | Lambda_t (_, _, tname) -> tname\n    | Option_t (_, _, tname) -> tname\n    | List_t (_, tname) -> tname\n    | Set_t (_, tname) -> tname\n    | Map_t (_, _, tname) -> tname\n    | Big_map_t (_, _, tname) -> tname\n\n(* ---- Equality witnesses --------------------------------------------------*)\n\ntype ('ta, 'tb) eq = Eq : ('same, 'same) eq\n\nlet comparable_ty_eq\n  : type ta tb.\n    context ->\n    ta comparable_ty -> tb comparable_ty ->\n    (ta comparable_ty, tb comparable_ty) eq tzresult\n  = fun ctxt ta tb -> match ta, tb with\n    | Int_key _, Int_key _ -> Ok Eq\n    | Nat_key _, Nat_key _ -> Ok Eq\n    | String_key _, String_key _ -> Ok Eq\n    | Mutez_key _, Mutez_key _ -> Ok Eq\n    | Bool_key _, Bool_key _ -> Ok Eq\n    | Key_hash_key _, Key_hash_key _ -> Ok Eq\n    | Timestamp_key _, Timestamp_key _ -> Ok Eq\n    | Address_key _, Address_key _ -> Ok Eq\n    | _, _ ->\n        serialize_ty_for_error ctxt (ty_of_comparable_ty ta) >>? fun (ta, ctxt) ->\n        serialize_ty_for_error ctxt (ty_of_comparable_ty tb) >>? fun (tb, _ctxt) ->\n        error (Inconsistent_types (ta, tb))\n\nlet record_inconsistent ctxt ta tb =\n  record_trace_eval (fun () ->\n      serialize_ty_for_error ctxt ta >>? fun (ta, ctxt) ->\n      serialize_ty_for_error ctxt tb >|? fun (tb, _ctxt) ->\n      Inconsistent_types (ta, tb))\n\nlet record_inconsistent_type_annotations ctxt loc ta tb =\n  record_trace_eval (fun () ->\n      serialize_ty_for_error ctxt ta >>? fun (ta, ctxt) ->\n      serialize_ty_for_error ctxt tb >|? fun (tb, _ctxt) ->\n      Inconsistent_type_annotations (loc, ta, tb))\n\nlet rec ty_eq\n  : type ta tb. context -> ta ty -> tb ty -> ((ta ty, tb ty) eq * context) tzresult\n  = fun ctxt ta tb ->\n    let ok (eq : (ta ty, tb ty) eq) ctxt nb_args :\n      ((ta ty, tb ty) eq * context) tzresult =\n      Gas.consume ctxt (Typecheck_costs.type_ (2 * nb_args)) >>? fun ctxt ->\n      Ok (eq, ctxt) in\n    Gas.consume ctxt Typecheck_costs.cycle >>? fun ctxt ->\n    match ta, tb with\n    | Unit_t _, Unit_t _ -> ok Eq ctxt 0\n    | Int_t _, Int_t _ -> ok Eq ctxt 0\n    | Nat_t _, Nat_t _ -> ok Eq ctxt 0\n    | Key_t _, Key_t _ -> ok Eq ctxt 0\n    | Key_hash_t _, Key_hash_t _ -> ok Eq ctxt 0\n    | String_t _, String_t _ -> ok Eq ctxt 0\n    | Bytes_t _, Bytes_t _ -> ok Eq ctxt 0\n    | Signature_t _, Signature_t _ -> ok Eq ctxt 0\n    | Mutez_t _, Mutez_t _ -> ok Eq ctxt 0\n    | Timestamp_t _, Timestamp_t _ -> ok Eq ctxt 0\n    | Address_t _, Address_t _ -> ok Eq ctxt 0\n    | Bool_t _, Bool_t _ -> ok Eq ctxt 0\n    | Operation_t _, Operation_t _ -> ok Eq ctxt 0\n    | Map_t (tal, tar, _), Map_t (tbl, tbr, _) ->\n        (comparable_ty_eq ctxt tal tbl >>? fun Eq ->\n         ty_eq ctxt tar tbr >>? fun (Eq, ctxt) ->\n         (ok Eq ctxt 2)) |>\n        record_inconsistent ctxt ta tb\n    | Big_map_t (tal, tar, _), Big_map_t (tbl, tbr, _) ->\n        (comparable_ty_eq ctxt tal tbl >>? fun Eq ->\n         ty_eq ctxt tar tbr >>? fun (Eq, ctxt) ->\n         (ok Eq ctxt 2)) |>\n        record_inconsistent ctxt ta tb\n    | Set_t (ea, _), Set_t (eb, _) ->\n        (comparable_ty_eq ctxt ea eb >>? fun Eq ->\n         (ok Eq ctxt 1)) |>\n        record_inconsistent ctxt ta tb\n    | Pair_t ((tal, _, _), (tar, _, _), _),\n      Pair_t ((tbl, _, _), (tbr, _, _), _) ->\n        (ty_eq ctxt tal tbl >>? fun (Eq, ctxt) ->\n         ty_eq ctxt tar tbr >>? fun (Eq, ctxt) ->\n         (ok Eq ctxt 2)) |>\n        record_inconsistent ctxt ta tb\n    | Union_t ((tal, _), (tar, _), _), Union_t ((tbl, _), (tbr, _), _) ->\n        (ty_eq ctxt tal tbl >>? fun (Eq, ctxt) ->\n         ty_eq ctxt tar tbr >>? fun (Eq, ctxt) ->\n         (ok Eq ctxt 2)) |>\n        record_inconsistent ctxt ta tb\n    | Lambda_t (tal, tar, _), Lambda_t (tbl, tbr, _) ->\n        (ty_eq ctxt tal tbl >>? fun (Eq, ctxt) ->\n         ty_eq ctxt tar tbr >>? fun (Eq, ctxt) ->\n         (ok Eq ctxt 2)) |>\n        record_inconsistent ctxt ta tb\n    | Contract_t (tal, _), Contract_t (tbl, _) ->\n        (ty_eq ctxt tal tbl >>? fun (Eq, ctxt) ->\n         (ok Eq ctxt 1)) |>\n        record_inconsistent ctxt ta tb\n    | Option_t ((tva, _), _, _), Option_t ((tvb, _), _, _) ->\n        (ty_eq ctxt tva tvb >>? fun (Eq, ctxt) ->\n         (ok Eq ctxt 1)) |>\n        record_inconsistent ctxt ta tb\n    | List_t (tva, _), List_t (tvb, _) ->\n        (ty_eq ctxt tva tvb >>? fun (Eq, ctxt) ->\n         (ok Eq ctxt 1)) |>\n        record_inconsistent ctxt ta tb\n    | _, _ ->\n        serialize_ty_for_error ctxt ta >>? fun (ta, ctxt) ->\n        serialize_ty_for_error ctxt tb >>? fun (tb, _ctxt) ->\n        error (Inconsistent_types (ta, tb))\n\nlet rec stack_ty_eq\n  : type ta tb. context -> int -> ta stack_ty -> tb stack_ty ->\n    ((ta stack_ty, tb stack_ty) eq * context) tzresult\n  = fun ctxt lvl ta tb ->\n    match ta, tb with\n    | Item_t (tva, ra, _), Item_t (tvb, rb, _) ->\n        ty_eq ctxt tva tvb |>\n        record_trace (Bad_stack_item lvl) >>? fun (Eq, ctxt) ->\n        stack_ty_eq ctxt (lvl + 1) ra rb >>? fun (Eq, ctxt) ->\n        (Ok (Eq, ctxt) : ((ta stack_ty, tb stack_ty) eq * context) tzresult)\n    | Empty_t, Empty_t -> Ok (Eq, ctxt)\n    | _, _ -> error Bad_stack_length\n\nlet merge_comparable_types\n  : type ta. ta comparable_ty -> ta comparable_ty -> ta comparable_ty tzresult\n  = fun ta tb ->\n    match ta, tb with\n    | Int_key annot_a, Int_key annot_b ->\n        merge_type_annot annot_a annot_b >|? fun annot ->\n        Int_key annot\n    | Nat_key annot_a, Nat_key annot_b ->\n        merge_type_annot annot_a annot_b >|? fun annot ->\n        Nat_key annot\n    | String_key annot_a, String_key annot_b ->\n        merge_type_annot annot_a annot_b >|? fun annot ->\n        String_key annot\n    | Mutez_key annot_a, Mutez_key annot_b ->\n        merge_type_annot annot_a annot_b >|? fun annot ->\n        Mutez_key annot\n    | Bool_key annot_a, Bool_key annot_b ->\n        merge_type_annot annot_a annot_b >|? fun annot ->\n        Bool_key annot\n    | Key_hash_key annot_a, Key_hash_key annot_b ->\n        merge_type_annot annot_a annot_b >|? fun annot ->\n        Key_hash_key annot\n    | Timestamp_key annot_a, Timestamp_key annot_b ->\n        merge_type_annot annot_a annot_b >|? fun annot ->\n        Timestamp_key annot\n    | Address_key annot_a, Address_key annot_b ->\n        merge_type_annot annot_a annot_b >|? fun annot ->\n        Address_key annot\n    | _, _ -> assert false (* FIXME: fix injectivity of some types *)\n\nlet rec strip_annotations = function\n  | (Int (_,_) as i) -> i\n  | (String (_,_) as s) -> s\n  | (Bytes (_,_) as s) -> s\n  | Prim (loc, prim, args, _) -> Prim (loc, prim, List.map strip_annotations args, [])\n  | Seq (loc, items) -> Seq (loc, List.map strip_annotations items)\n\nlet merge_types :\n  type b. context -> Script.location -> b ty -> b ty -> (b ty * context) tzresult =\n  let rec help : type a. context -> a ty -> a ty -> (a ty * context) tzresult\n    = fun ctxt ty1 ty2 ->\n      match ty1, ty2 with\n      | Unit_t tn1, Unit_t tn2 ->\n          merge_type_annot tn1 tn2 >|? fun tname ->\n          Unit_t tname, ctxt\n      | Int_t tn1, Int_t tn2 ->\n          merge_type_annot tn1 tn2 >|? fun tname ->\n          Int_t tname, ctxt\n      | Nat_t tn1, Nat_t tn2 ->\n          merge_type_annot tn1 tn2 >|? fun tname ->\n          Nat_t tname, ctxt\n      | Key_t tn1, Key_t tn2 ->\n          merge_type_annot tn1 tn2 >|? fun tname ->\n          Key_t tname, ctxt\n      | Key_hash_t tn1, Key_hash_t tn2 ->\n          merge_type_annot tn1 tn2 >|? fun tname ->\n          Key_hash_t tname, ctxt\n      | String_t tn1, String_t tn2 ->\n          merge_type_annot tn1 tn2 >|? fun tname ->\n          String_t tname, ctxt\n      | Bytes_t tn1, Bytes_t tn2 ->\n          merge_type_annot tn1 tn2 >|? fun tname ->\n          Bytes_t tname, ctxt\n      | Signature_t tn1, Signature_t tn2 ->\n          merge_type_annot tn1 tn2 >|? fun tname ->\n          Signature_t tname, ctxt\n      | Mutez_t tn1, Mutez_t tn2 ->\n          merge_type_annot tn1 tn2 >|? fun tname ->\n          Mutez_t tname, ctxt\n      | Timestamp_t tn1, Timestamp_t tn2 ->\n          merge_type_annot tn1 tn2 >|? fun tname ->\n          Timestamp_t tname, ctxt\n      | Address_t tn1, Address_t tn2 ->\n          merge_type_annot tn1 tn2 >|? fun tname ->\n          Address_t tname, ctxt\n      | Bool_t tn1, Bool_t tn2 ->\n          merge_type_annot tn1 tn2 >|? fun tname ->\n          Bool_t tname, ctxt\n      | Operation_t tn1, Operation_t tn2 ->\n          merge_type_annot tn1 tn2 >|? fun tname ->\n          Operation_t tname, ctxt\n      | Map_t (tal, tar, tn1), Map_t (tbl, tbr, tn2) ->\n          merge_type_annot tn1 tn2 >>? fun tname ->\n          help ctxt tar tbr >>? fun (value, ctxt) ->\n          ty_eq ctxt tar value >>? fun (Eq, ctxt) ->\n          merge_comparable_types tal tbl >|? fun tk ->\n          Map_t (tk, value, tname), ctxt\n      | Big_map_t (tal, tar, tn1), Big_map_t (tbl, tbr, tn2) ->\n          merge_type_annot tn1 tn2 >>? fun tname ->\n          help ctxt tar tbr >>? fun (value, ctxt) ->\n          ty_eq ctxt tar value >>? fun (Eq, ctxt) ->\n          merge_comparable_types tal tbl >|? fun tk ->\n          Big_map_t (tk, value, tname), ctxt\n      | Set_t (ea, tn1), Set_t (eb, tn2) ->\n          merge_type_annot tn1 tn2 >>? fun tname ->\n          merge_comparable_types ea eb >|? fun e ->\n          Set_t (e, tname), ctxt\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_annot tn1 tn2 >>? fun tname ->\n          merge_field_annot l_field1 l_field2 >>? fun l_field ->\n          merge_field_annot 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 ctxt tal tbl >>? fun (left_ty, ctxt) ->\n          help ctxt tar tbr >|? fun (right_ty, ctxt) ->\n          Pair_t ((left_ty, l_field, l_var), (right_ty, r_field, r_var), tname),\n          ctxt\n      | Union_t ((tal, tal_annot), (tar, tar_annot), tn1),\n        Union_t ((tbl, tbl_annot), (tbr, tbr_annot), tn2) ->\n          merge_type_annot tn1 tn2 >>? fun tname ->\n          merge_field_annot tal_annot tbl_annot >>? fun left_annot ->\n          merge_field_annot tar_annot tbr_annot >>? fun right_annot ->\n          help ctxt tal tbl >>? fun (left_ty, ctxt) ->\n          help ctxt tar tbr >|? fun (right_ty, ctxt) ->\n          Union_t ((left_ty, left_annot), (right_ty, right_annot), tname),\n          ctxt\n      | Lambda_t (tal, tar, tn1), Lambda_t (tbl, tbr, tn2) ->\n          merge_type_annot tn1 tn2 >>? fun tname ->\n          help ctxt tal tbl >>? fun (left_ty, ctxt) ->\n          help ctxt tar tbr >|? fun (right_ty, ctxt) ->\n          Lambda_t (left_ty, right_ty, tname), ctxt\n      | Contract_t (tal, tn1), Contract_t (tbl, tn2) ->\n          merge_type_annot tn1 tn2 >>? fun tname ->\n          help ctxt tal tbl >|? fun (arg_ty, ctxt) ->\n          Contract_t (arg_ty, tname), ctxt\n      | Option_t ((tva, some_annot_a), none_annot_a, tn1),\n        Option_t ((tvb, some_annot_b), none_annot_b, tn2) ->\n          merge_type_annot tn1 tn2 >>? fun tname ->\n          merge_field_annot some_annot_a some_annot_b >>? fun some_annot ->\n          merge_field_annot none_annot_a none_annot_b >>? fun none_annot ->\n          help ctxt tva tvb >|? fun (ty, ctxt) ->\n          Option_t ((ty, some_annot), none_annot, tname), ctxt\n      | List_t (tva, tn1), List_t (tvb, tn2) ->\n          merge_type_annot tn1 tn2 >>? fun tname ->\n          help ctxt tva tvb >|? fun (ty, ctxt) ->\n          List_t (ty, tname), ctxt\n      | _, _ -> assert false\n  in (fun ctxt loc ty1 ty2 ->\n      record_inconsistent_type_annotations ctxt loc ty1 ty2\n        (help ctxt ty1 ty2))\n\nlet merge_stacks\n  : type ta. Script.location -> context -> ta stack_ty -> ta stack_ty ->\n    (ta stack_ty * context) tzresult\n  = fun loc ->\n    let rec help : type a. context -> a stack_ty -> a stack_ty ->\n      (a stack_ty * context) tzresult\n      = fun ctxt stack1 stack2 ->\n        match stack1, stack2 with\n        | Empty_t, Empty_t -> ok (Empty_t, ctxt)\n        | Item_t (ty1, rest1, annot1),\n          Item_t (ty2, rest2, annot2) ->\n            let annot = merge_var_annot annot1 annot2 in\n            merge_types ctxt loc ty1 ty2 >>? fun (ty, ctxt) ->\n            help ctxt rest1 rest2 >|? fun (rest, ctxt) ->\n            Item_t (ty, rest, annot), ctxt\n    in help\n\n(* ---- Type checker results -------------------------------------------------*)\n\ntype 'bef judgement =\n  | Typed : ('bef, 'aft) descr -> 'bef judgement\n  | Failed : { descr : 'aft. 'aft stack_ty -> ('bef, 'aft) descr } -> 'bef judgement\n\n(* ---- Type checker (Untyped expressions -> Typed IR) ----------------------*)\n\ntype ('t, 'f, 'b) branch =\n  { branch : 'r. ('t, 'r) descr -> ('f, 'r) descr -> ('b, 'r) descr } [@@unboxed]\n\n\nlet merge_branches\n  : type bef a b. context -> int -> a judgement -> b judgement ->\n    (a, b, bef) branch ->\n    (bef judgement * context) tzresult Lwt.t\n  = fun 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          serialize_stack_for_error ctxt aftbt >>=? fun (aftbt, ctxt) ->\n          serialize_stack_for_error ctxt aftbf >>|? fun (aftbf, _ctxt) ->\n          Unmatched_branches (loc, aftbt, aftbf) in\n        trace_eval unmatched_branches\n          (Lwt.return (stack_ty_eq ctxt 1 aftbt aftbf) >>=? fun (Eq, ctxt) ->\n           Lwt.return (merge_stacks loc ctxt aftbt aftbf) >>=? fun (merged_stack, ctxt) ->\n           return (\n             Typed (branch {dbt with aft=merged_stack} {dbf with aft=merged_stack}),\n             ctxt))\n    | Failed { descr = descrt }, Failed { descr = descrf } ->\n        let descr ret =\n          branch (descrt ret) (descrf ret) in\n        return (Failed { descr }, ctxt)\n    | Typed dbt, Failed { descr = descrf } ->\n        return (Typed (branch dbt (descrf dbt.aft)), ctxt)\n    | Failed { descr = descrt }, Typed dbf ->\n        return (Typed (branch (descrt dbf.aft) dbf), ctxt)\n\nlet rec parse_comparable_ty\n  : context -> Script.node -> (ex_comparable_ty * context) tzresult\n  = fun ctxt ty ->\n    Gas.consume ctxt Typecheck_costs.cycle >>? fun ctxt ->\n    Gas.consume ctxt (Typecheck_costs.type_ 0) >>? fun ctxt ->\n    match ty with\n    | Prim (loc, T_int, [], annot) ->\n        parse_type_annot loc annot >|? fun tname ->\n        Ex_comparable_ty ( Int_key tname ), ctxt\n    | Prim (loc, T_nat, [], annot) ->\n        parse_type_annot loc annot >|? fun tname ->\n        Ex_comparable_ty ( Nat_key tname ), ctxt\n    | Prim (loc, T_string, [], annot) ->\n        parse_type_annot loc annot >|? fun tname ->\n        Ex_comparable_ty ( String_key tname ), ctxt\n    | Prim (loc, T_mutez, [], annot) ->\n        parse_type_annot loc annot >|? fun tname ->\n        Ex_comparable_ty ( Mutez_key tname ), ctxt\n    | Prim (loc, T_bool, [], annot) ->\n        parse_type_annot loc annot >|? fun tname ->\n        Ex_comparable_ty ( Bool_key tname ), ctxt\n    | Prim (loc, T_key_hash, [], annot) ->\n        parse_type_annot loc annot >|? fun tname ->\n        Ex_comparable_ty ( Key_hash_key tname ), ctxt\n    | Prim (loc, T_timestamp, [], annot) ->\n        parse_type_annot loc annot >|? fun tname ->\n        Ex_comparable_ty ( Timestamp_key tname ), ctxt\n    | Prim (loc, T_address, [], annot) ->\n        parse_type_annot loc annot >|? fun tname ->\n        Ex_comparable_ty ( Address_key tname ), ctxt\n    | Prim (loc, (T_int | T_nat\n                 | T_string | T_mutez | T_bool\n                 | T_key | T_address | T_timestamp as prim), l, _) ->\n        error (Invalid_arity (loc, prim, 0, List.length l))\n    | Prim (loc, (T_pair | T_or | T_set | T_map\n                 | T_list | T_option  | T_lambda\n                 | T_unit | T_signature  | T_contract), _, _) ->\n        error (Comparable_type_expected (loc, Micheline.strip_locations ty))\n    | expr ->\n        error @@ unexpected expr [] Type_namespace\n          [ T_int ; T_nat ;\n            T_string ; T_mutez ; T_bool ;\n            T_key ; T_key_hash ; T_timestamp ]\n\nand parse_ty :\n  context ->\n  allow_big_map: bool ->\n  allow_operation: bool ->\n  Script.node -> (ex_ty * context) tzresult\n  = fun ctxt ~allow_big_map ~allow_operation node ->\n    Gas.consume ctxt Typecheck_costs.cycle >>? fun ctxt ->\n    match node with\n    | Prim (loc, T_pair,\n            [ Prim (big_map_loc, T_big_map, args, map_annot) ; remaining_storage ],\n            storage_annot)\n      when allow_big_map ->\n        begin match args with\n          | [ key_ty ; value_ty ] ->\n              parse_comparable_ty ctxt key_ty >>? fun (Ex_comparable_ty key_ty, ctxt) ->\n              parse_ty ctxt ~allow_big_map:false ~allow_operation value_ty\n              >>? fun (Ex_ty value_ty, ctxt) ->\n              parse_ty ctxt ~allow_big_map:false ~allow_operation remaining_storage\n              >>? fun (Ex_ty remaining_storage, ctxt) ->\n              parse_type_annot big_map_loc map_annot >>? fun map_name ->\n              parse_composed_type_annot loc storage_annot\n              >>? fun (ty_name, map_field, storage_field) ->\n              Gas.consume ctxt (Typecheck_costs.type_ 5) >|? fun ctxt ->\n              let big_map_ty = Big_map_t (key_ty, value_ty, map_name) in\n              Ex_ty (Pair_t ((big_map_ty, map_field, None),\n                             (remaining_storage, storage_field, None),\n                             ty_name)),\n              ctxt\n          | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args)\n        end\n    | Prim (loc, T_unit, [], annot) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->\n        Ex_ty (Unit_t ty_name), ctxt\n    | Prim (loc, T_int, [], annot) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->\n        Ex_ty (Int_t ty_name), ctxt\n    | Prim (loc, T_nat, [], annot) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->\n        Ex_ty (Nat_t ty_name), ctxt\n    | Prim (loc, T_string, [], annot) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->\n        Ex_ty (String_t ty_name), ctxt\n    | Prim (loc, T_bytes, [], annot) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->\n        Ex_ty (Bytes_t ty_name), ctxt\n    | Prim (loc, T_mutez, [], annot) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->\n        Ex_ty (Mutez_t ty_name), ctxt\n    | Prim (loc, T_bool, [], annot) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->\n        Ex_ty (Bool_t ty_name), ctxt\n    | Prim (loc, T_key, [], annot) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->\n        Ex_ty (Key_t ty_name), ctxt\n    | Prim (loc, T_key_hash, [], annot) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->\n        Ex_ty (Key_hash_t ty_name), ctxt\n    | Prim (loc, T_timestamp, [], annot) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->\n        Ex_ty (Timestamp_t ty_name), ctxt\n    | Prim (loc, T_address, [], annot) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->\n        Ex_ty (Address_t ty_name), ctxt\n    | Prim (loc, T_signature, [], annot) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->\n        Ex_ty (Signature_t ty_name), ctxt\n    | Prim (loc, T_operation, [], annot) ->\n        if allow_operation then\n          parse_type_annot loc annot >>? fun ty_name ->\n          Gas.consume ctxt (Typecheck_costs.type_ 0) >|? fun ctxt ->\n          Ex_ty (Operation_t ty_name), ctxt\n        else\n          error (Unexpected_operation loc)\n    | Prim (loc, T_contract, [ utl ], annot) ->\n        parse_ty ctxt ~allow_big_map:false ~allow_operation utl >>? fun (Ex_ty tl, ctxt) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 1) >|? fun ctxt ->\n        Ex_ty (Contract_t (tl, ty_name)), ctxt\n    | Prim (loc, T_pair, [ utl; utr ], annot) ->\n        extract_field_annot utl >>? fun (utl, left_field) ->\n        extract_field_annot utr >>? fun (utr, right_field) ->\n        parse_ty ctxt ~allow_big_map:false ~allow_operation utl >>? fun (Ex_ty tl, ctxt) ->\n        parse_ty ctxt ~allow_big_map:false ~allow_operation utr >>? fun (Ex_ty tr, ctxt) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 2) >|? fun ctxt ->\n        Ex_ty (Pair_t ((tl, left_field, None), (tr, right_field, None), ty_name)), 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 ctxt ~allow_big_map:false ~allow_operation utl >>? fun (Ex_ty tl, ctxt) ->\n        parse_ty ctxt ~allow_big_map:false ~allow_operation utr >>? fun (Ex_ty tr, ctxt) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 2) >|? fun ctxt ->\n        Ex_ty (Union_t ((tl, left_constr), (tr, right_constr), ty_name)), ctxt\n    | Prim (loc, T_lambda, [ uta; utr ], annot) ->\n        parse_ty ctxt ~allow_big_map:false ~allow_operation:true uta >>? fun (Ex_ty ta, ctxt) ->\n        parse_ty ctxt ~allow_big_map:false ~allow_operation:true utr >>? fun (Ex_ty tr, ctxt) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 2) >|? fun ctxt ->\n        Ex_ty (Lambda_t (ta, tr, ty_name)), ctxt\n    | Prim (loc, T_option, [ ut ], annot) ->\n        extract_field_annot ut >>? fun (ut, some_constr) ->\n        parse_ty ctxt ~allow_big_map:false ~allow_operation ut >>? fun (Ex_ty t, ctxt) ->\n        parse_composed_type_annot loc annot >>? fun (ty_name, none_constr, _) ->\n        Gas.consume ctxt (Typecheck_costs.type_ 2) >|? fun ctxt ->\n        Ex_ty (Option_t ((t, some_constr), none_constr, ty_name)), ctxt\n    | Prim (loc, T_list, [ ut ], annot) ->\n        parse_ty ctxt ~allow_big_map:false ~allow_operation ut >>? fun (Ex_ty t, ctxt) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 1) >|? fun ctxt ->\n        Ex_ty (List_t (t, ty_name)), ctxt\n    | Prim (loc, T_set, [ ut ], annot) ->\n        parse_comparable_ty ctxt ut >>? fun (Ex_comparable_ty t, ctxt) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 1) >|? fun ctxt ->\n        Ex_ty (Set_t (t, ty_name)), ctxt\n    | Prim (loc, T_map, [ uta; utr ], annot) ->\n        parse_comparable_ty ctxt uta >>? fun (Ex_comparable_ty ta, ctxt) ->\n        parse_ty ctxt ~allow_big_map:false ~allow_operation utr >>? fun (Ex_ty tr, ctxt) ->\n        parse_type_annot loc annot >>? fun ty_name ->\n        Gas.consume ctxt (Typecheck_costs.type_ 2) >|? fun ctxt ->\n        Ex_ty (Map_t (ta, tr, ty_name)), ctxt\n    | Prim (loc, T_big_map, _, _) ->\n        error (Unexpected_big_map loc)\n    | Prim (loc, (T_unit | T_signature\n                 | T_int | T_nat\n                 | T_string | T_bytes | T_mutez | T_bool\n                 | T_key | T_key_hash\n                 | T_timestamp | T_address as prim), l, _) ->\n        error (Invalid_arity (loc, prim, 0, List.length l))\n    | Prim (loc, (T_set | T_list | T_option as prim), l, _) ->\n        error (Invalid_arity (loc, prim, 1, List.length l))\n    | Prim (loc, (T_pair | T_or | T_map | T_lambda | T_contract as prim), l, _) ->\n        error (Invalid_arity (loc, prim, 2, List.length l))\n    | expr ->\n        error @@ unexpected expr [] Type_namespace\n          [ T_pair ; T_or ; T_set ; T_map ;\n            T_list ; T_option  ; T_lambda ;\n            T_unit ; T_signature  ; T_contract ;\n            T_int ; T_nat ; T_operation ;\n            T_string ; T_bytes ; T_mutez ; T_bool ;\n            T_key ; T_key_hash ; T_timestamp ]\n\nlet check_no_big_map_or_operation loc root =\n  let rec check : type t. t ty -> unit tzresult = function\n    | Big_map_t _ -> error (Unexpected_big_map loc)\n    | Operation_t _ -> error (Unexpected_operation loc)\n    | Unit_t _ -> ok ()\n    | Int_t _ -> ok ()\n    | Nat_t _ -> ok ()\n    | Signature_t _ -> ok ()\n    | String_t _ -> ok ()\n    | Bytes_t _ -> ok ()\n    | Mutez_t _ -> ok ()\n    | Key_hash_t _ -> ok ()\n    | Key_t _ -> ok ()\n    | Timestamp_t _ -> ok ()\n    | Address_t _ -> ok ()\n    | Bool_t _ -> ok ()\n    | Pair_t ((l_ty, _, _), (r_ty, _, _), _) ->\n        check l_ty >>? fun () -> check r_ty\n    | Union_t ((l_ty, _), (r_ty, _), _) ->\n        check l_ty >>? fun () -> check r_ty\n    | Lambda_t (l_ty, r_ty, _) ->\n        check l_ty >>? fun () -> check r_ty\n    | Option_t ((v_ty, _), _, _) -> check v_ty\n    | List_t (elt_ty, _) -> check elt_ty\n    | Set_t (_, _) -> ok ()\n    | Map_t (_, elt_ty, _) -> check elt_ty\n    | Contract_t (_, _) -> ok () in\n  check root\n\ntype ex_script = Ex_script : ('a, 'c) script -> ex_script\n\n(* Lwt versions *)\nlet parse_var_annot loc ?default annot =\n  Lwt.return (parse_var_annot loc ?default annot)\nlet parse_constr_annot loc ?if_special_first ?if_special_second annot =\n  Lwt.return (parse_constr_annot loc ?if_special_first ?if_special_second annot)\nlet parse_two_var_annot loc annot =\n  Lwt.return (parse_two_var_annot loc annot)\nlet parse_destr_annot loc annot ~default_accessor ~field_name ~pair_annot ~value_annot =\n  Lwt.return (parse_destr_annot loc annot ~default_accessor ~field_name ~pair_annot ~value_annot)\nlet parse_var_type_annot loc annot =\n  Lwt.return (parse_var_type_annot loc annot)\n\nlet rec parse_data\n  : type a.\n    ?type_logger: type_logger ->\n    context -> a ty -> Script.node -> (a * context) tzresult Lwt.t\n  = fun  ?type_logger ctxt ty script_data ->\n    Lwt.return (Gas.consume ctxt Typecheck_costs.cycle) >>=? fun ctxt ->\n    let error () =\n      Lwt.return (serialize_ty_for_error ctxt ty) >>|? fun (ty, _ctxt) ->\n      Invalid_constant (location script_data, strip_locations script_data, ty) in\n    let traced body =\n      trace_eval error body in\n    let parse_items ?type_logger loc ctxt expr key_type value_type items item_wrapper =\n      let length = List.length items in\n      fold_left_s\n        (fun (last_value, map, ctxt) item ->\n           Lwt.return (Gas.consume ctxt (Typecheck_costs.map_element length)) >>=? fun ctxt ->\n           match item with\n           | Prim (_, D_Elt, [ k; v ], _) ->\n               parse_comparable_data ?type_logger ctxt key_type k >>=? fun (k, ctxt) ->\n               parse_data ?type_logger ctxt value_type v >>=? fun (v, ctxt) ->\n               begin match last_value with\n                 | Some value ->\n                     if Compare.Int.(0 <= (compare_comparable key_type value k))\n                     then\n                       if Compare.Int.(0 = (compare_comparable key_type value k))\n                       then fail (Duplicate_map_keys (loc, strip_locations expr))\n                       else fail (Unordered_map_keys (loc, strip_locations expr))\n                     else return_unit\n                 | None -> return_unit\n               end >>=? fun () ->\n               return (Some k, map_update k (Some (item_wrapper v)) map, 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 _ ->\n               error () >>=? fail)\n        (None, empty_map key_type, ctxt) items |> traced >>|? fun (_, items, ctxt) ->\n      (items, ctxt) in\n    match ty, script_data with\n    (* Unit *)\n    | Unit_t ty_name, Prim (loc, D_Unit, [], annot) ->\n        check_const_type_annot loc annot ty_name [] >>=? fun () ->\n        Lwt.return (Gas.consume ctxt Typecheck_costs.unit) >>|? fun ctxt ->\n        ((() : a), ctxt)\n    | Unit_t _, Prim (loc, D_Unit, l, _) ->\n        traced (fail (Invalid_arity (loc, D_Unit, 0, List.length l)))\n    | Unit_t _, expr ->\n        traced (fail (unexpected expr [] Constant_namespace [ D_Unit ]))\n    (* Booleans *)\n    | Bool_t ty_name, Prim (loc, D_True, [], annot) ->\n        check_const_type_annot loc annot ty_name [] >>=? fun () ->\n        Lwt.return (Gas.consume ctxt Typecheck_costs.bool) >>|? fun ctxt ->\n        (true, ctxt)\n    | Bool_t ty_name, Prim (loc, D_False, [], annot) ->\n        check_const_type_annot loc annot ty_name [] >>=? fun () ->\n        Lwt.return (Gas.consume ctxt Typecheck_costs.bool) >>|? fun ctxt ->\n        (false, ctxt)\n    | Bool_t _, Prim (loc, (D_True | D_False as c), l, _) ->\n        traced (fail (Invalid_arity (loc, c, 0, List.length l)))\n    | Bool_t _, expr ->\n        traced (fail (unexpected expr [] Constant_namespace [ D_True ; D_False ]))\n    (* Strings *)\n    | String_t _, String (_, v) ->\n        Lwt.return (Gas.consume ctxt (Typecheck_costs.string (String.length v))) >>=? fun ctxt ->\n        let rec check_printable_ascii i =\n          if Compare.Int.(i < 0) then true\n          else match String.get v i with\n            | '\\n' | '\\x20'..'\\x7E' -> check_printable_ascii (i - 1)\n            | _ -> false in\n        if check_printable_ascii (String.length v - 1) then\n          return (v, ctxt)\n        else\n          error () >>=? fail\n    | String_t _, expr ->\n        traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr)))\n    (* Byte sequences *)\n    | Bytes_t _, Bytes (_, v) ->\n        Lwt.return (Gas.consume ctxt (Typecheck_costs.string (MBytes.length v))) >>=? fun ctxt ->\n        return (v, ctxt)\n    | Bytes_t _, expr ->\n        traced (fail (Invalid_kind (location expr, [ Bytes_kind ], kind expr)))\n    (* Integers *)\n    | Int_t _, Int (_, v) ->\n        Lwt.return (Gas.consume ctxt (Typecheck_costs.z v)) >>=? fun ctxt ->\n        return (Script_int.of_zint v, ctxt)\n    | Nat_t _, Int (_, v) ->\n        Lwt.return (Gas.consume ctxt (Typecheck_costs.z v)) >>=? fun ctxt ->\n        let v = Script_int.of_zint v in\n        if Compare.Int.(Script_int.compare v Script_int.zero >= 0) then\n          return (Script_int.abs v, ctxt)\n        else\n          error () >>=? fail\n    | Int_t _, expr ->\n        traced (fail (Invalid_kind (location expr, [ Int_kind ], kind expr)))\n    | Nat_t _, expr ->\n        traced (fail (Invalid_kind (location expr, [ Int_kind ], kind expr)))\n    (* Tez amounts *)\n    | Mutez_t _, Int (_, v) ->\n        Lwt.return (\n          Gas.consume ctxt Typecheck_costs.tez >>? fun ctxt ->\n          Gas.consume ctxt Michelson_v1_gas.Cost_of.z_to_int64\n        ) >>=? fun ctxt ->\n        begin try\n            match Tez.of_mutez (Z.to_int64 v) with\n            | None -> raise Exit\n            | Some tez -> return (tez, ctxt)\n          with _ ->\n            error () >>=? fail\n        end\n    | Mutez_t _, expr ->\n        traced (fail (Invalid_kind (location expr, [ Int_kind ], kind expr)))\n    (* Timestamps *)\n    | Timestamp_t _, (Int (_, v)) (* As unparsed with [Optimized] or out of bounds [Readable]. *) ->\n        Lwt.return (Gas.consume ctxt (Typecheck_costs.z v)) >>=? fun ctxt ->\n        return (Script_timestamp.of_zint v, ctxt)\n    | Timestamp_t _, String (_, s) (* As unparsed with [Redable]. *) ->\n        Lwt.return (Gas.consume ctxt Typecheck_costs.string_timestamp) >>=? fun ctxt ->\n        begin match Script_timestamp.of_string s with\n          | Some v -> return (v, ctxt)\n          | None -> error () >>=? fail\n        end\n    | Timestamp_t _, expr ->\n        traced (fail (Invalid_kind (location expr, [ String_kind ; Int_kind ], kind expr)))\n    (* IDs *)\n    | Key_t _, Bytes (_, bytes) -> (* As unparsed with [Optimized]. *)\n        Lwt.return (Gas.consume ctxt Typecheck_costs.key) >>=? fun ctxt ->\n        begin match Data_encoding.Binary.of_bytes Signature.Public_key.encoding bytes with\n          | Some k -> return (k, ctxt)\n          | None -> error () >>=? fail\n        end\n    | Key_t _, String (_, s) -> (* As unparsed with [Readable]. *)\n        Lwt.return (Gas.consume ctxt Typecheck_costs.key) >>=? fun ctxt ->\n        begin match Signature.Public_key.of_b58check_opt s with\n          | Some k -> return (k, ctxt)\n          | None -> error () >>=? fail\n        end\n    | Key_t _, expr ->\n        traced (fail (Invalid_kind (location expr, [ String_kind ; Bytes_kind ], kind expr)))\n    | Key_hash_t _, Bytes (_, bytes) -> (* As unparsed with [Optimized]. *)\n        Lwt.return (Gas.consume ctxt Typecheck_costs.key_hash) >>=? fun ctxt ->\n        begin\n          match Data_encoding.Binary.of_bytes Signature.Public_key_hash.encoding bytes with\n          | Some k -> return (k, ctxt)\n          | None -> error () >>=? fail\n        end\n    | Key_hash_t _, String (_, s) (* As unparsed with [Readable]. *) ->\n        Lwt.return (Gas.consume ctxt Typecheck_costs.key_hash) >>=? fun ctxt ->\n        begin match Signature.Public_key_hash.of_b58check_opt s with\n          | Some k -> return (k, ctxt)\n          | None -> error () >>=? fail\n        end\n    | Key_hash_t _, expr ->\n        traced (fail (Invalid_kind (location expr, [ String_kind ; Bytes_kind ], kind expr)))\n    (* Signatures *)\n    | Signature_t _, Bytes (_, bytes) (* As unparsed with [Optimized]. *) ->\n        Lwt.return (Gas.consume ctxt Typecheck_costs.signature) >>=? fun ctxt ->\n        begin match Data_encoding.Binary.of_bytes Signature.encoding bytes with\n          | Some k -> return (k, ctxt)\n          | None -> error () >>=? fail\n        end\n    | Signature_t _, String (_, s) (* As unparsed with [Readable]. *) ->\n        Lwt.return (Gas.consume ctxt Typecheck_costs.signature) >>=? fun ctxt ->\n        begin match Signature.of_b58check_opt s with\n          | Some s -> return (s, ctxt)\n          | None -> error () >>=? fail\n        end\n    | Signature_t _, expr ->\n        traced (fail (Invalid_kind (location expr, [ String_kind ; Bytes_kind ], kind expr)))\n    (* Operations *)\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    (* Addresses *)\n    | Address_t _, Bytes (_, bytes) (* As unparsed with [O[ptimized]. *) ->\n        Lwt.return (Gas.consume ctxt Typecheck_costs.contract) >>=? fun ctxt ->\n        begin\n          match Data_encoding.Binary.of_bytes Contract.encoding bytes with\n          | Some c -> return (c, ctxt)\n          | None -> error () >>=? fail\n        end\n    | Address_t _, String (_, s) (* As unparsed with [Readable]. *) ->\n        Lwt.return (Gas.consume ctxt Typecheck_costs.contract) >>=? fun ctxt ->\n        traced (Lwt.return (Contract.of_b58check s)) >>=? fun c ->\n        return (c, ctxt)\n    | Address_t _, expr ->\n        traced (fail (Invalid_kind (location expr, [ String_kind ; Bytes_kind ], kind expr)))\n    (* Contracts *)\n    | Contract_t (ty, _), Bytes (loc, bytes) (* As unparsed with [Optimized]. *) ->\n        Lwt.return (Gas.consume ctxt Typecheck_costs.contract) >>=? fun ctxt ->\n        begin\n          match Data_encoding.Binary.of_bytes Contract.encoding bytes with\n          | Some c ->\n              traced (parse_contract ctxt loc ty c) >>=? fun (ctxt, _) ->\n              return ((ty, c), ctxt)\n          | None -> error () >>=? fail\n        end\n    | Contract_t (ty, _), String (loc, s) (* As unparsed with [Readable]. *) ->\n        Lwt.return (Gas.consume ctxt Typecheck_costs.contract) >>=? fun ctxt ->\n        traced @@\n        Lwt.return (Contract.of_b58check s) >>=? fun c ->\n        parse_contract ctxt loc ty c >>=? fun (ctxt, _) ->\n        return ((ty, c), ctxt)\n    | Contract_t _, expr ->\n        traced (fail (Invalid_kind (location expr, [ String_kind ; Bytes_kind ], kind expr)))\n    (* Pairs *)\n    | Pair_t ((ta, af, _), (tb, bf, _), ty_name), Prim (loc, D_Pair, [ va; vb ], annot) ->\n        check_const_type_annot loc annot ty_name [af; bf] >>=? fun () ->\n        Lwt.return (Gas.consume ctxt Typecheck_costs.pair) >>=? fun ctxt ->\n        traced @@\n        parse_data ?type_logger ctxt ta va >>=? fun (va, ctxt) ->\n        parse_data ?type_logger ctxt tb vb >>=? fun (vb, ctxt) ->\n        return ((va, vb), ctxt)\n    | Pair_t _, Prim (loc, D_Pair, l, _) ->\n        fail @@ Invalid_arity (loc, D_Pair, 2, List.length l)\n    | Pair_t _, expr ->\n        traced (fail (unexpected expr [] Constant_namespace [ D_Pair ]))\n    (* Unions *)\n    | Union_t ((tl, lconstr), _, ty_name), Prim (loc, D_Left, [ v ], annot) ->\n        check_const_type_annot loc annot ty_name [lconstr]>>=? fun () ->\n        Lwt.return (Gas.consume ctxt Typecheck_costs.union) >>=? fun ctxt ->\n        traced @@\n        parse_data ?type_logger ctxt tl v >>=? fun (v, ctxt) ->\n        return (L v, ctxt)\n    | Union_t _, Prim (loc, D_Left, l, _) ->\n        fail @@ Invalid_arity (loc, D_Left, 1, List.length l)\n    | Union_t (_, (tr, rconstr), ty_name), Prim (loc, D_Right, [ v ], annot) ->\n        check_const_type_annot loc annot ty_name [rconstr] >>=? fun () ->\n        Lwt.return (Gas.consume ctxt Typecheck_costs.union) >>=? fun ctxt ->\n        traced @@\n        parse_data ?type_logger ctxt tr v >>=? fun (v, ctxt) ->\n        return (R v, ctxt)\n    | Union_t _, Prim (loc, D_Right, l, _) ->\n        fail @@ Invalid_arity (loc, D_Right, 1, List.length l)\n    | Union_t _, expr ->\n        traced (fail (unexpected expr [] Constant_namespace [ D_Left ; D_Right ]))\n    (* Lambdas *)\n    | Lambda_t (ta, tr, _ty_name), (Seq (_loc, _) as script_instr) ->\n        Lwt.return (Gas.consume ctxt Typecheck_costs.lambda) >>=? fun ctxt ->\n        traced @@\n        parse_returning Lambda ?type_logger ctxt (ta, Some (`Var_annot \"@arg\")) tr script_instr\n    | Lambda_t _, expr ->\n        traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr)))\n    (* Options *)\n    | Option_t ((t, some_constr), _, ty_name), Prim (loc, D_Some, [ v ], annot) ->\n        check_const_type_annot loc annot ty_name [some_constr] >>=? fun () ->\n        Lwt.return (Gas.consume ctxt Typecheck_costs.some) >>=? fun ctxt ->\n        traced @@\n        parse_data ?type_logger ctxt t v >>=? fun (v, ctxt) ->\n        return (Some v, ctxt)\n    | Option_t _, Prim (loc, D_Some, l, _) ->\n        fail @@ Invalid_arity (loc, D_Some, 1, List.length l)\n    | Option_t (_, none_constr, ty_name), Prim (loc, D_None, [], annot) ->\n        check_const_type_annot loc annot ty_name [none_constr] >>=? fun () ->\n        Lwt.return (Gas.consume ctxt Typecheck_costs.none) >>=? fun ctxt ->\n        return (None, ctxt)\n    | Option_t _, Prim (loc, D_None, l, _) ->\n        fail @@ Invalid_arity (loc, D_None, 0, List.length l)\n    | Option_t _, expr ->\n        traced (fail (unexpected expr [] Constant_namespace [ D_Some ; D_None ]))\n    (* Lists *)\n    | List_t (t, _ty_name), Seq (_loc, items) ->\n        traced @@\n        fold_right_s\n          (fun v (rest, ctxt) ->\n             Lwt.return (Gas.consume ctxt Typecheck_costs.list_element) >>=? fun ctxt ->\n             parse_data ?type_logger ctxt  t v >>=? fun (v, ctxt) ->\n             return ((v :: rest), ctxt))\n          items ([], ctxt)\n    | List_t _, expr ->\n        traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr)))\n    (* Sets *)\n    | Set_t (t, _ty_name), (Seq (loc, vs) as expr) ->\n        let length = List.length vs in\n        traced @@\n        fold_left_s\n          (fun (last_value, set, ctxt) v ->\n             Lwt.return (Gas.consume ctxt (Typecheck_costs.set_element length)) >>=? fun ctxt ->\n             parse_comparable_data ?type_logger ctxt t v >>=? fun (v, ctxt) ->\n             begin match last_value with\n               | Some value ->\n                   if Compare.Int.(0 <= (compare_comparable t value v))\n                   then\n                     if Compare.Int.(0 = (compare_comparable t value v))\n                     then fail (Duplicate_set_values (loc, strip_locations expr))\n                     else fail (Unordered_set_values (loc, strip_locations expr))\n                   else return_unit\n               | None -> return_unit\n             end >>=? fun () ->\n             Lwt.return (Gas.consume ctxt (Michelson_v1_gas.Cost_of.set_update v false set)) >>=? fun ctxt ->\n             return (Some v, set_update v true set, ctxt))\n          (None, empty_set t, ctxt) vs >>|? fun (_, set, ctxt) ->\n        (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 (loc, vs) as expr) ->\n        parse_items ?type_logger loc 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), (Seq (loc, vs) as expr) ->\n        parse_items ?type_logger loc ctxt expr tk tv vs (fun x -> Some x) >>|? fun (diff, ctxt) ->\n        ({ diff ; key_type = ty_of_comparable_ty tk ; value_type = tv }, ctxt)\n    | Big_map_t (_tk, _tv, _), expr ->\n        traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr)))\n\nand parse_comparable_data\n  : type a.\n    ?type_logger:type_logger ->\n    context -> a comparable_ty -> Script.node -> (a * context) tzresult Lwt.t\n  = fun ?type_logger ctxt ty script_data ->\n    parse_data ?type_logger ctxt (ty_of_comparable_ty ty) script_data\n\nand parse_returning\n  : type arg ret.\n    ?type_logger: type_logger ->\n    tc_context -> context ->\n    arg ty * var_annot option -> ret ty -> Script.node ->\n    ((arg, ret) lambda * context) tzresult Lwt.t =\n  fun ?type_logger tc_context ctxt (arg, arg_annot) ret script_instr ->\n    parse_instr ?type_logger tc_context ctxt\n      script_instr (Item_t (arg, Empty_t, arg_annot)) >>=? function\n    | (Typed ({ loc ; aft = (Item_t (ty, Empty_t, _) as stack_ty) ; _ } as descr), ctxt) ->\n        trace_eval\n          (fun () ->\n             Lwt.return (serialize_ty_for_error ctxt ret) >>=? fun (ret, ctxt) ->\n             serialize_stack_for_error ctxt stack_ty >>|? fun (stack_ty, _ctxt) ->\n             Bad_return (loc, stack_ty, ret))\n          (Lwt.return (ty_eq ctxt ty ret) >>=? fun (Eq, ctxt) ->\n           Lwt.return (merge_types ctxt loc ty ret) >>=? fun (_ret, ctxt) ->\n           return ((Lam (descr, strip_locations script_instr) : (arg, ret) lambda), ctxt))\n    | (Typed { loc ; aft = stack_ty ; _ }, ctxt) ->\n        Lwt.return (serialize_ty_for_error ctxt ret) >>=? fun (ret, ctxt) ->\n        serialize_stack_for_error ctxt stack_ty >>=? fun (stack_ty, _ctxt) ->\n        fail (Bad_return (loc, stack_ty, ret))\n    | (Failed { descr }, ctxt) ->\n        return ((Lam (descr (Item_t (ret, Empty_t, None)), strip_locations script_instr)\n                 : (arg, ret) lambda), ctxt)\n\nand parse_instr\n  : type bef.\n    ?type_logger: type_logger ->\n    tc_context -> context ->\n    Script.node -> bef stack_ty -> (bef judgement * context) tzresult Lwt.t =\n  fun ?type_logger tc_context ctxt script_instr stack_ty ->\n    let check_item check loc name n m =\n      trace_eval (fun () ->\n          serialize_stack_for_error ctxt stack_ty >>|? fun (stack_ty, _ctxt) ->\n          Bad_stack (loc, name, m, stack_ty)) @@\n      trace (Bad_stack_item n) @@\n      Lwt.return check in\n    let check_item_ty ctxt exp got loc n =\n      check_item (ty_eq ctxt exp got) loc n in\n    let log_stack ctxt loc stack_ty aft =\n      match type_logger, script_instr with\n      | None, _\n      | Some _, (Seq (-1, _) | Int _ | String _ | Bytes _) -> return ()\n      | Some log, (Prim _ | Seq _) ->\n          (* Unparsing for logging done in an unlimited context as this\n             is used only by the client and not the protocol *)\n          let ctxt = Gas.set_unlimited ctxt in\n          unparse_stack ctxt stack_ty >>=? fun (stack_ty, _) ->\n          unparse_stack ctxt aft >>=? fun (aft, _) ->\n          log loc stack_ty aft;\n          return ()\n    in\n    let return :\n      context -> bef judgement -> (bef judgement * context) tzresult Lwt.t = fun ctxt judgement ->\n      match judgement with\n      | Typed { instr ; loc ; aft ; _ } ->\n          let maximum_type_size = Constants.michelson_maximum_type_size ctxt in\n          let type_size =\n            type_size_of_stack_head aft\n              ~up_to:(number_of_generated_growing_types instr) in\n          if Compare.Int.(type_size > maximum_type_size) then\n            fail (Type_too_large (loc, type_size, maximum_type_size))\n          else\n            return (judgement, ctxt)\n      | Failed _ ->\n          return (judgement, ctxt) in\n    let typed ctxt loc instr aft =\n      log_stack ctxt loc stack_ty aft >>=? fun () ->\n      Lwt.return @@ Gas.consume ctxt (Typecheck_costs.instr instr) >>=? fun ctxt ->\n      return ctxt (Typed { loc ; instr ; bef = stack_ty ; aft }) in\n    Lwt.return @@ Gas.consume ctxt Typecheck_costs.cycle >>=? fun ctxt ->\n    match script_instr, stack_ty with\n    (* stack ops *)\n    | Prim (loc, I_DROP, [], annot),\n      Item_t (_, rest, _) ->\n        fail_unexpected_annot loc annot >>=? fun () ->\n        typed ctxt loc Drop\n          rest\n    | Prim (loc, I_DUP, [], annot),\n      Item_t (v, rest, stack_annot) ->\n        parse_var_annot loc annot ~default:stack_annot >>=? fun annot ->\n        typed ctxt loc Dup\n          (Item_t (v, Item_t (v, rest, stack_annot), annot))\n    | Prim (loc, I_SWAP, [], annot),\n      Item_t (v,  Item_t (w, rest, stack_annot), cur_top_annot) ->\n        fail_unexpected_annot loc annot >>=? fun () ->\n        typed ctxt loc Swap\n          (Item_t (w, Item_t (v, rest, cur_top_annot), stack_annot))\n    | Prim (loc, I_PUSH, [ t ; d ], annot),\n      stack ->\n        parse_var_annot loc annot >>=? fun annot ->\n        Lwt.return @@ parse_ty ctxt ~allow_big_map:false ~allow_operation:false t >>=? fun (Ex_ty t, ctxt) ->\n        parse_data ?type_logger ctxt t d >>=? fun (v, ctxt) ->\n        typed ctxt loc (Const v) (Item_t (t, stack, annot))\n    | Prim (loc, I_UNIT, [], annot),\n      stack ->\n        parse_var_type_annot loc annot >>=? fun (annot, ty_name) ->\n        typed ctxt loc (Const ()) (Item_t (Unit_t ty_name, stack, annot))\n    (* options *)\n    | Prim (loc, I_SOME, [], annot),\n      Item_t (t, rest, stack_annot) ->\n        parse_constr_annot loc annot\n          ~if_special_first:(var_to_field_annot stack_annot)\n        >>=? fun (annot, ty_name, some_field, none_field) ->\n        typed ctxt loc Cons_some\n          (Item_t (Option_t ((t, some_field), none_field, ty_name), rest, annot))\n    | Prim (loc, I_NONE, [ t ], annot),\n      stack ->\n        Lwt.return @@ parse_ty ctxt ~allow_big_map:false ~allow_operation:true t >>=? fun (Ex_ty t, ctxt) ->\n        parse_constr_annot loc annot >>=? fun (annot, ty_name, some_field, none_field) ->\n        typed ctxt loc (Cons_none t)\n          (Item_t (Option_t ((t, some_field), none_field, ty_name), stack, annot))\n    | Prim (loc, I_IF_NONE, [ bt ; bf ], annot),\n      (Item_t (Option_t ((t, some_field), _none_field, _), rest, option_annot) as bef) ->\n        check_kind [ Seq_kind ] bt >>=? fun () ->\n        check_kind [ Seq_kind ] bf >>=? fun () ->\n        fail_unexpected_annot loc annot >>=? fun () ->\n        let annot = gen_access_annot option_annot some_field ~default:default_some_annot in\n        parse_instr ?type_logger tc_context ctxt bt rest >>=? fun (btr, ctxt) ->\n        parse_instr ?type_logger tc_context ctxt bf (Item_t (t, rest, annot)) >>=? fun (bfr, ctxt) ->\n        let branch ibt ibf =\n          { loc ; instr = If_none (ibt, ibf) ; bef ; aft = ibt.aft } in\n        merge_branches ctxt loc btr bfr { branch } >>=? fun (judgement, ctxt) ->\n        return ctxt judgement\n    (* pairs *)\n    | Prim (loc, I_PAIR, [], annot),\n      Item_t (a, Item_t (b, rest, snd_annot), fst_annot) ->\n        parse_constr_annot loc 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        typed ctxt loc Cons_pair\n          (Item_t (Pair_t((a, l_field, fst_annot), (b, r_field, snd_annot), ty_name), rest, annot))\n    | Prim (loc, I_CAR, [], annot),\n      Item_t (Pair_t ((a, expected_field_annot, a_annot), _, _), rest, pair_annot) ->\n        parse_destr_annot loc 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        Lwt.return @@ check_correct_field field_annot expected_field_annot >>=? fun () ->\n        typed ctxt loc Car (Item_t (a, rest, annot))\n    | Prim (loc, I_CDR, [], annot),\n      Item_t (Pair_t (_, (b, expected_field_annot, b_annot), _), rest, pair_annot) ->\n        parse_destr_annot loc 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        Lwt.return @@ check_correct_field field_annot expected_field_annot >>=? fun () ->\n        typed ctxt loc Cdr (Item_t (b, rest, annot))\n    (* unions *)\n    | Prim (loc, I_LEFT, [ tr ], annot),\n      Item_t (tl, rest, stack_annot) ->\n        Lwt.return @@ parse_ty ctxt ~allow_big_map:false ~allow_operation:true tr >>=? fun (Ex_ty tr, ctxt) ->\n        parse_constr_annot loc annot\n          ~if_special_first:(var_to_field_annot stack_annot)\n        >>=? fun (annot, tname, l_field, r_field) ->\n        typed ctxt loc Left (Item_t (Union_t ((tl, l_field), (tr, r_field), tname), rest, annot))\n    | Prim (loc, I_RIGHT, [ tl ], annot),\n      Item_t (tr, rest, stack_annot) ->\n        Lwt.return @@ parse_ty ctxt ~allow_big_map:false ~allow_operation:true tl >>=? fun (Ex_ty tl, ctxt) ->\n        parse_constr_annot loc annot\n          ~if_special_second:(var_to_field_annot stack_annot)\n        >>=? fun (annot, tname, l_field, r_field) ->\n        typed ctxt loc Right (Item_t (Union_t ((tl, l_field), (tr, r_field), tname), rest, annot))\n    | Prim (loc, I_IF_LEFT, [ bt ; bf ], annot),\n      (Item_t (Union_t ((tl, l_field), (tr, r_field), _), rest, union_annot) as bef) ->\n        check_kind [ Seq_kind ] bt >>=? fun () ->\n        check_kind [ Seq_kind ] bf >>=? fun () ->\n        fail_unexpected_annot loc annot >>=? fun () ->\n        let left_annot = gen_access_annot union_annot l_field ~default:default_left_annot in\n        let right_annot = gen_access_annot union_annot r_field ~default:default_right_annot in\n        parse_instr ?type_logger tc_context ctxt bt (Item_t (tl, rest, left_annot)) >>=? fun (btr, ctxt) ->\n        parse_instr ?type_logger tc_context ctxt bf (Item_t (tr, rest, right_annot)) >>=? fun (bfr, ctxt) ->\n        let branch ibt ibf =\n          { loc ; instr = If_left (ibt, ibf) ; bef ; aft = ibt.aft } in\n        merge_branches ctxt loc btr bfr { branch } >>=? fun (judgement, ctxt) ->\n        return ctxt judgement\n    (* lists *)\n    | Prim (loc, I_NIL, [ t ], annot),\n      stack ->\n        Lwt.return @@ parse_ty ctxt ~allow_big_map:false ~allow_operation:true t >>=? fun (Ex_ty t, ctxt) ->\n        parse_var_type_annot loc annot >>=? fun (annot, ty_name) ->\n        typed ctxt loc Nil (Item_t (List_t (t, ty_name), 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, ctxt) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Cons_list (Item_t (List_t (t, ty_name), rest, annot))\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        fail_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        parse_instr ?type_logger tc_context ctxt bt\n          (Item_t (t, Item_t (List_t (t, ty_name), rest, tl_annot), hd_annot))\n        >>=? fun (btr, ctxt) ->\n        parse_instr ?type_logger tc_context ctxt bf\n          rest >>=? fun (bfr, ctxt) ->\n        let branch ibt ibf =\n          { loc ; instr = If_cons (ibt, ibf) ; bef ; aft = ibt.aft } in\n        merge_branches ctxt loc btr bfr { branch } >>=? fun (judgement, ctxt) ->\n        return ctxt judgement\n    | Prim (loc, I_SIZE, [], annot),\n      Item_t (List_t _, rest, _) ->\n        parse_var_type_annot loc annot >>=? fun (annot, tname) ->\n        typed ctxt loc List_size (Item_t (Nat_t 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\n        >>=? fun (ret_annot, list_ty_name) ->\n        let elt_annot = gen_access_annot list_annot default_elt_annot in\n        parse_instr ?type_logger tc_context ctxt\n          body (Item_t (elt, starting_rest, elt_annot)) >>=? begin fun (judgement, ctxt) ->\n          match judgement with\n          | Typed ({ aft = Item_t (ret, rest, _) ; _ } as ibody) ->\n              let invalid_map_body () =\n                serialize_stack_for_error ctxt ibody.aft >>|? fun (aft, _ctxt) ->\n                Invalid_map_body (loc, aft) in\n              trace_eval invalid_map_body\n                (Lwt.return @@ stack_ty_eq ctxt 1 rest starting_rest >>=? fun (Eq, ctxt) ->\n                 Lwt.return @@ merge_stacks loc ctxt rest starting_rest >>=? fun (rest, ctxt) ->\n                 typed ctxt loc (List_map ibody)\n                   (Item_t (List_t (ret, list_ty_name), rest, ret_annot)))\n          | Typed { aft ; _ } ->\n              serialize_stack_for_error ctxt aft >>=? fun (aft, _ctxt) ->\n              fail (Invalid_map_body (loc, aft))\n          | Failed _ -> fail (Invalid_map_block_fail loc)\n        end\n    | Prim (loc, I_ITER, [ body ], annot),\n      Item_t (List_t (elt, _), rest, list_annot) ->\n        check_kind [ Seq_kind ] body >>=? fun () ->\n        fail_unexpected_annot loc annot >>=? fun () ->\n        let elt_annot = gen_access_annot list_annot default_elt_annot in\n        parse_instr ?type_logger tc_context ctxt\n          body (Item_t (elt, rest, elt_annot)) >>=? begin fun (judgement, ctxt) ->\n          match judgement with\n          | Typed ({ aft ; _ } as ibody) ->\n              let invalid_iter_body () =\n                serialize_stack_for_error ctxt ibody.aft >>=? fun (aft, ctxt) ->\n                serialize_stack_for_error ctxt rest >>|? fun (rest, _ctxt) ->\n                Invalid_iter_body (loc, rest, aft) in\n              trace_eval invalid_iter_body\n                (Lwt.return @@ stack_ty_eq ctxt 1 aft rest >>=? fun (Eq, ctxt) ->\n                 Lwt.return @@ merge_stacks loc ctxt aft rest >>=? fun (rest, ctxt) ->\n                 typed ctxt loc (List_iter ibody) rest)\n          | Failed { descr } ->\n              typed ctxt loc (List_iter (descr rest)) rest\n        end\n    (* sets *)\n    | Prim (loc, I_EMPTY_SET, [ t ], annot),\n      rest ->\n        Lwt.return @@ parse_comparable_ty ctxt t >>=? fun (Ex_comparable_ty t, ctxt) ->\n        parse_var_type_annot loc annot >>=? fun (annot, tname) ->\n        typed ctxt loc (Empty_set t) (Item_t (Set_t (t, tname), 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        fail_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        parse_instr ?type_logger tc_context ctxt\n          body (Item_t (elt, rest, elt_annot)) >>=? begin fun (judgement, ctxt) ->\n          match judgement with\n          | Typed ({ aft ; _ } as ibody) ->\n              let invalid_iter_body () =\n                serialize_stack_for_error ctxt ibody.aft >>=? fun (aft, ctxt) ->\n                serialize_stack_for_error ctxt rest >>|? fun (rest, _ctxt) ->\n                Invalid_iter_body (loc, rest, aft) in\n              trace_eval invalid_iter_body\n                (Lwt.return @@ stack_ty_eq ctxt 1 aft rest >>=? fun (Eq, ctxt) ->\n                 Lwt.return @@ merge_stacks loc ctxt aft rest >>=? fun (rest, ctxt) ->\n                 typed ctxt loc (Set_iter ibody) rest)\n          | Failed { descr } ->\n              typed ctxt loc (Set_iter (descr rest)) rest\n        end\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        typed ctxt loc Set_mem (Item_t (Bool_t tname, rest, annot))\n    | Prim (loc, I_UPDATE, [], annot),\n      Item_t (v, Item_t (Bool_t _, Item_t (Set_t (elt, tname), rest, set_annot), _), _) ->\n        let ty = ty_of_comparable_ty elt in\n        parse_var_annot loc annot ~default:set_annot >>=? fun annot ->\n        check_item_ty ctxt ty v loc I_UPDATE 1 3 >>=? fun (Eq, ctxt) ->\n        typed ctxt loc Set_update (Item_t (Set_t (elt, tname), rest, annot))\n    | Prim (loc, I_SIZE, [], annot),\n      Item_t (Set_t _, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Set_size (Item_t (Nat_t None, rest, annot))\n    (* maps *)\n    | Prim (loc, I_EMPTY_MAP, [ tk ; tv ], annot),\n      stack ->\n        Lwt.return @@ parse_comparable_ty ctxt tk >>=? fun (Ex_comparable_ty tk, ctxt) ->\n        Lwt.return @@ parse_ty ctxt ~allow_big_map:false ~allow_operation:true tv >>=? fun (Ex_ty tv, ctxt) ->\n        parse_var_type_annot loc annot >>=? fun (annot, ty_name) ->\n        typed ctxt loc (Empty_map (tk, tv)) (Item_t (Map_t (tk, tv, ty_name), 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        parse_instr ?type_logger tc_context ctxt\n          body (Item_t (Pair_t ((k, None, k_name), (elt, None, e_name), None),\n                        starting_rest, None)) >>=? begin fun (judgement, ctxt) ->\n          match judgement with\n          | Typed ({ aft = Item_t (ret, rest, _) ; _ } as ibody) ->\n              let invalid_map_body () =\n                serialize_stack_for_error ctxt ibody.aft >>|? fun (aft, _ctxt) ->\n                Invalid_map_body (loc, aft) in\n              trace_eval invalid_map_body\n                (Lwt.return @@ stack_ty_eq ctxt 1 rest starting_rest >>=? fun (Eq, ctxt) ->\n                 Lwt.return @@ merge_stacks loc ctxt rest starting_rest >>=? fun (rest, ctxt) ->\n                 typed ctxt loc (Map_map ibody)\n                   (Item_t (Map_t (ck, ret, ty_name), rest, ret_annot)))\n          | Typed { aft ; _ } ->\n              serialize_stack_for_error ctxt aft >>=? fun (aft, _ctxt) ->\n              fail (Invalid_map_body (loc, aft))\n          | Failed _ -> fail (Invalid_map_block_fail loc)\n        end\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        fail_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        parse_instr ?type_logger tc_context ctxt body\n          (Item_t (Pair_t ((key, None, k_name), (element_ty, None, e_name), None),\n                   rest, None))\n        >>=? begin fun (judgement, ctxt) -> match judgement with\n          | Typed ({ aft ; _ } as ibody) ->\n              let invalid_iter_body () =\n                serialize_stack_for_error ctxt ibody.aft >>=? fun (aft, ctxt) ->\n                serialize_stack_for_error ctxt rest >>|? fun (rest, _ctxt) ->\n                Invalid_iter_body (loc, rest, aft) in\n              trace_eval invalid_iter_body\n                (Lwt.return @@ stack_ty_eq ctxt 1 aft rest >>=? fun (Eq, ctxt) ->\n                 Lwt.return @@ merge_stacks loc ctxt aft rest >>=? fun (rest, ctxt) ->\n                 typed ctxt loc (Map_iter ibody) rest)\n          | Failed { descr } ->\n              typed ctxt loc (Map_iter (descr rest)) rest\n        end\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        typed ctxt loc Map_mem (Item_t (Bool_t None, rest, annot))\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        typed ctxt loc Map_get (Item_t (Option_t ((elt, None), None, None), rest, annot))\n    | Prim (loc, I_UPDATE, [], annot),\n      Item_t (vk, Item_t (Option_t ((vv, _), _, _),\n                          Item_t (Map_t (ck, v, map_name), rest, map_annot), _), _) ->\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, ctxt) ->\n        parse_var_annot loc annot ~default:map_annot >>=? fun annot ->\n        typed ctxt loc Map_update (Item_t (Map_t (ck, v, map_name), rest, annot))\n    | Prim (loc, I_SIZE, [], annot),\n      Item_t (Map_t (_, _, _), rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Map_size (Item_t (Nat_t None, rest, annot))\n    (* big_map *)\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        typed ctxt loc Big_map_mem (Item_t (Bool_t None, rest, annot))\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        typed ctxt loc Big_map_get (Item_t (Option_t ((elt, None), None, None), rest, annot))\n    | Prim (loc, I_UPDATE, [], annot),\n      Item_t (set_key,\n              Item_t (Option_t ((set_value, _), _, _),\n                      Item_t (Big_map_t (map_key, map_value, map_name), rest, map_annot), _), _) ->\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 >>=? fun (Eq, ctxt) ->\n        parse_var_annot loc annot ~default:map_annot >>=? fun annot ->\n        typed ctxt loc Big_map_update (Item_t (Big_map_t (map_key, map_value, map_name), rest, annot))\n    (* control *)\n    | Seq (loc, []),\n      stack ->\n        typed ctxt loc Nop stack\n    | Seq (loc, [ single ]),\n      stack ->\n        parse_instr ?type_logger tc_context ctxt single\n          stack >>=? begin fun (judgement, ctxt) ->\n          match judgement with\n          | Typed ({ aft ; _ } as instr) ->\n              let nop = { bef = aft ; loc = loc ; aft ; instr = Nop } in\n              typed ctxt loc (Seq (instr, nop)) aft\n          | Failed { descr ; _ } ->\n              let descr aft =\n                let nop = { bef = aft ; loc = loc ; aft ; instr = Nop } in\n                let descr = descr aft in\n                { descr with instr = Seq (descr, nop) } in\n              return ctxt (Failed { descr })\n        end\n    | Seq (loc, hd :: tl),\n      stack ->\n        parse_instr ?type_logger tc_context ctxt hd\n          stack >>=? begin fun (judgement, ctxt) ->\n          match judgement with\n          | Failed _ ->\n              fail (Fail_not_in_tail_position (Micheline.location hd))\n          | Typed ({ aft = middle ; _ } as ihd) ->\n              parse_instr ?type_logger tc_context ctxt (Seq (-1, tl))\n                middle >>=? fun (judgement, ctxt) ->\n              match judgement with\n              | Failed { descr } ->\n                  let descr ret =\n                    { loc ; instr = Seq (ihd, descr ret) ;\n                      bef = stack ; aft = ret } in\n                  return ctxt (Failed { descr })\n              | Typed itl ->\n                  typed ctxt loc (Seq (ihd, itl)) itl.aft\n        end\n    | Prim (loc, I_IF, [ bt ; bf ], annot),\n      (Item_t (Bool_t _, rest, _) as bef) ->\n        check_kind [ Seq_kind ] bt >>=? fun () ->\n        check_kind [ Seq_kind ] bf >>=? fun () ->\n        fail_unexpected_annot loc annot >>=? fun () ->\n        parse_instr ?type_logger tc_context ctxt bt rest >>=? fun (btr, ctxt) ->\n        parse_instr ?type_logger tc_context ctxt bf rest >>=? fun (bfr, ctxt) ->\n        let branch ibt ibf =\n          { loc ; instr = If (ibt, ibf) ; bef ; aft = ibt.aft } in\n        merge_branches ctxt loc btr bfr { branch } >>=? fun (judgement, ctxt) ->\n        return ctxt judgement\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        fail_unexpected_annot loc annot >>=? fun () ->\n        parse_instr ?type_logger tc_context ctxt body\n          rest >>=? begin fun (judgement, ctxt) ->\n          match judgement with\n          | Typed ibody ->\n              let unmatched_branches () =\n                serialize_stack_for_error ctxt ibody.aft >>=? fun (aft, ctxt) ->\n                serialize_stack_for_error ctxt stack >>|? fun (stack, _ctxt) ->\n                Unmatched_branches (loc, aft, stack) in\n              trace_eval unmatched_branches\n                (Lwt.return @@ stack_ty_eq ctxt 1 ibody.aft stack >>=? fun (Eq, ctxt) ->\n                 Lwt.return @@ merge_stacks loc ctxt ibody.aft stack >>=? fun (_stack, ctxt) ->\n                 typed ctxt loc (Loop ibody) rest)\n          | Failed { descr } ->\n              let ibody = descr stack in\n              typed ctxt loc (Loop ibody) rest\n        end\n    | Prim (loc, I_LOOP_LEFT, [ body ], annot),\n      (Item_t (Union_t ((tl, l_field), (tr, _), _), rest, union_annot) as stack) ->\n        check_kind [ Seq_kind ] body >>=? fun () ->\n        parse_var_annot loc annot >>=? fun annot ->\n        let l_annot = gen_access_annot union_annot l_field ~default:default_left_annot in\n        parse_instr ?type_logger tc_context ctxt body\n          (Item_t (tl, rest, l_annot)) >>=? begin fun (judgement, ctxt) -> match judgement with\n          | Typed ibody ->\n              let unmatched_branches () =\n                serialize_stack_for_error ctxt ibody.aft >>=? fun (aft, ctxt) ->\n                serialize_stack_for_error ctxt stack >>|? fun (stack, _ctxt) ->\n                Unmatched_branches (loc, aft, stack) in\n              trace_eval unmatched_branches\n                (Lwt.return @@ stack_ty_eq ctxt 1 ibody.aft stack >>=? fun (Eq, ctxt) ->\n                 Lwt.return @@ merge_stacks loc ctxt ibody.aft stack >>=? fun (_stack, ctxt) ->\n                 typed ctxt loc (Loop_left ibody) (Item_t (tr, rest, annot)))\n          | Failed { descr } ->\n              let ibody = descr stack in\n              typed ctxt loc (Loop_left ibody) (Item_t (tr, rest, annot))\n        end\n    | Prim (loc, I_LAMBDA, [ arg ; ret ; code ], annot),\n      stack ->\n        Lwt.return @@ parse_ty ctxt ~allow_big_map:false ~allow_operation:true arg\n        >>=? fun (Ex_ty arg, ctxt) ->\n        Lwt.return @@ parse_ty ctxt ~allow_big_map:false ~allow_operation:true 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 Lambda ?type_logger ctxt\n          (arg, default_arg_annot) ret code >>=? fun (lambda, ctxt) ->\n        typed ctxt loc (Lambda lambda) (Item_t (Lambda_t (arg, ret, None), stack, annot))\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        typed ctxt loc Exec (Item_t (ret, rest, annot))\n    | Prim (loc, I_DIP, [ code ], annot),\n      Item_t (v, rest, stack_annot) ->\n        fail_unexpected_annot loc annot >>=? fun () ->\n        check_kind [ Seq_kind ] code >>=? fun () ->\n        parse_instr ?type_logger (add_dip v stack_annot tc_context) ctxt code\n          rest >>=? begin fun (judgement, ctxt) -> match judgement with\n          | Typed descr ->\n              typed ctxt loc (Dip descr) (Item_t (v, descr.aft, stack_annot))\n          | Failed _ ->\n              fail (Fail_not_in_tail_position loc)\n        end\n    | Prim (loc, I_FAILWITH, [], annot),\n      Item_t (v, _rest, _) ->\n        fail_unexpected_annot loc annot >>=? fun () ->\n        let descr aft = { loc ; instr = Failwith v ; bef = stack_ty ; aft } in\n        log_stack ctxt loc stack_ty Empty_t >>=? fun () ->\n        return ctxt (Failed { descr })\n    (* timestamp operations *)\n    | Prim (loc, I_ADD, [], annot),\n      Item_t (Timestamp_t tn1, Item_t (Int_t tn2, rest, _), _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Add_timestamp_to_seconds\n          (Item_t (Timestamp_t tname, rest, annot))\n    | Prim (loc, I_ADD, [], annot),\n      Item_t (Int_t tn1, Item_t (Timestamp_t tn2, rest, _), _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Add_seconds_to_timestamp\n          (Item_t (Timestamp_t tname, rest, annot))\n    | Prim (loc, I_SUB, [], annot),\n      Item_t (Timestamp_t tn1, Item_t (Int_t tn2, rest, _), _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Sub_timestamp_seconds\n          (Item_t (Timestamp_t tname, rest, annot))\n    | Prim (loc, I_SUB, [], annot),\n      Item_t (Timestamp_t tn1, Item_t (Timestamp_t tn2, rest, _), _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Diff_timestamps\n          (Item_t (Int_t tname, rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Concat\n          (Item_t (String_t tname, rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Add_tez\n          (Item_t (Mutez_t tname, rest, annot))\n    | Prim (loc, I_SUB, [], annot),\n      Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Sub_tez\n          (Item_t (Mutez_t tname, rest, annot))\n    | Prim (loc, I_MUL, [], annot),\n      Item_t (Mutez_t tname, Item_t (Nat_t _, rest, _), _) -> (* no type name check *)\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Mul_teznat\n          (Item_t (Mutez_t tname, rest, annot))\n    | Prim (loc, I_MUL, [], annot),\n      Item_t (Nat_t _, Item_t (Mutez_t tname, rest, _), _) -> (* no type name check *)\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Mul_nattez\n          (Item_t (Mutez_t tname, rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Or\n          (Item_t (Bool_t tname, rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc And\n          (Item_t (Bool_t tname, rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Xor\n          (Item_t (Bool_t tname, rest, annot))\n    | Prim (loc, I_NOT, [], annot),\n      Item_t (Bool_t tname, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Not\n          (Item_t (Bool_t tname, rest, annot))\n    (* integer operations *)\n    | Prim (loc, I_ABS, [], annot),\n      Item_t (Int_t _, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Abs_int\n          (Item_t (Nat_t None, rest, annot))\n    | Prim (loc, I_ISNAT, [], annot),\n      Item_t (Int_t _, rest, int_annot) ->\n        parse_var_annot loc annot ~default:int_annot >>=? fun annot ->\n        typed ctxt loc Is_nat\n          (Item_t (Option_t ((Nat_t None, None), None, None), rest, annot))\n    | Prim (loc, I_INT, [], annot),\n      Item_t (Nat_t _, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Int_nat\n          (Item_t (Int_t None, rest, annot))\n    | Prim (loc, I_NEG, [], annot),\n      Item_t (Int_t tname, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Neg_int\n          (Item_t (Int_t tname, rest, annot))\n    | Prim (loc, I_NEG, [], annot),\n      Item_t (Nat_t _, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Neg_nat\n          (Item_t (Int_t None, rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Add_intint\n          (Item_t (Int_t tname, rest, annot))\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        typed ctxt loc Add_intnat\n          (Item_t (Int_t tname, rest, annot))\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        typed ctxt loc Add_natint\n          (Item_t (Int_t tname, rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Add_natnat\n          (Item_t (Nat_t  tname, rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Sub_int\n          (Item_t (Int_t tname, rest, annot))\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        typed ctxt loc Sub_int\n          (Item_t (Int_t tname, rest, annot))\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        typed ctxt loc Sub_int\n          (Item_t (Int_t tname, rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun _tname ->\n        typed ctxt loc Sub_int\n          (Item_t (Int_t None, rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Mul_intint\n          (Item_t (Int_t tname, rest, annot))\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        typed ctxt loc Mul_intnat\n          (Item_t (Int_t tname, rest, annot))\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        typed ctxt loc Mul_natint\n          (Item_t (Int_t tname, rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Mul_natnat\n          (Item_t (Nat_t tname, rest, annot))\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        typed ctxt loc Ediv_teznat\n          (Item_t (Option_t\n                     ((Pair_t ((Mutez_t tname, None, None),\n                               (Mutez_t tname, None, None), None), None),\n                      None, None), rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Ediv_tez\n          (Item_t (Option_t ((Pair_t ((Nat_t None, None, None),\n                                      (Mutez_t tname, None, None), None), None),\n                             None, None), rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Ediv_intint\n          (Item_t (Option_t\n                     ((Pair_t ((Int_t tname, None, None),\n                               (Nat_t None, None, None), None), None),\n                      None, None), rest, annot))\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        typed ctxt loc Ediv_intnat\n          (Item_t (Option_t\n                     ((Pair_t ((Int_t tname, None, None),\n                               (Nat_t None, None, None), None), None),\n                      None, None), rest, annot))\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        typed ctxt loc Ediv_natint\n          (Item_t (Option_t ((Pair_t ((Int_t None, None, None),\n                                      (Nat_t tname, None, None), None), None),\n                             None, None), rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Ediv_natnat\n          (Item_t (Option_t ((Pair_t ((Nat_t tname, None, None),\n                                      (Nat_t tname, None, None), None), None),\n                             None, None), rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Lsl_nat\n          (Item_t (Nat_t tname, rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Lsr_nat\n          (Item_t (Nat_t tname, rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Or_nat\n          (Item_t (Nat_t tname, rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc And_nat\n          (Item_t (Nat_t tname, rest, annot))\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        typed ctxt loc And_int_nat\n          (Item_t (Nat_t tname, rest, annot))\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        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc Xor_nat\n          (Item_t (Nat_t tname, rest, annot))\n    | Prim (loc, I_NOT, [], annot),\n      Item_t (Int_t tname, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Not_int\n          (Item_t (Int_t tname, rest, annot))\n    | Prim (loc, I_NOT, [], annot),\n      Item_t (Nat_t _, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Not_nat\n          (Item_t (Int_t None, rest, annot))\n    (* comparison *)\n    | Prim (loc, I_COMPARE, [], annot),\n      Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc (Compare (Int_key tname))\n          (Item_t (Int_t None, rest, annot))\n    | Prim (loc, I_COMPARE, [], annot),\n      Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc (Compare (Nat_key tname))\n          (Item_t (Int_t None, rest, annot))\n    | Prim (loc, I_COMPARE, [], annot),\n      Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc (Compare (Bool_key tname))\n          (Item_t (Int_t None, rest, annot))\n    | Prim (loc, I_COMPARE, [], annot),\n      Item_t (String_t tn1, Item_t (String_t tn2, rest, _), _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc (Compare (String_key tname))\n          (Item_t (Int_t None, rest, annot))\n    | Prim (loc, I_COMPARE, [], annot),\n      Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc (Compare (Mutez_key tname))\n          (Item_t (Int_t None, rest, annot))\n    | Prim (loc, I_COMPARE, [], annot),\n      Item_t (Key_hash_t tn1, Item_t (Key_hash_t tn2, rest, _), _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc (Compare (Key_hash_key tname))\n          (Item_t (Int_t None, rest, annot))\n    | Prim (loc, I_COMPARE, [], annot),\n      Item_t (Timestamp_t tn1, Item_t (Timestamp_t tn2, rest, _), _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc (Compare (Timestamp_key tname))\n          (Item_t (Int_t None, rest, annot))\n    | Prim (loc, I_COMPARE, [], annot),\n      Item_t (Address_t tn1, Item_t (Address_t tn2, rest, _), _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc (Compare (Address_key tname))\n          (Item_t (Int_t None, rest, annot))\n    | Prim (loc, I_COMPARE, [], annot),\n      Item_t (Bytes_t tn1, Item_t (Bytes_t tn2, rest, _), _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname ->\n        typed ctxt loc (Compare (Bytes_key tname))\n          (Item_t (Int_t None, rest, annot))\n    (* comparators *)\n    | Prim (loc, I_EQ, [], annot),\n      Item_t (Int_t _, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Eq\n          (Item_t (Bool_t None, rest, annot))\n    | Prim (loc, I_NEQ, [], annot),\n      Item_t (Int_t _, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Neq\n          (Item_t (Bool_t None, rest, annot))\n    | Prim (loc, I_LT, [], annot),\n      Item_t (Int_t _, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Lt\n          (Item_t (Bool_t None, rest, annot))\n    | Prim (loc, I_GT, [], annot),\n      Item_t (Int_t _, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Gt\n          (Item_t (Bool_t None, rest, annot))\n    | Prim (loc, I_LE, [], annot),\n      Item_t (Int_t _, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Le\n          (Item_t (Bool_t None, rest, annot))\n    | Prim (loc, I_GE, [], annot),\n      Item_t (Int_t _, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Ge\n          (Item_t (Bool_t None, rest, annot))\n    (* annotations *)\n    | Prim (loc, I_CAST, [ cast_t ], annot),\n      Item_t (t, stack, item_annot) ->\n        parse_var_annot loc annot ~default:item_annot >>=? fun annot ->\n        (Lwt.return @@ parse_ty ctxt ~allow_big_map:true ~allow_operation:true cast_t)\n        >>=? fun (Ex_ty cast_t, ctxt) ->\n        Lwt.return @@ ty_eq ctxt cast_t t >>=? fun (Eq, ctxt) ->\n        Lwt.return @@ merge_types ctxt loc cast_t t >>=? fun (_, ctxt) ->\n        typed ctxt loc Nop (Item_t (cast_t, stack, annot))\n    | Prim (loc, I_RENAME, [], annot),\n      Item_t (t, stack, _) ->\n        parse_var_annot loc annot >>=? fun annot -> (* can erase annot *)\n        typed ctxt loc Nop (Item_t (t, stack, annot))\n    (* packing *)\n    | Prim (loc, I_PACK, [], annot),\n      Item_t (t, rest, unpacked_annot) ->\n        Lwt.return (check_no_big_map_or_operation loc t) >>=? fun () ->\n        parse_var_annot loc annot ~default:(gen_access_annot unpacked_annot default_pack_annot)\n        >>=? fun annot ->\n        typed ctxt loc (Pack t)\n          (Item_t (Bytes_t None, rest, annot))\n    | Prim (loc, I_UNPACK, [ ty ], annot),\n      Item_t (Bytes_t _, rest, packed_annot) ->\n        Lwt.return @@ parse_ty ctxt ~allow_big_map:false ~allow_operation:false ty >>=? fun (Ex_ty t, ctxt) ->\n        let stack_annot = gen_access_annot packed_annot default_unpack_annot in\n        parse_constr_annot loc annot\n          ~if_special_first:(var_to_field_annot stack_annot)\n        >>=? fun (annot, ty_name, some_field, none_field) ->\n        typed ctxt loc (Unpack t)\n          (Item_t (Option_t ((t, some_field), none_field, ty_name), rest, annot))\n    (* protocol *)\n    | Prim (loc, I_ADDRESS, [], annot),\n      Item_t (Contract_t _, rest, contract_annot) ->\n        parse_var_annot loc annot ~default:(gen_access_annot contract_annot default_addr_annot)\n        >>=? fun annot ->\n        typed ctxt loc Address\n          (Item_t (Address_t None, rest, annot))\n    | Prim (loc, I_CONTRACT, [ ty ], annot),\n      Item_t (Address_t _, rest, addr_annot) ->\n        Lwt.return @@ parse_ty ctxt ~allow_big_map:false ~allow_operation:false ty >>=? fun (Ex_ty t, ctxt) ->\n        parse_var_annot loc annot ~default:(gen_access_annot addr_annot default_contract_annot)\n        >>=? fun annot ->\n        typed ctxt loc (Contract t)\n          (Item_t (Option_t ((Contract_t (t, None), None), None, None), rest, annot))\n    | Prim (loc, I_TRANSFER_TOKENS, [], annot),\n      Item_t (p, Item_t\n                (Mutez_t _, Item_t\n                   (Contract_t (cp, _), rest, _), _), _) ->\n        check_item_ty ctxt p cp loc I_TRANSFER_TOKENS 1 4 >>=? fun (Eq, ctxt) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Transfer_tokens (Item_t (Operation_t None, rest, annot))\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        typed ctxt loc Set_delegate (Item_t (Operation_t None, rest, annot))\n    | Prim (loc, I_CREATE_ACCOUNT, [], annot),\n      Item_t\n        (Key_hash_t _, Item_t\n           (Option_t ((Key_hash_t _, _), _, _), Item_t\n              (Bool_t _, Item_t\n                 (Mutez_t _, rest, _), _), _), _) ->\n        parse_two_var_annot loc annot >>=? fun (op_annot, addr_annot) ->\n        typed ctxt loc Create_account\n          (Item_t (Operation_t None, Item_t (Address_t None, rest, addr_annot), op_annot))\n    | Prim (loc, I_IMPLICIT_ACCOUNT, [], annot),\n      Item_t (Key_hash_t _, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Implicit_account\n          (Item_t (Contract_t (Unit_t None, None), rest, annot))\n    | Prim (loc, I_CREATE_CONTRACT, [ (Seq _ as code)], annot),\n      Item_t\n        (Key_hash_t _, Item_t\n           (Option_t ((Key_hash_t _, _), _, _), Item_t\n              (Bool_t _, Item_t\n                 (Bool_t _, Item_t\n                    (Mutez_t _, Item_t\n                       (ginit, rest, _), _), _), _), _), _) ->\n        parse_two_var_annot loc annot >>=? fun (op_annot, addr_annot) ->\n        let cannonical_code = fst @@ Micheline.extract_locations code in\n        Lwt.return @@ parse_toplevel cannonical_code >>=? fun (arg_type, storage_type, code_field) ->\n        trace\n          (Ill_formed_type (Some \"parameter\", cannonical_code, location arg_type))\n          (Lwt.return @@ parse_ty ctxt ~allow_big_map:false ~allow_operation:false arg_type)\n        >>=? fun (Ex_ty arg_type, ctxt) ->\n        trace\n          (Ill_formed_type (Some \"storage\", cannonical_code, location storage_type))\n          (Lwt.return @@ parse_ty ctxt ~allow_big_map:true ~allow_operation:false storage_type)\n        >>=? fun (Ex_ty storage_type, ctxt) ->\n        let arg_annot = default_annot (type_to_var_annot (name_of_ty arg_type))\n            ~default:default_param_annot in\n        let storage_annot = default_annot (type_to_var_annot (name_of_ty storage_type))\n            ~default:default_storage_annot in\n        let arg_type_full = Pair_t ((arg_type, None, arg_annot),\n                                    (storage_type, None, storage_annot), None) in\n        let ret_type_full =\n          Pair_t ((List_t (Operation_t None, None), None, None),\n                  (storage_type, None, None), None) in\n        trace\n          (Ill_typed_contract (cannonical_code, []))\n          (parse_returning (Toplevel { storage_type ; param_type = arg_type })\n             ctxt ?type_logger (arg_type_full, None) ret_type_full code_field) >>=?\n        fun (Lam ({ bef = Item_t (arg, Empty_t, _) ;\n                    aft = Item_t (ret, Empty_t, _) ; _ }, _) as lambda, ctxt) ->\n        Lwt.return @@ ty_eq ctxt arg arg_type_full >>=? fun (Eq, ctxt) ->\n        Lwt.return @@ merge_types ctxt loc arg arg_type_full >>=? fun (_, ctxt) ->\n        Lwt.return @@ ty_eq ctxt ret ret_type_full >>=? fun (Eq, ctxt) ->\n        Lwt.return @@ merge_types ctxt loc ret ret_type_full >>=? fun (_, ctxt) ->\n        Lwt.return @@ ty_eq ctxt storage_type ginit >>=? fun (Eq, ctxt) ->\n        Lwt.return @@ merge_types ctxt loc storage_type ginit >>=? fun (_, ctxt) ->\n        typed ctxt loc (Create_contract (storage_type, arg_type, lambda))\n          (Item_t (Operation_t None, Item_t (Address_t None, rest, addr_annot), op_annot))\n    | Prim (loc, I_NOW, [], annot),\n      stack ->\n        parse_var_annot loc annot ~default:default_now_annot >>=? fun annot ->\n        typed ctxt loc Now (Item_t (Timestamp_t None, stack, annot))\n    | Prim (loc, I_AMOUNT, [], annot),\n      stack ->\n        parse_var_annot loc annot ~default:default_amount_annot >>=? fun annot ->\n        typed ctxt loc Amount\n          (Item_t (Mutez_t None, stack, annot))\n    | Prim (loc, I_BALANCE, [], annot),\n      stack ->\n        parse_var_annot loc annot ~default:default_balance_annot >>=? fun annot ->\n        typed ctxt loc Balance\n          (Item_t (Mutez_t None, stack, annot))\n    | Prim (loc, I_HASH_KEY, [], annot),\n      Item_t (Key_t _, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Hash_key\n          (Item_t (Key_hash_t None, rest, annot))\n    | Prim (loc, I_CHECK_SIGNATURE, [], annot),\n      Item_t (Key_t _, Item_t (Signature_t _, Item_t (Bytes_t _, rest, _), _), _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Check_signature\n          (Item_t (Bool_t None, rest, annot))\n    | Prim (loc, I_BLAKE2B, [], annot),\n      Item_t (Bytes_t _, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Blake2b\n          (Item_t (Bytes_t None, rest, annot))\n    | Prim (loc, I_SHA256, [], annot),\n      Item_t (Bytes_t _, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Sha256\n          (Item_t (Bytes_t None, rest, annot))\n    | Prim (loc, I_SHA512, [], annot),\n      Item_t (Bytes_t _, rest, _) ->\n        parse_var_annot loc annot >>=? fun annot ->\n        typed ctxt loc Sha512\n          (Item_t (Bytes_t None, rest, annot))\n    | Prim (loc, I_STEPS_TO_QUOTA, [], annot),\n      stack ->\n        parse_var_annot loc annot ~default:default_steps_annot >>=? fun annot ->\n        typed ctxt loc Steps_to_quota\n          (Item_t (Nat_t None, stack, annot))\n    | Prim (loc, I_SOURCE, [], annot),\n      stack ->\n        parse_var_annot loc annot ~default:default_source_annot >>=? fun annot ->\n        typed ctxt loc Source\n          (Item_t (Address_t None, stack, annot))\n    | Prim (loc, I_SENDER, [], annot),\n      stack ->\n        parse_var_annot loc annot ~default:default_sender_annot >>=? fun annot ->\n        typed ctxt loc Sender\n          (Item_t (Address_t None, stack, annot))\n    | Prim (loc, I_SELF, [], annot),\n      stack ->\n        parse_var_annot loc annot ~default:default_self_annot >>=? fun annot ->\n        let rec get_toplevel_type : tc_context -> (bef judgement * context) tzresult Lwt.t = function\n          | Lambda -> fail (Self_in_lambda loc)\n          | Dip (_, prev) -> get_toplevel_type prev\n          | Toplevel { param_type ; _ } ->\n              typed ctxt loc (Self param_type)\n                (Item_t (Contract_t (param_type, None), stack, annot)) in\n        get_toplevel_type tc_context\n    (* Primitive parsing errors *)\n    | Prim (loc, (I_DROP | I_DUP | I_SWAP | I_SOME | I_UNIT\n                 | I_PAIR | I_CAR | I_CDR | I_CONS\n                 | I_MEM | I_UPDATE | I_MAP\n                 | I_GET | I_EXEC | I_FAILWITH | I_SIZE\n                 | I_CONCAT | I_ADD | I_SUB\n                 | I_MUL | I_EDIV | I_OR | I_AND | I_XOR\n                 | I_NOT\n                 | I_ABS | I_NEG | I_LSL | I_LSR\n                 | I_COMPARE | I_EQ | I_NEQ\n                 | I_LT | I_GT | I_LE | I_GE\n                 | I_TRANSFER_TOKENS | I_CREATE_ACCOUNT\n                 | I_CREATE_CONTRACT | I_SET_DELEGATE | I_NOW\n                 | I_IMPLICIT_ACCOUNT | I_AMOUNT | I_BALANCE\n                 | I_CHECK_SIGNATURE | I_HASH_KEY | I_SOURCE | I_SENDER\n                 | I_BLAKE2B | I_SHA256 | I_SHA512 | I_STEPS_TO_QUOTA | I_ADDRESS\n                 as name), (_ :: _ as l), _), _ ->\n        fail (Invalid_arity (loc, name, 0, List.length l))\n    | Prim (loc, (I_NONE | I_LEFT | I_RIGHT | I_NIL | I_MAP | I_ITER\n                 | I_EMPTY_SET | I_DIP | I_LOOP | I_LOOP_LEFT | I_CONTRACT\n                 as name), ([]\n                           | _ :: _ :: _ as l), _), _ ->\n        fail (Invalid_arity (loc, name, 1, List.length l))\n    | Prim (loc, (I_PUSH | I_IF_NONE | I_IF_LEFT | I_IF_CONS\n                 | I_EMPTY_MAP | I_IF\n                 as name), ([] | [ _ ]\n                           | _ :: _ :: _ :: _ as l), _), _ ->\n        fail (Invalid_arity (loc, name, 2, List.length l))\n    | Prim (loc, I_LAMBDA, ([] | [ _ ]\n                           | _ :: _ :: _ :: _ :: _ as l), _), _ ->\n        fail (Invalid_arity (loc, I_LAMBDA, 3, List.length l))\n    (* Stack errors *)\n    | Prim (loc, (I_ADD | I_SUB | I_MUL | I_EDIV\n                 | I_AND | I_OR | I_XOR | I_LSL | I_LSR\n                 | I_CONCAT | I_COMPARE as name), [], _),\n      Item_t (ta, Item_t (tb, _, _), _) ->\n        Lwt.return @@ serialize_ty_for_error ctxt ta >>=? fun (ta, ctxt) ->\n        Lwt.return @@ serialize_ty_for_error ctxt tb >>=? fun (tb, _ctxt) ->\n        fail (Undefined_binop (loc, name, ta, tb))\n    | Prim (loc, (I_NEG | I_ABS | I_NOT\n                 | I_EQ | I_NEQ | I_LT | I_GT | I_LE | I_GE as name),\n            [], _),\n      Item_t (t, _, _) ->\n        Lwt.return @@ serialize_ty_for_error ctxt t >>=? fun (t, _ctxt) ->\n        fail (Undefined_unop (loc, name, t))\n    | Prim (loc, I_UPDATE, [], _),\n      stack ->\n        serialize_stack_for_error ctxt stack >>=? fun (stack, _ctxt) ->\n        fail (Bad_stack (loc, I_UPDATE, 3, stack))\n    | Prim (loc, I_CREATE_CONTRACT, [], _),\n      stack ->\n        serialize_stack_for_error ctxt stack >>=? fun (stack, _ctxt) ->\n        fail (Bad_stack (loc, I_CREATE_CONTRACT, 7, stack))\n    | Prim (loc, I_CREATE_ACCOUNT, [], _),\n      stack ->\n        serialize_stack_for_error ctxt stack >>=? fun (stack, _ctxt) ->\n        fail (Bad_stack (loc, I_CREATE_ACCOUNT, 4, stack))\n    | Prim (loc, I_TRANSFER_TOKENS, [], _),\n      stack ->\n        serialize_stack_for_error ctxt stack >>=? fun (stack, _ctxt) ->\n        fail (Bad_stack (loc, I_TRANSFER_TOKENS, 4, stack))\n    | Prim (loc, (I_DROP | I_DUP | I_CAR | I_CDR | I_SOME\n                 | I_BLAKE2B | I_SHA256 | I_SHA512 | I_DIP\n                 | I_IF_NONE | I_LEFT | I_RIGHT | I_IF_LEFT | I_IF\n                 | I_LOOP | I_IF_CONS | I_IMPLICIT_ACCOUNT\n                 | I_NEG | I_ABS | I_INT | I_NOT | I_HASH_KEY\n                 | I_EQ | I_NEQ | I_LT | I_GT | I_LE | I_GE as name), _, _),\n      stack ->\n        serialize_stack_for_error ctxt stack >>=? fun (stack, _ctxt) ->\n        fail (Bad_stack (loc, name, 1, stack))\n    | Prim (loc, (I_SWAP | I_PAIR | I_CONS\n                 | I_GET | I_MEM | I_EXEC\n                 | I_CHECK_SIGNATURE | I_ADD | I_SUB | I_MUL\n                 | I_EDIV | I_AND | I_OR | I_XOR\n                 | I_LSL | I_LSR | I_CONCAT as name), _, _),\n      stack ->\n        serialize_stack_for_error ctxt stack >>=? fun (stack, _ctxt) ->\n        fail (Bad_stack (loc, name, 2, stack))\n    (* Generic parsing errors *)\n    | expr, _ ->\n        fail @@ unexpected expr [ Seq_kind ] Instr_namespace\n          [ I_DROP ; I_DUP ; I_SWAP ; I_SOME ; I_UNIT ;\n            I_PAIR ; I_CAR ; I_CDR ; I_CONS ;\n            I_MEM ; I_UPDATE ; I_MAP ; I_ITER ;\n            I_GET ; I_EXEC ; I_FAILWITH ; I_SIZE ;\n            I_CONCAT ; I_ADD ; I_SUB ;\n            I_MUL ; I_EDIV ; I_OR ; I_AND ; I_XOR ;\n            I_NOT ;\n            I_ABS ; I_INT; I_NEG ; I_LSL ; I_LSR ;\n            I_COMPARE ; I_EQ ; I_NEQ ;\n            I_LT ; I_GT ; I_LE ; I_GE ;\n            I_TRANSFER_TOKENS ; I_CREATE_ACCOUNT ;\n            I_CREATE_CONTRACT ; I_NOW ; I_AMOUNT ; I_BALANCE ;\n            I_IMPLICIT_ACCOUNT ; I_CHECK_SIGNATURE ;\n            I_BLAKE2B ; I_SHA256 ; I_SHA512 ; I_HASH_KEY ;\n            I_STEPS_TO_QUOTA ;\n            I_PUSH ; I_NONE ; I_LEFT ; I_RIGHT ; I_NIL ;\n            I_EMPTY_SET ; I_DIP ; I_LOOP ;\n            I_IF_NONE ; I_IF_LEFT ; I_IF_CONS ;\n            I_EMPTY_MAP ; I_IF ; I_SOURCE ; I_SENDER ; I_SELF ; I_LAMBDA ]\n\nand parse_contract\n  : type arg. context -> Script.location -> arg ty -> Contract.t ->\n    (context * arg typed_contract) tzresult Lwt.t\n  = fun ctxt loc arg contract ->\n    Lwt.return @@ Gas.consume ctxt Typecheck_costs.contract_exists >>=? fun ctxt ->\n    Contract.exists ctxt contract >>=? function\n    | false -> fail (Invalid_contract (loc, contract))\n    | true ->\n        Lwt.return @@ Gas.consume ctxt Typecheck_costs.get_script >>=? fun ctxt ->\n        trace\n          (Invalid_contract (loc, contract)) @@\n        Contract.get_script ctxt contract >>=? fun (ctxt, script) -> match script with\n        | None ->\n            Lwt.return\n              (ty_eq ctxt arg (Unit_t None) >>? fun (Eq, ctxt) ->\n               let contract : arg typed_contract = (arg, contract) in\n               ok (ctxt, contract))\n        | Some { code ; _ } ->\n            Script.force_decode ctxt code >>=? fun (code, ctxt) ->\n            Lwt.return\n              (parse_toplevel code >>? fun (arg_type, _, _) ->\n               parse_ty ctxt ~allow_big_map:false ~allow_operation:false arg_type >>? fun (Ex_ty targ, ctxt) ->\n               ty_eq ctxt targ arg >>? fun (Eq, ctxt) ->\n               merge_types ctxt loc targ arg >>? fun (arg, ctxt) ->\n               let contract : arg typed_contract = (arg, contract) in\n               ok (ctxt, contract))\n\n(* Same as the one above, 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. *)\nand parse_contract_for_script\n  : type arg. context -> Script.location -> arg ty -> Contract.t ->\n    (context * arg typed_contract option) tzresult Lwt.t\n  = fun ctxt loc arg contract ->\n    Lwt.return @@ Gas.consume ctxt Typecheck_costs.contract_exists >>=? fun ctxt ->\n    Contract.exists ctxt contract >>=? function\n    | false -> return (ctxt, None)\n    | true ->\n        Lwt.return @@ Gas.consume ctxt Typecheck_costs.get_script >>=? fun ctxt ->\n        trace\n          (Invalid_contract (loc, contract)) @@\n        Contract.get_script ctxt contract >>=? fun (ctxt, script) -> match script with (* can only fail because of gas *)\n        | None ->\n            Lwt.return\n              (match ty_eq ctxt arg (Unit_t None) with\n               | Ok (Eq, ctxt) ->\n                   let contract : arg typed_contract = (arg, contract) in\n                   ok (ctxt, Some contract)\n               | Error _ ->\n                   Gas.consume ctxt Typecheck_costs.cycle >>? fun ctxt ->\n                   ok (ctxt, None))\n        | Some { code ; _ } ->\n            Script.force_decode ctxt code >>=? fun (code, ctxt) -> (* can only fail because of gas *)\n            Lwt.return\n              (match parse_toplevel code with\n               | Error _ -> error (Invalid_contract (loc, contract))\n               | Ok (arg_type, _, _) ->\n                   match parse_ty ctxt ~allow_big_map:false ~allow_operation:false arg_type with\n                   | Error _ ->\n                       error (Invalid_contract (loc, contract))\n                   | Ok (Ex_ty targ, ctxt) ->\n                       match\n                         (ty_eq ctxt targ arg >>? fun (Eq, ctxt) ->\n                          merge_types ctxt loc targ arg >>? fun (arg, ctxt) ->\n                          let contract : arg typed_contract = (arg, contract) in\n                          ok (ctxt, Some contract))\n                       with\n                       | Ok res -> ok res\n                       | Error _ ->\n                           (* overapproximation by checking if targ = targ,\n                              can only fail because of gas *)\n                           ty_eq ctxt targ targ >>? fun (Eq, ctxt) ->\n                           merge_types ctxt loc targ targ >>? fun (_, ctxt) ->\n                           ok (ctxt, None))\n\nand parse_toplevel\n  : Script.expr -> (Script.node * Script.node * Script.node) tzresult\n  = fun toplevel ->\n    record_trace (Ill_typed_contract (toplevel, [])) @@\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 p s c fields =\n          match fields with\n          | [] -> ok (p, s, c)\n          | Int (loc, _) :: _ -> error (Invalid_kind (loc, [ Prim_kind ], Int_kind))\n          | String (loc, _) :: _ -> error (Invalid_kind (loc, [ Prim_kind ], String_kind))\n          | Bytes (loc, _) :: _ -> 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 ], _) :: rest ->\n              begin match p with\n                | None -> find_fields (Some arg) s c rest\n                | Some _ -> error (Duplicate_field (loc, K_parameter))\n              end\n          | Prim (loc, K_storage, [ arg ], _) :: rest ->\n              begin match s with\n                | None -> find_fields p (Some arg) c rest\n                | Some _ -> error (Duplicate_field (loc, K_storage))\n              end\n          | Prim (loc, K_code, [ arg ], _) :: rest ->\n              begin match c with\n                | None -> find_fields p s (Some arg) rest\n                | Some _ -> error (Duplicate_field (loc, K_code))\n              end\n          | Prim (loc, (K_parameter | K_storage | K_code as name), args, _) :: _ ->\n              error (Invalid_arity (loc, name, 1, List.length args))\n          | Prim (loc, name, _, _) :: _ ->\n              let allowed = [ K_parameter ; K_storage ; K_code ] in\n              error (Invalid_primitive (loc, allowed, name))\n        in\n        find_fields None None None fields >>? function\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, Some s, Some c) -> ok (p, s, c)\n\nlet parse_script\n  : ?type_logger: type_logger ->\n    context -> Script.t -> (ex_script * context) tzresult Lwt.t\n  = fun ?type_logger ctxt { code ; storage } ->\n    Script.force_decode ctxt code >>=? fun (code, ctxt) ->\n    Script.force_decode ctxt storage >>=? fun (storage, ctxt) ->\n    Lwt.return @@ parse_toplevel code >>=? fun (arg_type, storage_type, code_field) ->\n    trace\n      (Ill_formed_type (Some \"parameter\", code, location arg_type))\n      (Lwt.return (parse_ty ctxt ~allow_big_map:false ~allow_operation:false arg_type))\n    >>=? fun (Ex_ty arg_type, ctxt) ->\n    trace\n      (Ill_formed_type (Some \"storage\", code, location storage_type))\n      (Lwt.return (parse_ty ctxt ~allow_big_map:true ~allow_operation:false storage_type))\n    >>=? fun (Ex_ty storage_type, ctxt) ->\n    let arg_annot = default_annot (type_to_var_annot (name_of_ty arg_type))\n        ~default:default_param_annot in\n    let storage_annot = default_annot (type_to_var_annot (name_of_ty storage_type))\n        ~default:default_storage_annot in\n    let arg_type_full = Pair_t ((arg_type, None, arg_annot),\n                                (storage_type, None, storage_annot), None) in\n    let ret_type_full =\n      Pair_t ((List_t (Operation_t None, None), None, None),\n              (storage_type, None, None), None) in\n    trace_eval\n      (fun () ->\n         Lwt.return @@ serialize_ty_for_error ctxt storage_type >>|? fun (storage_type, _ctxt) ->\n         Ill_typed_data (None, storage, storage_type))\n      (parse_data ?type_logger ctxt storage_type (root storage)) >>=? fun (storage, ctxt) ->\n    trace\n      (Ill_typed_contract (code, []))\n      (parse_returning (Toplevel { storage_type ; param_type = arg_type })\n         ctxt ?type_logger (arg_type_full, None) ret_type_full code_field) >>=? fun (code, ctxt) ->\n    return (Ex_script { code ; arg_type ; storage ; storage_type }, ctxt)\n\nlet typecheck_code\n  : context -> Script.expr -> (type_map * context) tzresult Lwt.t\n  = fun ctxt code ->\n    Lwt.return @@ parse_toplevel code >>=? fun (arg_type, storage_type, code_field) ->\n    let type_map = ref [] in\n    (* TODO: annotation checking *)\n    trace\n      (Ill_formed_type (Some \"parameter\", code, location arg_type))\n      (Lwt.return (parse_ty ctxt ~allow_big_map:false ~allow_operation:false arg_type))\n    >>=? fun (Ex_ty arg_type, ctxt) ->\n    trace\n      (Ill_formed_type (Some \"storage\", code, location storage_type))\n      (Lwt.return (parse_ty ctxt ~allow_big_map:true ~allow_operation:false storage_type))\n    >>=? fun (Ex_ty storage_type, ctxt) ->\n    let arg_annot = default_annot (type_to_var_annot (name_of_ty arg_type))\n        ~default:default_param_annot in\n    let storage_annot = default_annot (type_to_var_annot (name_of_ty storage_type))\n        ~default:default_storage_annot in\n    let arg_type_full = Pair_t ((arg_type, None, arg_annot),\n                                (storage_type, None, storage_annot), None) in\n    let ret_type_full =\n      Pair_t ((List_t (Operation_t None, None), None, None),\n              (storage_type, None, None), None) in\n    let result =\n      parse_returning\n        (Toplevel { storage_type ; param_type = arg_type })\n        ctxt\n        ~type_logger: (fun loc bef aft -> type_map := (loc, (bef, aft)) :: !type_map)\n        (arg_type_full, None) ret_type_full code_field in\n    trace\n      (Ill_typed_contract (code, !type_map))\n      result >>=? fun (Lam _, ctxt) ->\n    return (!type_map, ctxt)\n\nlet typecheck_data\n  : ?type_logger: type_logger ->\n    context -> Script.expr * Script.expr -> context tzresult Lwt.t\n  = fun ?type_logger ctxt (data, exp_ty) ->\n    trace\n      (Ill_formed_type (None, exp_ty, 0))\n      (Lwt.return @@ parse_ty ctxt ~allow_big_map:true ~allow_operation:false (root exp_ty))\n    >>=? fun (Ex_ty exp_ty, ctxt) ->\n    trace_eval\n      (fun () ->\n         Lwt.return @@ serialize_ty_for_error ctxt exp_ty >>|? fun (exp_ty, _ctxt) ->\n         Ill_typed_data (None, data, exp_ty))\n      (parse_data ?type_logger ctxt exp_ty (root data)) >>=? fun (_, ctxt) ->\n    return ctxt\n\n(* ---- Unparsing (Typed IR -> Untyped expressions) --------------------------*)\n\nlet rec unparse_data\n  : type a. context -> unparsing_mode -> a ty -> a -> (Script.node * context) tzresult Lwt.t\n  = fun ctxt mode ty a ->\n    Lwt.return (Gas.consume ctxt Unparse_costs.cycle) >>=? fun ctxt ->\n    match ty, a with\n    | Unit_t _, () ->\n        Lwt.return (Gas.consume ctxt Unparse_costs.unit) >>=? fun ctxt ->\n        return (Prim (-1, D_Unit, [], []), ctxt)\n    | Int_t _, v ->\n        Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt ->\n        return (Int (-1, Script_int.to_zint v), ctxt)\n    | Nat_t _, v ->\n        Lwt.return (Gas.consume ctxt (Unparse_costs.int v)) >>=? fun ctxt ->\n        return (Int (-1, Script_int.to_zint v), ctxt)\n    | String_t _, s ->\n        Lwt.return (Gas.consume ctxt (Unparse_costs.string s)) >>=? fun ctxt ->\n        return (String (-1, s), ctxt)\n    | Bytes_t _, s ->\n        Lwt.return (Gas.consume ctxt (Unparse_costs.bytes s)) >>=? fun ctxt ->\n        return (Bytes (-1, s), ctxt)\n    | Bool_t _, true ->\n        Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt ->\n        return (Prim (-1, D_True, [], []), ctxt)\n    | Bool_t _, false ->\n        Lwt.return (Gas.consume ctxt Unparse_costs.bool) >>=? fun ctxt ->\n        return (Prim (-1, D_False, [], []), ctxt)\n    | Timestamp_t _, t ->\n        Lwt.return (Gas.consume ctxt (Unparse_costs.timestamp t)) >>=? fun ctxt ->\n        begin\n          match mode with\n          | Optimized -> return (Int (-1, Script_timestamp.to_zint t), ctxt)\n          | Readable ->\n              match Script_timestamp.to_notation t with\n              | None -> return (Int (-1, Script_timestamp.to_zint t), ctxt)\n              | Some s -> return (String (-1, s), ctxt)\n        end\n    | Address_t _, c  ->\n        Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt ->\n        begin\n          match mode with\n          | Optimized ->\n              let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in\n              return (Bytes (-1, bytes), ctxt)\n          | Readable -> return (String (-1, Contract.to_b58check c), ctxt)\n        end\n    | Contract_t _, (_, c)  ->\n        Lwt.return (Gas.consume ctxt Unparse_costs.contract) >>=? fun ctxt ->\n        begin\n          match mode with\n          | Optimized ->\n              let bytes = Data_encoding.Binary.to_bytes_exn Contract.encoding c in\n              return (Bytes (-1, bytes), ctxt)\n          | Readable -> return (String (-1, Contract.to_b58check c), ctxt)\n        end\n    | Signature_t _, s ->\n        Lwt.return (Gas.consume ctxt Unparse_costs.signature) >>=? fun ctxt ->\n        begin\n          match mode with\n          | Optimized ->\n              let bytes = Data_encoding.Binary.to_bytes_exn Signature.encoding s in\n              return (Bytes (-1, bytes), ctxt)\n          | Readable ->\n              return (String (-1, Signature.to_b58check s), ctxt)\n        end\n    | Mutez_t _, v ->\n        Lwt.return (Gas.consume ctxt Unparse_costs.tez) >>=? fun ctxt ->\n        return (Int (-1, Z.of_int64 (Tez.to_mutez v)), ctxt)\n    | Key_t _, k ->\n        Lwt.return (Gas.consume ctxt Unparse_costs.key) >>=? fun ctxt ->\n        begin\n          match mode with\n          | Optimized ->\n              let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key.encoding k in\n              return (Bytes (-1, bytes), ctxt)\n          | Readable ->\n              return (String (-1, Signature.Public_key.to_b58check k), ctxt)\n        end\n    | Key_hash_t _, k ->\n        Lwt.return (Gas.consume ctxt Unparse_costs.key_hash) >>=? fun ctxt ->\n        begin\n          match mode with\n          | Optimized ->\n              let bytes = Data_encoding.Binary.to_bytes_exn Signature.Public_key_hash.encoding k in\n              return (Bytes (-1, bytes), ctxt)\n          | Readable ->\n              return (String (-1, Signature.Public_key_hash.to_b58check k), ctxt)\n        end\n    | Operation_t _, op ->\n        let bytes = Data_encoding.Binary.to_bytes_exn Operation.internal_operation_encoding op in\n        Lwt.return (Gas.consume ctxt (Unparse_costs.operation bytes)) >>=? fun ctxt ->\n        return (Bytes (-1, bytes), ctxt)\n    | Pair_t ((tl, _, _), (tr, _, _), _), (l, r) ->\n        Lwt.return (Gas.consume ctxt Unparse_costs.pair) >>=? fun ctxt ->\n        unparse_data ctxt mode tl l >>=? fun (l, ctxt) ->\n        unparse_data ctxt mode tr r >>=? fun (r, ctxt) ->\n        return (Prim (-1, D_Pair, [ l; r ], []), ctxt)\n    | Union_t ((tl, _), _, _), L l ->\n        Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt ->\n        unparse_data ctxt mode tl l >>=? fun (l, ctxt) ->\n        return (Prim (-1, D_Left, [ l ], []), ctxt)\n    | Union_t (_, (tr, _), _), R r ->\n        Lwt.return (Gas.consume ctxt Unparse_costs.union) >>=? fun ctxt ->\n        unparse_data ctxt mode tr r >>=? fun (r, ctxt) ->\n        return (Prim (-1, D_Right, [ r ], []), ctxt)\n    | Option_t ((t, _), _, _), Some v ->\n        Lwt.return (Gas.consume ctxt Unparse_costs.some) >>=? fun ctxt ->\n        unparse_data ctxt mode t v >>=? fun (v, ctxt) ->\n        return (Prim (-1, D_Some, [ v ], []), ctxt)\n    | Option_t _, None ->\n        Lwt.return (Gas.consume ctxt Unparse_costs.none) >>=? fun ctxt ->\n        return (Prim (-1, D_None, [], []), ctxt)\n    | List_t (t, _), items ->\n        fold_left_s\n          (fun (l, ctxt) element ->\n             Lwt.return (Gas.consume ctxt Unparse_costs.list_element) >>=? fun ctxt ->\n             unparse_data ctxt mode t element >>=? fun (unparsed, ctxt) ->\n             return (unparsed :: l, ctxt))\n          ([], ctxt)\n          items >>=? fun (items, ctxt) ->\n        return (Micheline.Seq (-1, List.rev items), ctxt)\n    | Set_t (t, _), set ->\n        let t = ty_of_comparable_ty t in\n        fold_left_s\n          (fun (l, ctxt) item ->\n             Lwt.return (Gas.consume ctxt Unparse_costs.set_element) >>=? fun ctxt ->\n             unparse_data ctxt mode t item >>=? fun (item, ctxt) ->\n             return (item :: l, ctxt))\n          ([], ctxt)\n          (set_fold (fun e acc -> e :: acc) set []) >>=? fun (items, ctxt) ->\n        return (Micheline.Seq (-1, items), ctxt)\n    | Map_t (kt, vt, _), map ->\n        let kt = ty_of_comparable_ty kt in\n        fold_left_s\n          (fun (l, ctxt) (k, v) ->\n             Lwt.return (Gas.consume ctxt Unparse_costs.map_element) >>=? fun ctxt ->\n             unparse_data ctxt mode kt k >>=? fun (key, ctxt) ->\n             unparse_data ctxt mode vt v >>=? fun (value, ctxt) ->\n             return (Prim (-1, D_Elt, [ key ; value ], []) :: l, ctxt))\n          ([], ctxt)\n          (map_fold (fun k v acc -> (k, v) :: acc) map []) >>=? fun (items, ctxt) ->\n        return (Micheline.Seq (-1, items), ctxt)\n    | Big_map_t (_kt, _kv, _), _map ->\n        return (Micheline.Seq (-1, []), ctxt)\n    | Lambda_t _, Lam (_, original_code) ->\n        unparse_code ctxt mode (root original_code)\n\n(* Gas accounting may not be perfect in this function, as it is only called by RPCs. *)\nand unparse_code ctxt mode = function\n  | Prim (loc, I_PUSH, [ ty ; data ], annot) ->\n      Lwt.return (parse_ty ctxt ~allow_big_map:false ~allow_operation:false ty) >>=? fun (Ex_ty t, ctxt) ->\n      parse_data ctxt t data >>=? fun (data, ctxt) ->\n      unparse_data ctxt mode t data >>=? fun (data, ctxt) ->\n      Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 2 annot)) >>=? fun ctxt ->\n      return (Prim (loc, I_PUSH, [ ty ; data ], annot), ctxt)\n  | Seq (loc, items) ->\n      fold_left_s\n        (fun (l, ctxt) item ->\n           unparse_code ctxt mode item >>=? fun (item, ctxt) ->\n           return (item :: l, ctxt))\n        ([], ctxt) items >>=? fun (items, ctxt) ->\n      Lwt.return (Gas.consume ctxt (Unparse_costs.seq_cost (List.length items))) >>=? fun ctxt ->\n      return (Micheline.Seq (loc, List.rev items), ctxt)\n  | Prim (loc, prim, items, annot) ->\n      fold_left_s\n        (fun (l, ctxt) item ->\n           unparse_code ctxt mode item >>=? fun (item, ctxt) ->\n           return (item :: l, ctxt))\n        ([], ctxt) items >>=? fun (items, ctxt) ->\n      Lwt.return (Gas.consume ctxt (Unparse_costs.prim_cost 3 annot)) >>=? fun 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. *)\nlet unparse_script ctxt mode { code ; arg_type ; storage ; storage_type } =\n  let Lam (_, original_code) = code in\n  unparse_code ctxt mode (root original_code) >>=? fun (code, ctxt) ->\n  unparse_data ctxt mode storage_type storage >>=? fun (storage, ctxt) ->\n  unparse_ty ctxt arg_type >>=? fun (arg_type, ctxt) ->\n  unparse_ty ctxt storage_type >>=? fun (storage_type, ctxt) ->\n  let open Micheline in\n  let code =\n    Seq (-1, [ Prim (-1, K_parameter, [ arg_type ], []) ;\n               Prim (-1, K_storage, [ storage_type ], []) ;\n               Prim (-1, K_code, [ code ], []) ]) in\n  Lwt.return\n    (Gas.consume ctxt (Unparse_costs.seq_cost 3) >>? fun ctxt ->\n     Gas.consume ctxt (Unparse_costs.prim_cost 1 []) >>? fun ctxt ->\n     Gas.consume ctxt (Unparse_costs.prim_cost 1 []) >>? fun ctxt ->\n     Gas.consume ctxt (Unparse_costs.prim_cost 1 [])) >>=? fun ctxt ->\n  return ({ code = lazy_expr (strip_locations code) ;\n            storage = lazy_expr (strip_locations storage) }, ctxt)\n\nlet pack_data ctxt typ data =\n  unparse_data ctxt Optimized typ data >>=? fun (data, ctxt) ->\n  let unparsed = strip_annotations @@ data in\n  let bytes = Data_encoding.Binary.to_bytes_exn expr_encoding (Micheline.strip_locations unparsed) in\n  Lwt.return @@ Gas.consume ctxt (Script.serialized_cost bytes) >>=? fun ctxt ->\n  let bytes = MBytes.concat \"\" [ MBytes.of_string \"\\005\" ; bytes ] in\n  Lwt.return @@ Gas.consume ctxt (Script.serialized_cost bytes) >>=? fun ctxt ->\n  return (bytes, ctxt)\n\nlet hash_data ctxt typ data =\n  pack_data ctxt typ data >>=? fun (bytes, ctxt) ->\n  Lwt.return @@ Gas.consume ctxt\n    (Michelson_v1_gas.Cost_of.hash bytes Script_expr_hash.size) >>=? fun ctxt ->\n  return (Script_expr_hash.(hash_bytes [ bytes ]), ctxt)\n\n(* ---------------- Big map -------------------------------------------------*)\n\nlet big_map_mem ctxt contract key { diff ; key_type ; _ } =\n  match map_get key diff with\n  | None -> hash_data ctxt key_type key >>=? fun (hash, ctxt) ->\n      Alpha_context.Contract.Big_map.mem ctxt contract hash >>=? fun (ctxt, res) ->\n      return (res, ctxt)\n  | Some None -> return (false, ctxt)\n  | Some (Some _) -> return (true, ctxt)\n\nlet big_map_get ctxt contract key { diff ; key_type ; value_type } =\n  match map_get key diff with\n  | Some x -> return (x, ctxt)\n  | None ->\n      hash_data ctxt key_type key >>=? fun (hash, ctxt) ->\n      Alpha_context.Contract.Big_map.get_opt\n        ctxt contract hash >>=? begin function\n        | (ctxt, None) -> return (None, ctxt)\n        | (ctxt, Some value) ->\n            parse_data ctxt value_type\n              (Micheline.root value) >>=? fun (x, ctxt) ->\n            return (Some x, ctxt)\n      end\n\nlet big_map_update key value ({ diff ; _ } as map) =\n  { map with diff = map_set key value diff }\n\nlet diff_of_big_map ctxt mode (Ex_bm { key_type ; value_type ; diff }) =\n  Lwt.return (Gas.consume ctxt (Michelson_v1_gas.Cost_of.map_to_list diff)) >>=? fun ctxt ->\n  let pairs = map_fold (fun key value acc -> (key, value) :: acc) diff [] in\n  fold_left_s\n    (fun (acc, ctxt) (key, value) ->\n       Lwt.return (Gas.consume ctxt Typecheck_costs.cycle) >>=? fun ctxt ->\n       hash_data ctxt key_type key >>=? fun (hash, ctxt) ->\n       begin\n         match value with\n         | None -> return (None, ctxt)\n         | Some x ->\n             begin\n               unparse_data ctxt mode value_type x >>=? fun (node, ctxt) ->\n               return (Some (Micheline.strip_locations node), ctxt)\n             end\n       end >>=? fun (value, ctxt) ->\n       return ((hash, value) :: acc, ctxt))\n    ([], ctxt) pairs\n\n(* Get the big map from a contract's storage if one exists *)\nlet extract_big_map : type a. a ty -> a -> ex_big_map option = fun ty x ->\n  match (ty, x) with\n  | Pair_t ((Big_map_t (_, _, _), _, _), _, _), (map, _) -> Some (Ex_bm map)\n  | _, _ -> None\n\nlet erase_big_map_initialization ctxt mode ({ code ; storage } : Script.t) =\n  Script.force_decode ctxt code >>=? fun (code, ctxt) ->\n  Script.force_decode ctxt storage >>=? fun (storage, ctxt) ->\n  Lwt.return @@ parse_toplevel code >>=? fun (_, storage_type, _) ->\n  Lwt.return @@ parse_ty ctxt ~allow_big_map:true ~allow_operation:false storage_type >>=? fun (Ex_ty ty, ctxt) ->\n  parse_data ctxt ty\n    (Micheline.root storage) >>=? fun (storage, ctxt) ->\n  begin\n    match extract_big_map ty storage with\n    | None -> return (None, ctxt)\n    | Some bm -> diff_of_big_map ctxt mode bm >>=? fun (bm, ctxt) ->\n        return (Some bm, ctxt)\n  end >>=? fun (bm, ctxt) ->\n  unparse_data ctxt mode ty storage >>=? fun (storage, ctxt) ->\n  return ({ code = Script.lazy_expr code ;\n            storage = Script.lazy_expr (Micheline.strip_locations storage) }, bm, ctxt)\n" ;
                } ;
                { name = "Script_tc_errors_registration" ;
                  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\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 \"stackBefore\" stack_enc)\n          (req \"stackAfter\" stack_enc)))\n\nlet stack_ty_enc =\n  let open Data_encoding in\n  (list\n     (obj2\n        (req \"type\" Script.expr_encoding)\n        (dft \"annots\" (list string) [])))\n\n(* main registration *)\nlet () =\n  let open Data_encoding in\n  let located enc =\n    merge_objs\n      (obj1 (req \"location\" Script.location_encoding))\n      enc in\n  let arity_enc =\n    int8 in\n  let namespace_enc =\n    def \"primitiveNamespace\"\n      ~title: \"Primitive namespace\"\n      ~description:\n        \"One of the three possible namespaces of primitive \\\n         (data constructor, type name or instruction).\" @@\n    string_enum [ \"type\", Type_namespace ;\n                  \"constant\", Constant_namespace ;\n                  \"instruction\", Instr_namespace ] in\n  let kind_enc =\n    def \"expressionKind\"\n      ~title: \"Expression kind\"\n      ~description:\n        \"One of the four possible kinds of expression \\\n         (integer, string, primitive application or sequence).\" @@\n    string_enum [ \"integer\", Int_kind ;\n                  \"string\", String_kind ;\n                  \"bytes\", Bytes_kind ;\n                  \"primitiveApplication\", Prim_kind ;\n                  \"sequence\", Seq_kind ] in\n  (* -- Structure errors ---------------------- *)\n  (* Invalid arity *)\n  register_error_kind\n    `Permanent\n    ~id:\"invalidArityTypeError\"\n    ~title: \"Invalid arity (typechecking error)\"\n    ~description:\n      \"In a script or data expression, a primitive was applied \\\n       to an unsupported number of arguments.\"\n    (located (obj3\n                (req \"primitiveName\" Script.prim_encoding)\n                (req \"expectedArity\" arity_enc)\n                (req \"wrongArity\" arity_enc)))\n    (function\n      | Invalid_arity (loc, name, exp, got) ->\n          Some (loc, (name, exp, got))\n      | _ -> None)\n    (fun (loc, (name, exp, got)) ->\n       Invalid_arity (loc, name, exp, got)) ;\n  (* Missing field *)\n  register_error_kind\n    `Permanent\n    ~id:\"missingScriptField\"\n    ~title:\"Script is missing a field (parse error)\"\n    ~description:\n      \"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:\"invalidPrimitiveTypeError\"\n    ~title: \"Invalid primitive (typechecking error)\"\n    ~description:\n      \"In a script or data expression, a primitive was unknown.\"\n    (located (obj2\n                (dft \"expectedPrimitiveNames\" (list prim_encoding) [])\n                (req \"wrongPrimitiveName\" prim_encoding)))\n    (function\n      | Invalid_primitive (loc, exp, got) -> Some (loc, (exp, got))\n      | _ -> None)\n    (fun (loc, (exp, got)) ->\n       Invalid_primitive (loc, exp, got)) ;\n  (* Invalid kind *)\n  register_error_kind\n    `Permanent\n    ~id:\"invalidExpressionKindTypeError\"\n    ~title: \"Invalid expression kind (typechecking error)\"\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 (obj2\n                (req \"expectedKinds\" (list kind_enc))\n                (req \"wrongKind\" kind_enc)))\n    (function\n      | Invalid_kind (loc, exp, got) -> Some (loc, (exp, got))\n      | _ -> None)\n    (fun (loc, (exp, got)) ->\n       Invalid_kind (loc, exp, got)) ;\n  (* Invalid namespace *)\n  register_error_kind\n    `Permanent\n    ~id:\"invalidPrimitiveNamespaceTypeError\"\n    ~title: \"Invalid primitive namespace (typechecking error)\"\n    ~description:\n      \"In a script or data expression, a primitive was of the wrong namespace.\"\n    (located (obj3\n                (req \"primitiveName\" prim_encoding)\n                (req \"expectedNamespace\" namespace_enc)\n                (req \"wrongNamespace\" namespace_enc)))\n    (function\n      | Invalid_namespace (loc, name, exp, got) -> Some (loc, (name, exp, got))\n      | _ -> None)\n    (fun (loc, (name, exp, got)) ->\n       Invalid_namespace (loc, name, exp, got)) ;\n  (* Duplicate field *)\n  register_error_kind\n    `Permanent\n    ~id:\"duplicateScriptField\"\n    ~title: \"Script has a duplicated field (parse error)\"\n    ~description:\n      \"When parsing script, a field was found more than once\"\n    (obj2\n       (req \"loc\" location_encoding)\n       (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:\"unexpectedBigMap\"\n    ~title: \"Big map in unauthorized position (type error)\"\n    ~description:\n      \"When parsing script, a big_map type was found somewhere else \\\n       than in the left component of the toplevel storage pair.\"\n    (obj1\n       (req \"loc\" location_encoding))\n    (function Unexpected_big_map loc -> Some loc | _ -> None)\n    (fun loc -> Unexpected_big_map loc) ;\n  (* Unexpected operation *)\n  register_error_kind\n    `Permanent\n    ~id:\"unexpectedOperation\"\n    ~title: \"Big map in unauthorized position (type error)\"\n    ~description:\n      \"When parsing script, a operation type was found \\\n       in the storage or parameter field.\"\n    (obj1\n       (req \"loc\" location_encoding))\n    (function Unexpected_operation loc -> Some loc | _ -> None)\n    (fun loc -> Unexpected_operation loc) ;\n  (* -- Value typing errors ---------------------- *)\n  (* Unordered map keys *)\n  register_error_kind\n    `Permanent\n    ~id:\"unorderedMapLiteral\"\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\n      | Unordered_map_keys (loc, expr) -> Some (loc, expr)\n      | _ -> None)\n    (fun (loc, expr) -> Unordered_map_keys (loc, expr));\n  (* Duplicate map keys *)\n  register_error_kind\n    `Permanent\n    ~id:\"duplicateMapKeys\"\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\n      | Duplicate_map_keys (loc, expr) -> Some (loc, expr)\n      | _ -> None)\n    (fun (loc, expr) -> Duplicate_map_keys (loc, expr));\n  (* Unordered set values *)\n  register_error_kind\n    `Permanent\n    ~id:\"unorderedSetLiteral\"\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)\n      | _ -> None)\n    (fun (loc, expr) -> Unordered_set_values (loc, expr));\n  (* Duplicate set values *)\n  register_error_kind\n    `Permanent\n    ~id:\"duplicateSetValuesInLiteral\"\n    ~title:\"Sets literals cannot contain duplicate elements\"\n    ~description:\"Set literals cannot contain duplicate elements, \\\n                  but a duplicae was 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)\n      | _ -> 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:\"failNotInTailPositionTypeError\"\n    ~title: \"FAIL not in tail position (typechecking error)\"\n    ~description:\n      \"There is non trivial garbage code after a FAIL instruction.\"\n    (located empty)\n    (function\n      | Fail_not_in_tail_position loc -> Some (loc, ())\n      | _ -> None)\n    (fun (loc, ()) ->\n       Fail_not_in_tail_position loc) ;\n  (* Undefined binary operation *)\n  register_error_kind\n    `Permanent\n    ~id:\"undefinedBinopTypeError\"\n    ~title: \"Undefined binop (typechecking error)\"\n    ~description:\n      \"A binary operation is called on operands of types \\\n       over which it is not defined.\"\n    (located (obj3\n                (req \"operatorName\" prim_encoding)\n                (req \"wrongLeftOperandType\" Script.expr_encoding)\n                (req \"wrongRightOperandType\" Script.expr_encoding)))\n    (function\n      | Undefined_binop (loc, n, tyl, tyr) ->\n          Some (loc, (n, tyl, tyr))\n      | _ -> None)\n    (fun (loc, (n, tyl, tyr)) ->\n       Undefined_binop (loc, n, tyl, tyr)) ;\n  (* Undefined unary operation *)\n  register_error_kind\n    `Permanent\n    ~id:\"undefinedUnopTypeError\"\n    ~title: \"Undefined unop (typechecking error)\"\n    ~description:\n      \"A unary operation is called on an operand of type \\\n       over which it is not defined.\"\n    (located (obj2\n                (req \"operatorName\" prim_encoding)\n                (req \"wrongOperandType\" Script.expr_encoding)))\n    (function\n      | Undefined_unop (loc, n, ty) ->\n          Some (loc, (n, ty))\n      | _ -> None)\n    (fun (loc, (n, ty)) ->\n       Undefined_unop (loc, n, ty)) ;\n  (* Bad return *)\n  register_error_kind\n    `Permanent\n    ~id:\"badReturnTypeError\"\n    ~title: \"Bad return (typechecking error)\"\n    ~description:\n      \"Unexpected stack at the end of a lambda or script.\"\n    (located (obj2\n                (req \"expectedReturnType\" Script.expr_encoding)\n                (req \"wrongStackType\" stack_ty_enc)))\n    (function\n      | Bad_return (loc, sty, ty) -> Some (loc, (ty, sty))\n      | _ -> None)\n    (fun (loc, (ty, sty)) ->\n       Bad_return (loc, sty, ty)) ;\n  (* Bad stack *)\n  register_error_kind\n    `Permanent\n    ~id:\"badStackTypeError\"\n    ~title: \"Bad stack (typechecking error)\"\n    ~description:\n      \"The stack has an unexpected length or contents.\"\n    (located (obj3\n                (req \"primitiveName\" prim_encoding)\n                (req \"relevantStackPortion\" int16)\n                (req \"wrongStackType\" stack_ty_enc)))\n    (function\n      | Bad_stack (loc, name, s, sty) -> Some (loc, (name, s, sty))\n      | _ -> None)\n    (fun (loc, (name, s, sty)) ->\n       Bad_stack (loc, name, s, sty)) ;\n  (* Inconsistent annotations *)\n  register_error_kind\n    `Permanent\n    ~id:\"inconsistentAnnotations\"\n    ~title:\"Annotations inconsistent between branches\"\n    ~description:\"The annotations on two types could not be merged\"\n    (obj2\n       (req \"annot1\" string)\n       (req \"annot2\" string))\n    (function 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:\"inconsistentFieldAnnotations\"\n    ~title:\"Annotations for field accesses is inconsistent\"\n    ~description:\"The specified field does not match the field annotation in the type\"\n    (obj2\n       (req \"annot1\" string)\n       (req \"annot2\" string))\n    (function 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:\"inconsistentTypeAnnotations\"\n    ~title:\"Types contain inconsistent annotations\"\n    ~description:\"The two types contain annotations that do not match\"\n    (located (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:\"unexpectedAnnotation\"\n    ~title:\"An annotation was encountered where no annotation is expected\"\n    ~description:\"A node in the syntax tree was impropperly annotated\"\n    (located empty)\n    (function Unexpected_annotation loc -> Some (loc, ())\n            | _ -> None)\n    (fun (loc, ()) -> Unexpected_annotation loc);\n  (* Ungrouped annotations *)\n  register_error_kind\n    `Permanent\n    ~id:\"ungroupedAnnotations\"\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, ())\n            | _ -> None)\n    (fun (loc, ()) -> Ungrouped_annotations loc);\n  (* Unmatched branches *)\n  register_error_kind\n    `Permanent\n    ~id:\"unmatchedBranchesTypeError\"\n    ~title: \"Unmatched branches (typechecking error)\"\n    ~description:\n      \"At the join point at the end of two code branches \\\n       the stacks have inconsistent lengths or contents.\"\n    (located (obj2\n                (req \"firstStackType\" stack_ty_enc)\n                (req \"otherStackType\" stack_ty_enc)))\n    (function\n      | Unmatched_branches (loc, stya, styb) ->\n          Some (loc, (stya, styb))\n      | _ -> None)\n    (fun (loc, (stya, styb)) ->\n       Unmatched_branches (loc, stya, styb)) ;\n  (* Bad stack item *)\n  register_error_kind\n    `Permanent\n    ~id:\"badStackItemTypeError\"\n    ~title: \"Bad stack item (typechecking error)\"\n    ~description:\n      \"The type of a stack item is unexpected \\\n       (this error is always accompanied by a more precise one).\"\n    (obj1 (req \"itemLevel\" int16))\n    (function\n      | Bad_stack_item n -> Some n\n      | _ -> None)\n    (fun n ->\n       Bad_stack_item n) ;\n  (* SELF in lambda *)\n  register_error_kind\n    `Permanent\n    ~id:\"selfInLambda\"\n    ~title: \"SELF instruction in lambda (typechecking error)\"\n    ~description:\n      \"A SELF instruction was encountered in a lambda expression.\"\n    (located empty)\n    (function\n      | Self_in_lambda loc -> Some (loc, ())\n      | _ -> None)\n    (fun (loc, ()) ->\n       Self_in_lambda loc) ;\n  (* Bad stack length *)\n  register_error_kind\n    `Permanent\n    ~id:\"inconsistentStackLengthsTypeError\"\n    ~title: \"Inconsistent stack lengths (typechecking error)\"\n    ~description:\n      \"A stack was of an unexpected length \\\n       (this error is always in the context of a located error).\"\n    empty\n    (function\n      | Bad_stack_length -> Some ()\n      | _ -> None)\n    (fun () ->\n       Bad_stack_length) ;\n  (* -- Value typing errors ------------------- *)\n  (* Invalid constant *)\n  register_error_kind\n    `Permanent\n    ~id:\"invalidConstantTypeError\"\n    ~title: \"Invalid constant (typechecking error)\"\n    ~description:\n      \"A data expression was invalid for its expected type.\"\n    (located (obj2\n                (req \"expectedType\" Script.expr_encoding)\n                (req \"wrongExpression\" Script.expr_encoding)))\n    (function\n      | Invalid_constant (loc, expr, ty) ->\n          Some (loc, (ty, expr))\n      | _ -> None)\n    (fun (loc, (ty, expr)) ->\n       Invalid_constant (loc, expr, ty)) ;\n  (* Invalid contract *)\n  register_error_kind\n    `Permanent\n    ~id:\"invalidContractTypeError\"\n    ~title: \"Invalid contract (typechecking error)\"\n    ~description:\n      \"A script or data expression references a contract that does not \\\n       exist or assumes a wrong type for an existing contract.\"\n    (located (obj1 (req \"contract\" Contract.encoding)))\n    (function\n      | Invalid_contract (loc, c) ->\n          Some (loc, c)\n      | _ -> None)\n    (fun (loc, c) ->\n       Invalid_contract (loc, c)) ;\n  (* Comparable type expected *)\n  register_error_kind\n    `Permanent\n    ~id:\"comparableTypeExpectedTypeError\"\n    ~title: \"Comparable type expected (typechecking error)\"\n    ~description:\n      \"A non comparable type was used in a place where \\\n       only comparable types are accepted.\"\n    (located (obj1 (req \"wrongType\" Script.expr_encoding)))\n    (function\n      | Comparable_type_expected (loc, ty) -> Some (loc, ty)\n      | _ -> None)\n    (fun (loc, ty) ->\n       Comparable_type_expected (loc, ty)) ;\n  (* Inconsistent types *)\n  register_error_kind\n    `Permanent\n    ~id:\"InconsistentTypesTypeError\"\n    ~title: \"Inconsistent types (typechecking error)\"\n    ~description:\n      \"This is the basic type clash error, \\\n       that appears in several places where the equality of \\\n       two types have to be proven, it is always accompanied \\\n       with another error that provides more context.\"\n    (obj2\n       (req \"firstType\" Script.expr_encoding)\n       (req \"otherType\" Script.expr_encoding))\n    (function\n      | Inconsistent_types (tya, tyb) -> Some (tya, tyb)\n      | _ -> None)\n    (fun (tya, tyb) -> Inconsistent_types (tya, tyb)) ;\n  (* -- Instruction typing errors ------------------- *)\n  (* Invalid map body *)\n  register_error_kind\n    `Permanent\n    ~id:\"invalidMapBody\"\n    ~title: \"Invalid map body\"\n    ~description:\n      \"The body of a map block did not match the expected type\"\n    (obj2\n       (req \"loc\" Script.location_encoding)\n       (req \"bodyType\" stack_ty_enc))\n    (function\n      | Invalid_map_body (loc, stack) -> Some (loc, stack)\n      | _ -> None)\n    (fun (loc, stack) -> Invalid_map_body (loc, stack)) ;\n  (* Invalid map block FAIL *)\n  register_error_kind\n    `Permanent\n    ~id:\"invalidMapBlockFail\"\n    ~title:\"FAIL instruction occurred as body of map block\"\n    ~description:\"FAIL cannot be the only instruction in the body. \\\n                  The propper type of the return list cannot be inferred.\"\n    (obj1 (req \"loc\" Script.location_encoding))\n    (function\n      | Invalid_map_block_fail loc -> Some loc\n      | _ -> None)\n    (fun loc -> Invalid_map_block_fail loc) ;\n  (* Invalid ITER body *)\n  register_error_kind\n    `Permanent\n    ~id:\"invalidIterBody\"\n    ~title:\"ITER body returned wrong stack type\"\n    ~description:\"The body of an ITER instruction \\\n                  must result in the same stack type as before \\\n                  the ITER.\"\n    (obj3\n       (req \"loc\" Script.location_encoding)\n       (req \"befStack\" stack_ty_enc)\n       (req \"aftStack\" stack_ty_enc))\n    (function\n      | Invalid_iter_body (loc, bef, aft) -> Some (loc, bef, aft)\n      | _ -> None)\n    (fun (loc, bef, aft) -> Invalid_iter_body (loc, bef, aft)) ;\n  (* Type too large *)\n  register_error_kind\n    `Permanent\n    ~id:\"typeTooLarge\"\n    ~title:\"Stack item type too large\"\n    ~description:\"An instruction generated a type larger than the limit.\"\n    (obj3\n       (req \"loc\" Script.location_encoding)\n       (req \"typeSize\" uint16)\n       (req \"maximumTypeSize\" uint16))\n    (function\n      | Type_too_large (loc, ts, maxts) -> Some (loc, ts, maxts)\n      | _ -> None)\n    (fun (loc, ts, maxts) -> Type_too_large (loc, ts, maxts)) ;\n  (* -- Toplevel errors ------------------- *)\n  (* Ill typed data *)\n  register_error_kind\n    `Permanent\n    ~id:\"illTypedDataTypeError\"\n    ~title: \"Ill typed data (typechecking error)\"\n    ~description:\n      \"The toplevel error thrown when trying to typecheck \\\n       a data expression against a given type \\\n       (always followed by more precise errors).\"\n    (obj3\n       (opt \"identifier\" string)\n       (req \"expectedType\" Script.expr_encoding)\n       (req \"illTypedExpression\" Script.expr_encoding))\n    (function\n      | Ill_typed_data (name, expr, ty) -> Some (name, ty,  expr)\n      | _ -> None)\n    (fun (name, ty,  expr) -> Ill_typed_data (name, expr, ty)) ;\n  (* Ill formed type *)\n  register_error_kind\n    `Permanent\n    ~id:\"illFormedTypeTypeError\"\n    ~title: \"Ill formed type (typechecking error)\"\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 \"illFormedExpression\" Script.expr_encoding)\n       (req \"location\" Script.location_encoding))\n    (function\n      | Ill_formed_type (name, expr, loc) -> Some (name, expr, loc)\n      | _ -> None)\n    (fun (name, expr, loc) ->\n       Ill_formed_type (name, expr, loc)) ;\n  (* Ill typed contract *)\n  register_error_kind\n    `Permanent\n    ~id:\"illTypedContractTypeError\"\n    ~title: \"Ill typed contract (typechecking error)\"\n    ~description:\n      \"The toplevel error thrown when trying to typecheck \\\n       a contract code against given input, output and storage types \\\n       (always followed by more precise errors).\"\n    (obj2\n       (req \"illTypedCode\" Script.expr_encoding)\n       (req \"typeMap\" type_map_enc))\n    (function\n      | Ill_typed_contract (expr, type_map) ->\n          Some (expr, type_map)\n      | _ -> None)\n    (fun (expr, type_map) ->\n       Ill_typed_contract (expr, type_map)) ;\n  (* Cannot serialize error *)\n  register_error_kind\n    `Temporary\n    ~id:\"cannotSerializeError\"\n    ~title:\"Not enough gas to serialize error\"\n    ~description:\"The error was too big to be serialized with \\\n                  the provided gas\"\n    Data_encoding.empty\n    (function Cannot_serialize_error -> Some () | _ -> None)\n    (fun () -> Cannot_serialize_error)\n" ;
                } ;
                { name = "Script_interpreter" ;
                  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 execution_trace =\n  (Script.location * Gas.t * (Script.expr * string option) list) list\n\ntype error += Reject of Script.location * Script.expr * execution_trace option\ntype error += Overflow of Script.location * execution_trace option\ntype error += Runtime_contract_error : Contract.t * Script.expr -> error\ntype error += Bad_contract_parameter of Contract.t (* `Permanent *)\ntype error += Cannot_serialize_log\ntype error += Cannot_serialize_failure\ntype error += Cannot_serialize_storage\n\ntype execution_result =\n  { ctxt : context ;\n    storage : Script.expr ;\n    big_map_diff : Contract.big_map_diff option ;\n    operations : packed_internal_operation list }\n\nval execute:\n  Alpha_context.t ->\n  Script_ir_translator.unparsing_mode ->\n  source: Contract.t ->\n  payer: Contract.t ->\n  self: (Contract.t * Script.t) ->\n  parameter: Script.expr ->\n  amount: Tez.t ->\n  execution_result tzresult Lwt.t\n\nval trace:\n  Alpha_context.t ->\n  Script_ir_translator.unparsing_mode ->\n  source: Contract.t ->\n  payer: Contract.t ->\n  self: (Contract.t * Script.t) ->\n  parameter: Script.expr ->\n  amount: Tez.t ->\n  (execution_result * execution_trace) 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\nopen Script\nopen Script_typed_ir\nopen Script_ir_translator\n\n(* ---- Run-time errors -----------------------------------------------------*)\n\ntype execution_trace =\n  (Script.location * Gas.t * (Script.expr * string option) list) list\n\ntype error += Reject of Script.location * Script.expr * execution_trace option\ntype error += Overflow of Script.location * execution_trace option\ntype error += Runtime_contract_error : Contract.t * Script.expr -> error\ntype error += Bad_contract_parameter of Contract.t (* `Permanent *)\ntype error += Cannot_serialize_log\ntype error += Cannot_serialize_failure\ntype error += Cannot_serialize_storage\n\nlet () =\n  let open Data_encoding in\n  let trace_encoding =\n    (list @@ obj3\n       (req \"location\" Script.location_encoding)\n       (req \"gas\" Gas.encoding)\n       (req \"stack\"\n          (list\n             (obj2\n                (req \"item\" (Script.expr_encoding))\n                (opt \"annot\" string))))) in\n  (* Reject *)\n  register_error_kind\n    `Temporary\n    ~id:\"scriptRejectedRuntimeError\"\n    ~title: \"Script failed (runtime script error)\"\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:\"scriptOverflowRuntimeError\"\n    ~title: \"Script failed (overflow error)\"\n    ~description: \"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:\"scriptRuntimeError\"\n    ~title: \"Script runtime error\"\n    ~description: \"Toplevel error for all runtime script errors\"\n    (obj2\n       (req \"contractHandle\" Contract.encoding)\n       (req \"contractCode\" Script.expr_encoding))\n    (function\n      | Runtime_contract_error (contract, expr) ->\n          Some (contract, expr)\n      | _ -> None)\n    (fun (contract, expr) ->\n       Runtime_contract_error (contract, expr)) ;\n  (* Bad contract parameter *)\n  register_error_kind\n    `Permanent\n    ~id:\"badContractParameter\"\n    ~title:\"Contract supplied an invalid parameter\"\n    ~description:\"Either no parameter was supplied to a contract with \\\n                  a non-unit parameter type, a non-unit parameter was \\\n                  passed to an account, or a parameter was supplied of \\\n                  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 log *)\n  register_error_kind\n    `Temporary\n    ~id:\"cannotSerializeLog\"\n    ~title:\"Not enough gas to serialize execution trace\"\n    ~description:\"Execution trace with stacks was to big to be serialized with \\\n                  the provided gas\"\n    Data_encoding.empty\n    (function Cannot_serialize_log -> Some () | _ -> None)\n    (fun () -> Cannot_serialize_log) ;\n  (* Cannot serialize failure *)\n  register_error_kind\n    `Temporary\n    ~id:\"cannotSerializeFailure\"\n    ~title:\"Not enough gas to serialize argument of FAILWITH\"\n    ~description:\"Argument of FAILWITH was too big to be serialized with \\\n                  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:\"cannotSerializeStorage\"\n    ~title:\"Not enough gas to serialize execution storage\"\n    ~description:\"The returned storage was too big to be serialized with \\\n                  the provided gas\"\n    Data_encoding.empty\n    (function Cannot_serialize_storage -> Some () | _ -> None)\n    (fun () -> Cannot_serialize_storage)\n\n(* ---- interpreter ---------------------------------------------------------*)\n\ntype 'tys stack =\n  | Item : 'ty * 'rest stack -> ('ty * 'rest) stack\n  | Empty : end_of_stack stack\n\nlet unparse_stack ctxt (stack, stack_ty) =\n  (* We drop the gas limit as this function is only used for debugging/errors. *)\n  let ctxt = Gas.set_unlimited ctxt in\n  let rec unparse_stack\n    : type a. a stack * a stack_ty -> (Script.expr * string option) list tzresult Lwt.t\n    = function\n      | Empty, Empty_t -> return_nil\n      | Item (v, rest), Item_t (ty, rest_ty, annot) ->\n          unparse_data ctxt Readable ty v >>=? fun (data, _ctxt) ->\n          unparse_stack (rest, rest_ty) >>=? fun rest ->\n          let annot = match Script_ir_annot.unparse_var_annot annot with\n            | [] -> None\n            | [ a ] -> Some a\n            | _ -> assert false in\n          let data = Micheline.strip_locations data in\n          return ((data, annot) :: rest) in\n  unparse_stack (stack, stack_ty)\n\nmodule Interp_costs = Michelson_v1_gas.Cost_of\n\nlet rec interp\n  : type p r.\n    (?log: execution_trace ref ->\n     context ->\n     source: Contract.t -> payer:Contract.t -> self: Contract.t -> Tez.t ->\n     (p, r) lambda -> p ->\n     (r * context) tzresult Lwt.t)\n  = fun ?log ctxt ~source ~payer ~self amount (Lam (code, _)) arg ->\n    let rec step\n      : type b a.\n        context -> (b, a) descr -> b stack ->\n        (a stack * context) tzresult Lwt.t =\n      fun ctxt ({ instr ; loc ; _ } as descr) stack ->\n        Lwt.return (Gas.consume ctxt Interp_costs.cycle) >>=? fun ctxt ->\n        let logged_return : type a b.\n          (b, a) descr ->\n          a stack * context ->\n          (a stack * context) tzresult Lwt.t =\n          fun descr (ret, ctxt) ->\n            match log with\n            | None -> return (ret, ctxt)\n            | Some log ->\n                trace\n                  Cannot_serialize_log\n                  (unparse_stack ctxt (ret, descr.aft)) >>=? fun stack ->\n                log := (descr.loc, Gas.level ctxt, stack) :: !log ;\n                return (ret, ctxt) in\n        let get_log (log : execution_trace ref option) =\n          Option.map ~f:(!) log in\n        let consume_gas_terop : type ret arg1 arg2 arg3 rest.\n          (_ * (_ * (_ * rest)), ret * rest) descr ->\n          ((arg1 -> arg2 -> arg3 -> ret) * arg1 * arg2 * arg3) ->\n          (arg1 -> arg2 -> arg3 -> Gas.cost) ->\n          rest stack ->\n          ((ret * rest) stack * context) tzresult Lwt.t =\n          fun descr (op, x1, x2, x3) cost_func rest ->\n            Lwt.return (Gas.consume ctxt (cost_func x1 x2 x3)) >>=? fun ctxt ->\n            logged_return descr (Item (op x1 x2 x3, rest), ctxt) in\n        let consume_gas_binop : type ret arg1 arg2 rest.\n          (_ * (_ * rest), ret * rest) descr ->\n          ((arg1 -> arg2 -> ret) * arg1 * arg2) ->\n          (arg1 -> arg2 -> Gas.cost) ->\n          rest stack ->\n          context ->\n          ((ret * rest) stack * context) tzresult Lwt.t =\n          fun descr (op, x1, x2) cost_func rest ctxt ->\n            Lwt.return (Gas.consume ctxt (cost_func x1 x2)) >>=? fun ctxt ->\n            logged_return descr (Item (op x1 x2, rest), ctxt) in\n        let consume_gas_unop : type ret arg rest.\n          (_ * rest, ret * rest) descr ->\n          ((arg -> ret) * arg) ->\n          (arg -> Gas.cost) ->\n          rest stack ->\n          context ->\n          ((ret * rest) stack * context) tzresult Lwt.t =\n          fun descr (op, arg) cost_func rest ctxt ->\n            Lwt.return (Gas.consume ctxt (cost_func arg)) >>=? fun ctxt ->\n            logged_return descr (Item (op arg, rest), ctxt) in\n        let consume_gaz_comparison :\n          type t rest.\n          (t * (t * rest), Script_int.z Script_int.num * rest) descr ->\n          (t -> t -> int) ->\n          (t -> t -> Gas.cost) ->\n          t -> t ->\n          rest stack ->\n          ((Script_int.z Script_int.num * rest) stack * context) tzresult Lwt.t =\n          fun descr op cost x1 x2 rest ->\n            Lwt.return (Gas.consume ctxt (cost x1 x2)) >>=? fun ctxt ->\n            logged_return descr (Item (Script_int.of_int @@ op x1 x2, rest), ctxt) in\n        let logged_return :\n          a stack * context ->\n          (a stack * context) tzresult Lwt.t =\n          logged_return descr in\n        match instr, stack with\n        (* stack ops *)\n        | Drop, Item (_, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.stack_op) >>=? fun ctxt ->\n            logged_return (rest, ctxt)\n        | Dup, Item (v, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.stack_op) >>=? fun ctxt ->\n            logged_return (Item (v, Item (v, rest)), ctxt)\n        | Swap, Item (vi, Item (vo, rest)) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.stack_op) >>=? fun ctxt ->\n            logged_return (Item (vo, Item (vi, rest)), ctxt)\n        | Const v, rest ->\n            Lwt.return (Gas.consume ctxt Interp_costs.push) >>=? fun ctxt ->\n            logged_return (Item (v, rest), ctxt)\n        (* options *)\n        | Cons_some, Item (v, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.wrap) >>=? fun ctxt ->\n            logged_return (Item (Some v, rest), ctxt)\n        | Cons_none _, rest ->\n            Lwt.return (Gas.consume ctxt Interp_costs.variant_no_data) >>=? fun ctxt ->\n            logged_return (Item (None, rest), ctxt)\n        | If_none (bt, _), Item (None, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->\n            step ctxt bt rest\n        | If_none (_, bf), Item (Some v, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->\n            step ctxt bf (Item (v, rest))\n        (* pairs *)\n        | Cons_pair, Item (a, Item (b, rest)) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.pair) >>=? fun ctxt ->\n            logged_return (Item ((a, b), rest), ctxt)\n        | Car, Item ((a, _), rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.pair_access) >>=? fun ctxt ->\n            logged_return (Item (a, rest), ctxt)\n        | Cdr, Item ((_, b), rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.pair_access) >>=? fun ctxt ->\n            logged_return (Item (b, rest), ctxt)\n        (* unions *)\n        | Left, Item (v, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.wrap) >>=? fun ctxt ->\n            logged_return (Item (L v, rest), ctxt)\n        | Right, Item (v, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.wrap) >>=? fun ctxt ->\n            logged_return (Item (R v, rest), ctxt)\n        | If_left (bt, _), Item (L v, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->\n            step ctxt bt (Item (v, rest))\n        | If_left (_, bf), Item (R v, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->\n            step ctxt bf (Item (v, rest))\n        (* lists *)\n        | Cons_list, Item (hd, Item (tl, rest)) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.cons) >>=? fun ctxt ->\n            logged_return (Item (hd :: tl, rest), ctxt)\n        | Nil, rest ->\n            Lwt.return (Gas.consume ctxt Interp_costs.variant_no_data) >>=? fun ctxt ->\n            logged_return (Item ([], rest), ctxt)\n        | If_cons (_, bf), Item ([], rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->\n            step ctxt bf rest\n        | If_cons (bt, _), Item (hd :: tl, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->\n            step ctxt bt (Item (hd, Item (tl, rest)))\n        | List_map body, Item (l, rest) ->\n            let rec loop rest ctxt l acc =\n              Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->\n              match l with\n              | [] -> return (Item (List.rev acc, rest), ctxt)\n              | hd :: tl ->\n                  step ctxt body (Item (hd, rest))\n                  >>=? fun (Item (hd, rest), ctxt) ->\n                  loop rest ctxt tl (hd :: acc)\n            in loop rest ctxt l [] >>=? fun (res, ctxt) ->\n            logged_return (res, ctxt)\n        | List_size, Item (list, rest) ->\n            Lwt.return\n              (List.fold_left\n                 (fun acc _ ->\n                    acc >>? fun (size, ctxt) ->\n                    Gas.consume ctxt Interp_costs.list_size >>? fun ctxt ->\n                    ok (size + 1 (* FIXME: overflow *), ctxt))\n                 (ok (0, ctxt)) list) >>=? fun (len, ctxt) ->\n            logged_return (Item (Script_int.(abs (of_int len)), rest), ctxt)\n        | List_iter body, Item (l, init) ->\n            let rec loop ctxt l stack =\n              Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->\n              match l with\n              | [] -> return (stack, ctxt)\n              | hd :: tl ->\n                  step ctxt body (Item (hd, stack))\n                  >>=? fun (stack, ctxt) ->\n                  loop ctxt tl stack\n            in loop ctxt l init >>=? fun (res, ctxt) ->\n            logged_return (res, ctxt)\n        (* sets *)\n        | Empty_set t, rest ->\n            Lwt.return (Gas.consume ctxt Interp_costs.empty_set) >>=? fun ctxt ->\n            logged_return (Item (empty_set t, rest), ctxt)\n        | Set_iter body, Item (set, init) ->\n            Lwt.return (Gas.consume ctxt (Interp_costs.set_to_list set)) >>=? fun ctxt ->\n            let l = List.rev (set_fold (fun e acc -> e :: acc) set []) in\n            let rec loop ctxt l stack =\n              Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->\n              match l with\n              | [] -> return (stack, ctxt)\n              | hd :: tl ->\n                  step ctxt body (Item (hd, stack))\n                  >>=? fun (stack, ctxt) ->\n                  loop ctxt tl stack\n            in loop ctxt l init >>=? fun (res, ctxt) ->\n            logged_return (res, ctxt)\n        | Set_mem, Item (v, Item (set, rest)) ->\n            consume_gas_binop descr (set_mem, v, set) Interp_costs.set_mem rest ctxt\n        | Set_update, Item (v, Item (presence, Item (set, rest))) ->\n            consume_gas_terop descr (set_update, v, presence, set) Interp_costs.set_update rest\n        | Set_size, Item (set, rest) ->\n            consume_gas_unop descr (set_size, set) (fun _ -> Interp_costs.set_size) rest ctxt\n        (* maps *)\n        | Empty_map (t, _), rest ->\n            Lwt.return (Gas.consume ctxt Interp_costs.empty_map) >>=? fun ctxt ->\n            logged_return (Item (empty_map t, rest), ctxt)\n        | Map_map body, Item (map, rest) ->\n            Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map)) >>=? fun ctxt ->\n            let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in\n            let rec loop rest ctxt l acc =\n              Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->\n              match l with\n              | [] -> return (acc, ctxt)\n              | (k, _) as hd :: tl ->\n                  step ctxt body (Item (hd, rest))\n                  >>=? fun (Item (hd, rest), ctxt) ->\n                  loop rest ctxt tl (map_update k (Some hd) acc)\n            in loop rest ctxt l (empty_map (map_key_ty map)) >>=? fun (res, ctxt) ->\n            logged_return (Item (res, rest), ctxt)\n        | Map_iter body, Item (map, init) ->\n            Lwt.return (Gas.consume ctxt (Interp_costs.map_to_list map)) >>=? fun ctxt ->\n            let l = List.rev (map_fold (fun k v acc -> (k, v) :: acc) map []) in\n            let rec loop ctxt l stack =\n              Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->\n              match l with\n              | [] -> return (stack, ctxt)\n              | hd :: tl ->\n                  step ctxt body (Item (hd, stack))\n                  >>=? fun (stack, ctxt) ->\n                  loop ctxt tl stack\n            in loop ctxt l init >>=? fun (res, ctxt) ->\n            logged_return (res, ctxt)\n        | Map_mem, Item (v, Item (map, rest)) ->\n            consume_gas_binop descr (map_mem, v, map) Interp_costs.map_mem rest ctxt\n        | Map_get, Item (v, Item (map, rest)) ->\n            consume_gas_binop descr (map_get, v, map) Interp_costs.map_get rest ctxt\n        | Map_update, Item (k, Item (v, Item (map, rest))) ->\n            consume_gas_terop descr (map_update, k, v, map) Interp_costs.map_update rest\n        | Map_size, Item (map, rest) ->\n            consume_gas_unop descr (map_size, map) (fun _ -> Interp_costs.map_size) rest ctxt\n        (* Big map operations *)\n        | Big_map_mem, Item (key, Item (map, rest)) ->\n            Lwt.return (Gas.consume ctxt (Interp_costs.big_map_mem key map)) >>=? fun ctxt ->\n            Script_ir_translator.big_map_mem ctxt self key map >>=? fun (res, ctxt) ->\n            logged_return (Item (res, rest), ctxt)\n        | Big_map_get, Item (key, Item (map, rest)) ->\n            Lwt.return (Gas.consume ctxt (Interp_costs.big_map_get key map)) >>=? fun ctxt ->\n            Script_ir_translator.big_map_get ctxt self key map >>=? fun (res, ctxt) ->\n            logged_return (Item (res, rest), ctxt)\n        | Big_map_update, Item (key, Item (maybe_value, Item (map, rest))) ->\n            consume_gas_terop descr\n              (Script_ir_translator.big_map_update, key, maybe_value, map)\n              Interp_costs.big_map_update rest\n        (* timestamp operations *)\n        | Add_seconds_to_timestamp, Item (n, Item (t, rest)) ->\n            consume_gas_binop descr\n              (Script_timestamp.add_delta, t, n)\n              Interp_costs.add_timestamp rest ctxt\n        | Add_timestamp_to_seconds, Item (t, Item (n, rest)) ->\n            consume_gas_binop descr (Script_timestamp.add_delta, t, n)\n              Interp_costs.add_timestamp rest ctxt\n        | Sub_timestamp_seconds, Item (t, Item (s, rest)) ->\n            consume_gas_binop descr (Script_timestamp.sub_delta, t, s)\n              Interp_costs.sub_timestamp rest ctxt\n        | Diff_timestamps, Item (t1, Item (t2, rest)) ->\n            consume_gas_binop descr (Script_timestamp.diff, t1, t2)\n              Interp_costs.diff_timestamps rest ctxt\n        (* string operations *)\n        | Concat, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr ((^), x, y) Interp_costs.concat rest ctxt\n        (* currency operations *)\n        | Add_tez, Item (x, Item (y, rest)) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.int64_op) >>=? fun ctxt ->\n            Lwt.return Tez.(x +? y) >>=? fun res ->\n            logged_return (Item (res, rest), ctxt)\n        | Sub_tez, Item (x, Item (y, rest)) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.int64_op) >>=? fun ctxt ->\n            Lwt.return Tez.(x -? y) >>=? fun res ->\n            logged_return (Item (res, rest), ctxt)\n        | Mul_teznat, Item (x, Item (y, rest)) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.int64_op) >>=? fun ctxt ->\n            Lwt.return (Gas.consume ctxt Interp_costs.z_to_int64) >>=? fun ctxt ->\n            begin\n              match Script_int.to_int64 y with\n              | None -> fail (Overflow (loc, get_log log))\n              | Some y ->\n                  Lwt.return Tez.(x *? y) >>=? fun res ->\n                  logged_return (Item (res, rest), ctxt)\n            end\n        | Mul_nattez, Item (y, Item (x, rest)) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.int64_op) >>=? fun ctxt ->\n            Lwt.return (Gas.consume ctxt Interp_costs.z_to_int64) >>=? fun ctxt ->\n            begin\n              match Script_int.to_int64 y with\n              | None -> fail (Overflow (loc, get_log log))\n              | Some y ->\n                  Lwt.return Tez.(x *? y) >>=? fun res ->\n                  logged_return (Item (res, rest), ctxt)\n            end\n        (* boolean operations *)\n        | Or, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr ((||), x, y) Interp_costs.bool_binop rest ctxt\n        | And, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr ((&&), x, y) Interp_costs.bool_binop rest ctxt\n        | Xor, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Compare.Bool.(<>), x, y) Interp_costs.bool_binop rest ctxt\n        | Not, Item (x, rest) ->\n            consume_gas_unop descr (not, x) Interp_costs.bool_unop rest ctxt\n        (* integer operations *)\n        | Is_nat, Item (x, rest) ->\n            consume_gas_unop descr (Script_int.is_nat, x) Interp_costs.abs rest ctxt\n        | Abs_int, Item (x, rest) ->\n            consume_gas_unop descr (Script_int.abs, x) Interp_costs.abs rest ctxt\n        | Int_nat, Item (x, rest) ->\n            consume_gas_unop descr (Script_int.int, x) Interp_costs.int rest ctxt\n        | Neg_int, Item (x, rest) ->\n            consume_gas_unop descr (Script_int.neg, x) Interp_costs.neg rest ctxt\n        | Neg_nat, Item (x, rest) ->\n            consume_gas_unop descr (Script_int.neg, x) Interp_costs.neg rest ctxt\n        | Add_intint, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt\n        | Add_intnat, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt\n        | Add_natint, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Script_int.add, x, y) Interp_costs.add rest ctxt\n        | Add_natnat, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Script_int.add_n, x, y) Interp_costs.add rest ctxt\n        | Sub_int, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Script_int.sub, x, y) Interp_costs.sub rest ctxt\n        | Mul_intint, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt\n        | Mul_intnat, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt\n        | Mul_natint, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Script_int.mul, x, y) Interp_costs.mul rest ctxt\n        | Mul_natnat, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Script_int.mul_n, x, y) Interp_costs.mul rest ctxt\n        | Ediv_teznat, Item (x, Item (y, rest)) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.int64_to_z) >>=? fun ctxt ->\n            let x = Script_int.of_int64 (Tez.to_mutez x) in\n            consume_gas_binop descr\n              ((fun x y ->\n                  match Script_int.ediv x y with\n                  | None -> None\n                  | Some (q, r) ->\n                      match Script_int.to_int64 q,\n                            Script_int.to_int64 r with\n                      | Some q, Some r ->\n                          begin\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                          end\n                      (* Cannot overflow *)\n                      | _ -> assert false),\n               x, y)\n              Interp_costs.div\n              rest\n              ctxt\n        | Ediv_tez, Item (x, Item (y, rest)) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.int64_to_z) >>=? fun ctxt ->\n            Lwt.return (Gas.consume ctxt Interp_costs.int64_to_z) >>=? fun ctxt ->\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            consume_gas_binop descr\n              ((fun x y -> 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               x, y)\n              Interp_costs.div\n              rest\n              ctxt\n        | Ediv_intint, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Script_int.ediv, x, y) Interp_costs.div rest ctxt\n        | Ediv_intnat, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Script_int.ediv, x, y) Interp_costs.div rest ctxt\n        | Ediv_natint, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Script_int.ediv, x, y) Interp_costs.div rest ctxt\n        | Ediv_natnat, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Script_int.ediv_n, x, y) Interp_costs.div rest ctxt\n        | Lsl_nat, Item (x, Item (y, rest)) ->\n            Lwt.return (Gas.consume ctxt (Interp_costs.shift_left x y)) >>=? fun ctxt ->\n            begin\n              match Script_int.shift_left_n x y with\n              | None -> fail (Overflow (loc, get_log log))\n              | Some x -> logged_return (Item (x, rest), ctxt)\n            end\n        | Lsr_nat, Item (x, Item (y, rest)) ->\n            Lwt.return (Gas.consume ctxt (Interp_costs.shift_right x y)) >>=? fun ctxt ->\n            begin\n              match Script_int.shift_right_n x y with\n              | None -> fail (Overflow (loc, get_log log))\n              | Some r -> logged_return (Item (r, rest), ctxt)\n            end\n        | Or_nat, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Script_int.logor, x, y) Interp_costs.logor rest ctxt\n        | And_nat, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Script_int.logand, x, y) Interp_costs.logand rest ctxt\n        | And_int_nat, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Script_int.logand, x, y) Interp_costs.logand rest ctxt\n        | Xor_nat, Item (x, Item (y, rest)) ->\n            consume_gas_binop descr (Script_int.logxor, x, y) Interp_costs.logxor rest ctxt\n        | Not_int, Item (x, rest) ->\n            consume_gas_unop descr (Script_int.lognot, x) Interp_costs.lognot rest ctxt\n        | Not_nat, Item (x, rest) ->\n            consume_gas_unop descr (Script_int.lognot, x) Interp_costs.lognot rest ctxt\n        (* control *)\n        | Seq (hd, tl), stack ->\n            step ctxt hd stack >>=? fun (trans, ctxt) ->\n            step ctxt tl trans\n        | If (bt, _), Item (true, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->\n            step ctxt bt rest\n        | If (_, bf), Item (false, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.branch) >>=? fun ctxt ->\n            step ctxt bf rest\n        | Loop body, Item (true, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->\n            step ctxt body rest >>=? fun (trans, ctxt) ->\n            step ctxt descr trans\n        | Loop _, Item (false, rest) ->\n            logged_return (rest, ctxt)\n        | Loop_left body, Item (L v, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->\n            step ctxt body (Item (v, rest)) >>=? fun (trans, ctxt) ->\n            step ctxt descr trans\n        | Loop_left _, Item (R v, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.loop_cycle) >>=? fun ctxt ->\n            logged_return (Item (v, rest), ctxt)\n        | Dip b, Item (ign, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.stack_op) >>=? fun ctxt ->\n            step ctxt b rest >>=? fun (res, ctxt) ->\n            logged_return (Item (ign, res), ctxt)\n        | Exec, Item (arg, Item (lam, rest)) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.exec) >>=? fun ctxt ->\n            interp ?log ctxt ~source ~payer ~self amount lam arg >>=? fun (res, ctxt) ->\n            logged_return (Item (res, rest), ctxt)\n        | Lambda lam, rest ->\n            Lwt.return (Gas.consume ctxt Interp_costs.push) >>=? fun ctxt ->\n            logged_return (Item (lam, rest), ctxt)\n        | Failwith tv, Item (v, _) ->\n            trace Cannot_serialize_failure\n              (unparse_data ctxt Optimized tv v) >>=? fun (v, _ctxt) ->\n            let v = Micheline.strip_locations v in\n            fail (Reject (loc, v, get_log log))\n        | Nop, stack ->\n            logged_return (stack, ctxt)\n        (* comparison *)\n        | Compare (Bool_key _), Item (a, Item (b, rest)) ->\n            consume_gaz_comparison descr Compare.Bool.compare Interp_costs.compare_bool a b rest\n        | Compare (String_key _), Item (a, Item (b, rest)) ->\n            consume_gaz_comparison descr Compare.String.compare Interp_costs.compare_string a b rest\n        | Compare (Bytes_key _), Item (a, Item (b, rest)) ->\n            consume_gaz_comparison descr MBytes.compare Interp_costs.compare_bytes a b rest\n        | Compare (Mutez_key _), Item (a, Item (b, rest)) ->\n            consume_gaz_comparison descr Tez.compare Interp_costs.compare_tez a b rest\n        | Compare (Int_key _), Item (a, Item (b, rest)) ->\n            consume_gaz_comparison descr Script_int.compare Interp_costs.compare_int a b rest\n        | Compare (Nat_key _), Item (a, Item (b, rest)) ->\n            consume_gaz_comparison descr Script_int.compare Interp_costs.compare_nat a b rest\n        | Compare (Key_hash_key _), Item (a, Item (b, rest)) ->\n            consume_gaz_comparison descr Signature.Public_key_hash.compare\n              Interp_costs.compare_key_hash a b rest\n        | Compare (Timestamp_key _), Item (a, Item (b, rest)) ->\n            consume_gaz_comparison descr Script_timestamp.compare Interp_costs.compare_timestamp a b rest\n        | Compare (Address_key _), Item (a, Item (b, rest)) ->\n            consume_gaz_comparison descr Contract.compare Interp_costs.compare_address a b rest\n        (* comparators *)\n        | Eq, Item (cmpres, rest) ->\n            let cmpres = Script_int.compare cmpres Script_int.zero in\n            let cmpres = Compare.Int.(cmpres = 0) in\n            Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->\n            logged_return (Item (cmpres, rest), ctxt)\n        | Neq, Item (cmpres, rest) ->\n            let cmpres = Script_int.compare cmpres Script_int.zero in\n            let cmpres = Compare.Int.(cmpres <> 0) in\n            Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->\n            logged_return (Item (cmpres, rest), ctxt)\n        | Lt, Item (cmpres, rest) ->\n            let cmpres = Script_int.compare cmpres Script_int.zero in\n            let cmpres = Compare.Int.(cmpres < 0) in\n            Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->\n            logged_return (Item (cmpres, rest), ctxt)\n        | Le, Item (cmpres, rest) ->\n            let cmpres = Script_int.compare cmpres Script_int.zero in\n            let cmpres = Compare.Int.(cmpres <= 0) in\n            Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->\n            logged_return (Item (cmpres, rest), ctxt)\n        | Gt, Item (cmpres, rest) ->\n            let cmpres = Script_int.compare cmpres Script_int.zero in\n            let cmpres = Compare.Int.(cmpres > 0) in\n            Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->\n            logged_return (Item (cmpres, rest), ctxt)\n        | Ge, Item (cmpres, rest) ->\n            let cmpres = Script_int.compare cmpres Script_int.zero in\n            let cmpres = Compare.Int.(cmpres >= 0) in\n            Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt ->\n            logged_return (Item (cmpres, rest), ctxt)\n        (* packing *)\n        | Pack t, Item (value, rest) ->\n            Script_ir_translator.pack_data ctxt t value >>=? fun (bytes, ctxt) ->\n            logged_return (Item (bytes, rest), ctxt)\n        | Unpack t, Item (bytes, rest) ->\n            Lwt.return (Gas.check_enough ctxt (Script.serialized_cost bytes)) >>=? fun () ->\n            if Compare.Int.(MBytes.length bytes >= 1) &&\n               Compare.Int.(MBytes.get_uint8 bytes 0 = 0x05) then\n              let bytes = MBytes.sub bytes 1 (MBytes.length bytes - 1) in\n              match Data_encoding.Binary.of_bytes Script.expr_encoding bytes with\n              | None ->\n                  Lwt.return (Gas.consume ctxt (Interp_costs.unpack_failed bytes)) >>=? fun ctxt ->\n                  logged_return (Item (None, rest), ctxt)\n              | Some expr ->\n                  Lwt.return (Gas.consume ctxt (Script.deserialized_cost expr)) >>=? fun ctxt ->\n                  parse_data ctxt t (Micheline.root expr) >>= function\n                  | Ok (value, ctxt) ->\n                      logged_return (Item (Some value, rest), ctxt)\n                  | Error _ignored ->\n                      Lwt.return (Gas.consume ctxt (Interp_costs.unpack_failed bytes)) >>=? fun ctxt ->\n                      logged_return (Item (None, rest), ctxt)\n            else\n              logged_return (Item (None, rest), ctxt)\n        (* protocol *)\n        | Address, Item ((_, contract), rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.address) >>=? fun ctxt ->\n            logged_return (Item (contract, rest), ctxt)\n        | Contract t, Item (contract, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.contract) >>=? fun ctxt ->\n            Script_ir_translator.parse_contract_for_script ctxt loc t contract >>=? fun (ctxt, maybe_contract) ->\n            logged_return (Item (maybe_contract, rest), ctxt)\n        | Transfer_tokens,\n          Item (p, Item (amount, Item ((tp, destination), rest))) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.transfer) >>=? fun ctxt ->\n            unparse_data ctxt Optimized tp p >>=? fun (p, ctxt) ->\n            let operation =\n              Transaction\n                { amount ; destination ;\n                  parameters = Some (Script.lazy_expr (Micheline.strip_locations p)) } in\n            Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->\n            logged_return (Item (Internal_operation { source = self ; operation ; nonce }, rest), ctxt)\n        | Create_account,\n          Item (manager, Item (delegate, Item (delegatable, Item (credit, rest)))) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.create_account) >>=? fun ctxt ->\n            Contract.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) ->\n            let operation =\n              Origination\n                { credit ; manager ; delegate ; preorigination = Some contract ;\n                  delegatable ; script = None ; spendable = true } in\n            Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->\n            logged_return (Item (Internal_operation { source = self ; operation ; nonce },\n                                 Item (contract, rest)), ctxt)\n        | Implicit_account, Item (key, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.implicit_account) >>=? fun ctxt ->\n            let contract = Contract.implicit_contract key in\n            logged_return (Item ((Unit_t None, contract), rest), ctxt)\n        | Create_contract (storage_type, param_type, Lam (_, code)),\n          Item (manager, Item\n                  (delegate, Item\n                     (spendable, Item\n                        (delegatable, Item\n                           (credit, Item\n                              (init, rest)))))) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.create_contract) >>=? fun ctxt ->\n            unparse_ty ctxt param_type >>=? fun (unparsed_param_type, ctxt) ->\n            unparse_ty ctxt storage_type >>=? fun (unparsed_storage_type, ctxt) ->\n            let code =\n              Micheline.strip_locations\n                (Seq (0, [ Prim (0, K_parameter, [ unparsed_param_type ], []) ;\n                           Prim (0, K_storage, [ unparsed_storage_type ], []) ;\n                           Prim (0, K_code, [ Micheline.root code ], []) ])) in\n            unparse_data ctxt Optimized storage_type init >>=? fun (storage, ctxt) ->\n            let storage = Micheline.strip_locations storage in\n            Contract.spend_from_script ctxt self credit >>=? fun ctxt ->\n            Contract.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) ->\n            let operation =\n              Origination\n                { credit ; manager ; delegate ; preorigination = Some contract ;\n                  delegatable ; spendable ;\n                  script = Some { code = Script.lazy_expr code ;\n                                  storage = Script.lazy_expr storage } } in\n            Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->\n            logged_return\n              (Item (Internal_operation { source = self ; operation ; nonce },\n                     Item (contract, rest)), ctxt)\n        | Set_delegate,\n          Item (delegate, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.create_account) >>=? fun ctxt ->\n            let operation = Delegation delegate in\n            Lwt.return (fresh_internal_nonce ctxt) >>=? fun (ctxt, nonce) ->\n            logged_return (Item (Internal_operation { source = self ; operation ; nonce }, rest), ctxt)\n        | Balance, rest ->\n            Lwt.return (Gas.consume ctxt Interp_costs.balance) >>=? fun ctxt ->\n            Contract.get_balance ctxt self >>=? fun balance ->\n            logged_return (Item (balance, rest), ctxt)\n        | Now, rest ->\n            Lwt.return (Gas.consume ctxt Interp_costs.now) >>=? fun ctxt ->\n            let now = Script_timestamp.now ctxt in\n            logged_return (Item (now, rest), ctxt)\n        | Check_signature, Item (key, Item (signature, Item (message, rest))) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.check_signature) >>=? fun ctxt ->\n            let res = Signature.check key signature message in\n            logged_return (Item (res, rest), ctxt)\n        | Hash_key, Item (key, rest) ->\n            Lwt.return (Gas.consume ctxt Interp_costs.hash_key) >>=? fun ctxt ->\n            logged_return (Item (Signature.Public_key.hash key, rest), ctxt)\n        | Blake2b, Item (bytes, rest) ->\n            Lwt.return (Gas.consume ctxt (Interp_costs.hash bytes 32)) >>=? fun ctxt ->\n            let hash = Raw_hashes.blake2b bytes in\n            logged_return (Item (hash, rest), ctxt)\n        | Sha256, Item (bytes, rest) ->\n            Lwt.return (Gas.consume ctxt (Interp_costs.hash bytes 32)) >>=? fun ctxt ->\n            let hash = Raw_hashes.sha256 bytes in\n            logged_return (Item (hash, rest), ctxt)\n        | Sha512, Item (bytes, rest) ->\n            Lwt.return (Gas.consume ctxt (Interp_costs.hash bytes 64)) >>=? fun ctxt ->\n            let hash = Raw_hashes.sha512 bytes in\n            logged_return (Item (hash, rest), ctxt)\n        | Steps_to_quota, rest ->\n            Lwt.return (Gas.consume ctxt Interp_costs.steps_to_quota) >>=? fun ctxt ->\n            let steps = match Gas.level ctxt with\n              | Limited { remaining } -> remaining\n              | Unaccounted -> Z.of_string \"99999999\" in\n            logged_return (Item (Script_int.(abs (of_zint steps)), rest), ctxt)\n        | Source, rest ->\n            Lwt.return (Gas.consume ctxt Interp_costs.source) >>=? fun ctxt ->\n            logged_return (Item (payer, rest), ctxt)\n        | Sender, rest ->\n            Lwt.return (Gas.consume ctxt Interp_costs.source) >>=? fun ctxt ->\n            logged_return (Item (source, rest), ctxt)\n        | Self t, rest ->\n            Lwt.return (Gas.consume ctxt Interp_costs.self) >>=? fun ctxt ->\n            logged_return (Item ((t,self), rest), ctxt)\n        | Amount, rest ->\n            Lwt.return (Gas.consume ctxt Interp_costs.amount) >>=? fun ctxt ->\n            logged_return (Item (amount, rest), ctxt) in\n    let stack = (Item (arg, Empty)) in\n    begin match log with\n      | None -> return_unit\n      | Some log ->\n          trace Cannot_serialize_log\n            (unparse_stack ctxt (stack, code.bef)) >>=? fun stack ->\n          log := (code.loc, Gas.level ctxt, stack) :: !log ;\n          return_unit\n    end >>=? fun () ->\n    step ctxt code stack >>=? fun (Item (ret, Empty), ctxt) ->\n    return (ret, ctxt)\n\n(* ---- contract handling ---------------------------------------------------*)\n\nand execute ?log ctxt mode ~source ~payer ~self script amount arg :\n  (Script.expr * packed_internal_operation list * context *\n   Script_typed_ir.ex_big_map option) tzresult Lwt.t =\n  parse_script ctxt script\n  >>=? fun ((Ex_script { code ; arg_type ; storage ; storage_type }), ctxt) ->\n  trace\n    (Bad_contract_parameter self)\n    (parse_data ctxt arg_type arg) >>=? fun (arg, ctxt) ->\n  Script.force_decode ctxt script.code >>=? fun (script_code, ctxt) ->\n  trace\n    (Runtime_contract_error (self, script_code))\n    (interp ?log ctxt ~source ~payer ~self amount code (arg, storage))\n  >>=? fun ((ops, sto), ctxt) ->\n  trace Cannot_serialize_storage\n    (unparse_data ctxt mode storage_type sto) >>=? fun (storage, ctxt) ->\n  return (Micheline.strip_locations storage, ops, ctxt,\n          Script_ir_translator.extract_big_map storage_type sto)\n\ntype execution_result =\n  { ctxt : context ;\n    storage : Script.expr ;\n    big_map_diff : Contract.big_map_diff option ;\n    operations : packed_internal_operation list }\n\nlet trace ctxt mode ~source ~payer ~self:(self, script) ~parameter ~amount =\n  let log = ref [] in\n  execute ~log ctxt mode ~source ~payer ~self script amount (Micheline.root parameter)\n  >>=? fun (storage, operations, ctxt, big_map) ->\n  begin match big_map with\n    | None -> return (None, ctxt)\n    | Some big_map ->\n        Script_ir_translator.diff_of_big_map ctxt mode big_map >>=? fun (big_map_diff, ctxt) ->\n        return (Some big_map_diff, ctxt)\n  end >>=? fun (big_map_diff, ctxt) ->\n  let trace = List.rev !log in\n  return ({ ctxt ; storage ; big_map_diff ; operations }, trace)\n\nlet execute ctxt mode ~source ~payer ~self:(self, script) ~parameter ~amount =\n  execute ctxt mode ~source ~payer ~self script amount (Micheline.root parameter)\n  >>=? fun (storage, operations, ctxt, big_map) ->\n  begin match big_map with\n    | None -> return (None, ctxt)\n    | Some big_map ->\n        Script_ir_translator.diff_of_big_map ctxt mode big_map >>=? fun (big_map_diff, ctxt) ->\n        return (Some big_map_diff, ctxt)\n  end >>=? fun (big_map_diff, ctxt) ->\n  return { ctxt ; storage ; big_map_diff ; operations }\n" ;
                } ;
                { name = "Baking" ;
                  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\nopen Alpha_context\nopen Misc\n\ntype error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)\ntype error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *)\ntype error += Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t (* `Permanent *)\ntype error += Unexpected_endorsement\ntype error += Invalid_signature  (* `Permanent *)\ntype error += Invalid_stamp  (* `Permanent *)\n\n(** [minimal_time ctxt priority pred_block_time] returns the minimal\n    time, given the predecessor block timestamp [pred_block_time],\n    after which a baker with priority [priority] is allowed to\n    bake. Fail with [Invalid_time_between_blocks_constant] if the minimal\n    time cannot be computed. *)\nval minimal_time: context -> int -> Time.t -> Time.t tzresult Lwt.t\n\n(** [check_baking_rights ctxt block pred_timestamp] verifies that:\n    * the contract that owned the roll at cycle start has the block signer as delegate.\n    * the timestamp is coherent with the announced slot.\n*)\nval check_baking_rights:\n  context -> Block_header.contents -> Time.t ->\n  public_key tzresult Lwt.t\n\n(** For a given level computes who has the right to\n    include an endorsement in the next block.\n    The result can be stored in Alpha_context.allowed_endorsements *)\nval endorsement_rights:\n  context ->\n  Level.t ->\n  (public_key * int list * bool) Signature.Public_key_hash.Map.t tzresult Lwt.t\n\n(** Check that the operation was signed by a delegate allowed\n    to endorse at the level specified by the endorsement. *)\nval check_endorsement_rights:\n  context -> Chain_id.t -> Kind.endorsement Operation.t ->\n  (public_key_hash * int list * bool) tzresult Lwt.t\n\n(** Returns the endorsement reward calculated w.r.t a given priority.  *)\nval endorsement_reward: context -> block_priority:int -> int -> Tez.t tzresult Lwt.t\n\n(** [baking_priorities ctxt level] is the lazy list of contract's\n    public key hashes that are allowed to bake for [level]. *)\nval baking_priorities:\n  context -> Level.t -> public_key lazy_list\n\n(** [first_baking_priorities ctxt ?max_priority contract_hash level]\n    is a list of priorities of max [?max_priority] elements, where the\n    delegate of [contract_hash] is allowed to bake for [level]. If\n    [?max_priority] is [None], a sensible number of priorities is\n    returned. *)\nval first_baking_priorities:\n  context ->\n  ?max_priority:int ->\n  public_key_hash ->\n  Level.t ->\n  int list tzresult Lwt.t\n\n(** [check_signature ctxt chain_id block id] check if the block is\n    signed with the given key, and belongs to the given [chain_id] *)\nval check_signature: Block_header.t -> Chain_id.t -> public_key -> unit tzresult Lwt.t\n\n(** Checks if the header that would be built from the given components\n    is valid for the given diffculty. The signature is not passed as it\n    is does not impact the proof-of-work stamp. The stamp is checked on\n    the hash of a block header whose signature has been zeroed-out. *)\nval check_header_proof_of_work_stamp:\n  Block_header.shell_header -> Block_header.contents -> int64 -> bool\n\n(** verify if the proof of work stamp is valid *)\nval check_proof_of_work_stamp:\n  context -> Block_header.t -> unit tzresult Lwt.t\n\n(** check if the gap between the fitness of the current context\n    and the given block is within the protocol parameters *)\nval check_fitness_gap:\n  context -> Block_header.t -> unit tzresult Lwt.t\n\nval dawn_of_a_new_cycle: context -> Cycle.t option tzresult Lwt.t\n\nval earlier_predecessor_timestamp: context -> Level.t -> Timestamp.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\n\nopen Alpha_context\nopen Misc\n\ntype error += Invalid_fitness_gap of int64 * int64 (* `Permanent *)\ntype error += Timestamp_too_early of Timestamp.t * Timestamp.t (* `Permanent *)\ntype error += Unexpected_endorsement (* `Permanent *)\ntype error += Invalid_block_signature of Block_hash.t * Signature.Public_key_hash.t (* `Permanent *)\ntype error += Invalid_signature  (* `Permanent *)\ntype error += Invalid_stamp  (* `Permanent *)\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"baking.timestamp_too_early\"\n    ~title:\"Block forged too early\"\n    ~description:\"The block timestamp is before the first slot \\\n                  for this baker at this level\"\n    ~pp:(fun ppf (r, p) ->\n        Format.fprintf ppf \"Block forged too early (%a is before %a)\"\n          Time.pp_hum p Time.pp_hum r)\n    Data_encoding.(obj2\n                     (req \"minimum\" Time.encoding)\n                     (req \"provided\" Time.encoding))\n    (function Timestamp_too_early (r, p)   -> Some (r, p) | _ -> None)\n    (fun (r, p) -> Timestamp_too_early (r, p)) ;\n  register_error_kind\n    `Permanent\n    ~id:\"baking.invalid_fitness_gap\"\n    ~title:\"Invalid fitness gap\"\n    ~description:\"The gap of fitness is out of bounds\"\n    ~pp:(fun ppf (m, g) ->\n        Format.fprintf ppf\n          \"The gap of fitness %Ld is not between 0 and %Ld\" g m)\n    Data_encoding.(obj2\n                     (req \"maximum\" int64)\n                     (req \"provided\" int64))\n    (function Invalid_fitness_gap (m, g)   -> Some (m, g) | _ -> None)\n    (fun (m, g) -> Invalid_fitness_gap (m, g)) ;\n  register_error_kind\n    `Permanent\n    ~id:\"baking.invalid_block_signature\"\n    ~title:\"Invalid block signature\"\n    ~description:\n      \"A block was not signed with the expected private key.\"\n    ~pp:(fun ppf (block, pkh) ->\n        Format.fprintf ppf \"Invalid signature for block %a. Expected: %a.\"\n          Block_hash.pp_short block\n          Signature.Public_key_hash.pp_short pkh)\n    Data_encoding.(obj2\n                     (req \"block\" Block_hash.encoding)\n                     (req \"expected\" Signature.Public_key_hash.encoding))\n    (function 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:\"baking.invalid_signature\"\n    ~title:\"Invalid block signature\"\n    ~description:\"The block's signature is invalid\"\n    ~pp:(fun ppf () ->\n        Format.fprintf ppf \"Invalid block signature\")\n    Data_encoding.empty\n    (function Invalid_signature -> Some () | _ -> None)\n    (fun () -> Invalid_signature) ;\n  register_error_kind\n    `Permanent\n    ~id:\"baking.insufficient_proof_of_work\"\n    ~title:\"Insufficient block proof-of-work stamp\"\n    ~description:\"The block's proof-of-work stamp is insufficient\"\n    ~pp:(fun ppf () ->\n        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:\"baking.unexpected_endorsement\"\n    ~title:\"Endorsement from unexpected delegate\"\n    ~description:\"The operation is signed by a delegate without endorsement rights.\"\n    ~pp:(fun ppf () ->\n        Format.fprintf ppf\n          \"The endorsement is signed by a delegate without endorsement rights.\")\n    Data_encoding.unit\n    (function Unexpected_endorsement -> Some () | _ -> None)\n    (fun () -> Unexpected_endorsement)\n\nlet minimal_time c priority pred_timestamp =\n  let priority = Int32.of_int priority in\n  let rec cumsum_time_between_blocks acc durations p =\n    if Compare.Int32.(<=) p 0l then\n      ok acc\n    else match durations with\n      | [] -> cumsum_time_between_blocks acc [ Period.one_minute ] p\n      | [ last ] ->\n          Period.mult p last >>? fun period ->\n          Timestamp.(acc +? period)\n      | first :: durations ->\n          Timestamp.(acc +? first) >>? fun acc ->\n          let p = Int32.pred p in\n          cumsum_time_between_blocks acc durations p in\n  Lwt.return\n    (cumsum_time_between_blocks\n       pred_timestamp (Constants.time_between_blocks c) (Int32.succ priority))\n\nlet earlier_predecessor_timestamp ctxt level =\n  let current = Level.current ctxt in\n  let current_timestamp = Timestamp.current ctxt in\n  let gap = Level.diff level current in\n  let step = List.hd (Constants.time_between_blocks ctxt) in\n  if Compare.Int32.(gap < 1l) then\n    failwith \"Baking.earlier_block_timestamp: past block.\"\n  else\n    Lwt.return (Period.mult (Int32.pred gap) step) >>=? fun delay ->\n    Lwt.return Timestamp.(current_timestamp +? delay) >>=? fun result ->\n    return result\n\nlet check_timestamp c priority pred_timestamp =\n  minimal_time c priority pred_timestamp >>=? fun minimal_time ->\n  let timestamp = Alpha_context.Timestamp.current c in\n  fail_unless Timestamp.(minimal_time <= timestamp)\n    (Timestamp_too_early (minimal_time, timestamp))\n\nlet check_baking_rights c { Block_header.priority ; _ }\n    pred_timestamp =\n  let level = Level.current c in\n  Roll.baking_rights_owner c level ~priority >>=? fun delegate ->\n  check_timestamp c priority pred_timestamp >>=? fun () ->\n  return delegate\n\ntype error += Incorrect_priority (* `Permanent *)\n\nlet () =\n  register_error_kind\n    `Permanent\n    ~id:\"incorrect_priority\"\n    ~title:\"Incorrect priority\"\n    ~description:\"Block priority must be non-negative.\"\n    ~pp:(fun ppf () ->\n        Format.fprintf ppf \"The block priority must be non-negative.\")\n    Data_encoding.unit\n    (function Incorrect_priority -> Some () | _ -> None)\n    (fun () -> Incorrect_priority)\n\nlet endorsement_reward ctxt ~block_priority:prio n =\n  if Compare.Int.(prio >= 0)\n  then\n    Lwt.return\n      Tez.(Constants.endorsement_reward ctxt /? (Int64.(succ (of_int prio)))) >>=? fun tez ->\n    Lwt.return Tez.(tez *? Int64.of_int n)\n  else fail Incorrect_priority\n\nlet baking_priorities c level =\n  let rec f priority =\n    Roll.baking_rights_owner c level ~priority >>=? fun delegate ->\n    return (LCons (delegate, (fun () -> f (succ priority))))\n  in\n  f 0\n\nlet endorsement_rights c level =\n  fold_left_s\n    (fun acc slot ->\n       Roll.endorsement_rights_owner c level ~slot >>=? fun pk ->\n       let pkh = Signature.Public_key.hash pk in\n       let right =\n         match Signature.Public_key_hash.Map.find_opt pkh acc with\n         | None -> (pk, [slot], false)\n         | Some (pk, slots, used) -> (pk, slot :: slots, used) in\n       return (Signature.Public_key_hash.Map.add pkh right acc))\n    Signature.Public_key_hash.Map.empty\n    (0 --> (Constants.endorsers_per_block c - 1))\n\nlet check_endorsement_rights ctxt chain_id (op : Kind.endorsement Operation.t) =\n  let current_level = Level.current ctxt in\n  let Single (Endorsement { level ; _ }) = op.protocol_data.contents in\n  begin\n    if Raw_level.(succ level = current_level.level) then\n      return (Alpha_context.allowed_endorsements ctxt)\n    else\n      endorsement_rights ctxt (Level.from_raw ctxt level)\n  end >>=? fun endorsements ->\n  match\n    Signature.Public_key_hash.Map.fold (* no find_first *)\n      (fun pkh (pk, slots, used) acc ->\n         match Operation.check_signature_sync pk chain_id op with\n         | Error _ -> acc\n         | Ok () -> Some (pkh, slots, used))\n      endorsements None\n  with\n  | None -> fail Unexpected_endorsement\n  | Some v -> return v\n\nlet select_delegate delegate delegate_list max_priority =\n  let rec loop acc l n =\n    if Compare.Int.(n >= max_priority)\n    then return (List.rev acc)\n    else\n      let LCons (pk, t) = l in\n      let acc =\n        if Signature.Public_key_hash.equal delegate (Signature.Public_key.hash pk)\n        then n :: acc\n        else acc in\n      t () >>=? fun t ->\n      loop acc t (succ n)\n  in\n  loop [] delegate_list 0\n\nlet first_baking_priorities\n    ctxt\n    ?(max_priority = 32)\n    delegate level =\n  baking_priorities ctxt level >>=? fun delegate_list ->\n  select_delegate delegate delegate_list max_priority\n\nlet check_hash hash stamp_threshold =\n  let bytes = Block_hash.to_bytes hash in\n  let word = MBytes.get_int64 bytes 0 in\n  Compare.Uint64.(word <= stamp_threshold)\n\nlet check_header_proof_of_work_stamp shell contents stamp_threshold =\n  let hash =\n    Block_header.hash\n      { shell ; protocol_data = { contents ; signature = Signature.zero } } in\n  check_hash hash stamp_threshold\n\nlet check_proof_of_work_stamp ctxt block =\n  let proof_of_work_threshold = Constants.proof_of_work_threshold ctxt in\n  if check_header_proof_of_work_stamp\n      block.Block_header.shell\n      block.protocol_data.contents\n      proof_of_work_threshold then\n    return_unit\n  else\n    fail Invalid_stamp\n\nlet check_signature block chain_id key =\n  let check_signature key\n      { Block_header.shell ; protocol_data = { contents ; signature } } =\n    let unsigned_header =\n      Data_encoding.Binary.to_bytes_exn\n        Block_header.unsigned_encoding\n        (shell, contents) in\n    Signature.check ~watermark:(Block_header chain_id) key signature unsigned_header in\n  if check_signature key block then\n    return_unit\n  else\n    fail (Invalid_block_signature (Block_header.hash block,\n                                   Signature.Public_key.hash key))\n\nlet max_fitness_gap ctxt =\n  let slots = Int64.of_int (Constants.endorsers_per_block ctxt + 1) in\n  Int64.add slots 1L\n\nlet check_fitness_gap ctxt (block : Block_header.t) =\n  let current_fitness = Fitness.current ctxt in\n  Lwt.return (Fitness.to_int64 block.shell.fitness) >>=? fun announced_fitness ->\n  let gap = Int64.sub announced_fitness current_fitness in\n  if Compare.Int64.(gap <= 0L || max_fitness_gap ctxt < gap) then\n    fail (Invalid_fitness_gap (max_fitness_gap ctxt, gap))\n  else\n    return_unit\n\nlet last_of_a_cycle ctxt l =\n  Compare.Int32.(Int32.succ l.Level.cycle_position =\n                 Constants.blocks_per_cycle ctxt)\n\nlet dawn_of_a_new_cycle ctxt =\n  let level = Level.current ctxt in\n  if last_of_a_cycle ctxt level then\n    return_some level.cycle\n  else\n    return_none\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\nopen Alpha_context\n\nval may_start_new_voting_cycle:\n  context -> context tzresult Lwt.t\n\ntype error +=\n  | Unexpected_proposal\n  | Unauthorized_proposal\n\nval record_proposals:\n  context ->\n  public_key_hash -> Protocol_hash.t list ->\n  context tzresult Lwt.t\n\ntype error +=\n  | Invalid_proposal\n  | Unexpected_ballot\n  | Unauthorized_ballot\n\nval record_ballot:\n  context ->\n  public_key_hash -> Protocol_hash.t -> 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\nlet () = ()\n\nlet select_winning_proposal 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\n          Some ([proposal], vote)\n        else\n          previous in\n  match Protocol_hash.Map.fold merge proposals None with\n  | None -> None\n  | Some ([proposal], _) -> Some proposal\n  | Some _ -> None (* in case of a tie, lets do nothing. *)\n\nlet check_approval_and_update_quorum ctxt =\n  Vote.get_ballots ctxt >>=? fun ballots ->\n  Vote.listing_size ctxt >>=? fun maximum_vote ->\n  Vote.get_current_quorum ctxt >>=? fun expected_quorum ->\n  (* FIXME check overflow ??? *)\n  let casted_vote = Int32.add ballots.yay ballots.nay in\n  let actual_vote = Int32.add casted_vote ballots.pass in\n  let actual_quorum =\n    Int32.div (Int32.mul actual_vote 100_00l) maximum_vote in\n  let supermajority = Int32.div (Int32.mul 8l casted_vote) 10l in\n  let updated_quorum =\n    Int32.div\n      (Int32.add (Int32.mul 8l expected_quorum)\n         (Int32.mul 2l actual_quorum))\n      10l in\n  Vote.set_current_quorum ctxt updated_quorum >>=? fun ctxt ->\n  return\n    (ctxt,\n     Compare.Int32.(actual_quorum >= expected_quorum\n                    && ballots.yay >= supermajority))\n\nlet start_new_voting_cycle ctxt =\n  Vote.get_current_period_kind ctxt >>=? function\n  | Proposal -> begin\n      Vote.get_proposals ctxt >>= fun proposals ->\n      Vote.clear_proposals ctxt >>= fun ctxt ->\n      Vote.clear_listings ctxt >>=? fun ctxt ->\n      match select_winning_proposal proposals with\n      | None ->\n          Vote.freeze_listings ctxt >>=? fun ctxt ->\n          return ctxt\n      | Some proposal ->\n          Vote.init_current_proposal ctxt proposal >>=? fun ctxt ->\n          Vote.freeze_listings ctxt >>=? fun ctxt ->\n          Vote.set_current_period_kind ctxt Testing_vote >>=? fun ctxt ->\n          return ctxt\n    end\n  | Testing_vote ->\n      check_approval_and_update_quorum ctxt >>=? fun (ctxt, approved) ->\n      Vote.clear_ballots ctxt >>= fun ctxt ->\n      Vote.clear_listings ctxt >>=? fun ctxt ->\n      if approved then\n        let expiration = (* in two days maximum... *)\n          Time.add (Timestamp.current ctxt) (Int64.mul 48L 3600L) in\n        Vote.get_current_proposal ctxt >>=? fun proposal ->\n        fork_test_chain ctxt proposal expiration >>= fun ctxt ->\n        Vote.set_current_period_kind ctxt Testing >>=? fun ctxt ->\n        return ctxt\n      else\n        Vote.clear_current_proposal ctxt >>=? fun ctxt ->\n        Vote.freeze_listings ctxt >>=? fun ctxt ->\n        Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt ->\n        return ctxt\n  | Testing ->\n      Vote.freeze_listings ctxt >>=? fun ctxt ->\n      Vote.set_current_period_kind ctxt Promotion_vote >>=? fun ctxt ->\n      return ctxt\n  | Promotion_vote ->\n      check_approval_and_update_quorum ctxt >>=? fun (ctxt, approved) ->\n      begin\n        if approved then\n          Vote.get_current_proposal ctxt >>=? fun proposal ->\n          activate ctxt proposal >>= fun ctxt ->\n          return ctxt\n        else\n          return ctxt\n      end >>=? fun ctxt ->\n      Vote.clear_ballots ctxt >>= fun ctxt ->\n      Vote.clear_listings ctxt >>=? fun ctxt ->\n      Vote.clear_current_proposal ctxt >>=? fun ctxt ->\n      Vote.freeze_listings ctxt >>=? fun ctxt ->\n      Vote.set_current_period_kind ctxt Proposal >>=? fun ctxt ->\n      return ctxt\n\ntype error += (* `Branch *)\n  | Invalid_proposal\n  | Unexpected_proposal\n  | Unauthorized_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:\"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:\"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\nlet record_proposals ctxt delegate proposals =\n  Vote.get_current_period_kind ctxt >>=? function\n  | Proposal ->\n      Vote.in_listings ctxt delegate >>= fun in_listings ->\n      if in_listings then\n        Lwt_list.fold_left_s\n          (fun ctxt proposal ->\n             Vote.record_proposal ctxt proposal delegate)\n          ctxt proposals >>= return\n      else\n        fail Unauthorized_proposal\n  | Testing_vote | Testing | Promotion_vote ->\n      fail Unexpected_proposal\n\nlet record_ballot ctxt delegate proposal ballot =\n  Vote.get_current_period_kind ctxt >>=? function\n  | Testing_vote | Promotion_vote ->\n      Vote.get_current_proposal ctxt >>=? fun current_proposal ->\n      fail_unless (Protocol_hash.equal proposal current_proposal)\n        Invalid_proposal >>=? fun () ->\n      Vote.in_listings ctxt delegate >>= fun in_listings ->\n      if in_listings then\n        Vote.record_ballot ctxt delegate ballot >>= return\n      else\n        fail Unauthorized_ballot\n  | Testing | Proposal ->\n      fail Unexpected_ballot\n\nlet last_of_a_voting_period ctxt l =\n  Compare.Int32.(Int32.succ l.Level.voting_period_position =\n                 Constants.blocks_per_voting_period ctxt )\n\nlet may_start_new_voting_cycle ctxt =\n  let level = Level.current ctxt in\n  if last_of_a_voting_period ctxt level then\n    start_new_voting_cycle ctxt\n  else\n    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(** Result of applying an operation, 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\nopen Alpha_context\n\n(** Result of applying a {!Operation.t}. Follows the same structure. *)\ntype 'kind operation_metadata = {\n  contents: 'kind contents_result_list ;\n}\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 * 'rest Kind.manager contents_result_list ->\n    (('kind * 'rest) Kind.manager ) contents_result_list\n\nand packed_contents_result_list =\n  | Contents_result_list : 'kind contents_result_list -> packed_contents_result_list\n\n(** Result of applying an {!Operation.contents}. Follows the same structure. *)\nand 'kind contents_result =\n  | Endorsement_result :\n      { balance_updates : Delegate.balance_updates ;\n        delegate : Signature.Public_key_hash.t ;\n        slots: int list ;\n      } -> Kind.endorsement contents_result\n  | Seed_nonce_revelation_result :\n      Delegate.balance_updates -> Kind.seed_nonce_revelation contents_result\n  | Double_endorsement_evidence_result :\n      Delegate.balance_updates -> Kind.double_endorsement_evidence contents_result\n  | Double_baking_evidence_result :\n      Delegate.balance_updates -> Kind.double_baking_evidence contents_result\n  | Activate_account_result :\n      Delegate.balance_updates -> 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 : Delegate.balance_updates ;\n        operation_result : 'kind manager_operation_result ;\n        internal_operation_results : packed_internal_operation_result list ;\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 'kind successful_manager_operation_result * error list option\n  | Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result\n  | Skipped : 'kind Kind.manager -> 'kind manager_operation_result\n\n(** Result of applying a {!manager_operation_content}, either internal\n    or external. *)\nand _ successful_manager_operation_result =\n  | Reveal_result : Kind.reveal successful_manager_operation_result\n  | Transaction_result :\n      { storage : Script.expr option ;\n        balance_updates : Delegate.balance_updates ;\n        originated_contracts : Contract.t list ;\n        consumed_gas : Z.t ;\n        storage_size : Z.t ;\n        paid_storage_size_diff : Z.t ;\n      } -> Kind.transaction successful_manager_operation_result\n  | Origination_result :\n      { balance_updates : Delegate.balance_updates ;\n        originated_contracts : Contract.t list ;\n        consumed_gas : Z.t ;\n        storage_size : Z.t ;\n        paid_storage_size_diff : Z.t ;\n      } -> Kind.origination successful_manager_operation_result\n  | Delegation_result : Kind.delegation successful_manager_operation_result\n\nand packed_successful_manager_operation_result =\n  | Successful_manager_result :\n      'kind successful_manager_operation_result -> 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\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\n\n\ntype 'kind contents_and_result_list =\n  | Single_and_result : 'kind Alpha_context.contents * 'kind contents_result -> 'kind contents_and_result_list\n  | Cons_and_result : 'kind Kind.manager Alpha_context.contents * 'kind Kind.manager contents_result * 'rest Kind.manager contents_and_result_list -> ('kind * 'rest) Kind.manager contents_and_result_list\n\ntype packed_contents_and_result_list =\n  | Contents_and_result_list : 'kind contents_and_result_list -> 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 -> '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\ntype ('a, 'b) eq = Eq : ('a, 'a) eq\nval kind_equal_list :\n  'kind contents_list -> 'kind2 contents_result_list -> ('kind, 'kind2) eq option\n\ntype block_metadata = {\n  baker: Signature.Public_key_hash.t ;\n  level: Level.t ;\n  voting_period_kind: Voting_period.kind ;\n  nonce_hash: Nonce_hash.t option ;\n  consumed_gas: Z.t ;\n  deactivated: Signature.Public_key_hash.t list ;\n  balance_updates: Delegate.balance_updates ;\n}\nval block_metadata_encoding: block_metadata 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 Data_encoding\n\nlet error_encoding =\n  def \"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 `proto.alpha`.\" @@\n  splitted\n    ~json:(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\ntype _ successful_manager_operation_result =\n  | Reveal_result : Kind.reveal successful_manager_operation_result\n  | Transaction_result :\n      { storage : Script.expr option ;\n        balance_updates : Delegate.balance_updates ;\n        originated_contracts : Contract.t list ;\n        consumed_gas : Z.t ;\n        storage_size : Z.t ;\n        paid_storage_size_diff : Z.t ;\n      } -> Kind.transaction successful_manager_operation_result\n  | Origination_result :\n      { balance_updates : Delegate.balance_updates ;\n        originated_contracts : Contract.t list ;\n        consumed_gas : Z.t ;\n        storage_size : Z.t ;\n        paid_storage_size_diff : Z.t ;\n      } -> Kind.origination successful_manager_operation_result\n  | Delegation_result : Kind.delegation successful_manager_operation_result\n\ntype packed_successful_manager_operation_result =\n  | Successful_manager_result :\n      'kind successful_manager_operation_result -> packed_successful_manager_operation_result\n\ntype 'kind manager_operation_result =\n  | Applied of 'kind successful_manager_operation_result\n  | Backtracked of 'kind successful_manager_operation_result * error list option\n  | Failed : 'kind Kind.manager * error list -> 'kind manager_operation_result\n  | Skipped : 'kind Kind.manager -> 'kind manager_operation_result\n\ntype packed_internal_operation_result =\n  | Internal_operation_result :\n      'kind internal_operation * 'kind manager_operation_result -> packed_internal_operation_result\n\nmodule Manager_result = struct\n\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      } -> '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 ~tag_size:`Uint8 [\n        case (Tag 0)\n          ~title:\"Applied\"\n          (merge_objs\n             (obj1\n                (req \"status\" (constant \"applied\")))\n             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 (Tag 1)\n          ~title:\"Failed\"\n          (obj2\n             (req \"status\" (constant \"failed\"))\n             (req \"errors\" (list error_encoding)))\n          (function  (Failed (_, errs)) -> Some ((), errs) | _ -> None)\n          (fun ((), errs) -> Failed (kind, errs)) ;\n        case (Tag 2)\n          ~title:\"Skipped\"\n          (obj1 (req \"status\" (constant \"skipped\")))\n          (function Skipped _ -> Some () | _ -> None)\n          (fun () -> Skipped kind) ;\n        case (Tag 3)\n          ~title:\"Backtracked\"\n          (merge_objs\n             (obj2\n                (req \"status\" (constant \"backtracked\"))\n                (opt \"errors\" (list error_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      ] in\n    MCase { op_case ; encoding ; kind ; iselect ; select ; proj ; inj ; t }\n\n  let reveal_case =\n    make\n      ~op_case: Operation.Encoding.Manager_operations.reveal_case\n      ~encoding: Data_encoding.empty\n      ~iselect:\n        (function\n          | Internal_operation_result\n              ({ operation = Reveal _ ; _} as op, res) ->\n              Some (op, res)\n          | _ -> None)\n      ~select:\n        (function\n          | Successful_manager_result (Reveal_result as op) -> Some op\n          | _ -> None)\n      ~kind: Kind.Reveal_manager_kind\n      ~proj: (function Reveal_result -> ())\n      ~inj: (fun () -> Reveal_result)\n\n  let transaction_case =\n    make\n      ~op_case: Operation.Encoding.Manager_operations.transaction_case\n      ~encoding:\n        (obj6\n           (opt \"storage\" Script.expr_encoding)\n           (dft \"balance_updates\" Delegate.balance_updates_encoding [])\n           (dft \"originated_contracts\" (list Contract.encoding) [])\n           (dft \"consumed_gas\" z Z.zero)\n           (dft \"storage_size\" z Z.zero)\n           (dft \"paid_storage_size_diff\" z Z.zero))\n      ~iselect:\n        (function\n          | Internal_operation_result\n              ({ operation = Transaction _ ; _} as op, res) ->\n              Some (op, res)\n          | _ -> None)\n      ~select:\n        (function\n          | Successful_manager_result (Transaction_result _ as op) -> Some op\n          | _ -> None)\n      ~kind: Kind.Transaction_manager_kind\n      ~proj:\n        (function\n          | Transaction_result\n              { storage ; balance_updates ;\n                originated_contracts ; consumed_gas ;\n                storage_size ; paid_storage_size_diff } ->\n              (storage, balance_updates,\n               originated_contracts, consumed_gas,\n               storage_size, paid_storage_size_diff))\n      ~inj:\n        (fun (storage, balance_updates,\n              originated_contracts, consumed_gas,\n              storage_size, paid_storage_size_diff) ->\n          Transaction_result { storage ; balance_updates ;\n                               originated_contracts ; consumed_gas ;\n                               storage_size ; paid_storage_size_diff })\n\n  let origination_case =\n    make\n      ~op_case: Operation.Encoding.Manager_operations.origination_case\n      ~encoding:\n        (obj5\n           (dft \"balance_updates\" Delegate.balance_updates_encoding [])\n           (dft \"originated_contracts\" (list Contract.encoding) [])\n           (dft \"consumed_gas\" z Z.zero)\n           (dft \"storage_size\" z Z.zero)\n           (dft \"paid_storage_size_diff\" z Z.zero))\n      ~iselect:\n        (function\n          | Internal_operation_result\n              ({ operation = Origination _ ; _} as op, res) ->\n              Some (op, res)\n          | _ -> None)\n      ~select:\n        (function\n          | Successful_manager_result (Origination_result _ as op) -> Some op\n          | _ -> None)\n      ~proj:\n        (function\n          | Origination_result\n              { balance_updates ;\n                originated_contracts ; consumed_gas ;\n                storage_size ; paid_storage_size_diff } ->\n              (balance_updates,\n               originated_contracts, consumed_gas,\n               storage_size, paid_storage_size_diff))\n      ~kind: Kind.Origination_manager_kind\n      ~inj:\n        (fun (balance_updates,\n              originated_contracts, consumed_gas,\n              storage_size, paid_storage_size_diff) ->\n          Origination_result\n            { balance_updates ;\n              originated_contracts ; consumed_gas ;\n              storage_size ; paid_storage_size_diff })\n\n  let delegation_case =\n    make\n      ~op_case: Operation.Encoding.Manager_operations.delegation_case\n      ~encoding: Data_encoding.empty\n      ~iselect:\n        (function\n          | Internal_operation_result\n              ({ operation = Delegation _ ; _} as op, res) ->\n              Some (op, res)\n          | _ -> None)\n      ~select:\n        (function\n          | Successful_manager_result (Delegation_result as op) -> Some op\n          | _ -> None)\n      ~kind: Kind.Delegation_manager_kind\n      ~proj: (function Delegation_result -> ())\n      ~inj: (fun () -> Delegation_result)\n\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 = res_case.op_case in\n    case (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\n            op_case.encoding\n            (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),\n                   (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)) in\n  def \"operation.alpha.internal_operation_result\" @@\n  union [\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  ]\n\ntype 'kind contents_result =\n  | Endorsement_result :\n      { balance_updates : Delegate.balance_updates ;\n        delegate : Signature.Public_key_hash.t ;\n        slots: int list ;\n      } -> Kind.endorsement contents_result\n  | Seed_nonce_revelation_result :\n      Delegate.balance_updates -> Kind.seed_nonce_revelation contents_result\n  | Double_endorsement_evidence_result :\n      Delegate.balance_updates -> Kind.double_endorsement_evidence contents_result\n  | Double_baking_evidence_result :\n      Delegate.balance_updates -> Kind.double_baking_evidence contents_result\n  | Activate_account_result :\n      Delegate.balance_updates -> 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 : Delegate.balance_updates ;\n        operation_result : 'kind manager_operation_result ;\n        internal_operation_results : packed_internal_operation_result list ;\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 -> packed_contents_and_result\n\ntype ('a, 'b) eq = Eq : ('a, 'a) eq\n\nlet equal_manager_kind\n  : type a b. a Kind.manager -> b Kind.manager -> (a, b) eq option\n  = fun ka kb -> 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\nmodule Encoding = struct\n\n  type 'kind case =\n      Case : { op_case: 'kind Operation.Encoding.case ;\n               encoding: 'a Data_encoding.t ;\n               select: packed_contents_result -> 'kind contents_result option ;\n               mselect: packed_contents_and_result -> ('kind contents * 'kind contents_result) option ;\n               proj: 'kind contents_result -> 'a ;\n               inj: 'a -> 'kind contents_result ;\n             } -> 'kind case\n\n  let tagged_case tag name args proj inj =\n    let open Data_encoding in\n    case tag\n      ~title:(String.capitalize_ascii name)\n      (merge_objs\n         (obj1 (req \"kind\" (constant name)))\n         args)\n      (fun x -> match proj x with None -> None | Some x -> Some ((), x))\n      (fun ((), x) -> inj x)\n\n  let endorsement_case =\n    Case {\n      op_case = Operation.Encoding.endorsement_case ;\n      encoding =\n        (obj3\n           (req \"balance_updates\" Delegate.balance_updates_encoding)\n           (req \"delegate\" Signature.Public_key_hash.encoding)\n           (req \"slots\" (list uint8)));\n      select =\n        (function\n          | Contents_result (Endorsement_result _ as op) -> Some op\n          | _ -> 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 ; slots }\n            -> (balance_updates, delegate, slots)) ;\n      inj =\n        (fun (balance_updates, delegate, slots) ->\n           Endorsement_result { balance_updates ; delegate ; slots })\n    }\n\n  let seed_nonce_revelation_case =\n    Case {\n      op_case = Operation.Encoding.seed_nonce_revelation_case ;\n      encoding =\n        (obj1\n           (req \"balance_updates\" Delegate.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) -> 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 double_endorsement_evidence_case =\n    Case {\n      op_case = Operation.Encoding.double_endorsement_evidence_case ;\n      encoding =\n        (obj1\n           (req \"balance_updates\" Delegate.balance_updates_encoding)) ;\n      select =\n        (function\n          | Contents_result (Double_endorsement_evidence_result _ as op) -> Some op\n          | _ -> None) ;\n      mselect =\n        (function\n          | Contents_and_result (Double_endorsement_evidence _ as op, res) -> Some (op, res)\n          | _ -> None) ;\n      proj =\n        (fun (Double_endorsement_evidence_result bus) -> bus) ;\n      inj = (fun bus -> Double_endorsement_evidence_result bus)\n    }\n\n  let double_baking_evidence_case =\n    Case {\n      op_case = Operation.Encoding.double_baking_evidence_case ;\n      encoding =\n        (obj1\n           (req \"balance_updates\" Delegate.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) -> Some (op, res)\n          | _ -> None) ;\n      proj =\n        (fun (Double_baking_evidence_result bus) -> bus) ;\n      inj = (fun bus -> Double_baking_evidence_result bus) ;\n    }\n\n  let activate_account_case =\n    Case {\n      op_case = Operation.Encoding.activate_account_case ;\n      encoding =\n        (obj1\n           (req \"balance_updates\" Delegate.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) -> 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 proposals_case =\n    Case {\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\n          | _ -> 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 ballot_case =\n    Case {\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\n          | _ -> 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 make_manager_case\n      (type kind)\n      (Operation.Encoding.Case op_case : kind Kind.manager Operation.Encoding.case)\n      (Manager_result.MCase res_case : kind Manager_result.case)\n      mselect =\n    Case {\n      op_case = Operation.Encoding.Case op_case ;\n      encoding =\n        (obj3\n           (req \"balance_updates\" Delegate.balance_updates_encoding)\n           (req \"operation_result\" res_case.t)\n           (dft \"internal_operation_results\"\n              (list internal_operation_result_encoding) [])) ;\n      select =\n        (function\n          | Contents_result\n              (Manager_operation_result\n                 ({ operation_result = Applied res ; _ } as op)) -> begin\n              match res_case.select (Successful_manager_result res) with\n              | Some res ->\n                  Some (Manager_operation_result\n                          { op with operation_result = Applied res })\n              | None -> None\n            end\n          | Contents_result\n              (Manager_operation_result\n                 ({ operation_result = Backtracked (res, errs) ; _ } as op)) -> begin\n              match res_case.select (Successful_manager_result res) with\n              | Some res ->\n                  Some (Manager_operation_result\n                          { op with operation_result = Backtracked (res, errs) })\n              | None -> None\n            end\n          | Contents_result\n              (Manager_operation_result\n                 ({ operation_result = Skipped kind ; _ } as op)) ->\n              begin match equal_manager_kind kind res_case.kind with\n                | None -> None\n                | Some Eq ->\n                    Some (Manager_operation_result\n                            { op with operation_result = Skipped kind })\n              end\n          | Contents_result\n              (Manager_operation_result\n                 ({ operation_result = Failed (kind, errs) ; _ } as op)) ->\n              begin match equal_manager_kind kind res_case.kind with\n                | None -> None\n                | Some Eq ->\n                    Some (Manager_operation_result\n                            { op with operation_result = Failed (kind, errs) })\n              end\n          | Contents_result Ballot_result -> None\n          | Contents_result (Endorsement_result _) -> None\n          | Contents_result (Seed_nonce_revelation_result _) -> None\n          | Contents_result (Double_endorsement_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                { balance_updates = bus ; operation_result = r ;\n                  internal_operation_results = rs }) ->\n          (bus, r, rs)) ;\n      inj =\n        (fun (bus, r, rs) ->\n           Manager_operation_result\n             { balance_updates = bus ; operation_result = r ;\n               internal_operation_results = rs }) ;\n    }\n\n  let 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\n               { operation = Reveal _ ; _ } as op, res) ->\n            Some (op, res)\n        | _ -> None)\n\n  let 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\n               { operation = Transaction _ ; _ } as op, res) ->\n            Some (op, res)\n        | _ -> None)\n\n  let 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\n               { operation = Origination _ ; _ } as op, res) ->\n            Some (op, res)\n        | _ -> None)\n\n  let 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\n               { operation = Delegation _ ; _ } as op, res) ->\n            Some (op, res)\n        | _ -> None)\n\nend\n\nlet contents_result_encoding =\n  let open Encoding in\n  let make (Case { op_case = Operation.Encoding.Case { tag ; name ; _ } ;\n                   encoding ; mselect = _ ; select ; proj ; inj }) =\n    let proj x =\n      match select x with\n      | None -> None\n      | Some x -> Some (proj x) in\n    let inj x = Contents_result (inj x) in\n    tagged_case (Tag tag) name encoding proj inj in\n  def \"operation.alpha.contents_result\" @@\n  union [\n    make endorsement_case ;\n    make seed_nonce_revelation_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  ]\n\nlet contents_and_result_encoding =\n  let open Encoding in\n  let make\n      (Case { op_case = Operation.Encoding.Case { tag ; name ; encoding ; proj ; inj ; _ } ;\n              mselect ; encoding = meta_encoding ; proj = meta_proj ; inj = meta_inj ; _ }) =\n    let proj c =\n      match mselect c with\n      | Some (op, res) -> Some (proj op, meta_proj res)\n      | _ -> None in\n    let inj (op, res) = Contents_and_result (inj op, meta_inj res) in\n    let encoding =\n      merge_objs\n        encoding\n        (obj1\n           (req \"metadata\" meta_encoding)) in\n    tagged_case (Tag tag) name encoding proj inj in\n  def \"operation.alpha.operation_contents_and_result\" @@\n  union [\n    make endorsement_case ;\n    make seed_nonce_revelation_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  ]\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 * 'rest Kind.manager contents_result_list ->\n    (('kind * 'rest) Kind.manager ) contents_result_list\n\ntype packed_contents_result_list =\n    Contents_result_list : 'kind contents_result_list -> 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) in\n  let rec of_list = function\n    | [] -> Pervasives.failwith \"cannot decode empty operation result\"\n    | [Contents_result o] -> Contents_result_list (Single_result o)\n    | (Contents_result o) :: os ->\n        let Contents_result_list os = of_list os in\n        match o, os with\n        | Manager_operation_result _, Single_result (Manager_operation_result _) ->\n            Contents_result_list (Cons_result (o, os))\n        | Manager_operation_result _, Cons_result _ ->\n            Contents_result_list (Cons_result (o, os))\n        | _ -> Pervasives.failwith \"cannot decode ill-formed operation result\" in\n  def \"operation.alpha.contents_list_result\" @@\n  conv to_list of_list (list contents_result_encoding)\n\ntype 'kind contents_and_result_list =\n  | Single_and_result : 'kind Alpha_context.contents * 'kind contents_result -> 'kind contents_and_result_list\n  | Cons_and_result : 'kind Kind.manager Alpha_context.contents * 'kind Kind.manager contents_result * 'rest Kind.manager contents_and_result_list -> ('kind * 'rest) Kind.manager contents_and_result_list\n\ntype packed_contents_and_result_list =\n  | Contents_and_result_list : 'kind contents_and_result_list -> 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) ::\n        to_list (Contents_and_result_list rest) in\n  let rec of_list = function\n    | [] -> Pervasives.failwith \"cannot decode empty combined operation result\"\n    | [Contents_and_result (op, res)] ->\n        Contents_and_result_list (Single_and_result (op, res))\n    | (Contents_and_result (op, res)) :: rest ->\n        let Contents_and_result_list rest = of_list rest in\n        match op, rest with\n        | Manager_operation _, Single_and_result (Manager_operation _, _) ->\n            Contents_and_result_list (Cons_and_result (op, res, rest))\n        | Manager_operation _, Cons_and_result (_, _, _) ->\n            Contents_and_result_list (Cons_and_result (op, res, rest))\n        | _ -> Pervasives.failwith \"cannot decode ill-formed combined operation result\" in\n  conv to_list of_list (Variable.list contents_and_result_encoding)\n\ntype 'kind operation_metadata = {\n  contents: 'kind contents_result_list ;\n}\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    case (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) -> Operation_metadata { contents }) ;\n    case (Tag 1)\n      ~title:\"No_operation_metadata\"\n      empty\n      (function\n        | No_operation_metadata -> Some ()\n        | _ -> None)\n      (fun () -> No_operation_metadata) ;\n  ]\n\nlet kind_equal\n  : type kind kind2. 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    | Seed_nonce_revelation _, Seed_nonce_revelation_result _ -> Some Eq\n    | Seed_nonce_revelation _, _ -> None\n    | Double_endorsement_evidence _, Double_endorsement_evidence_result _ -> 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    | Manager_operation\n        { operation = Reveal _ ; _ },\n      Manager_operation_result\n        { operation_result = Applied Reveal_result ; _ } -> Some Eq\n    | Manager_operation\n        { operation = Reveal _ ; _ },\n      Manager_operation_result\n        { operation_result = Backtracked (Reveal_result, _) ; _ } -> Some Eq\n    | Manager_operation\n        { operation = Reveal _ ; _ },\n      Manager_operation_result\n        { operation_result =\n            Failed (Alpha_context.Kind.Reveal_manager_kind, _); _ } -> Some Eq\n    | Manager_operation\n        { operation = Reveal _ ; _ },\n      Manager_operation_result\n        { operation_result =\n            Skipped (Alpha_context.Kind.Reveal_manager_kind); _ } -> Some Eq\n    | Manager_operation { operation = Reveal _ ; _ }, _ -> None\n    | Manager_operation\n        { operation = Transaction _ ; _ },\n      Manager_operation_result\n        { operation_result = Applied (Transaction_result _); _ } -> Some Eq\n    | Manager_operation\n        { operation = Transaction _ ; _ },\n      Manager_operation_result\n        { operation_result = Backtracked (Transaction_result _, _); _ } -> Some Eq\n    | Manager_operation\n        { operation = Transaction _ ; _ },\n      Manager_operation_result\n        { operation_result =\n            Failed (Alpha_context.Kind.Transaction_manager_kind, _); _ } -> Some Eq\n    | Manager_operation\n        { operation = Transaction _ ; _ },\n      Manager_operation_result\n        { operation_result =\n            Skipped (Alpha_context.Kind.Transaction_manager_kind); _ } -> Some Eq\n    | Manager_operation { operation = Transaction _ ; _ }, _ -> None\n    | Manager_operation\n        { operation = Origination _ ; _ },\n      Manager_operation_result\n        { operation_result = Applied (Origination_result _); _ } -> Some Eq\n    | Manager_operation\n        { operation = Origination _ ; _ },\n      Manager_operation_result\n        { operation_result = Backtracked (Origination_result _, _); _ } -> Some Eq\n    | Manager_operation\n        { operation = Origination _ ; _ },\n      Manager_operation_result\n        { operation_result =\n            Failed (Alpha_context.Kind.Origination_manager_kind, _); _ } -> Some Eq\n    | Manager_operation\n        { operation = Origination _ ; _ },\n      Manager_operation_result\n        { operation_result =\n            Skipped (Alpha_context.Kind.Origination_manager_kind); _ } -> Some Eq\n    | Manager_operation { operation = Origination _ ; _ }, _ -> None\n    | Manager_operation\n        { operation = Delegation _ ; _ },\n      Manager_operation_result\n        { operation_result = Applied Delegation_result ; _ } -> Some Eq\n    | Manager_operation\n        { operation = Delegation _ ; _ },\n      Manager_operation_result\n        { operation_result = Backtracked (Delegation_result, _) ; _ } -> Some Eq\n    | Manager_operation\n        { operation = Delegation _ ; _ },\n      Manager_operation_result\n        { operation_result =\n            Failed (Alpha_context.Kind.Delegation_manager_kind, _); _ } -> Some Eq\n    | Manager_operation\n        { operation = Delegation _ ; _ },\n      Manager_operation_result\n        { operation_result =\n            Skipped (Alpha_context.Kind.Delegation_manager_kind); _ } -> Some Eq\n    | Manager_operation { operation = Delegation _ ; _ }, _ -> None\n\nlet rec kind_equal_list\n  : type kind kind2. kind contents_list -> kind2 contents_result_list -> (kind, kind2) eq option =\n  fun contents res ->\n    match contents, res with\n    | Single op, Single_result res -> begin\n        match kind_equal op res with\n        | None -> None\n        | Some Eq -> Some Eq\n      end\n    | Cons (op, ops), Cons_result (res, ress) -> begin\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      end\n    | _ -> None\n\nlet rec pack_contents_list :\n  type kind. kind contents_list -> kind contents_result_list -> kind contents_and_result_list =\n  fun contents res -> begin\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      | Cons (_, _),\n        Single_result (Manager_operation_result\n                         { operation_result = Failed _ ; _}) -> .\n      | Cons (_, _),\n        Single_result (Manager_operation_result\n                         { operation_result = Skipped _ ; _}) -> .\n      | Cons (_, _),\n        Single_result (Manager_operation_result\n                         { operation_result = Applied _ ; _}) -> .\n      | Cons (_, _),\n        Single_result (Manager_operation_result\n                         { operation_result = Backtracked _ ; _}) -> .\n      | Single _, Cons_result _ -> .\n    end\n\nlet rec unpack_contents_list :\n  type kind. kind contents_and_result_list ->\n  (kind contents_list * kind contents_result_list) =\n  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 operation_data_and_metadata_encoding =\n  def \"operation.alpha.operation_with_metadata\" @@\n  union [\n    case (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 -> Pervasives.failwith \"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 (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 _) ->\n            None)\n      (fun (Contents_list contents, signature) ->\n         (Operation_data { contents ; signature }, No_operation_metadata))\n  ]\n\ntype block_metadata = {\n  baker: Signature.Public_key_hash.t ;\n  level: Level.t ;\n  voting_period_kind: Voting_period.kind ;\n  nonce_hash: Nonce_hash.t option ;\n  consumed_gas: Z.t ;\n  deactivated: Signature.Public_key_hash.t list ;\n  balance_updates: Delegate.balance_updates ;\n}\n\nlet block_metadata_encoding =\n  let open Data_encoding in\n  def \"block_header.alpha.metadata\" @@\n  conv\n    (fun { baker ; level ; voting_period_kind ; nonce_hash ;\n           consumed_gas ; deactivated ; balance_updates } ->\n      ( baker, level, voting_period_kind, nonce_hash,\n        consumed_gas, deactivated, balance_updates ))\n    (fun ( baker, level, voting_period_kind, nonce_hash,\n           consumed_gas, deactivated, balance_updates ) ->\n      { baker ; level ; voting_period_kind ; nonce_hash ;\n        consumed_gas ; deactivated ; balance_updates })\n    (obj7\n       (req \"baker\" Signature.Public_key_hash.encoding)\n       (req \"level\" Level.encoding)\n       (req \"voting_period_kind\" Voting_period.kind_encoding)\n       (req \"nonce_hash\" (option Nonce_hash.encoding))\n       (req \"consumed_gas\" (check_size 10 n))\n       (req \"deactivated\" (list Signature.Public_key_hash.encoding))\n       (req \"balance_updates\" Delegate.balance_updates_encoding))\n" ;
                } ;
                { name = "Apply" ;
                  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\n(** Tezos Protocol Implementation - Main Entry Points *)\n\nopen Alpha_context\n\ntype error += Wrong_voting_period of Voting_period.t * Voting_period.t (* `Temporary *)\ntype error += Wrong_endorsement_predecessor of Block_hash.t * Block_hash.t (* `Temporary *)\ntype error += Duplicate_endorsement of Signature.Public_key_hash.t (* `Branch *)\ntype error += Invalid_endorsement_level\ntype error += Invalid_commitment of { expected: bool }\ntype error += Internal_operation_replay of packed_internal_operation\n\ntype error += Invalid_double_endorsement_evidence (* `Permanent *)\ntype error += Inconsistent_double_endorsement_evidence\n  of { delegate1: Signature.Public_key_hash.t ; delegate2: Signature.Public_key_hash.t } (* `Permanent *)\ntype error += Unrequired_double_endorsement_evidence (* `Branch*)\ntype error += Too_early_double_endorsement_evidence\n  of { level: Raw_level.t ; current: Raw_level.t } (* `Temporary *)\ntype error += Outdated_double_endorsement_evidence\n  of { level: Raw_level.t ; last: Raw_level.t } (* `Permanent *)\n\ntype error += Invalid_double_baking_evidence\n  of { hash1: Block_hash.t ;\n       level1: Int32.t ;\n       hash2: Block_hash.t ;\n       level2: Int32.t } (* `Permanent *)\ntype error += Inconsistent_double_baking_evidence\n  of { delegate1: Signature.Public_key_hash.t ; delegate2: Signature.Public_key_hash.t } (* `Permanent *)\ntype error += Unrequired_double_baking_evidence (* `Branch*)\ntype error += Too_early_double_baking_evidence\n  of { level: Raw_level.t ; current: Raw_level.t } (* `Temporary *)\ntype error += Outdated_double_baking_evidence\n  of { level: Raw_level.t ; last: Raw_level.t } (* `Permanent *)\ntype error += Invalid_activation of { pkh : Ed25519.Public_key_hash.t }\ntype error += Multiple_revelation\ntype error += Gas_quota_exceeded_init_deserialize (* Permanent *)\n\nlet () =\n  register_error_kind\n    `Temporary\n    ~id:\"operation.wrong_endorsement_predecessor\"\n    ~title:\"Wrong endorsement predecessor\"\n    ~description:\"Trying to include an endorsement in a block \\\n                  that is not the successor of the endorsed one\"\n    ~pp:(fun ppf (e, p) ->\n        Format.fprintf ppf \"Wrong predecessor %a, expected %a\"\n          Block_hash.pp p Block_hash.pp e)\n    Data_encoding.(obj2\n                     (req \"expected\" Block_hash.encoding)\n                     (req \"provided\" Block_hash.encoding))\n    (function Wrong_endorsement_predecessor (e, p) -> Some (e, p) | _ -> None)\n    (fun (e, p) -> Wrong_endorsement_predecessor (e, p)) ;\n  register_error_kind\n    `Temporary\n    ~id:\"operation.wrong_voting_period\"\n    ~title:\"Wrong voting period\"\n    ~description:\"Trying to onclude a proposal or ballot \\\n                  meant for another voting period\"\n    ~pp:(fun ppf (e, p) ->\n        Format.fprintf ppf \"Wrong voting period %a, current is %a\"\n          Voting_period.pp p Voting_period.pp e)\n    Data_encoding.(obj2\n                     (req \"current\" Voting_period.encoding)\n                     (req \"provided\" Voting_period.encoding))\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    `Branch\n    ~id:\"operation.duplicate_endorsement\"\n    ~title:\"Duplicate endorsement\"\n    ~description:\"Two endorsements received from same delegate\"\n    ~pp:(fun ppf k ->\n        Format.fprintf ppf \"Duplicate endorsement from delegate %a (possible replay attack).\"\n          Signature.Public_key_hash.pp_short k)\n    Data_encoding.(obj1 (req \"delegate\" Signature.Public_key_hash.encoding))\n    (function Duplicate_endorsement k -> Some k | _ -> None)\n    (fun k -> Duplicate_endorsement k);\n  register_error_kind\n    `Temporary\n    ~id:\"operation.invalid_endorsement_level\"\n    ~title:\"Unexpected level in endorsement\"\n    ~description:\"The level of an endorsement is inconsistent with the \\\n                 \\ provided block hash.\"\n    ~pp:(fun ppf () ->\n        Format.fprintf ppf \"Unexpected level in endorsement.\")\n    Data_encoding.unit\n    (function Invalid_endorsement_level -> Some () | _ -> None)\n    (fun () -> Invalid_endorsement_level) ;\n  register_error_kind\n    `Permanent\n    ~id:\"block.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:\"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 ppf \"Internal operation %d was emitted twice by a script\" 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_double_endorsement_evidence\"\n    ~title:\"Invalid double endorsement evidence\"\n    ~description:\"A double-endorsement evidence is malformed\"\n    ~pp:(fun ppf () ->\n        Format.fprintf ppf \"Malformed double-endorsement evidence\")\n    Data_encoding.empty\n    (function Invalid_double_endorsement_evidence -> Some () | _ -> None)\n    (fun () -> Invalid_double_endorsement_evidence) ;\n  register_error_kind\n    `Permanent\n    ~id:\"block.inconsistent_double_endorsement_evidence\"\n    ~title:\"Inconsistent double endorsement evidence\"\n    ~description:\"A double-endorsement evidence is inconsistent \\\n                 \\ (two distinct delegates)\"\n    ~pp:(fun ppf (delegate1, delegate2) ->\n        Format.fprintf ppf\n          \"Inconsistent double-endorsement evidence \\\n          \\ (distinct delegate: %a and %a)\"\n          Signature.Public_key_hash.pp_short delegate1\n          Signature.Public_key_hash.pp_short delegate2)\n    Data_encoding.(obj2\n                     (req \"delegate1\" Signature.Public_key_hash.encoding)\n                     (req \"delegate2\" Signature.Public_key_hash.encoding))\n    (function\n      | Inconsistent_double_endorsement_evidence { delegate1 ; delegate2 } ->\n          Some (delegate1, delegate2)\n      | _ -> None)\n    (fun (delegate1, delegate2) ->\n       Inconsistent_double_endorsement_evidence { delegate1 ; delegate2 }) ;\n  register_error_kind\n    `Branch\n    ~id:\"block.unrequired_double_endorsement_evidence\"\n    ~title:\"Unrequired double endorsement evidence\"\n    ~description:\"A double-endorsement evidence is unrequired\"\n    ~pp:(fun ppf () ->\n        Format.fprintf ppf \"A valid double-endorsement operation cannot \\\n                           \\ be applied: the associated delegate \\\n                           \\ has previously been denunciated in this cycle.\")\n    Data_encoding.empty\n    (function Unrequired_double_endorsement_evidence -> Some () | _ -> None)\n    (fun () -> Unrequired_double_endorsement_evidence) ;\n  register_error_kind\n    `Temporary\n    ~id:\"block.too_early_double_endorsement_evidence\"\n    ~title:\"Too early double endorsement evidence\"\n    ~description:\"A double-endorsement evidence is in the future\"\n    ~pp:(fun ppf (level, current) ->\n        Format.fprintf ppf\n          \"A double-endorsement evidence is in the future \\\n          \\ (current level: %a, endorsement level: %a)\"\n          Raw_level.pp current\n          Raw_level.pp level)\n    Data_encoding.(obj2\n                     (req \"level\" Raw_level.encoding)\n                     (req \"current\" Raw_level.encoding))\n    (function\n      | Too_early_double_endorsement_evidence { level ; current } ->\n          Some (level, current)\n      | _ -> None)\n    (fun (level, current) ->\n       Too_early_double_endorsement_evidence { level ; current }) ;\n  register_error_kind\n    `Permanent\n    ~id:\"block.outdated_double_endorsement_evidence\"\n    ~title:\"Outdated double endorsement evidence\"\n    ~description:\"A double-endorsement evidence is outdated.\"\n    ~pp:(fun ppf (level, last) ->\n        Format.fprintf ppf\n          \"A double-endorsement evidence is outdated \\\n          \\ (last acceptable level: %a, endorsement level: %a)\"\n          Raw_level.pp last\n          Raw_level.pp level)\n    Data_encoding.(obj2\n                     (req \"level\" Raw_level.encoding)\n                     (req \"last\" Raw_level.encoding))\n    (function\n      | Outdated_double_endorsement_evidence { level ; last } ->\n          Some (level, last)\n      | _ -> None)\n    (fun (level, last) ->\n       Outdated_double_endorsement_evidence { level ; last }) ;\n  register_error_kind\n    `Permanent\n    ~id:\"block.invalid_double_baking_evidence\"\n    ~title:\"Invalid double baking evidence\"\n    ~description:\"A double-baking evidence is inconsistent \\\n                 \\ (two distinct level)\"\n    ~pp:(fun ppf (hash1, level1, hash2, level2) ->\n        Format.fprintf ppf\n          \"Invalid double-baking evidence (hash: %a and %a, levels: %ld and %ld)\"\n          Block_hash.pp hash1 Block_hash.pp hash2\n          level1 level2)\n    Data_encoding.(obj4\n                     (req \"hash1\" Block_hash.encoding)\n                     (req \"level1\" int32)\n                     (req \"hash2\" Block_hash.encoding)\n                     (req \"level2\" int32))\n    (function\n      | Invalid_double_baking_evidence { hash1 ; level1 ; hash2 ; level2 } ->\n          Some (hash1, level1, hash2, level2)\n      | _ -> None)\n    (fun (hash1, level1, hash2, level2) ->\n       Invalid_double_baking_evidence { hash1 ; level1 ; hash2 ; level2 }) ;\n  register_error_kind\n    `Permanent\n    ~id:\"block.inconsistent_double_baking_evidence\"\n    ~title:\"Inconsistent double baking evidence\"\n    ~description:\"A double-baking evidence is inconsistent \\\n                 \\ (two distinct delegates)\"\n    ~pp:(fun ppf (delegate1, delegate2) ->\n        Format.fprintf ppf\n          \"Inconsistent double-baking evidence \\\n          \\ (distinct delegate: %a and %a)\"\n          Signature.Public_key_hash.pp_short delegate1\n          Signature.Public_key_hash.pp_short delegate2)\n    Data_encoding.(obj2\n                     (req \"delegate1\" Signature.Public_key_hash.encoding)\n                     (req \"delegate2\" Signature.Public_key_hash.encoding))\n    (function\n      | Inconsistent_double_baking_evidence { delegate1 ; delegate2 } ->\n          Some (delegate1, delegate2)\n      | _ -> None)\n    (fun (delegate1, delegate2) ->\n       Inconsistent_double_baking_evidence { delegate1 ; delegate2 }) ;\n  register_error_kind\n    `Branch\n    ~id:\"block.unrequired_double_baking_evidence\"\n    ~title:\"Unrequired double baking evidence\"\n    ~description:\"A double-baking evidence is unrequired\"\n    ~pp:(fun ppf () ->\n        Format.fprintf ppf \"A valid double-baking operation cannot \\\n                           \\ be applied: the associated delegate \\\n                           \\ has previously been denunciated in this cycle.\")\n    Data_encoding.empty\n    (function Unrequired_double_baking_evidence -> Some () | _ -> None)\n    (fun () -> Unrequired_double_baking_evidence) ;\n  register_error_kind\n    `Temporary\n    ~id:\"block.too_early_double_baking_evidence\"\n    ~title:\"Too early double baking evidence\"\n    ~description:\"A double-baking evidence is in the future\"\n    ~pp:(fun ppf (level, current) ->\n        Format.fprintf ppf\n          \"A double-baking evidence is in the future \\\n          \\ (current level: %a, baking level: %a)\"\n          Raw_level.pp current\n          Raw_level.pp level)\n    Data_encoding.(obj2\n                     (req \"level\" Raw_level.encoding)\n                     (req \"current\" Raw_level.encoding))\n    (function\n      | Too_early_double_baking_evidence { level ; current } ->\n          Some (level, current)\n      | _ -> None)\n    (fun (level, current) ->\n       Too_early_double_baking_evidence { level ; current }) ;\n  register_error_kind\n    `Permanent\n    ~id:\"block.outdated_double_baking_evidence\"\n    ~title:\"Outdated double baking evidence\"\n    ~description:\"A double-baking evidence is outdated.\"\n    ~pp:(fun ppf (level, last) ->\n        Format.fprintf ppf\n          \"A double-baking evidence is outdated \\\n          \\ (last acceptable level: %a, baking level: %a)\"\n          Raw_level.pp last\n          Raw_level.pp level)\n    Data_encoding.(obj2\n                     (req \"level\" Raw_level.encoding)\n                     (req \"last\" Raw_level.encoding))\n    (function\n      | Outdated_double_baking_evidence { level ; last } ->\n          Some (level, last)\n      | _ -> None)\n    (fun (level, last) ->\n       Outdated_double_baking_evidence { level ; last }) ;\n  register_error_kind\n    `Permanent\n    ~id:\"operation.invalid_activation\"\n    ~title:\"Invalid activation\"\n    ~description:\"The given key and secret do not correspond to any \\\n                  existing preallocated contract\"\n    ~pp:(fun ppf pkh ->\n        Format.fprintf ppf \"Invalid activation. The public key %a does \\\n                            not match any commitment.\"\n          Ed25519.Public_key_hash.pp pkh\n      )\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:\"A manager operation should not contain more than one revelation\"\n    ~pp:(fun ppf () ->\n        Format.fprintf 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 expresions\"\n    ~description:\"Gas limit was not high enough to deserialize the \\\n                  transaction parameters or origination script code or \\\n                  initial storage, making the operation impossible to \\\n                  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\nopen Apply_results\n\nlet apply_manager_operation_content :\n  type kind.\n  ( Alpha_context.t -> Script_ir_translator.unparsing_mode -> payer:Contract.t -> source:Contract.t ->\n    internal:bool -> kind manager_operation ->\n    (context * kind successful_manager_operation_result * packed_internal_operation list) tzresult Lwt.t ) =\n  fun ctxt mode ~payer ~source ~internal 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 in\n    Contract.must_exist ctxt source >>=? fun () ->\n    let spend =\n      (* Ignore the spendable flag for smart contracts. *)\n      if internal then Contract.spend_from_script else Contract.spend in\n    let set_delegate =\n      (* Ignore the delegatable flag for smart contracts. *)\n      if internal then Delegate.set_from_script else Delegate.set in\n    match operation with\n    | Reveal _ ->\n        return (* No-op: action already performed by `precheck_manager_contents`. *)\n          (ctxt, (Reveal_result : kind successful_manager_operation_result), [])\n    | Transaction { amount ; parameters ; destination } -> begin\n        spend ctxt source amount >>=? fun ctxt ->\n        Contract.credit ctxt destination amount >>=? fun ctxt ->\n        Contract.get_script ctxt destination >>=? fun (ctxt, script) ->\n        match script with\n        | None -> begin\n            match parameters with\n            | None -> return ctxt\n            | Some arg ->\n                Script.force_decode ctxt arg >>=? fun (arg, ctxt) -> (* see [note] *)\n                (* [note]: for toplevel ops, cost is nil since the\n                   lazy value has already been forced at precheck, so\n                   we compute and consume the full cost again *)\n                let cost_arg = Script.deserialized_cost arg in\n                Lwt.return (Gas.consume ctxt cost_arg) >>=? fun ctxt ->\n                match Micheline.root arg with\n                | Prim (_, D_Unit, [], _) ->\n                    (* Allow [Unit] parameter to non-scripted contracts. *)\n                    return ctxt\n                | _ -> fail (Script_interpreter.Bad_contract_parameter destination)\n          end >>=? fun ctxt ->\n            let result =\n              Transaction_result\n                { storage = None ;\n                  balance_updates =\n                    Delegate.cleanup_balance_updates\n                      [ Contract source, Debited amount ;\n                        Contract destination, Credited amount ] ;\n                  originated_contracts = [] ;\n                  consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt ;\n                  storage_size = Z.zero ;\n                  paid_storage_size_diff = Z.zero ;\n                } in\n            return (ctxt, result, [])\n        | Some script ->\n            begin match parameters with\n              | None ->\n                  (* Forge a [Unit] parameter that will be checked by [execute]. *)\n                  let unit = Micheline.strip_locations (Prim (0, Script.D_Unit, [], [])) in\n                  return (ctxt, unit)\n              | Some parameters ->\n                  Script.force_decode ctxt parameters >>=? fun (arg, ctxt) -> (* see [note] *)\n                  let cost_arg = Script.deserialized_cost arg in\n                  Lwt.return (Gas.consume ctxt cost_arg) >>=? fun ctxt ->\n                  return (ctxt, arg)\n            end >>=? fun (ctxt, parameter) ->\n            Script_interpreter.execute\n              ctxt mode\n              ~source ~payer ~self:(destination, script) ~amount ~parameter\n            >>=? fun { ctxt ; storage ; big_map_diff ; operations } ->\n            Contract.update_script_storage\n              ctxt destination storage big_map_diff >>=? fun ctxt ->\n            Fees.record_paid_storage_space\n              ctxt destination >>=? fun (ctxt, new_size, paid_storage_size_diff, fees) ->\n            Contract.originated_from_current_nonce\n              ~since: before_operation\n              ~until: ctxt >>=? fun originated_contracts ->\n            let result =\n              Transaction_result\n                { storage = Some storage ;\n                  balance_updates =\n                    Delegate.cleanup_balance_updates\n                      [ Contract payer, Debited fees ;\n                        Contract source, Debited amount ;\n                        Contract destination, Credited amount ] ;\n                  originated_contracts ;\n                  consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt ;\n                  storage_size = new_size ;\n                  paid_storage_size_diff } in\n            return (ctxt, result, operations)\n      end\n    | Origination { manager ; delegate ; script ; preorigination ;\n                    spendable ; delegatable ; credit } ->\n        begin match script with\n          | None -> return (None, ctxt)\n          | Some script ->\n              Script.force_decode ctxt script.storage >>=? fun (unparsed_storage, ctxt) -> (* see [note] *)\n              Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_storage)) >>=? fun ctxt ->\n              Script.force_decode ctxt script.code >>=? fun (unparsed_code, ctxt) -> (* see [note] *)\n              Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_code)) >>=? fun ctxt ->\n              Script_ir_translator.parse_script ctxt script >>=? fun (_, ctxt) ->\n              Script_ir_translator.erase_big_map_initialization ctxt Optimized script >>=? fun (script, big_map_diff, ctxt) ->\n              return (Some (script, big_map_diff), ctxt)\n        end >>=? fun (script, ctxt) ->\n        spend ctxt source credit >>=? fun ctxt ->\n        begin 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              return (ctxt, contract)\n          | None ->\n              Contract.fresh_contract_from_current_nonce ctxt\n        end >>=? fun (ctxt, contract) ->\n        Contract.originate ctxt contract\n          ~manager ~delegate ~balance:credit\n          ?script\n          ~spendable ~delegatable >>=? fun ctxt ->\n        Fees.origination_burn ctxt ~payer >>=? fun (ctxt, orignation_burn) ->\n        Fees.record_paid_storage_space ctxt contract >>=? fun (ctxt, size, paid_storage_size_diff, fees) ->\n        Lwt.return Tez.(orignation_burn +? fees) >>=? fun all_fees ->\n        let result =\n          Origination_result\n            { balance_updates =\n                Delegate.cleanup_balance_updates\n                  [ Contract payer, Debited all_fees ;\n                    Contract source, Debited credit ;\n                    Contract contract, Credited credit ] ;\n              originated_contracts = [ contract ] ;\n              consumed_gas = Gas.consumed ~since:before_operation ~until:ctxt ;\n              storage_size = size ;\n              paid_storage_size_diff } in\n        return (ctxt, result, [])\n    | Delegation delegate ->\n        set_delegate ctxt source delegate >>=? fun ctxt ->\n        return (ctxt, Delegation_result, [])\n\nlet apply_internal_manager_operations ctxt mode ~payer ops =\n  let rec apply ctxt applied worklist =\n    match worklist with\n    | [] -> Lwt.return (`Success ctxt, List.rev applied)\n    | (Internal_operation\n         ({ source ; operation ; nonce } as op)) :: rest ->\n        begin\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 mode ~source ~payer ~internal:true operation\n        end >>= function\n        | Error errors ->\n            let result =\n              Internal_operation_result (op, Failed (manager_kind op.operation, errors)) in\n            let skipped =\n              List.rev_map\n                (fun (Internal_operation op) ->\n                   Internal_operation_result (op, Skipped (manager_kind op.operation)))\n                rest in\n            Lwt.return (`Failure, List.rev (skipped @ (result :: applied)))\n        | Ok (ctxt, result, emitted) ->\n            apply ctxt\n              (Internal_operation_result (op, Applied result) :: applied)\n              (rest @ emitted) in\n  apply ctxt [] ops\n\nlet precheck_manager_contents\n    (type kind) ctxt chain_id raw_operation (op : kind Kind.manager contents)\n  : context tzresult Lwt.t =\n  let Manager_operation { source ; fee ; counter ; operation ; gas_limit ; storage_limit } = op in\n  Lwt.return (Gas.check_limit ctxt gas_limit) >>=? fun () ->\n  let ctxt = Gas.set_limit ctxt gas_limit in\n  Lwt.return (Fees.check_storage_limit ctxt storage_limit) >>=? fun () ->\n  Contract.must_be_allocated ctxt source >>=? fun () ->\n  Contract.check_counter_increment ctxt source counter >>=? fun () ->\n  begin\n    match operation with\n    | Reveal pk ->\n        Contract.reveal_manager_key ctxt source pk\n    | Transaction { parameters = Some arg ; _ } ->\n        (* Fail quickly if not enough gas for minimal deserialization cost *)\n        Lwt.return @@ record_trace Gas_quota_exceeded_init_deserialize @@\n        Gas.check_enough ctxt (Script.minimal_deserialize_cost arg) >>=? fun () ->\n        (* Fail if not enough gas for complete deserialization cost *)\n        trace Gas_quota_exceeded_init_deserialize @@\n        Script.force_decode ctxt arg >>|? fun (_arg, ctxt) -> ctxt\n    | Origination { script = Some script ; _ } ->\n        (* Fail quickly if not enough gas for minimal deserialization cost *)\n        Lwt.return @@ record_trace Gas_quota_exceeded_init_deserialize @@\n        (Gas.consume ctxt (Script.minimal_deserialize_cost script.code) >>? fun ctxt ->\n         Gas.check_enough ctxt (Script.minimal_deserialize_cost script.storage)) >>=? fun () ->\n        (* Fail if not enough gas for complete deserialization cost *)\n        trace Gas_quota_exceeded_init_deserialize @@\n        Script.force_decode ctxt script.code >>=? fun (_code, ctxt) ->\n        trace Gas_quota_exceeded_init_deserialize @@\n        Script.force_decode ctxt script.storage >>|? fun (_storage, ctxt) ->\n        ctxt\n    | _ -> return ctxt\n  end >>=? fun ctxt ->\n  Contract.get_manager_key ctxt source >>=? fun public_key ->\n  (* Currently, the `raw_operation` 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  Operation.check_signature public_key chain_id raw_operation >>=? fun () ->\n  Contract.increment_counter ctxt source >>=? fun ctxt ->\n  Contract.spend ctxt source fee >>=? fun ctxt ->\n  add_fees ctxt fee >>=? fun ctxt ->\n  return ctxt\n\nlet apply_manager_contents\n    (type kind) ctxt mode (op : kind Kind.manager contents)\n  : ([ `Success of context | `Failure ] *\n     kind manager_operation_result *\n     packed_internal_operation_result list) Lwt.t =\n  let Manager_operation\n      { source ; operation ; gas_limit ; storage_limit } = op in\n  let ctxt = Gas.set_limit ctxt gas_limit in\n  let ctxt = Fees.start_counting_storage_fees ctxt in\n  apply_manager_operation_content ctxt mode\n    ~source ~payer:source ~internal:false operation >>= function\n  | Ok (ctxt, operation_results, internal_operations) -> begin\n      apply_internal_manager_operations\n        ctxt mode ~payer:source internal_operations >>= function\n      | (`Success ctxt, internal_operations_results) ->\n          Fees.burn_storage_fees ctxt ~storage_limit ~payer:source >>= begin function\n            | Ok ctxt ->\n                Lwt.return\n                  (`Success ctxt, Applied operation_results, internal_operations_results)\n            | Error errors ->\n                Lwt.return\n                  (`Failure, Backtracked (operation_results, Some errors), internal_operations_results)\n          end\n      | (`Failure, internal_operations_results) ->\n          Lwt.return\n            (`Failure, Applied operation_results, internal_operations_results)\n    end\n  | Error errors ->\n      Lwt.return\n        (`Failure, Failed (manager_kind operation, errors), [])\n\nlet rec mark_skipped\n  : type kind.\n    baker : Signature.Public_key_hash.t -> Level.t -> kind Kind.manager contents_list ->\n  kind Kind.manager contents_result_list = fun ~baker level -> function\n  | Single (Manager_operation ({ source ; fee } as op)) ->\n      Single_result\n        (Manager_operation_result\n           { balance_updates =\n               Delegate.cleanup_balance_updates\n                 [ Contract source, Debited fee ;\n                   Fees (baker, level.cycle), Credited fee ] ;\n             operation_result = Skipped (manager_kind op.operation) ;\n             internal_operation_results = [] })\n  | Cons (Manager_operation ({ source ; fee } as op), rest) ->\n      Cons_result\n        (Manager_operation_result {\n            balance_updates =\n              Delegate.cleanup_balance_updates\n                [ Contract source, Debited fee ;\n                  Fees (baker, level.cycle), Credited fee ] ;\n            operation_result = Skipped (manager_kind op.operation) ;\n            internal_operation_results = [] },\n         mark_skipped ~baker level rest)\n\nlet rec precheck_manager_contents_list\n  : type kind.\n    Alpha_context.t -> Chain_id.t -> _ Operation.t -> kind Kind.manager contents_list ->\n    context tzresult Lwt.t =\n  fun ctxt chain_id raw_operation contents_list ->\n    match contents_list with\n    | Single (Manager_operation _ as op) ->\n        precheck_manager_contents ctxt chain_id raw_operation op\n    | Cons (Manager_operation _ as op, rest) ->\n        precheck_manager_contents ctxt chain_id raw_operation op >>=? fun ctxt ->\n        precheck_manager_contents_list ctxt chain_id raw_operation rest\n\nlet rec apply_manager_contents_list_rec\n  : type kind.\n    Alpha_context.t -> Script_ir_translator.unparsing_mode ->\n    public_key_hash -> kind Kind.manager contents_list ->\n    ([ `Success of context | `Failure ] *\n     kind Kind.manager contents_result_list) Lwt.t =\n  fun ctxt mode baker contents_list ->\n    let level = Level.current ctxt in\n    match contents_list with\n    | Single (Manager_operation { source ; fee ; _ } as op) -> begin\n        apply_manager_contents ctxt mode op\n        >>= fun (ctxt_result, operation_result, internal_operation_results) ->\n        let result =\n          Manager_operation_result {\n            balance_updates =\n              Delegate.cleanup_balance_updates\n                [ Contract source, Debited fee ;\n                  Fees (baker, level.cycle), Credited fee ] ;\n            operation_result ;\n            internal_operation_results ;\n          } in\n        Lwt.return (ctxt_result, Single_result (result))\n      end\n    | Cons (Manager_operation { source ; fee ; _ } as op, rest) ->\n        apply_manager_contents ctxt mode op >>= function\n        | (`Failure, operation_result, internal_operation_results) ->\n            let result =\n              Manager_operation_result {\n                balance_updates =\n                  Delegate.cleanup_balance_updates\n                    [ Contract source, Debited fee ;\n                      Fees (baker, level.cycle), Credited fee ] ;\n                operation_result ;\n                internal_operation_results ;\n              } in\n            Lwt.return (`Failure, Cons_result (result, mark_skipped ~baker level rest))\n        | (`Success ctxt, operation_result, internal_operation_results) ->\n            let result =\n              Manager_operation_result {\n                balance_updates =\n                  Delegate.cleanup_balance_updates\n                    [ Contract source, Debited fee ;\n                      Fees (baker, level.cycle), Credited fee ] ;\n                operation_result ;\n                internal_operation_results ;\n              } in\n            apply_manager_contents_list_rec ctxt mode baker rest >>= fun (ctxt_result, results) ->\n            Lwt.return (ctxt_result, Cons_result (result, results))\n\nlet mark_backtracked results =\n  let rec mark_contents_list\n    : type kind. kind Kind.manager contents_result_list -> kind Kind.manager contents_result_list\n    = function\n      | Single_result (Manager_operation_result op) ->\n          Single_result (Manager_operation_result\n                           { balance_updates =\n                               op.balance_updates ;\n                             operation_result =\n                               mark_manager_operation_result op.operation_result ;\n                             internal_operation_results =\n                               List.map mark_internal_operation_results op.internal_operation_results})\n      | Cons_result (Manager_operation_result op, rest) ->\n          Cons_result (Manager_operation_result\n                         { balance_updates =\n                             op.balance_updates ;\n                           operation_result =\n                             mark_manager_operation_result op.operation_result ;\n                           internal_operation_results =\n                             List.map mark_internal_operation_results op.internal_operation_results},\n                       mark_contents_list rest)\n  and mark_internal_operation_results (Internal_operation_result (kind, result)) =\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 result -> Backtracked (result, None) in\n  mark_contents_list results\n\nlet apply_manager_contents_list ctxt mode baker contents_list =\n  apply_manager_contents_list_rec ctxt mode baker contents_list >>= fun (ctxt_result, results) ->\n  match ctxt_result with\n  | `Failure -> Lwt.return (ctxt (* backtracked *), mark_backtracked results)\n  | `Success ctxt -> Lwt.return (ctxt, results)\n\nlet apply_contents_list\n    (type kind) ctxt chain_id mode pred_block baker\n    (operation : kind operation)\n    (contents_list : kind contents_list)\n  : (context * kind contents_result_list) tzresult Lwt.t =\n  match contents_list with\n  | Single (Endorsement { level }) ->\n      let block = operation.shell.branch in\n      fail_unless\n        (Block_hash.equal block pred_block)\n        (Wrong_endorsement_predecessor (pred_block, block)) >>=? fun () ->\n      let current_level = (Level.current ctxt).level in\n      fail_unless\n        Raw_level.(succ level = current_level)\n        Invalid_endorsement_level >>=? fun () ->\n      Baking.check_endorsement_rights ctxt chain_id operation >>=? fun (delegate, slots, used) ->\n      if used then fail (Duplicate_endorsement delegate)\n      else\n        let ctxt = record_endorsement ctxt delegate in\n        let gap = List.length slots in\n        let ctxt = Fitness.increase ~gap ctxt in\n        Lwt.return\n          Tez.(Constants.endorsement_security_deposit ctxt *?\n               Int64.of_int gap) >>=? fun deposit ->\n        add_deposit ctxt delegate deposit >>=? fun ctxt ->\n        Global.get_last_block_priority ctxt >>=? fun block_priority ->\n        Baking.endorsement_reward ctxt ~block_priority gap >>=? fun reward ->\n        Delegate.freeze_rewards ctxt delegate reward >>=? fun ctxt ->\n        let level = Level.from_raw ctxt level in\n        return (ctxt, Single_result\n                  (Endorsement_result\n                     { balance_updates = Delegate.cleanup_balance_updates\n                           [ Contract (Contract.implicit_contract delegate), Debited deposit;\n                             Deposits (delegate, level.cycle), Credited deposit;\n                             Rewards (delegate, level.cycle), Credited reward; ] ;\n                       delegate ; slots }))\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 seed_nonce_revelation_tip =\n        Constants.seed_nonce_revelation_tip ctxt in\n      add_rewards ctxt seed_nonce_revelation_tip >>=? fun ctxt ->\n      return (ctxt, Single_result\n                (Seed_nonce_revelation_result\n                   [ Rewards (baker, level.cycle), Credited seed_nonce_revelation_tip ]))\n  | Single (Double_endorsement_evidence { op1 ; op2 }) -> begin\n      match op1.protocol_data.contents, op2.protocol_data.contents with\n      | Single (Endorsement e1),\n        Single (Endorsement e2)\n        when Raw_level.(e1.level = e2.level) &&\n             not (Block_hash.equal op1.shell.branch op2.shell.branch) ->\n          let level = Level.from_raw ctxt e1.level in\n          let oldest_level = Level.last_allowed_fork_level ctxt in\n          fail_unless Level.(level < Level.current ctxt)\n            (Too_early_double_endorsement_evidence\n               { level = level.level ;\n                 current = (Level.current ctxt).level }) >>=? fun () ->\n          fail_unless Raw_level.(oldest_level <= level.level)\n            (Outdated_double_endorsement_evidence\n               { level = level.level ;\n                 last = oldest_level }) >>=? fun () ->\n          Baking.check_endorsement_rights ctxt chain_id op1 >>=? fun (delegate1, _, _) ->\n          Baking.check_endorsement_rights ctxt chain_id op2 >>=? fun (delegate2, _, _) ->\n          fail_unless\n            (Signature.Public_key_hash.equal delegate1 delegate2)\n            (Inconsistent_double_endorsement_evidence\n               { delegate1 ; delegate2 }) >>=? fun () ->\n          Delegate.has_frozen_balance ctxt delegate1 level.cycle >>=? fun valid ->\n          fail_unless valid Unrequired_double_endorsement_evidence >>=? fun () ->\n          Delegate.punish ctxt delegate1 level.cycle >>=? fun (ctxt, balance) ->\n          Lwt.return Tez.(balance.deposit +? balance.fees) >>=? fun burned ->\n          let reward =\n            match Tez.(burned /? 2L) with\n            | Ok v -> v\n            | Error _ -> Tez.zero in\n          add_rewards ctxt reward >>=? fun ctxt ->\n          let current_cycle = (Level.current ctxt).cycle in\n          return (ctxt, Single_result\n                    (Double_endorsement_evidence_result\n                       (Delegate.cleanup_balance_updates [\n                           Deposits (delegate1, level.cycle), Debited balance.deposit ;\n                           Fees (delegate1, level.cycle), Debited balance.fees ;\n                           Rewards (delegate1, level.cycle), Debited balance.rewards ;\n                           Rewards (baker, current_cycle), Credited reward ])))\n      | _, _ -> fail Invalid_double_endorsement_evidence\n    end\n  | Single (Double_baking_evidence { bh1 ; bh2 }) ->\n      let hash1 = Block_header.hash bh1 in\n      let hash2 = Block_header.hash bh2 in\n      fail_unless\n        (Compare.Int32.(bh1.shell.level = bh2.shell.level) &&\n         not (Block_hash.equal hash1 hash2))\n        (Invalid_double_baking_evidence\n           { hash1 ;\n             level1 = bh1.shell.level ;\n             hash2 ;\n             level2 = bh2.shell.level ;\n           }) >>=? fun () ->\n      Lwt.return (Raw_level.of_int32 bh1.shell.level) >>=? fun raw_level ->\n      let oldest_level = Level.last_allowed_fork_level ctxt in\n      fail_unless Raw_level.(raw_level < (Level.current ctxt).level)\n        (Too_early_double_baking_evidence\n           { level = raw_level ;\n             current = (Level.current ctxt).level }) >>=? fun () ->\n      fail_unless Raw_level.(oldest_level <= raw_level)\n        (Outdated_double_baking_evidence\n           { level = raw_level ;\n             last = oldest_level }) >>=? fun () ->\n      let level = Level.from_raw ctxt raw_level in\n      Roll.baking_rights_owner\n        ctxt level ~priority:bh1.protocol_data.contents.priority >>=? fun delegate1 ->\n      Baking.check_signature bh1 chain_id delegate1 >>=? fun () ->\n      Roll.baking_rights_owner\n        ctxt level ~priority:bh2.protocol_data.contents.priority >>=? fun delegate2 ->\n      Baking.check_signature bh2 chain_id delegate2 >>=? fun () ->\n      fail_unless\n        (Signature.Public_key.equal delegate1 delegate2)\n        (Inconsistent_double_baking_evidence\n           { delegate1 = Signature.Public_key.hash delegate1 ;\n             delegate2 = Signature.Public_key.hash delegate2 }) >>=? fun () ->\n      let delegate = Signature.Public_key.hash delegate1 in\n      Delegate.has_frozen_balance ctxt delegate level.cycle >>=? fun valid ->\n      fail_unless valid Unrequired_double_baking_evidence >>=? fun () ->\n      Delegate.punish ctxt delegate level.cycle >>=? fun (ctxt, balance) ->\n      Lwt.return Tez.(balance.deposit +? balance.fees) >>=? fun burned ->\n      let reward =\n        match Tez.(burned /? 2L) with\n        | Ok v -> v\n        | Error _ -> Tez.zero in\n      add_rewards ctxt reward >>=? fun ctxt ->\n      let current_cycle = (Level.current ctxt).cycle in\n      return (ctxt, Single_result\n                (Double_baking_evidence_result\n                   (Delegate.cleanup_balance_updates [\n                       Deposits (delegate, level.cycle), Debited balance.deposit ;\n                       Fees (delegate, level.cycle), Debited balance.fees ;\n                       Rewards (delegate, level.cycle), Debited balance.rewards ;\n                       Rewards (baker, current_cycle), Credited reward ; ])))\n  | Single (Activate_account { id = pkh ; activation_code }) -> begin\n      let blinded_pkh =\n        Blinded_public_key_hash.of_ed25519_pkh activation_code pkh in\n      Commitment.get_opt ctxt blinded_pkh >>=? function\n      | None -> fail (Invalid_activation { pkh })\n      | Some amount ->\n          Commitment.delete ctxt blinded_pkh >>=? fun ctxt ->\n          let contract = Contract.implicit_contract (Signature.Ed25519 pkh) in\n          Contract.(credit ctxt contract amount) >>=? fun ctxt ->\n          return (ctxt, Single_result (Activate_account_result\n                                         [ Contract contract, Credited amount ]))\n    end\n  | Single (Proposals { source ; period ; proposals }) ->\n      Roll.delegate_pubkey ctxt source >>=? fun delegate ->\n      Operation.check_signature delegate chain_id operation >>=? fun () ->\n      let level = Level.current ctxt in\n      fail_unless Voting_period.(level.voting_period = period)\n        (Wrong_voting_period (level.voting_period, period)) >>=? fun () ->\n      Amendment.record_proposals ctxt source proposals >>=? fun ctxt ->\n      return (ctxt, Single_result Proposals_result)\n  | Single (Ballot { source ; period ; proposal ; ballot }) ->\n      Roll.delegate_pubkey ctxt source >>=? fun delegate ->\n      Operation.check_signature delegate chain_id operation >>=? fun () ->\n      let level = Level.current ctxt in\n      fail_unless Voting_period.(level.voting_period = period)\n        (Wrong_voting_period (level.voting_period, period)) >>=? fun () ->\n      Amendment.record_ballot ctxt source proposal ballot >>=? fun ctxt ->\n      return (ctxt, Single_result Ballot_result)\n  | Single (Manager_operation _) as op ->\n      precheck_manager_contents_list ctxt chain_id operation op >>=? fun ctxt ->\n      apply_manager_contents_list ctxt mode baker op >>= fun (ctxt, result) ->\n      return (ctxt, result)\n  | Cons (Manager_operation _, _) as op ->\n      precheck_manager_contents_list ctxt chain_id operation op >>=? fun ctxt ->\n      apply_manager_contents_list ctxt mode baker op >>= fun (ctxt, result) ->\n      return (ctxt, result)\n\nlet apply_operation ctxt chain_id mode pred_block baker hash operation =\n  let ctxt = Contract.init_origination_nonce ctxt hash in\n  apply_contents_list\n    ctxt chain_id mode pred_block baker operation\n    operation.protocol_data.contents >>=? fun (ctxt, result) ->\n  let ctxt = Gas.set_unlimited ctxt in\n  let ctxt = Contract.unset_origination_nonce ctxt in\n  return (ctxt, { contents = result })\n\nlet may_snapshot_roll ctxt =\n  let level = Alpha_context.Level.current ctxt in\n  let blocks_per_roll_snapshot = Constants.blocks_per_roll_snapshot ctxt in\n  if Compare.Int32.equal\n      (Int32.rem level.cycle_position blocks_per_roll_snapshot)\n      (Int32.pred blocks_per_roll_snapshot)\n  then\n    Alpha_context.Roll.snapshot_rolls ctxt >>=? fun ctxt ->\n    return ctxt\n  else\n    return ctxt\n\nlet may_start_new_cycle ctxt =\n  Baking.dawn_of_a_new_cycle ctxt >>=? function\n  | None -> return (ctxt, [], [])\n  | Some last_cycle ->\n      Seed.cycle_end ctxt last_cycle >>=? fun (ctxt, unrevealed) ->\n      Roll.cycle_end ctxt last_cycle >>=? fun ctxt ->\n      Delegate.cycle_end ctxt last_cycle unrevealed >>=? fun (ctxt, update_balances, deactivated) ->\n      Bootstrap.cycle_end ctxt last_cycle >>=? fun ctxt ->\n      return (ctxt, update_balances, deactivated)\n\nlet begin_full_construction ctxt pred_timestamp protocol_data =\n  Baking.check_baking_rights\n    ctxt protocol_data pred_timestamp >>=? fun delegate_pk ->\n  let ctxt = Fitness.increase ctxt in\n  match Level.pred ctxt (Level.current ctxt) with\n  | None -> assert false (* genesis *)\n  | Some pred_level ->\n      Baking.endorsement_rights ctxt pred_level >>=? fun rights ->\n      let ctxt = init_endorsements ctxt rights in\n      return (ctxt, protocol_data, delegate_pk)\n\nlet begin_partial_construction ctxt =\n  let ctxt = Fitness.increase ctxt in\n  match Level.pred ctxt (Level.current ctxt) with\n  | None -> assert false (* genesis *)\n  | Some pred_level ->\n      Baking.endorsement_rights ctxt pred_level >>=? fun rights ->\n      let ctxt = init_endorsements ctxt rights in\n      return ctxt\n\nlet begin_application ctxt chain_id block_header pred_timestamp =\n  let current_level = Alpha_context.Level.current ctxt in\n  Baking.check_proof_of_work_stamp ctxt block_header >>=? fun () ->\n  Baking.check_fitness_gap ctxt block_header >>=? fun () ->\n  Baking.check_baking_rights\n    ctxt block_header.protocol_data.contents pred_timestamp >>=? fun delegate_pk ->\n  Baking.check_signature block_header chain_id delegate_pk >>=? fun () ->\n  let has_commitment =\n    match block_header.protocol_data.contents.seed_nonce_hash with\n    | None -> false\n    | Some _ -> true in\n  fail_unless\n    Compare.Bool.(has_commitment = current_level.expected_commitment)\n    (Invalid_commitment\n       { expected = current_level.expected_commitment }) >>=? fun () ->\n  let ctxt = Fitness.increase ctxt in\n  match Level.pred ctxt (Level.current ctxt) with\n  | None -> assert false (* genesis *)\n  | Some pred_level ->\n      Baking.endorsement_rights ctxt pred_level >>=? fun rights ->\n      let ctxt = init_endorsements ctxt rights in\n      return (ctxt, delegate_pk)\n\nlet finalize_application ctxt protocol_data delegate =\n  let deposit = Constants.block_security_deposit ctxt in\n  add_deposit ctxt delegate deposit >>=? fun ctxt ->\n  let reward = (Constants.block_reward ctxt) in\n  add_rewards ctxt reward >>=? fun ctxt ->\n  Signature.Public_key_hash.Map.fold\n    (fun delegate deposit ctxt ->\n       ctxt >>=? fun ctxt ->\n       Delegate.freeze_deposit ctxt delegate deposit)\n    (get_deposits ctxt)\n    (return ctxt) >>=? fun ctxt ->\n  (* end of level (from this point nothing should fail) *)\n  let fees = Alpha_context.get_fees ctxt in\n  Delegate.freeze_fees ctxt delegate fees >>=? fun ctxt ->\n  let rewards = Alpha_context.get_rewards ctxt in\n  Delegate.freeze_rewards ctxt delegate rewards >>=? fun ctxt ->\n  begin\n    match protocol_data.Block_header.seed_nonce_hash with\n    | None -> return ctxt\n    | Some nonce_hash ->\n        Nonce.record_hash ctxt\n          { nonce_hash ; delegate ; rewards ; fees }\n  end >>=? fun ctxt ->\n  Alpha_context.Global.set_last_block_priority\n    ctxt protocol_data.priority >>=? fun ctxt ->\n  (* end of cycle *)\n  may_snapshot_roll ctxt >>=? fun ctxt ->\n  may_start_new_cycle ctxt >>=? fun (ctxt, balance_updates, deactivated) ->\n  Amendment.may_start_new_voting_cycle ctxt >>=? fun ctxt ->\n  let cycle = (Level.current ctxt).cycle in\n  let balance_updates =\n    Delegate.(cleanup_balance_updates\n                ([ Contract (Contract.implicit_contract delegate), Debited deposit ;\n                   Deposits (delegate, cycle), Credited deposit ;\n                   Rewards (delegate, cycle), Credited reward ] @ balance_updates)) in\n  let consumed_gas = Z.sub (Constants.hard_gas_limit_per_block ctxt) (Alpha_context.Gas.block_level ctxt) in\n  Alpha_context.Vote.get_current_period_kind ctxt >>=? fun voting_period_kind ->\n  let receipt = Apply_results.{ baker = delegate ;\n                                level = Level.current ctxt;\n                                voting_period_kind ;\n                                nonce_hash = protocol_data.seed_nonce_hash ;\n                                consumed_gas ;\n                                deactivated ;\n                                balance_updates } in\n  return (ctxt, receipt)\n" ;
                } ;
                { name = "Services_registration" ;
                  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\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  let fitness = block_header.fitness in\n  Alpha_context.prepare ~level ~timestamp ~fitness context >>=? fun context ->\n  return { block_hash ; block_header ; context }\n\nlet rpc_services = ref (RPC_directory.empty : Updater.rpc_context RPC_directory.t)\n\nlet register0_fullctxt s f =\n  rpc_services :=\n    RPC_directory.register !rpc_services s\n      (fun ctxt q i ->\n         rpc_init ctxt >>=? fun ctxt ->\n         f ctxt q i)\nlet opt_register0_fullctxt s f =\n  rpc_services :=\n    RPC_directory.opt_register !rpc_services s\n      (fun ctxt q i ->\n         rpc_init ctxt >>=? fun ctxt ->\n         f ctxt q i)\nlet register0 s f =\n  register0_fullctxt s (fun { context ; _ } -> f context)\nlet register0_noctxt s f =\n  rpc_services :=\n    RPC_directory.register !rpc_services s\n      (fun _ q i -> f q i)\n\nlet register1_fullctxt s f =\n  rpc_services :=\n    RPC_directory.register !rpc_services s\n      (fun (ctxt, arg) q i ->\n         rpc_init ctxt >>=? fun ctxt ->\n         f ctxt arg q i)\nlet register1 s f = register1_fullctxt s (fun { context ; _ } x -> f context x)\nlet register1_noctxt s f =\n  rpc_services :=\n    RPC_directory.register !rpc_services s\n      (fun (_, arg) q i -> f arg q i)\n\nlet register2_fullctxt s f =\n  rpc_services :=\n    RPC_directory.register !rpc_services s\n      (fun ((ctxt, arg1), arg2) q i ->\n         rpc_init ctxt >>=? fun ctxt ->\n         f ctxt arg1 arg2 q i)\nlet register2 s f =\n  register2_fullctxt s (fun { context ; _ } a1 a2 q i -> 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 _ -> assert false\n         | Ok c -> Lwt.return c.context)\n      (Storage_description.build_directory Alpha_context.description) 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:\n  '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\") : RPC_context.t RPC_path.context)\n\nmodule S = struct\n\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\n\nend\n\nlet register () =\n  let open Services_registration in\n  register0_noctxt S.errors begin fun () () ->\n    return (Data_encoding.Json.(schema error_encoding))\n  end ;\n  register0 S.all begin fun ctxt () () ->\n    let open Constants in\n    return { fixed = fixed ;\n             parametric = parametric ctxt }\n  end\n\nlet errors ctxt block =\n  RPC_context.make_call0 S.errors ctxt block () ()\nlet all ctxt block =\n  RPC_context.make_call0 S.all ctxt block () ()\n" ;
                } ;
                { name = "Contract_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 list:\n  'a #RPC_context.simple -> 'a -> Contract.t list shell_tzresult Lwt.t\n\ntype info = {\n  manager: public_key_hash ;\n  balance: Tez.t ;\n  spendable: bool ;\n  delegate: bool * public_key_hash option ;\n  counter: counter ;\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:\n  'a #RPC_context.simple -> 'a -> Contract.t -> public_key_hash shell_tzresult Lwt.t\n\nval manager_key:\n  'a #RPC_context.simple -> 'a -> Contract.t -> (public_key_hash * public_key option) shell_tzresult Lwt.t\n\nval delegate:\n  'a #RPC_context.simple -> 'a -> Contract.t -> public_key_hash shell_tzresult Lwt.t\n\nval delegate_opt:\n  'a #RPC_context.simple -> 'a -> Contract.t -> public_key_hash option shell_tzresult Lwt.t\n\nval is_delegatable:\n  'a #RPC_context.simple -> 'a -> Contract.t -> bool shell_tzresult Lwt.t\n\nval is_spendable:\n  'a #RPC_context.simple -> 'a -> Contract.t -> bool shell_tzresult Lwt.t\n\nval counter:\n  'a #RPC_context.simple -> 'a -> Contract.t -> 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 -> 'a -> Contract.t -> 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 storage_opt:\n  'a #RPC_context.simple -> 'a -> Contract.t -> Script.expr option shell_tzresult Lwt.t\n\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\" / \"contracts\") : RPC_context.t RPC_path.context)\n\ntype info = {\n  manager: public_key_hash ;\n  balance: Tez.t ;\n  spendable: bool ;\n  delegate: bool * public_key_hash option ;\n  counter: counter ;\n  script: Script.t option ;\n}\n\nlet info_encoding =\n  let open Data_encoding in\n  conv\n    (fun {manager ; balance ; spendable ; delegate ;\n          script ; counter } ->\n      (manager, balance, spendable, delegate,\n       script, counter))\n    (fun (manager, balance, spendable, delegate,\n          script, counter) ->\n      {manager ; balance ; spendable ; delegate ;\n       script ; counter}) @@\n  obj6\n    (req \"manager\" Signature.Public_key_hash.encoding)\n    (req \"balance\" Tez.encoding)\n    (req \"spendable\" bool)\n    (req \"delegate\" @@ obj2\n       (req \"setable\" bool)\n       (opt \"value\" Signature.Public_key_hash.encoding))\n    (opt \"script\" Script.encoding)\n    (req \"counter\" n)\n\nmodule S = struct\n\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 =\n    RPC_service.get_service\n      ~description: \"Access the manager of a contract.\"\n      ~query: RPC_query.empty\n      ~output: Signature.Public_key_hash.encoding\n      RPC_path.(custom_root /: Contract.rpc_arg / \"manager\")\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: (obj2\n                  (req \"manager\" Signature.Public_key_hash.encoding)\n                  (opt \"key\" 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 spendable =\n    RPC_service.get_service\n      ~description: \"Tells if the contract tokens can be spent by the manager.\"\n      ~query: RPC_query.empty\n      ~output: bool\n      RPC_path.(custom_root /: Contract.rpc_arg / \"spendable\")\n\n  let delegatable =\n    RPC_service.get_service\n      ~description: \"Tells if the contract delegate can be changed.\"\n      ~query: RPC_query.empty\n      ~output: bool\n      RPC_path.(custom_root /: Contract.rpc_arg / \"delegatable\")\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 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\nend\n\nlet register () =\n  let open Services_registration in\n  register0 S.list begin fun ctxt () () ->\n    Contract.list ctxt >>= return\n  end ;\n  let register_field s f =\n    register1 s (fun ctxt contract () () ->\n        Contract.exists ctxt contract >>=? function\n        | true -> f ctxt contract\n        | false -> raise Not_found) in\n  let register_opt_field s f =\n    register_field s\n      (fun ctxt a1 ->\n         f ctxt a1 >>=? function\n         | None -> raise Not_found\n         | Some v -> return v) in\n  register_field S.balance Contract.get_balance ;\n  register_field S.manager Contract.get_manager ;\n  register_field S.manager_key\n    (fun ctxt c ->\n       Contract.get_manager ctxt c >>=? fun mgr ->\n       Contract.is_manager_key_revealed ctxt c >>=? fun revealed ->\n       if revealed then\n         Contract.get_manager_key ctxt c >>=? fun key ->\n         return (mgr, Some key)\n       else return (mgr, None)) ;\n  register_opt_field S.delegate Delegate.get ;\n  register_field S.counter Contract.get_counter ;\n  register_field S.spendable Contract.is_spendable ;\n  register_field S.delegatable Contract.is_delegatable ;\n  register_opt_field S.script\n    (fun c v -> Contract.get_script c v >>=? fun (_, v) -> return v) ;\n  register_opt_field 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 script >>=? fun (Ex_script script, ctxt) ->\n          unparse_script ctxt Readable script >>=? fun (script, ctxt) ->\n          Script.force_decode ctxt script.storage >>=? fun (storage, _ctxt) ->\n          return_some storage) ;\n  register_field S.info (fun ctxt contract ->\n      Contract.get_balance ctxt contract >>=? fun balance ->\n      Contract.get_manager ctxt contract >>=? fun manager ->\n      Delegate.get ctxt contract >>=? fun delegate ->\n      Contract.get_counter ctxt contract >>=? fun counter ->\n      Contract.is_delegatable ctxt contract >>=? fun delegatable ->\n      Contract.is_spendable ctxt contract >>=? fun spendable ->\n      Contract.get_script ctxt contract >>=? fun (ctxt, script) ->\n      begin 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 script >>=? fun (Ex_script script, ctxt) ->\n            unparse_script ctxt Readable script >>=? fun (script, ctxt) ->\n            return (Some script, ctxt)\n      end >>=? fun (script, _ctxt) ->\n      return { manager ; balance ;\n               spendable ; delegate = (delegatable, delegate) ;\n               script ; counter })\n\nlet list ctxt block =\n  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 ctxt block contract =\n  RPC_context.make_call1 S.manager ctxt block contract () ()\n\nlet manager_key ctxt block contract =\n  RPC_context.make_call1 S.manager_key ctxt block contract () ()\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 contract =\n  RPC_context.make_call1 S.counter ctxt block contract () ()\n\nlet is_delegatable ctxt block contract =\n  RPC_context.make_call1 S.delegatable ctxt block contract () ()\n\nlet is_spendable ctxt block contract =\n  RPC_context.make_call1 S.spendable ctxt block contract () ()\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 storage_opt ctxt block contract =\n  RPC_context.make_opt_call1 S.storage ctxt block contract () ()\n" ;
                } ;
                { name = "Delegate_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 list:\n  'a #RPC_context.simple -> 'a ->\n  ?active:bool ->\n  ?inactive:bool ->\n  unit -> Signature.Public_key_hash.t list shell_tzresult Lwt.t\n\ntype info = {\n  balance: Tez.t ;\n  frozen_balance: Tez.t ;\n  frozen_balance_by_cycle: Delegate.frozen_balance Cycle.Map.t ;\n  staking_balance: Tez.t ;\n  delegated_contracts: Contract_hash.t list ;\n  delegated_balance: Tez.t ;\n  deactivated: bool ;\n  grace_period: Cycle.t ;\n}\n\nval info_encoding: info Data_encoding.t\n\nval info:\n  'a #RPC_context.simple -> 'a ->\n  Signature.Public_key_hash.t ->\n  info shell_tzresult Lwt.t\n\nval balance:\n  'a #RPC_context.simple -> 'a ->\n  Signature.Public_key_hash.t ->\n  Tez.t shell_tzresult Lwt.t\n\nval frozen_balance:\n  'a #RPC_context.simple -> 'a ->\n  Signature.Public_key_hash.t ->\n  Tez.t shell_tzresult Lwt.t\n\nval frozen_balance_by_cycle:\n  'a #RPC_context.simple -> 'a ->\n  Signature.Public_key_hash.t ->\n  Delegate.frozen_balance Cycle.Map.t shell_tzresult Lwt.t\n\nval staking_balance:\n  'a #RPC_context.simple -> 'a ->\n  Signature.Public_key_hash.t ->\n  Tez.t shell_tzresult Lwt.t\n\nval delegated_contracts:\n  'a #RPC_context.simple -> 'a ->\n  Signature.Public_key_hash.t ->\n  Contract_hash.t list shell_tzresult Lwt.t\n\nval delegated_balance:\n  'a #RPC_context.simple -> 'a ->\n  Signature.Public_key_hash.t ->\n  Tez.t shell_tzresult Lwt.t\n\nval deactivated:\n  'a #RPC_context.simple -> 'a ->\n  Signature.Public_key_hash.t ->\n  bool shell_tzresult Lwt.t\n\nval grace_period:\n  'a #RPC_context.simple -> 'a ->\n  Signature.Public_key_hash.t ->\n  Cycle.t shell_tzresult Lwt.t\n\n\nmodule Baking_rights : sig\n\n  type t = {\n    level: Raw_level.t ;\n    delegate: Signature.Public_key_hash.t ;\n    priority: int ;\n    timestamp: Timestamp.t option ;\n  }\n\n  (** Retrieves the list of delegates allowed to bake a block.\n\n      By default, it gives the best baking priorities for bakers\n      that have at least one opportunity below the 64th priority for\n      the next block.\n\n      Parameters [levels] and [cycles] can be used to specify the\n      (valid) level(s) in the past or future at which the baking rights\n      have to be returned. Parameter [delegates] can be used to\n      restrict the results to the given delegates. If parameter [all]\n      is [true], all the baking opportunities for each baker at each level\n      are returned, instead of just the first one.\n\n      Returns the list of baking slots. Also returns the minimal\n      timestamps that correspond to these slots. The timestamps are\n      omitted for levels in the past, and are only estimates for levels\n      later that the next block, based on the hypothesis that all\n      predecessor blocks were baked at the first priority. *)\n  val get:\n    'a #RPC_context.simple ->\n    ?levels: Raw_level.t list ->\n    ?cycles: Cycle.t list ->\n    ?delegates: Signature.public_key_hash list ->\n    ?all: bool ->\n    ?max_priority: int ->\n    'a -> t list shell_tzresult Lwt.t\n\nend\n\nmodule Endorsing_rights : sig\n\n  type t = {\n    level: Raw_level.t ;\n    delegate: Signature.Public_key_hash.t ;\n    slots: int list ;\n    estimated_time: Timestamp.t option ;\n  }\n\n  (** Retrieves the delegates allowed to endorse a block.\n\n      By default, it gives the endorsement slots for bakers that have\n      at least one in the next block.\n\n      Parameters [levels] and [cycles] can be used to specify the\n      (valid) level(s) in the past or future at which the endorsement\n      rights have to be returned. Parameter [delegates] can be used to\n      restrict the results to the given delegates.  Returns the list of\n      endorsement slots. Also returns the minimal timestamps that\n      correspond to these slots.\n\n      Timestamps are omitted for levels in the past, and are only\n      estimates for levels later that the next block, based on the\n      hypothesis that all predecessor blocks were baked at the first\n      priority. *)\n  val get:\n    'a #RPC_context.simple ->\n    ?levels: Raw_level.t list ->\n    ?cycles: Cycle.t list ->\n    ?delegates: Signature.public_key_hash list ->\n    'a -> t list shell_tzresult Lwt.t\n\nend\n\n(* temporary export for deprecated unit test *)\nval endorsement_rights:\n  Alpha_context.t ->\n  Level.t ->\n  public_key_hash list tzresult Lwt.t\n\nval baking_rights:\n  Alpha_context.t ->\n  int option ->\n  (Raw_level.t * (public_key_hash * Time.t option) list) 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\ntype info = {\n  balance: Tez.t ;\n  frozen_balance: Tez.t ;\n  frozen_balance_by_cycle: Delegate.frozen_balance Cycle.Map.t ;\n  staking_balance: Tez.t ;\n  delegated_contracts: Contract_hash.t list ;\n  delegated_balance: Tez.t ;\n  deactivated: bool ;\n  grace_period: Cycle.t ;\n}\n\nlet info_encoding =\n  let open Data_encoding in\n  conv\n    (fun { balance ; frozen_balance ; frozen_balance_by_cycle ;\n           staking_balance ; delegated_contracts ;  delegated_balance ;\n           deactivated ; grace_period } ->\n      (balance, frozen_balance, frozen_balance_by_cycle,\n       staking_balance, delegated_contracts, delegated_balance,\n       deactivated, grace_period))\n    (fun (balance, frozen_balance, frozen_balance_by_cycle,\n          staking_balance, delegated_contracts, delegated_balance,\n          deactivated, grace_period) ->\n      { balance ; frozen_balance ; frozen_balance_by_cycle ;\n        staking_balance ; delegated_contracts ;  delegated_balance ;\n        deactivated ; grace_period })\n    (obj8\n       (req \"balance\" Tez.encoding)\n       (req \"frozen_balance\" Tez.encoding)\n       (req \"frozen_balance_by_cycle\" Delegate.frozen_balance_by_cycle_encoding)\n       (req \"staking_balance\" Tez.encoding)\n       (req \"delegated_contracts\" (list Contract_hash.encoding))\n       (req \"delegated_balance\" Tez.encoding)\n       (req \"deactivated\" bool)\n       (req \"grace_period\" Cycle.encoding))\n\nmodule S = struct\n\n  let path = RPC_path.(open_root / \"context\" / \"delegates\")\n\n  open Data_encoding\n\n  type list_query = {\n    active: bool ;\n    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:\n        \"Lists all registered delegates.\"\n      ~query: list_query\n      ~output: (list Signature.Public_key_hash.encoding)\n      path\n\n  let path = RPC_path.(path /: Signature.Public_key_hash.rpc_arg)\n\n  let info =\n    RPC_service.get_service\n      ~description:\n        \"Everything about a delegate.\"\n      ~query: RPC_query.empty\n      ~output: info_encoding\n      path\n\n  let balance =\n    RPC_service.get_service\n      ~description:\n        \"Returns the full balance of a given delegate, \\\n         including the frozen balances.\"\n      ~query: RPC_query.empty\n      ~output: Tez.encoding\n      RPC_path.(path / \"balance\")\n\n  let frozen_balance =\n    RPC_service.get_service\n      ~description:\n        \"Returns the total frozen balances of a given delegate, \\\n         this includes the frozen deposits, rewards and fees.\"\n      ~query: RPC_query.empty\n      ~output: Tez.encoding\n      RPC_path.(path / \"frozen_balance\")\n\n  let frozen_balance_by_cycle =\n    RPC_service.get_service\n      ~description:\n        \"Returns the frozen balances of a given delegate, \\\n         indexed by the cycle by which it will be unfrozen\"\n      ~query: RPC_query.empty\n      ~output: Delegate.frozen_balance_by_cycle_encoding\n      RPC_path.(path / \"frozen_balance_by_cycle\")\n\n  let staking_balance =\n    RPC_service.get_service\n      ~description:\n        \"Returns the total amount of tokens delegated to a given delegate. \\\n         This includes the balances of all the contracts that delegate \\\n         to it, but also the balance of the delegate itself and its frozen \\\n         fees and deposits. The rewards do not count in the delegated balance \\\n         until they are unfrozen.\"\n      ~query: RPC_query.empty\n      ~output: Tez.encoding\n      RPC_path.(path / \"staking_balance\")\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_hash.encoding)\n      RPC_path.(path / \"delegated_contracts\")\n\n  let delegated_balance =\n    RPC_service.get_service\n      ~description:\n        \"Returns the balances of all the contracts that delegate to a \\\n         given delegate. This excludes the delegate's own balance and \\\n         its frozen balances.\"\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. \\\n         A deactivated delegate might be reactivated \\\n         (without loosing any rolls) by simply re-registering as a delegate. \\\n         For deactivated delegates, this value contains the cycle by which \\\n         they were deactivated.\"\n      ~query: RPC_query.empty\n      ~output: Cycle.encoding\n      RPC_path.(path / \"grace_period\")\n\nend\n\nlet register () =\n  let open Services_registration in\n  register0 S.list_delegate begin fun ctxt q () ->\n    Delegate.list ctxt >>= fun delegates ->\n    if q.active && q.inactive then\n      return delegates\n    else if q.active then\n      Lwt_list.filter_p\n        (fun pkh -> Delegate.deactivated ctxt pkh >|= not)\n        delegates >>= return\n    else if q.inactive then\n      Lwt_list.filter_p\n        (fun pkh -> Delegate.deactivated ctxt pkh)\n        delegates >>= return\n    else\n      return_nil\n  end ;\n  register1 S.info begin fun ctxt pkh () () ->\n    Delegate.full_balance ctxt pkh >>=? fun balance ->\n    Delegate.frozen_balance ctxt pkh >>=? fun frozen_balance ->\n    Delegate.frozen_balance_by_cycle ctxt pkh >>= fun frozen_balance_by_cycle ->\n    Delegate.staking_balance ctxt pkh >>=? fun staking_balance ->\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    return {\n      balance ; frozen_balance ; frozen_balance_by_cycle ;\n      staking_balance ; delegated_contracts ; delegated_balance ;\n      deactivated ; grace_period\n    }\n  end ;\n  register1 S.balance begin fun ctxt pkh () () ->\n    Delegate.full_balance ctxt pkh\n  end ;\n  register1 S.frozen_balance begin fun ctxt pkh () () ->\n    Delegate.frozen_balance ctxt pkh\n  end ;\n  register1 S.frozen_balance_by_cycle begin fun ctxt pkh () () ->\n    Delegate.frozen_balance_by_cycle ctxt pkh >>= return\n  end ;\n  register1 S.staking_balance begin fun ctxt pkh () () ->\n    Delegate.staking_balance ctxt pkh\n  end ;\n  register1 S.delegated_contracts begin fun ctxt pkh () () ->\n    Delegate.delegated_contracts ctxt pkh >>= return\n  end ;\n  register1 S.delegated_balance begin fun ctxt pkh () () ->\n    Delegate.delegated_balance ctxt pkh\n  end ;\n  register1 S.deactivated begin fun ctxt pkh () () ->\n    Delegate.deactivated ctxt pkh >>= return\n  end ;\n  register1 S.grace_period begin fun ctxt pkh () () ->\n    Delegate.grace_period ctxt pkh\n  end\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 =\n  RPC_context.make_call1 S.info ctxt block pkh () ()\n\nlet balance ctxt block pkh =\n  RPC_context.make_call1 S.balance ctxt block pkh () ()\n\nlet frozen_balance ctxt block pkh =\n  RPC_context.make_call1 S.frozen_balance ctxt block pkh () ()\n\nlet frozen_balance_by_cycle ctxt block pkh =\n  RPC_context.make_call1 S.frozen_balance_by_cycle ctxt block pkh () ()\n\nlet staking_balance ctxt block pkh =\n  RPC_context.make_call1 S.staking_balance 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 requested_levels ~default ctxt cycles levels =\n  match levels, cycles with\n  | [], [] ->\n      return [default]\n  | levels, cycles ->\n      (* explicitly fail when requested levels or cycle are in the past...\n         or too far in the future... *)\n      let levels =\n        List.sort_uniq\n          Level.compare\n          (List.concat (List.map (Level.from_raw ctxt) levels ::\n                        List.map (Level.levels_in_cycle ctxt) cycles)) in\n      map_p\n        (fun level ->\n           let current_level = Level.current ctxt in\n           if Level.(level <= current_level) then\n             return (level, None)\n           else\n             Baking.earlier_predecessor_timestamp\n               ctxt level >>=? fun timestamp ->\n             return (level, Some timestamp))\n        levels\n\nmodule Baking_rights = struct\n\n  type t = {\n    level: Raw_level.t ;\n    delegate: Signature.Public_key_hash.t ;\n    priority: int ;\n    timestamp: Timestamp.t option ;\n  }\n\n  let encoding =\n    let open Data_encoding in\n    conv\n      (fun { level ; delegate ; priority ; timestamp } ->\n         (level, delegate, priority, timestamp))\n      (fun (level, delegate, priority, timestamp) ->\n         { level ; delegate ; priority ; timestamp })\n      (obj4\n         (req \"level\" Raw_level.encoding)\n         (req \"delegate\" Signature.Public_key_hash.encoding)\n         (req \"priority\" uint16)\n         (opt \"estimated_time\" Timestamp.encoding))\n\n  module S = struct\n\n    open Data_encoding\n\n    let custom_root =\n      RPC_path.(open_root / \"helpers\" / \"baking_rights\")\n\n    type baking_rights_query = {\n      levels: Raw_level.t list ;\n      cycles: Cycle.t list ;\n      delegates: Signature.Public_key_hash.t list ;\n      max_priority: int option ;\n      all: bool ;\n    }\n\n    let baking_rights_query =\n      let open RPC_query in\n      query (fun levels cycles delegates max_priority all ->\n          { levels ; cycles ; delegates ; max_priority ; all })\n      |+ multi_field \"level\" Raw_level.rpc_arg (fun t -> t.levels)\n      |+ multi_field \"cycle\" Cycle.rpc_arg (fun t -> t.cycles)\n      |+ multi_field \"delegate\" Signature.Public_key_hash.rpc_arg (fun t -> t.delegates)\n      |+ opt_field \"max_priority\" RPC_arg.int (fun t -> t.max_priority)\n      |+ flag \"all\" (fun t -> t.all)\n      |> seal\n\n    let baking_rights =\n      RPC_service.get_service\n        ~description:\n          \"Retrieves the list of delegates allowed to bake a block.\\n\\\n           By default, it gives the best baking priorities for bakers \\\n           that have at least one opportunity below the 64th priority \\\n           for the next block.\\n\\\n           Parameters `level` and `cycle` can be used to specify the \\\n           (valid) level(s) in the past or future at which the baking \\\n           rights have to be returned. Parameter `delegate` can be \\\n           used to restrict the results to the given delegates. If \\\n           parameter `all` is set, all the baking opportunities for \\\n           each baker at each level are returned, instead of just the \\\n           first one.\\n\\\n           Returns the list of baking slots. Also returns the minimal \\\n           timestamps that correspond to these slots. The timestamps \\\n           are omitted for levels in the past, and are only estimates \\\n           for levels later that the next block, based on the \\\n           hypothesis that all predecessor blocks were baked at the \\\n           first priority.\"\n        ~query: baking_rights_query\n        ~output: (list encoding)\n        custom_root\n\n  end\n\n  let baking_priorities ctxt max_prio (level, pred_timestamp) =\n    Baking.baking_priorities ctxt level >>=? fun contract_list ->\n    let rec loop l acc priority =\n      if Compare.Int.(priority >= max_prio) then\n        return (List.rev acc)\n      else\n        let Misc.LCons (pk, next) = l in\n        let delegate = Signature.Public_key.hash pk in\n        begin\n          match pred_timestamp with\n          | None -> return_none\n          | Some pred_timestamp ->\n              Baking.minimal_time ctxt priority pred_timestamp >>=? fun t ->\n              return_some t\n        end>>=? fun timestamp ->\n        let acc =\n          { level = level.level ; delegate ; priority ; timestamp } :: acc in\n        next () >>=? fun l ->\n        loop l acc (priority+1) in\n    loop contract_list [] 0\n\n  let remove_duplicated_delegates rights =\n    List.rev @@ fst @@\n    List.fold_left\n      (fun (acc, previous) r ->\n         if Signature.Public_key_hash.Set.mem r.delegate previous then\n           (acc, previous)\n         else\n           (r :: acc,\n            Signature.Public_key_hash.Set.add r.delegate previous))\n      ([], Signature.Public_key_hash.Set.empty)\n      rights\n\n  let register () =\n    let open Services_registration in\n    register0 S.baking_rights begin fun ctxt q () ->\n      requested_levels\n        ~default:\n          (Level.succ ctxt (Level.current ctxt), Some (Timestamp.current ctxt))\n        ctxt q.cycles q.levels >>=? fun levels ->\n      let max_priority =\n        match q.max_priority with\n        | None -> 64\n        | Some max -> max in\n      map_p (baking_priorities ctxt max_priority) levels >>=? fun rights ->\n      let rights =\n        if q.all then\n          rights\n        else\n          List.map remove_duplicated_delegates rights in\n      let rights = List.concat rights in\n      match q.delegates with\n      | [] -> return rights\n      | _ :: _ as delegates ->\n          let is_requested p =\n            List.exists (Signature.Public_key_hash.equal p.delegate) delegates in\n          return (List.filter is_requested rights)\n    end\n\n  let get ctxt\n      ?(levels = []) ?(cycles = []) ?(delegates = []) ?(all = false)\n      ?max_priority block =\n    RPC_context.make_call0 S.baking_rights ctxt block\n      { levels ; cycles ; delegates ; max_priority ; all }\n      ()\n\nend\n\nmodule Endorsing_rights = struct\n\n  type t = {\n    level: Raw_level.t ;\n    delegate: Signature.Public_key_hash.t ;\n    slots: int list ;\n    estimated_time: Time.t option ;\n  }\n\n  let encoding =\n    let open Data_encoding in\n    conv\n      (fun { level ; delegate ; slots ; estimated_time } ->\n         (level, delegate, slots, estimated_time))\n      (fun (level, delegate, slots, estimated_time) ->\n         { level ; delegate ; slots ; estimated_time })\n      (obj4\n         (req \"level\" Raw_level.encoding)\n         (req \"delegate\" Signature.Public_key_hash.encoding)\n         (req \"slots\" (list uint16))\n         (opt \"estimated_time\" Timestamp.encoding))\n\n  module S = struct\n\n    open Data_encoding\n\n    let custom_root =\n      RPC_path.(open_root / \"helpers\" / \"endorsing_rights\")\n\n    type endorsing_rights_query = {\n      levels: Raw_level.t list ;\n      cycles: Cycle.t list ;\n      delegates: Signature.Public_key_hash.t list ;\n    }\n\n    let endorsing_rights_query =\n      let open RPC_query in\n      query (fun levels cycles delegates ->\n          { levels ; cycles ; delegates })\n      |+ multi_field \"level\" Raw_level.rpc_arg (fun t -> t.levels)\n      |+ multi_field \"cycle\" Cycle.rpc_arg (fun t -> t.cycles)\n      |+ multi_field \"delegate\" Signature.Public_key_hash.rpc_arg (fun t -> t.delegates)\n      |> seal\n\n    let endorsing_rights =\n      RPC_service.get_service\n        ~description:\n          \"Retrieves the delegates allowed to endorse a block.\\n\\\n           By default, it gives the endorsement slots for delegates that \\\n           have at least one in the next block.\\n\\\n           Parameters `level` and `cycle` can be used to specify the \\\n           (valid) level(s) in the past or future at which the \\\n           endorsement rights have to be returned. Parameter \\\n           `delegate` can be used to restrict the results to the given \\\n           delegates.\\n\\\n           Returns the list of endorsement slots. Also returns the \\\n           minimal timestamps that correspond to these slots. The \\\n           timestamps are omitted for levels in the past, and are only \\\n           estimates for levels later that the next block, based on \\\n           the hypothesis that all predecessor blocks were baked at \\\n           the first priority.\"\n        ~query: endorsing_rights_query\n        ~output: (list encoding)\n        custom_root\n\n  end\n\n  let endorsement_slots ctxt (level, estimated_time) =\n    Baking.endorsement_rights ctxt level >>=? fun rights ->\n    return\n      (Signature.Public_key_hash.Map.fold\n         (fun delegate (_, slots, _) acc -> {\n              level = level.level ; delegate ; slots ; estimated_time\n            } :: acc)\n         rights [])\n\n  let register () =\n    let open Services_registration in\n    register0 S.endorsing_rights begin fun ctxt q () ->\n      requested_levels\n        ~default: (Level.current ctxt, Some (Timestamp.current ctxt))\n        ctxt q.cycles q.levels >>=? fun levels ->\n      map_p (endorsement_slots ctxt) levels >>=? fun rights ->\n      let rights = List.concat rights in\n      match q.delegates with\n      | [] -> return rights\n      | _ :: _ as delegates ->\n          let is_requested p =\n            List.exists (Signature.Public_key_hash.equal p.delegate) delegates in\n          return (List.filter is_requested rights)\n    end\n\n  let get ctxt\n      ?(levels = []) ?(cycles = []) ?(delegates = []) block =\n    RPC_context.make_call0 S.endorsing_rights ctxt block\n      { levels ; cycles ; delegates }\n      ()\n\nend\n\nlet register () =\n  register () ;\n  Baking_rights.register () ;\n  Endorsing_rights.register ()\n\nlet endorsement_rights ctxt level =\n  Endorsing_rights.endorsement_slots ctxt (level, None) >>=? fun l ->\n  return (List.map (fun { Endorsing_rights.delegate ; _ } -> delegate) l)\n\nlet baking_rights ctxt max_priority =\n  let max = match max_priority with None -> 64 | Some m -> m in\n  let level = Level.current ctxt in\n  Baking_rights.baking_priorities ctxt max (level, None) >>=? fun l ->\n  return (level.level,\n          List.map\n            (fun { Baking_rights.delegate ; timestamp ; _ } ->\n               (delegate, timestamp)) l)\n" ;
                } ;
                { name = "Helpers_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\ntype error += Cannot_parse_operation (* `Branch *)\n\nval current_level:\n  'a #RPC_context.simple ->\n  ?offset:int32 -> 'a -> Level.t shell_tzresult Lwt.t\n\nval levels_in_current_cycle:\n  'a #RPC_context.simple ->\n  ?offset:int32 -> 'a -> (Raw_level.t * Raw_level.t) shell_tzresult Lwt.t\n\nmodule Scripts : sig\n\n  val run_code:\n    'a #RPC_context.simple ->\n    'a -> Script.expr -> (Script.expr * Script.expr * Tez.t) ->\n    (Script.expr *\n     packed_internal_operation list *\n     Contract.big_map_diff option) shell_tzresult Lwt.t\n\n  val trace_code:\n    'a #RPC_context.simple ->\n    'a -> Script.expr ->\n    (Script.expr * Script.expr * Tez.t) ->\n    (Script.expr *\n     packed_internal_operation list *\n     Script_interpreter.execution_trace *\n     Contract.big_map_diff option) shell_tzresult Lwt.t\n\n  val typecheck_code:\n    'a #RPC_context.simple ->\n    'a -> (Script.expr * Z.t option) ->\n    (Script_tc_errors.type_map * Gas.t) shell_tzresult Lwt.t\n\n  val typecheck_data:\n    'a #RPC_context.simple ->\n    'a -> Script.expr * Script.expr * Z.t option -> Gas.t shell_tzresult Lwt.t\n\n  val pack_data:\n    'a #RPC_context.simple ->\n    'a -> Script.expr * Script.expr * Z.t option -> (MBytes.t * Gas.t) shell_tzresult Lwt.t\n\n  val run_operation:\n    'a #RPC_context.simple ->\n    'a -> packed_operation ->\n    (packed_protocol_data * Apply_results.packed_operation_metadata) shell_tzresult Lwt.t\n\nend\n\nmodule Forge : sig\n\n  module Manager : sig\n\n    val operations:\n      'a #RPC_context.simple -> 'a ->\n      branch:Block_hash.t ->\n      source:Contract.t ->\n      ?sourcePubKey:public_key ->\n      counter:counter ->\n      fee:Tez.t ->\n      gas_limit:Z.t ->\n      storage_limit:Z.t ->\n      packed_manager_operation list -> MBytes.t shell_tzresult Lwt.t\n\n    val reveal:\n      'a #RPC_context.simple -> 'a ->\n      branch:Block_hash.t ->\n      source:Contract.t ->\n      sourcePubKey:public_key ->\n      counter:counter ->\n      fee:Tez.t ->\n      unit -> MBytes.t shell_tzresult Lwt.t\n\n    val transaction:\n      'a #RPC_context.simple -> 'a ->\n      branch:Block_hash.t ->\n      source:Contract.t ->\n      ?sourcePubKey:public_key ->\n      counter:counter ->\n      amount:Tez.t ->\n      destination:Contract.t ->\n      ?parameters:Script.expr ->\n      gas_limit:Z.t ->\n      storage_limit:Z.t ->\n      fee:Tez.t ->\n      unit -> MBytes.t shell_tzresult Lwt.t\n\n    val origination:\n      'a #RPC_context.simple -> 'a ->\n      branch:Block_hash.t ->\n      source:Contract.t ->\n      ?sourcePubKey:public_key ->\n      counter:counter ->\n      managerPubKey:public_key_hash ->\n      balance:Tez.t ->\n      ?spendable:bool ->\n      ?delegatable:bool ->\n      ?delegatePubKey: public_key_hash ->\n      ?script:Script.t ->\n      gas_limit:Z.t ->\n      storage_limit:Z.t ->\n      fee:Tez.t->\n      unit -> MBytes.t shell_tzresult Lwt.t\n\n    val delegation:\n      'a #RPC_context.simple -> 'a ->\n      branch:Block_hash.t ->\n      source:Contract.t ->\n      ?sourcePubKey:public_key ->\n      counter:counter ->\n      fee:Tez.t ->\n      public_key_hash option ->\n      MBytes.t shell_tzresult Lwt.t\n\n  end\n\n  val endorsement:\n    'a #RPC_context.simple -> 'a ->\n    branch:Block_hash.t ->\n    level:Raw_level.t ->\n    unit -> MBytes.t shell_tzresult Lwt.t\n\n  val proposals:\n    'a #RPC_context.simple -> 'a ->\n    branch:Block_hash.t ->\n    source:public_key_hash ->\n    period:Voting_period.t ->\n    proposals:Protocol_hash.t list ->\n    unit -> MBytes.t shell_tzresult Lwt.t\n\n  val ballot:\n    'a #RPC_context.simple -> 'a ->\n    branch:Block_hash.t ->\n    source:public_key_hash ->\n    period:Voting_period.t ->\n    proposal:Protocol_hash.t ->\n    ballot:Vote.ballot ->\n    unit -> MBytes.t shell_tzresult Lwt.t\n\n  val seed_nonce_revelation:\n    'a #RPC_context.simple -> 'a ->\n    branch:Block_hash.t ->\n    level:Raw_level.t ->\n    nonce:Nonce.t ->\n    unit -> MBytes.t shell_tzresult Lwt.t\n\n  val double_baking_evidence:\n    'a #RPC_context.simple -> 'a ->\n    branch:Block_hash.t ->\n    bh1: Block_header.t ->\n    bh2: Block_header.t ->\n    unit -> MBytes.t shell_tzresult Lwt.t\n\n  val double_endorsement_evidence:\n    'a #RPC_context.simple -> 'a ->\n    branch:Block_hash.t ->\n    op1: Kind.endorsement operation ->\n    op2: Kind.endorsement operation ->\n    unit -> MBytes.t shell_tzresult Lwt.t\n\n  val protocol_data:\n    'a #RPC_context.simple -> 'a ->\n    priority: int ->\n    ?seed_nonce_hash: Nonce_hash.t ->\n    ?proof_of_work_nonce: MBytes.t ->\n    unit -> MBytes.t shell_tzresult Lwt.t\n\nend\n\nmodule Parse : sig\n\n  val operations:\n    'a #RPC_context.simple -> 'a ->\n    ?check:bool -> Operation.raw list ->\n    Operation.packed list shell_tzresult Lwt.t\n\n  val block:\n    'a #RPC_context.simple -> 'a ->\n    Block_header.shell_header -> MBytes.t ->\n    Block_header.protocol_data shell_tzresult Lwt.t\n\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(*                                                                           *)\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 += Cannot_parse_operation (* `Branch *)\n\nlet () =\n  register_error_kind\n    `Branch\n    ~id:\"operation.cannot_parse\"\n    ~title:\"Cannot parse operation\"\n    ~description:\"The operation is ill-formed \\\n                  or for another protocol version\"\n    ~pp:(fun ppf () ->\n        Format.fprintf ppf \"The operation cannot be parsed\")\n    Data_encoding.unit\n    (function Cannot_parse_operation -> Some () | _ -> None)\n    (fun () -> Cannot_parse_operation)\n\nlet parse_operation (op: Operation.raw) =\n  match Data_encoding.Binary.of_bytes\n          Operation.protocol_data_encoding\n          op.proto with\n  | Some protocol_data ->\n      ok { shell = op.shell ; protocol_data }\n  | None -> error Cannot_parse_operation\n\nlet path = RPC_path.(open_root / \"helpers\")\n\nmodule Scripts = struct\n\n  module S = struct\n\n    open Data_encoding\n\n    let path = RPC_path.(path / \"scripts\")\n\n    let run_code_input_encoding =\n      (obj4\n         (req \"script\" Script.expr_encoding)\n         (req \"storage\" Script.expr_encoding)\n         (req \"input\" Script.expr_encoding)\n         (req \"amount\" Tez.encoding))\n\n    let run_code =\n      RPC_service.post_service\n        ~description: \"Run a piece of code in the current context\"\n        ~query: RPC_query.empty\n        ~input: run_code_input_encoding\n        ~output: (obj3\n                    (req \"storage\" Script.expr_encoding)\n                    (req \"operations\" (list Operation.internal_operation_encoding))\n                    (opt \"big_map_diff\" (list (tup2\n                                                 Script_expr_hash.encoding\n                                                 (option Script.expr_encoding)))))\n        RPC_path.(path / \"run_code\")\n\n    let trace_code =\n      RPC_service.post_service\n        ~description: \"Run a piece of code in the current context, \\\n                       keeping a trace\"\n        ~query: RPC_query.empty\n        ~input: run_code_input_encoding\n        ~output: (obj4\n                    (req \"storage\" Script.expr_encoding)\n                    (req \"operations\" (list Operation.internal_operation_encoding))\n                    (req \"trace\"\n                       (list @@ obj3\n                          (req \"location\" Script.location_encoding)\n                          (req \"gas\" Gas.encoding)\n                          (req \"stack\"\n                             (list\n                                (obj2\n                                   (req \"item\" (Script.expr_encoding))\n                                   (opt \"annot\" string))))))\n                    (opt \"big_map_diff\" (list (tup2\n                                                 Script_expr_hash.encoding\n                                                 (option Script.expr_encoding)))))\n        RPC_path.(path / \"trace_code\")\n\n    let typecheck_code =\n      RPC_service.post_service\n        ~description: \"Typecheck a piece of code in the current context\"\n        ~query: RPC_query.empty\n        ~input: (obj2\n                   (req \"program\" Script.expr_encoding)\n                   (opt \"gas\" z))\n        ~output: (obj2\n                    (req \"type_map\" Script_tc_errors_registration.type_map_enc)\n                    (req \"gas\" Gas.encoding))\n        RPC_path.(path / \"typecheck_code\")\n\n    let typecheck_data =\n      RPC_service.post_service\n        ~description: \"Check that some data expression is well formed \\\n                       and of a given type in the current context\"\n        ~query: RPC_query.empty\n        ~input: (obj3\n                   (req \"data\" Script.expr_encoding)\n                   (req \"type\" Script.expr_encoding)\n                   (opt \"gas\" z))\n        ~output: (obj1 (req \"gas\" Gas.encoding))\n        RPC_path.(path / \"typecheck_data\")\n\n    let pack_data =\n      RPC_service.post_service\n        ~description: \"Computes the serialized version of some data expression \\\n                       using the same algorithm as script instruction PACK\"\n\n        ~input: (obj3\n                   (req \"data\" Script.expr_encoding)\n                   (req \"type\" Script.expr_encoding)\n                   (opt \"gas\" z))\n        ~output: (obj2\n                    (req \"packed\" bytes)\n                    (req \"gas\" Gas.encoding))\n        ~query: RPC_query.empty\n        RPC_path.(path / \"pack_data\")\n\n    let run_operation =\n      RPC_service.post_service\n        ~description:\n          \"Run an operation without signature checks\"\n        ~query: RPC_query.empty\n        ~input: Operation.encoding\n        ~output: Apply_results.operation_data_and_metadata_encoding\n        RPC_path.(path / \"run_operation\")\n\n  end\n\n  let register () =\n    let open Services_registration in\n    let originate_dummy_contract ctxt script =\n      let ctxt = Contract.init_origination_nonce ctxt Operation_hash.zero in\n      Contract.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, dummy_contract) ->\n      let balance = match Tez.of_mutez 4_000_000_000_000L with\n        | Some balance -> balance\n        | None -> assert false in\n      Contract.originate ctxt dummy_contract\n        ~balance\n        ~manager: Signature.Public_key_hash.zero\n        ~delegate: None\n        ~spendable: false\n        ~delegatable: false\n        ~script: (script, None) >>=? fun ctxt ->\n      return (ctxt, dummy_contract) in\n    register0 S.run_code begin fun ctxt ()\n      (code, storage, parameter, amount) ->\n      let storage = Script.lazy_expr storage in\n      let code = Script.lazy_expr code in\n      originate_dummy_contract ctxt { storage ; code } >>=? fun (ctxt, dummy_contract) ->\n      let ctxt = Gas.set_limit ctxt (Constants.hard_gas_limit_per_operation ctxt) in\n      Script_interpreter.execute\n        ctxt Readable\n        ~source:dummy_contract\n        ~payer:dummy_contract\n        ~self:(dummy_contract, { storage ; code })\n        ~amount ~parameter\n      >>=? fun { Script_interpreter.storage ; operations ; big_map_diff ; _ } ->\n      return (storage, operations, big_map_diff)\n    end ;\n    register0 S.trace_code begin fun ctxt ()\n      (code, storage, parameter, amount) ->\n      let storage = Script.lazy_expr storage in\n      let code = Script.lazy_expr code in\n      originate_dummy_contract ctxt { storage ; code } >>=? fun (ctxt, dummy_contract) ->\n      let ctxt = Gas.set_limit ctxt (Constants.hard_gas_limit_per_operation ctxt) in\n      Script_interpreter.trace\n        ctxt Readable\n        ~source:dummy_contract\n        ~payer:dummy_contract\n        ~self:(dummy_contract, { storage ; code })\n        ~amount ~parameter\n      >>=? fun ({ Script_interpreter.storage ; operations ; big_map_diff ; _ }, trace) ->\n      return (storage, operations, trace, big_map_diff)\n    end ;\n    register0 S.typecheck_code begin fun ctxt () (expr, maybe_gas) ->\n      let ctxt = match maybe_gas with\n        | None -> Gas.set_unlimited ctxt\n        | Some gas -> Gas.set_limit ctxt gas in\n      Script_ir_translator.typecheck_code ctxt expr >>=? fun (res, ctxt) ->\n      return (res, Gas.level ctxt)\n    end ;\n    register0 S.typecheck_data begin fun ctxt () (data, ty, maybe_gas) ->\n      let ctxt = match maybe_gas with\n        | None -> Gas.set_unlimited ctxt\n        | Some gas -> Gas.set_limit ctxt gas in\n      Script_ir_translator.typecheck_data ctxt (data, ty) >>=? fun ctxt ->\n      return (Gas.level ctxt)\n    end ;\n    register0 S.pack_data begin fun ctxt () (expr, typ, maybe_gas) ->\n      let open Script_ir_translator in\n      let ctxt = match maybe_gas with\n        | None -> Gas.set_unlimited ctxt\n        | Some gas -> Gas.set_limit ctxt gas in\n      Lwt.return (parse_ty ctxt ~allow_big_map:false ~allow_operation:false (Micheline.root typ)) >>=? fun (Ex_ty typ, ctxt) ->\n      parse_data ctxt typ (Micheline.root expr) >>=? fun (data, ctxt) ->\n      Script_ir_translator.pack_data ctxt typ data >>=? fun (bytes, ctxt) ->\n      return (bytes, Gas.level ctxt)\n    end ;\n    register0 S.run_operation begin fun ctxt ()\n      { shell ; protocol_data = Operation_data protocol_data } ->\n      (* this code is a duplicate of Apply without signature check *)\n      let partial_precheck_manager_contents\n          (type kind) ctxt (op : kind Kind.manager contents)\n        : context tzresult Lwt.t =\n        let Manager_operation { source ; fee ; counter ; operation ; gas_limit ; storage_limit } = op in\n        Lwt.return (Gas.check_limit ctxt gas_limit) >>=? fun () ->\n        let ctxt = Gas.set_limit ctxt gas_limit in\n        Lwt.return (Fees.check_storage_limit ctxt storage_limit) >>=? fun () ->\n        Contract.must_be_allocated ctxt source >>=? fun () ->\n        Contract.check_counter_increment ctxt source counter >>=? fun () ->\n        begin\n          match operation with\n          | Reveal pk ->\n              Contract.reveal_manager_key ctxt source pk\n          | Transaction { parameters = Some arg ; _ } ->\n              (* Here the data comes already deserialized, so we need to fake the deserialization to mimic apply *)\n              let arg_bytes = Data_encoding.Binary.to_bytes_exn Script.lazy_expr_encoding arg in\n              let arg = match Data_encoding.Binary.of_bytes Script.lazy_expr_encoding arg_bytes with\n                | Some arg -> arg\n                | None -> assert false in\n              (* Fail quickly if not enough gas for minimal deserialization cost *)\n              Lwt.return @@ record_trace Apply.Gas_quota_exceeded_init_deserialize @@\n              Gas.check_enough ctxt (Script.minimal_deserialize_cost arg) >>=? fun () ->\n              (* Fail if not enough gas for complete deserialization cost *)\n              trace Apply.Gas_quota_exceeded_init_deserialize @@\n              Script.force_decode ctxt arg >>|? fun (_arg, ctxt) -> ctxt\n          | Origination { script = Some script ; _ } ->\n              (* Here the data comes already deserialized, so we need to fake the deserialization to mimic apply *)\n              let script_bytes = Data_encoding.Binary.to_bytes_exn Script.encoding script in\n              let script = match Data_encoding.Binary.of_bytes Script.encoding script_bytes with\n                | Some script -> script\n                | None -> assert false in\n              (* Fail quickly if not enough gas for minimal deserialization cost *)\n              Lwt.return @@ record_trace Apply.Gas_quota_exceeded_init_deserialize @@\n              (Gas.consume ctxt (Script.minimal_deserialize_cost script.code) >>? fun ctxt ->\n               Gas.check_enough ctxt (Script.minimal_deserialize_cost script.storage)) >>=? fun () ->\n              (* Fail if not enough gas for complete deserialization cost *)\n              trace Apply.Gas_quota_exceeded_init_deserialize @@\n              Script.force_decode ctxt script.code >>=? fun (_code, ctxt) ->\n              trace Apply.Gas_quota_exceeded_init_deserialize @@\n              Script.force_decode ctxt script.storage >>|? fun (_storage, ctxt) -> ctxt\n          | _ -> return ctxt\n        end >>=? fun ctxt ->\n        Contract.get_manager_key ctxt source >>=? fun _public_key ->\n        (* signature check unplugged from here *)\n        Contract.increment_counter ctxt source >>=? fun ctxt ->\n        Contract.spend ctxt source fee >>=? fun ctxt ->\n        return ctxt in\n      let rec partial_precheck_manager_contents_list\n        : type kind.\n          Alpha_context.t -> kind Kind.manager contents_list ->\n          context tzresult Lwt.t =\n        fun ctxt contents_list ->\n          match contents_list with\n          | Single (Manager_operation _ as op) ->\n              partial_precheck_manager_contents ctxt op\n          | Cons (Manager_operation _ as op, rest) ->\n              partial_precheck_manager_contents ctxt op >>=? fun ctxt ->\n              partial_precheck_manager_contents_list ctxt rest in\n      let return contents =\n        return (Operation_data protocol_data,\n                Apply_results.Operation_metadata { contents }) in\n      let operation : _ operation = { shell ; protocol_data } in\n      let hash = Operation.hash { shell ; protocol_data } in\n      let ctxt = Contract.init_origination_nonce ctxt hash in\n      let baker = Signature.Public_key_hash.zero in\n      match protocol_data.contents with\n      | Single (Manager_operation _) as op ->\n          partial_precheck_manager_contents_list ctxt op >>=? fun ctxt ->\n          Apply.apply_manager_contents_list ctxt Optimized baker op >>= fun (_ctxt, result) ->\n          return result\n      | Cons (Manager_operation _, _) as op ->\n          partial_precheck_manager_contents_list ctxt op >>=? fun ctxt ->\n          Apply.apply_manager_contents_list ctxt Optimized baker op >>= fun (_ctxt, result) ->\n          return result\n      | _ ->\n          Apply.apply_contents_list\n            ctxt Chain_id.zero Optimized shell.branch baker operation\n            operation.protocol_data.contents >>=? fun (_ctxt, result) ->\n          return result\n\n    end\n\n  let run_code ctxt block code (storage, input, amount) =\n    RPC_context.make_call0 S.run_code ctxt\n      block () (code, storage, input, amount)\n\n  let trace_code ctxt block code (storage, input, amount) =\n    RPC_context.make_call0 S.trace_code ctxt\n      block () (code, storage, input, amount)\n\n  let typecheck_code ctxt block =\n    RPC_context.make_call0 S.typecheck_code ctxt block ()\n\n  let typecheck_data ctxt block =\n    RPC_context.make_call0 S.typecheck_data ctxt block ()\n\n  let pack_data ctxt block =\n    RPC_context.make_call0 S.pack_data ctxt block ()\n\n  let run_operation ctxt block =\n    RPC_context.make_call0 S.run_operation ctxt block ()\n\nend\n\nmodule Forge = struct\n\n  module S = struct\n\n    open Data_encoding\n\n    let path = RPC_path.(path / \"forge\")\n\n    let operations =\n      RPC_service.post_service\n        ~description:\"Forge an operation\"\n        ~query: RPC_query.empty\n        ~input: Operation.unsigned_encoding\n        ~output: bytes\n        RPC_path.(path / \"operations\" )\n\n    let empty_proof_of_work_nonce =\n      MBytes.of_string\n        (String.make Constants_repr.proof_of_work_nonce_size  '\\000')\n\n    let protocol_data =\n      RPC_service.post_service\n        ~description: \"Forge the protocol-specific part of a block header\"\n        ~query: RPC_query.empty\n        ~input:\n          (obj3\n             (req \"priority\" uint16)\n             (opt \"nonce_hash\" Nonce_hash.encoding)\n             (dft \"proof_of_work_nonce\"\n                (Fixed.bytes\n                   Alpha_context.Constants.proof_of_work_nonce_size)\n                empty_proof_of_work_nonce))\n        ~output: (obj1 (req \"protocol_data\" bytes))\n        RPC_path.(path / \"protocol_data\")\n\n  end\n\n  let register () =\n    let open Services_registration in\n    register0_noctxt S.operations begin fun () (shell, proto) ->\n      return (Data_encoding.Binary.to_bytes_exn\n                Operation.unsigned_encoding (shell, proto))\n    end ;\n    register0_noctxt S.protocol_data begin fun ()\n      (priority, seed_nonce_hash, proof_of_work_nonce) ->\n      return (Data_encoding.Binary.to_bytes_exn\n                Block_header.contents_encoding\n                { priority ; seed_nonce_hash ; proof_of_work_nonce })\n    end\n\n  module Manager = struct\n\n    let operations ctxt\n        block ~branch ~source ?sourcePubKey ~counter ~fee\n        ~gas_limit ~storage_limit operations =\n      Contract_services.manager_key ctxt block source >>= function\n      | Error _ as e -> Lwt.return e\n      | Ok (_, revealed) ->\n          let ops =\n            List.map\n              (fun (Manager operation) ->\n                 Contents\n                   (Manager_operation { source ;\n                                        counter ; operation ; fee ;\n                                        gas_limit ; storage_limit }))\n              operations in\n          let ops =\n            match sourcePubKey, revealed with\n            | None, _ | _, Some _ ->  ops\n            | Some pk, None ->\n                let operation = Reveal pk in\n                Contents\n                  (Manager_operation { source ;\n                                       counter ; operation ; fee ;\n                                       gas_limit ; storage_limit }) :: ops in\n          RPC_context.make_call0 S.operations ctxt block\n            () ({ branch }, Operation.of_list ops)\n\n    let reveal ctxt\n        block ~branch ~source ~sourcePubKey ~counter ~fee () =\n      operations ctxt block ~branch ~source ~sourcePubKey ~counter ~fee\n        ~gas_limit:Z.zero ~storage_limit:Z.zero []\n\n    let transaction ctxt\n        block ~branch ~source ?sourcePubKey ~counter\n        ~amount ~destination ?parameters\n        ~gas_limit ~storage_limit ~fee ()=\n      let parameters = Option.map ~f:Script.lazy_expr parameters in\n      operations ctxt block ~branch ~source ?sourcePubKey ~counter\n        ~fee ~gas_limit ~storage_limit\n        [Manager (Transaction { amount ; parameters ; destination })]\n\n    let origination ctxt\n        block ~branch\n        ~source ?sourcePubKey ~counter\n        ~managerPubKey ~balance\n        ?(spendable = true)\n        ?(delegatable = true)\n        ?delegatePubKey ?script\n        ~gas_limit ~storage_limit ~fee () =\n      operations ctxt block ~branch ~source ?sourcePubKey ~counter\n        ~fee ~gas_limit ~storage_limit\n        [Manager (Origination { manager = managerPubKey ;\n                                delegate = delegatePubKey ;\n                                script ;\n                                spendable ;\n                                delegatable ;\n                                credit = balance ;\n                                preorigination = None })]\n\n    let delegation ctxt\n        block ~branch ~source ?sourcePubKey ~counter ~fee delegate =\n      operations ctxt block ~branch ~source ?sourcePubKey ~counter ~fee\n        ~gas_limit:Z.zero ~storage_limit:Z.zero\n        [Manager (Delegation delegate)]\n\n  end\n\n  let operation ctxt\n      block ~branch operation =\n    RPC_context.make_call0 S.operations ctxt block\n      () ({ branch }, Contents_list (Single operation))\n\n  let endorsement ctxt\n      b ~branch ~level () =\n    operation ctxt b ~branch\n      (Endorsement { level })\n\n  let proposals ctxt\n      b ~branch ~source ~period ~proposals () =\n    operation ctxt b ~branch\n      (Proposals { source ; period ; proposals })\n\n  let ballot ctxt\n      b ~branch ~source ~period ~proposal ~ballot () =\n    operation ctxt b ~branch\n      (Ballot { source ; period ; proposal ; ballot })\n\n  let seed_nonce_revelation ctxt\n      block ~branch ~level ~nonce () =\n    operation ctxt block ~branch (Seed_nonce_revelation { level ; nonce })\n\n  let double_baking_evidence ctxt\n      block ~branch ~bh1 ~bh2 () =\n    operation ctxt block ~branch (Double_baking_evidence { bh1 ; bh2 })\n\n  let double_endorsement_evidence ctxt\n      block ~branch ~op1 ~op2 () =\n    operation ctxt block ~branch (Double_endorsement_evidence { op1 ; op2 })\n\n  let empty_proof_of_work_nonce =\n    MBytes.of_string\n      (String.make Constants_repr.proof_of_work_nonce_size  '\\000')\n\n  let protocol_data ctxt\n      block\n      ~priority ?seed_nonce_hash\n      ?(proof_of_work_nonce = empty_proof_of_work_nonce)\n      () =\n    RPC_context.make_call0 S.protocol_data\n      ctxt block () (priority, seed_nonce_hash, proof_of_work_nonce)\n\nend\n\nmodule Parse = struct\n\n  module S = struct\n\n    open Data_encoding\n\n    let path = RPC_path.(path / \"parse\")\n\n    let operations =\n      RPC_service.post_service\n        ~description:\"Parse operations\"\n        ~query: RPC_query.empty\n        ~input:\n          (obj2\n             (req \"operations\" (list (dynamic_size Operation.raw_encoding)))\n             (opt \"check_signature\" bool))\n        ~output: (list (dynamic_size Operation.encoding))\n        RPC_path.(path / \"operations\" )\n\n    let block =\n      RPC_service.post_service\n        ~description:\"Parse a block\"\n        ~query: RPC_query.empty\n        ~input: Block_header.raw_encoding\n        ~output: Block_header.protocol_data_encoding\n        RPC_path.(path / \"block\" )\n\n  end\n\n  let parse_protocol_data protocol_data =\n    match\n      Data_encoding.Binary.of_bytes\n        Block_header.protocol_data_encoding\n        protocol_data\n    with\n    | None -> failwith \"Cant_parse_protocol_data\"\n    | Some protocol_data -> return protocol_data\n\n  let register () =\n    let open Services_registration in\n    register0 S.operations begin fun _ctxt () (operations, check) ->\n      map_s begin fun raw ->\n        Lwt.return (parse_operation raw) >>=? fun op ->\n        begin match check with\n          | Some true ->\n              return_unit (* FIXME *)\n          (* I.check_signature ctxt *)\n          (* op.protocol_data.signature op.shell op.protocol_data.contents *)\n          | Some false | None -> return_unit\n        end >>|? fun () -> op\n      end operations\n    end ;\n    register0_noctxt S.block begin fun () raw_block ->\n      parse_protocol_data raw_block.protocol_data\n    end\n\n  let operations ctxt block ?check operations =\n    RPC_context.make_call0\n      S.operations ctxt block () (operations, check)\n  let block ctxt block shell protocol_data =\n    RPC_context.make_call0\n      S.block ctxt block () ({ shell ; protocol_data } : Block_header.raw)\n\nend\n\nmodule S = struct\n\n  open Data_encoding\n\n  type level_query = {\n    offset: int32 ;\n  }\n  let level_query : level_query RPC_query.t =\n    let open RPC_query in\n    query (fun offset -> { offset })\n    |+ field \"offset\" RPC_arg.int32 0l (fun t -> t.offset)\n    |> seal\n\n  let current_level =\n    RPC_service.get_service\n      ~description:\n        \"Returns the level of the interrogated block, or the one of a \\\n         block located `offset` blocks after in the chain (or before \\\n         when negative). For instance, the next block if `offset` is 1.\"\n      ~query: level_query\n      ~output: Level.encoding\n      RPC_path.(path / \"current_level\")\n\n  let levels_in_current_cycle =\n    RPC_service.get_service\n      ~description: \"Levels of a cycle\"\n      ~query: level_query\n      ~output: (obj2\n                  (req \"first\" Raw_level.encoding)\n                  (req \"last\" Raw_level.encoding))\n      RPC_path.(path / \"levels_in_current_cycle\")\n\nend\n\nlet register () =\n  Scripts.register () ;\n  Forge.register () ;\n  Parse.register () ;\n  let open Services_registration in\n  register0 S.current_level begin fun ctxt q () ->\n    let level = Level.current ctxt in\n    return (Level.from_raw ctxt ~offset:q.offset level.level)\n  end ;\n  register0 S.levels_in_current_cycle begin fun ctxt q () ->\n    let levels = Level.levels_in_current_cycle ctxt ~offset:q.offset () in\n    match levels with\n    | [] -> raise Not_found\n    | _ ->\n        let first = List.hd (List.rev levels) in\n        let last = List.hd levels in\n        return (first.level, last.level)\n  end\n\nlet current_level ctxt ?(offset = 0l) block =\n  RPC_context.make_call0 S.current_level ctxt block { offset } ()\n\nlet levels_in_current_cycle ctxt ?(offset = 0l) block =\n  RPC_context.make_call0 S.levels_in_current_cycle ctxt block { offset } ()\n" ;
                } ;
                { name = "Alpha_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\nmodule Seed : sig\n\n  val get: 'a #RPC_context.simple -> 'a -> Seed.seed shell_tzresult Lwt.t\n\nend\n\nmodule Nonce : sig\n\n  type info =\n    | Revealed of Nonce.t\n    | Missing of Nonce_hash.t\n    | Forgotten\n\n  val get:\n    'a #RPC_context.simple ->\n    'a -> Raw_level.t -> info shell_tzresult Lwt.t\n\nend\n\nmodule Contract = Contract_services\nmodule Constants = Constants_services\nmodule Delegate = Delegate_services\nmodule Helpers = Helpers_services\nmodule Forge = Helpers_services.Forge\nmodule Parse = Helpers_services.Parse\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 = RPC_path.open_root\n\nmodule Seed = struct\n\n  module S = struct\n\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\n  end\n\n  let () =\n    let open Services_registration in\n    register0 S.seed begin fun ctxt () () ->\n      let l = Level.current ctxt in\n      Seed.for_cycle ctxt l.cycle\n    end\n\n\n  let get ctxt block =\n    RPC_context.make_call0 S.seed ctxt block () ()\n\nend\n\nmodule Nonce = struct\n\n  type info =\n    | Revealed of Nonce.t\n    | Missing of Nonce_hash.t\n    | Forgotten\n\n  let info_encoding =\n    let open Data_encoding in\n    union [\n      case (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 (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 (Tag 2)\n        ~title:\"Forgotten\"\n        empty\n        (function Forgotten -> Some () | _ -> None)\n        (fun () -> Forgotten) ;\n    ]\n\n  module S = struct\n\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\n  end\n\n  let register () =\n    let open Services_registration in\n    register1 S.get begin fun ctxt raw_level () () ->\n      let level = Level.from_raw ctxt raw_level in\n      Nonce.get ctxt level >>= function\n      | Ok (Revealed nonce) -> return (Revealed nonce)\n      | Ok (Unrevealed { nonce_hash ; _ }) ->\n          return (Missing nonce_hash)\n      | Error _ -> return Forgotten\n    end\n\n  let get ctxt block level =\n    RPC_context.make_call1 S.get ctxt block level () ()\n\nend\n\nmodule Contract = Contract_services\nmodule Constants = Constants_services\nmodule Delegate = Delegate_services\nmodule Helpers = Helpers_services\nmodule Forge = Helpers_services.Forge\nmodule Parse = Helpers_services.Parse\n\nlet register () =\n  Contract.register () ;\n  Constants.register () ;\n  Delegate.register () ;\n  Helpers.register () ;\n  Nonce.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\ntype validation_mode =\n  | Application of {\n      block_header : Alpha_context.Block_header.t ;\n      baker : Alpha_context.public_key_hash ;\n    }\n  | Partial_application of {\n      block_header : Alpha_context.Block_header.t ;\n      baker : Alpha_context.public_key_hash ;\n    }\n  | Partial_construction of {\n      predecessor : Block_hash.t ;\n    }\n  | Full_construction of {\n      predecessor : Block_hash.t ;\n      protocol_data : Alpha_context.Block_header.contents ;\n      baker : Alpha_context.public_key_hash ;\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  }\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\ninclude 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\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 = Alpha_context.Block_header.protocol_data_encoding\n\ntype block_header_metadata = Apply_results.block_metadata\nlet block_header_metadata_encoding = Apply_results.block_metadata_encoding\n\ntype operation_data = Alpha_context.packed_protocol_data =\n  | Operation_data : 'kind Alpha_context.Operation.protocol_data -> operation_data\nlet operation_data_encoding = Alpha_context.Operation.protocol_data_encoding\n\ntype operation_receipt = Apply_results.packed_operation_metadata =\n  | Operation_metadata : 'kind Apply_results.operation_metadata -> operation_receipt\n  | No_operation_metadata: operation_receipt\nlet operation_receipt_encoding =\n  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\n\nlet acceptable_passes = Alpha_context.Operation.acceptable_passes\n\nlet max_block_length =\n  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 max_anonymous_operations =\n    Alpha_context.Constants.max_revelations_per_block +\n    (* allow 100 wallet activations or denunciations per block *) 100 in\n  Updater.[ { max_size = 32 * 1024 ; max_op = Some 32 } ; (* 32 endorsements *)\n            { max_size = 32 * 1024 ; max_op = None } ; (* 32k of voting operations *)\n            { max_size = max_anonymous_operations * 1024 ;\n              max_op = Some max_anonymous_operations } ;\n            { max_size = 512 * 1024 ; max_op = None } ] (* 512kB *)\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      baker : Alpha_context.public_key_hash ;\n    }\n  | Partial_application of {\n      block_header : Alpha_context.Block_header.t ;\n      baker : Alpha_context.public_key_hash ;\n    }\n  | Partial_construction of {\n      predecessor : Block_hash.t ;\n    }\n  | Full_construction of {\n      predecessor : Block_hash.t ;\n      protocol_data : Alpha_context.Block_header.contents ;\n      baker : Alpha_context.public_key_hash ;\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  }\n\nlet current_context { ctxt ; _ } =\n  return (Alpha_context.finalize ctxt).context\n\nlet begin_partial_application\n    ~chain_id\n    ~ancestor_context:ctxt\n    ~predecessor_timestamp\n    ~predecessor_fitness\n    (block_header : Alpha_context.Block_header.t) =\n  let level = block_header.shell.level in\n  let fitness = predecessor_fitness in\n  let timestamp = block_header.shell.timestamp in\n  Alpha_context.prepare ~level ~timestamp ~fitness ctxt >>=? fun ctxt ->\n  Apply.begin_application\n    ctxt chain_id block_header predecessor_timestamp >>=? fun (ctxt, baker) ->\n  let mode =\n    Partial_application\n      { block_header ; baker = Signature.Public_key.hash baker } in\n  return { mode ; chain_id ; ctxt ; op_count = 0 }\n\nlet begin_application\n    ~chain_id\n    ~predecessor_context:ctxt\n    ~predecessor_timestamp\n    ~predecessor_fitness\n    (block_header : Alpha_context.Block_header.t) =\n  let level = block_header.shell.level in\n  let fitness = predecessor_fitness in\n  let timestamp = block_header.shell.timestamp in\n  Alpha_context.prepare ~level ~timestamp ~fitness ctxt >>=? fun ctxt ->\n  Apply.begin_application\n    ctxt chain_id block_header predecessor_timestamp >>=? fun (ctxt, baker) ->\n  let mode = Application { block_header ; baker = Signature.Public_key.hash baker } in\n  return { mode ; chain_id ; ctxt ; op_count = 0 }\n\nlet begin_construction\n    ~chain_id\n    ~predecessor_context:ctxt\n    ~predecessor_timestamp:pred_timestamp\n    ~predecessor_level:pred_level\n    ~predecessor_fitness:pred_fitness\n    ~predecessor\n    ~timestamp\n    ?(protocol_data : block_header_data option)\n    () =\n  let level = Int32.succ pred_level in\n  let fitness = pred_fitness in\n  Alpha_context.prepare ~timestamp ~level ~fitness ctxt >>=? fun ctxt ->\n  begin\n    match protocol_data with\n    | None ->\n        Apply.begin_partial_construction ctxt >>=? fun ctxt ->\n        let mode = Partial_construction { predecessor } in\n        return (mode, ctxt)\n    | Some proto_header ->\n        Apply.begin_full_construction\n          ctxt pred_timestamp\n          proto_header.contents >>=? fun (ctxt, protocol_data, baker) ->\n        let mode =\n          let baker = Signature.Public_key.hash baker in\n          Full_construction { predecessor ; baker ; protocol_data } in\n        return (mode, ctxt)\n  end >>=? fun (mode, ctxt) ->\n  return { mode ; chain_id ; ctxt ; op_count = 0 }\n\nlet apply_operation\n    ({ mode ; chain_id ; ctxt ; op_count ; _ } as data)\n    (operation : Alpha_context.packed_operation) =\n  match mode with\n  | Partial_application _ when\n      not (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  | _ ->\n      let { shell ; protocol_data = Operation_data protocol_data } = operation in\n      let operation : _ Alpha_context.operation = { shell ; protocol_data } in\n      let predecessor, baker =\n        match mode with\n        | Partial_application\n            { block_header = { shell = { predecessor ; _ } ; _ } ; baker }\n        | Application\n            { block_header = { shell = { predecessor ; _ } ; _ } ; baker }\n        | Full_construction { predecessor ; baker ; _ }\n          -> predecessor, baker\n        | Partial_construction { predecessor }\n          -> predecessor, Signature.Public_key_hash.zero\n      in\n      Apply.apply_operation ctxt chain_id Optimized predecessor baker\n        (Alpha_context.Operation.hash operation)\n        operation >>=? fun (ctxt, result) ->\n      let op_count = op_count + 1 in\n      return ({ data with ctxt ; op_count }, Operation_metadata result)\n\nlet finalize_block { mode ; ctxt ; op_count } =\n  match mode with\n  | Partial_construction _ ->\n      let level = Alpha_context.Level.current ctxt in\n      Alpha_context.Vote.get_current_period_kind ctxt >>=? fun voting_period_kind ->\n      let baker = Signature.Public_key_hash.zero in\n      Signature.Public_key_hash.Map.fold\n        (fun delegate deposit ctxt ->\n           ctxt >>=? fun ctxt ->\n           Alpha_context.Delegate.freeze_deposit ctxt delegate deposit)\n        (Alpha_context.get_deposits ctxt)\n        (return ctxt) >>=? fun ctxt ->\n      let ctxt = Alpha_context.finalize ctxt in\n      return (ctxt, Apply_results.{ baker ;\n                                    level ;\n                                    voting_period_kind ;\n                                    nonce_hash = None ;\n                                    consumed_gas = Z.zero ;\n                                    deactivated = [];\n                                    balance_updates = []})\n  | Partial_application { baker ; _ } ->\n      let level = Alpha_context. Level.current ctxt in\n      Alpha_context.Vote.get_current_period_kind ctxt >>=? fun voting_period_kind ->\n      let ctxt = Alpha_context.finalize ctxt in\n      return (ctxt, Apply_results.{ baker ;\n                                    level ;\n                                    voting_period_kind ;\n                                    nonce_hash = None ;\n                                    consumed_gas = Z.zero ;\n                                    deactivated = [];\n                                    balance_updates = []})\n  | Application\n      { baker ;  block_header = { protocol_data = { contents = protocol_data ; _ } ; _ } }\n  | Full_construction { protocol_data ; baker ; _ } ->\n      Apply.finalize_application ctxt protocol_data baker >>=? fun (ctxt, receipt) ->\n      let level = Alpha_context.Level.current ctxt in\n      let priority = protocol_data.priority in\n      let raw_level = Alpha_context.Raw_level.to_int32 level.level in\n      let fitness = Alpha_context.Fitness.current ctxt in\n      let commit_message =\n        Format.asprintf\n          \"lvl %ld, fit %Ld, prio %d, %d ops\"\n          raw_level fitness priority op_count in\n      let ctxt = Alpha_context.finalize ~commit_message ctxt in\n      return (ctxt, receipt)\n\nlet compare_operations 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 op1.contents, op2.contents with\n  | Single (Endorsement _), Single (Endorsement _) -> 0\n  | _, Single (Endorsement _) -> 1\n  | Single (Endorsement _), _ -> -1\n\n  | Single (Seed_nonce_revelation _), Single (Seed_nonce_revelation _) -> 0\n  | _, Single (Seed_nonce_revelation _) -> 1\n  | Single (Seed_nonce_revelation _), _ -> -1\n\n  | Single (Double_endorsement_evidence _), Single (Double_endorsement_evidence _) -> 0\n  | _, Single (Double_endorsement_evidence _) -> 1\n  | Single (Double_endorsement_evidence _), _ -> -1\n\n  | Single (Double_baking_evidence _), Single (Double_baking_evidence _) -> 0\n  | _, Single (Double_baking_evidence _) -> 1\n  | Single (Double_baking_evidence _), _ -> -1\n\n  | Single (Activate_account _), Single (Activate_account _) -> 0\n  | _, Single (Activate_account _) -> 1\n  | Single (Activate_account _), _ -> -1\n\n  | Single (Proposals _), Single (Proposals _) -> 0\n  | _, Single (Proposals _) -> 1\n  | Single (Proposals _), _ -> -1\n\n  | Single (Ballot _), Single (Ballot _) -> 0\n  | _, Single (Ballot _) -> 1\n  | Single (Ballot _), _ -> -1\n\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 ctxt block_header =\n  let level = block_header.Block_header.level in\n  let fitness = block_header.fitness in\n  let timestamp = block_header.timestamp in\n  let typecheck (ctxt:Alpha_context.context) (script:Alpha_context.Script.t) =\n    Script_ir_translator.parse_script ctxt script >>=? fun (_ex_script, ctxt) ->\n    return ctxt\n  in\n  Alpha_context.prepare_first_block\n    ~typecheck\n    ~level ~timestamp ~fitness ctxt >>=? fun ctxt ->\n  return (Alpha_context.finalize ctxt)\n" ;
                }] ;
}
end


module Registered =
  Tezos_protocol_updater.Registered_protocol.Register_embedded_V0
    (Tezos_protocol_001_PtCJ7pwo.Environment)
    (Tezos_protocol_001_PtCJ7pwo.Protocol.Main)
    (Source)