Michelson: introducing big maps, limited edition

Quick and dirty (yet safe, of course) implementation of lazily
  deserialized maps for storing large collections of indexed data.

  Only one big_map is allowed, as the left component of the toplevel
  storage pair.

  Review and bugfixes: Benjamin Canou <benjamin@canou.fr>

src/bin_client/test/contracts/big_map_get_add.tz

@@ -0,0 +1,8 @@
+parameter (pair (pair @set_pair int (option int)) (pair @check_pair int (option int))) ;
+storage (pair (big_map int int) unit) ;
+return unit ;
+code { DUP ; DIP { CDAR } ;
+       DUP ; DIP { CADR; DUP ; CAR ; DIP { CDR } ; UPDATE ; DUP } ;
+       CADR ; DUP ; CDR ; DIP { CAR ; GET } ;
+       IF_SOME { SWAP ; IF_SOME { ASSERT_CMPEQ } {FAIL}} { ASSERT_NONE } ;
+       UNIT ; SWAP ; PAIR ; UNIT ; PAIR }

src/bin_client/test/contracts/big_map_mem.tz

@@ -0,0 +1,6 @@
+# Fails if the boolean does not match the membership criteria
+parameter (pair int bool) ;
+storage (pair (big_map int unit) unit) ;
+return unit ;
+code { DUP ; DUP ; CADR ; DIP { CAAR ; DIP { CDAR ; DUP } ; MEM } ;
+       ASSERT_CMPEQ ; UNIT ; SWAP ; PAIR ; UNIT ; PAIR }

src/bin_client/test/test_contracts.sh

@@ -405,12 +405,13 @@ init_with_transfer $contract_dir/self.tz $key1 \
 $client transfer 0 from bootstrap1 to self
 assert_storage_contains self "\"$(get_contract_addr self)\""
 
-
+# Test sets and map literals
 assert_fails $client typecheck data '{ Elt 0 1 ; Elt 0 1 }' against type '(map nat nat)'
 assert_fails $client typecheck data '{ Elt 0 1 ; Elt 10 1 ; Elt 5 1 }' against type '(map nat nat)'
 assert_fails $client typecheck data '{ "A" ; "C" ; "B" }' against type '(set string)'
 assert_fails $client typecheck data '{ "A" ; "B" ; "B" }' against type '(set string)'
 
+# Test hash consistency between Michelson and the CLI
 hash_result=`$client hash data '(Pair "22220.00" (Pair "2017-12-13T04:49:00Z" 034))' \
                      of type '(pair tez (pair timestamp int))'`
 
@@ -420,6 +421,33 @@ assert_output $contract_dir/hash_consistency_checker.tz Unit \
 assert_output $contract_dir/hash_consistency_checker.tz Unit \
               '(Pair "22,220" (Pair "2017-12-13T04:49:00+00:00" 34))' "$hash_result"
 
+# Test for big maps
+init_with_transfer $contract_dir/big_map_mem.tz $key1\
+                   '(Pair { Elt 1 Unit ; Elt 2 Unit ; Elt 3 Unit } Unit)' \
+                   100 bootstrap1
+$client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 0 False)'
+assert_fails $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 0 True)'
+$client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 1 True)'
+assert_fails $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 1 False)'
+$client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 2 True)'
+assert_fails $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 2 False)'
+$client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 3 True)'
+assert_fails $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 3 False)'
+$client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 4 False)'
+assert_fails $client transfer 1 from bootstrap1 to big_map_mem -arg '(Pair 4 True)'
+
+init_with_transfer $contract_dir/big_map_get_add.tz $key1\
+                   '(Pair { Elt 0 1 ; Elt 1 2 ; Elt 2 3 } Unit)' \
+                   100 bootstrap1
+
+$client transfer 1 from bootstrap1 to big_map_get_add -arg '(Pair (Pair 200 (Some 2)) (Pair 200 (Some 2)))'
+$client transfer 1 from bootstrap1 to big_map_get_add -arg '(Pair (Pair 200 None) (Pair 200 None))'
+$client transfer 1 from bootstrap1 to big_map_get_add -arg '(Pair (Pair 200 None) (Pair 300 None))'
+$client transfer 1 from bootstrap1 to big_map_get_add -arg '(Pair (Pair 1 None) (Pair 200 None))'
+$client transfer 1 from bootstrap1 to big_map_get_add -arg '(Pair (Pair 1 (Some 2)) (Pair 0 (Some 1)))'
+$client transfer 1 from bootstrap1 to big_map_get_add -arg '(Pair (Pair 400 (Some 1232)) (Pair 400 (Some 1232)))'
+$client transfer 1 from bootstrap1 to big_map_get_add -arg '(Pair (Pair 401 (Some 0)) (Pair 400 (Some 1232)))'
+
 printf "\nEnd of test\n"
 
 show_logs="no"

src/proto_alpha/lib_client/client_proto_programs.ml

@@ -35,23 +35,44 @@ let print_errors (cctxt : #Client_commands.logger) errs ~show_source ~parsed =
   cctxt#error "error running program" >>= fun () ->
   return ()
 
+let print_big_map_diff ppf = function
+  | None -> ()
+  | Some diff ->
+      Format.fprintf ppf
+        "@[<v 2>map diff:@,%a@]@,"
+        (Format.pp_print_list
+           ~pp_sep:Format.pp_print_space
+           (fun ppf (key, value) ->
+              Format.fprintf ppf "%s %a%a"
+                (match value with
+                 | None -> "-"
+                 | Some _ -> "+")
+                print_expr key
+                (fun ppf -> function
+                   | None -> ()
+                   | Some x -> Format.fprintf ppf "-> %a" print_expr x)
+                value))
+        diff
+
 let print_run_result (cctxt : #Client_commands.logger) ~show_source ~parsed = function
-  | Ok (storage, output) ->
+  | Ok (storage, output, maybe_diff) ->
-      cctxt#message "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@]@."
+      cctxt#message "@[<v 0>@[<v 2>storage@,%a@]@,@[<v 2>output@,%a@]@,@[%a@]@]@."
         print_expr storage
-        print_expr output >>= fun () ->
+        print_expr output
+        print_big_map_diff maybe_diff >>= fun () ->
       return ()
   | Error errs ->
       print_errors cctxt errs ~show_source ~parsed
 
 let print_trace_result (cctxt : #Client_commands.logger) ~show_source ~parsed =
   function
-  | Ok (storage, output, trace) ->
+  | Ok (storage, output, trace, maybe_big_map_diff) ->
       cctxt#message
         "@[<v 0>@[<v 2>storage@,%a@]@,\
-         @[<v 2>output@,%a@]@,@[<v 2>trace@,%a@]@]@."
+         @[<v 2>output@,%a@]@,%a@[<v 2>@[<v 2>trace@,%a@]@]@."
         print_expr storage
         print_expr output
+        print_big_map_diff maybe_big_map_diff
         (Format.pp_print_list
            (fun ppf (loc, gas, stack) ->
               Format.fprintf ppf

src/proto_alpha/lib_client/client_proto_programs.mli

@@ -21,7 +21,7 @@ val run :
   input:Michelson_v1_parser.parsed ->
   Client_rpcs.block ->
   #Client_rpcs.ctxt ->
-  (Script.expr * Script.expr) tzresult Lwt.t
+  (Script.expr * Script.expr * (Script.expr * Script.expr option) list option) tzresult Lwt.t
 
 val trace :
   ?amount:Tez.t ->
@@ -30,23 +30,24 @@ val trace :
   input:Michelson_v1_parser.parsed ->
   Client_rpcs.block ->
   #Client_rpcs.ctxt ->
-  (Script.expr * Script.expr * (int * Gas.t * Script.expr list) list) tzresult Lwt.t
+  (Script.expr * Script.expr * (int * Gas.t * Script.expr list) list * (Script.expr * Script.expr option) list option) tzresult Lwt.t
+
+val print_run_result :
+  #Client_commands.logger ->
+  show_source:bool ->
+  parsed:Michelson_v1_parser.parsed ->
+  (Script_repr.expr * Script_repr.expr *
+   (Script_repr.expr * Script_repr.expr option) list option) tzresult -> unit tzresult Lwt.t
 
 val print_trace_result :
   #Client_commands.logger ->
   show_source:bool ->
   parsed:Michelson_v1_parser.parsed ->
   (Script_repr.expr * Script_repr.expr *
-   (int * Gas.t * Script_repr.expr list) list)
+   (int * Gas.t * Script_repr.expr list) list *
+   (Script_repr.expr * Script_repr.expr option) list option)
     tzresult -> unit tzresult Lwt.t
 
-val print_run_result :
-  #Client_commands.logger ->
-  show_source:bool ->
-  parsed:Michelson_v1_parser.parsed ->
-  (Script.expr * Script.expr) tzresult ->
-  unit tzresult Lwt.t
-
 val hash_and_sign :
   Michelson_v1_parser.parsed ->
   Michelson_v1_parser.parsed ->

src/proto_alpha/lib_client/client_proto_rpcs.mli

@@ -160,13 +160,14 @@ module Helpers : sig
     #Client_rpcs.ctxt ->
     block -> Script.expr ->
     (Script.expr * Script.expr * Tez.t) ->
-    (Script.expr * Script.expr) tzresult Lwt.t
+    (Script.expr * Script.expr * (Script.expr * Script.expr option) list option) tzresult Lwt.t
   val trace_code:
     #Client_rpcs.ctxt ->
     block -> Script.expr ->
     (Script.expr * Script.expr * Tez.t) ->
     (Script.expr * Script.expr *
-     (Script.location * Gas.t * Script.expr list) list) tzresult Lwt.t
+     (Script.location * Gas.t * Script.expr list) list *
+     (Script.expr * Script.expr option) list option) tzresult Lwt.t
   val typecheck_code:
     #Client_rpcs.ctxt ->
     block -> Script.expr -> Script_tc_errors.type_map tzresult Lwt.t

src/proto_alpha/lib_client/michelson_v1_error_reporter.ml

@@ -66,6 +66,7 @@ let collect_error_locations errs =
       | Invalid_primitive (loc, _, _)
       | Invalid_kind (loc, _, _)
       | Duplicate_field (loc, _)
+      | Unexpected_big_map loc
       | Fail_not_in_tail_position loc
       | Undefined_binop (loc, _, _, _)
       | Undefined_unop (loc, _, _)
@@ -167,6 +168,10 @@ let report_errors ~details ~show_source ?parsed ppf errs =
           print_loc loc
           (Michelson_v1_primitives.string_of_prim prim) ;
         print_trace locations rest
+    | Unexpected_big_map loc :: rest ->
+        Format.fprintf ppf "%abig_map type only allowed on the left of the toplevel storage pair"
+          print_loc loc ;
+        print_trace locations rest
     | Runtime_contract_error (contract, expr) :: rest ->
         let parsed =
           match parsed with

src/proto_alpha/lib_protocol/src/apply.ml

@@ -135,12 +135,17 @@ let apply_manager_operation_content
               source destination ctxt script amount argument
               (Gas.of_int (Constants.max_gas ctxt))
             >>= function
-            | Ok (storage_res, _res, _steps, ctxt, origination_nonce) ->
+            | Ok (storage_res, _res, _steps, ctxt, origination_nonce, maybe_big_map_diff) ->
                 (* TODO: pay for the steps and the storage diff:
                    update_script_storage checks the storage cost *)
                 Contract.update_script_storage_and_fees
                   ctxt destination
-                  Script_interpreter.dummy_storage_fee storage_res >>=? fun ctxt ->
+                  Script_interpreter.dummy_storage_fee
+                  storage_res
+                  (match maybe_big_map_diff with
+                   | None -> None
+                   | Some map ->
+                       Some (Script_ir_translator.to_serializable_big_map map)) >>=? fun ctxt ->
                 return (ctxt, origination_nonce, None)
             | Error err ->
                 return (ctxt, origination_nonce, Some err) in
@@ -161,18 +166,30 @@ let apply_manager_operation_content
   | Origination { manager ; delegate ; script ;
                   spendable ; delegatable ; credit } ->
       begin match script with
-        | None -> return None
+        | None -> return (None, None)
         | Some script ->
             Script_ir_translator.parse_script ctxt script >>=? fun _ ->
-            return (Some (script, (Script_interpreter.dummy_code_fee, Script_interpreter.dummy_storage_fee)))
+            Script_ir_translator.erase_big_map_initialization ctxt script >>=? fun (script, big_map_diff) ->
-      end >>=? fun script ->
+            return (Some (script, (Script_interpreter.dummy_code_fee, Script_interpreter.dummy_storage_fee)),
+                    big_map_diff)
+      end >>=? fun (script, big_map) ->
       Contract.spend ctxt source Constants.origination_burn >>=? fun ctxt ->
       Contract.spend ctxt source credit >>=? fun ctxt ->
       Contract.originate ctxt
         origination_nonce
         ~manager ~delegate ~balance:credit
         ?script
-        ~spendable ~delegatable >>=? fun (ctxt, _, origination_nonce) ->
+        ~spendable ~delegatable >>=? fun (ctxt, contract, origination_nonce) ->
+      begin match big_map with
+        | None -> return ctxt
+        | Some diff ->
+            fold_left_s (fun ctxt (key, value) ->
+                match value with
+                | None -> Contract.Big_map_storage.remove ctxt contract key
+                | Some v ->
+                    Contract.Big_map_storage.set ctxt contract key v)
+              ctxt diff
+      end >>=? fun ctxt ->
       return (ctxt, origination_nonce, None)
   | Delegation delegate ->
       Contract.set_delegate ctxt source delegate >>=? fun ctxt ->

src/proto_alpha/lib_protocol/src/contract_storage.ml

@@ -237,6 +237,7 @@ let delete c contract =
   Storage.Contract.Storage.remove c contract >>= fun c ->
   Storage.Contract.Code_fees.remove c contract >>= fun c ->
   Storage.Contract.Storage_fees.remove c contract >>= fun c ->
+  Storage.Contract.Big_map.clear (c, contract) >>= fun c ->
   return c
 
 let exists c contract =
@@ -372,7 +373,9 @@ let contract_fee c contract =
       Lwt.return Tez_repr.(code_fees +? storage_fees) >>=? fun script_fees ->
       Lwt.return Tez_repr.(Constants_repr.minimal_contract_balance +? script_fees)
 
-let update_script_storage_and_fees c contract storage_fees storage =
+type big_map_diff = (string * Script_repr.expr option) list
+
+let update_script_storage_and_fees c contract storage_fees storage big_map  =
   Storage.Contract.Balance.get_option c contract >>=? function
   | None ->
       (* The contract was destroyed *)
@@ -382,6 +385,16 @@ let update_script_storage_and_fees c contract storage_fees storage =
       contract_fee c contract >>=? fun fee ->
       fail_unless Tez_repr.(balance > fee)
         (Cannot_pay_storage_fee (contract, balance, fee)) >>=? fun () ->
+      begin match big_map with
+        | None -> return c
+        | Some diff ->
+            fold_left_s (fun c (key, value) ->
+                match value with
+                | None -> Storage.Contract.Big_map.remove (c, contract) key >>= return
+                | Some v ->
+                    Storage.Contract.Big_map.init_set (c, contract) key v >>= return)
+              c diff
+      end >>=? fun c ->
       Storage.Contract.Storage.set c contract storage
 
 let spend_from_script c contract amount =
@@ -432,3 +445,10 @@ let originate c nonce ~balance ~manager ?script ~delegate ~spendable ~delegatabl
 
 let init c =
   Storage.Contract.Global_counter.init c 0l
+
+module Big_map = struct
+  let set handle key value = Storage.Contract.Big_map.init_set handle key value >>= return
+  let remove = Storage.Contract.Big_map.delete
+  let mem = Storage.Contract.Big_map.mem
+  let get_opt = Storage.Contract.Big_map.get_option
+end

src/proto_alpha/lib_protocol/src/contract_storage.mli

@@ -46,7 +46,12 @@ val get_counter: Raw_context.t -> Contract_repr.t -> int32 tzresult Lwt.t
 val get_script: Raw_context.t -> Contract_repr.t -> Script_repr.t option tzresult Lwt.t
 val get_storage: Raw_context.t -> Contract_repr.t -> Script_repr.expr option tzresult Lwt.t
 
-val update_script_storage_and_fees: Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Script_repr.expr -> Raw_context.t tzresult Lwt.t
+type big_map_diff = (string * Script_repr.expr option) list
+
+val update_script_storage_and_fees:
+  Raw_context.t -> Contract_repr.t -> Tez_repr.t -> Script_repr.expr ->
+  big_map_diff option ->
+  Raw_context.t tzresult Lwt.t
 
 (** fails if the contract is not delegatable *)
 val set_delegate : Raw_context.t -> Contract_repr.t -> Ed25519.Public_key_hash.t option -> Raw_context.t tzresult Lwt.t
@@ -72,3 +77,14 @@ val originate :
 
 val init :
   Raw_context.t -> Raw_context.t tzresult Lwt.t
+
+module Big_map : sig
+  val set :
+    Storage.Contract.bigmap_key ->
+    string -> Script_repr.expr -> Raw_context.t tzresult Lwt.t
+  val remove :
+    Storage.Contract.bigmap_key -> string -> Raw_context.t tzresult Lwt.t
+  val mem : Storage.Contract.bigmap_key -> string -> bool Lwt.t
+  val get_opt :
+    Storage.Contract.bigmap_key -> string -> Script_repr.expr option tzresult Lwt.t
+end

src/proto_alpha/lib_protocol/src/gas.ml

@@ -149,6 +149,10 @@ module Cost_of = struct
 
   let map_size = step_cost 2
 
+  let big_map_mem _key _map = step_cost 200
+  let big_map_get _key _map = step_cost 200
+  let big_map_update _key _value _map = step_cost 200
+
   let set_access : type elt. elt -> elt Script_typed_ir.set -> int
     = fun _key (module Box) ->
       log2 @@ Box.size

src/proto_alpha/lib_protocol/src/gas.mli

@@ -48,6 +48,9 @@ module Cost_of : sig
   val map_update :
     'a -> 'b -> ('c, 'd) Script_typed_ir.map -> cost
   val map_size : cost
+  val big_map_mem : 'key -> ('key, 'value) Script_typed_ir.big_map -> cost
+  val big_map_get : 'key -> ('key, 'value) Script_typed_ir.big_map -> cost
+  val big_map_update : 'key -> 'value option -> ('key, 'value) Script_typed_ir.big_map -> cost
   val set_to_list : 'a Script_typed_ir.set -> cost
   val set_update : 'a -> 'b -> 'a Script_typed_ir.set -> cost
   val set_mem : 'a -> 'a Script_typed_ir.set -> cost

src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml

@@ -103,6 +103,7 @@ type prim =
   | T_lambda
   | T_list
   | T_map
+  | T_big_map
   | T_nat
   | T_option
   | T_or
@@ -223,6 +224,7 @@ let string_of_prim = function
   | T_lambda -> "lambda"
   | T_list -> "list"
   | T_map -> "map"
+  | T_big_map -> "big_map"
   | T_nat -> "nat"
   | T_option -> "option"
   | T_or -> "or"
@@ -324,6 +326,7 @@ let prim_of_string = function
   | "lambda" -> ok T_lambda
   | "list" -> ok T_list
   | "map" -> ok T_map
+  | "big_map" -> ok T_big_map
   | "nat" -> ok T_nat
   | "option" -> ok T_option
   | "or" -> ok T_or
@@ -469,6 +472,7 @@ let prim_encoding =
     ("lambda", T_lambda) ;
     ("list", T_list) ;
     ("map", T_map) ;
+    ("big_map", T_big_map) ;
     ("nat", T_nat) ;
     ("option", T_option) ;
     ("or", T_or) ;

src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli

@@ -101,6 +101,7 @@ type prim =
   | T_lambda
   | T_list
   | T_map
+  | T_big_map
   | T_nat
   | T_option
   | T_or

src/proto_alpha/lib_protocol/src/script_interpreter.ml

@@ -392,6 +392,21 @@ let rec interp
             gas_check_terop descr (map_update, k, v, map) Gas.Cost_of.map_update rest
         | Map_size, Item (map, rest) ->
             gas_check_unop descr (map_size, map) (fun _ -> Gas.Cost_of.map_size) rest ctxt
+        (* Big map operations *)
+        | Big_map_mem, Item (key, Item (map, rest)) ->
+            let gas = Gas.consume gas (Gas.Cost_of.big_map_mem key map) in
+            Gas.check gas >>=? fun () ->
+            Script_ir_translator.big_map_mem ctxt source key map >>= fun res ->
+            logged_return (Item (res, rest), gas, ctxt)
+        | Big_map_get, Item (key, Item (map, rest)) ->
+            let gas = Gas.consume gas (Gas.Cost_of.big_map_get key map) in
+            Gas.check gas >>=? fun () ->
+            Script_ir_translator.big_map_get ctxt source key map >>=? fun res ->
+            logged_return (Item (res, rest), gas, ctxt)
+        | Big_map_update, Item (key, Item (maybe_value, Item (map, rest))) ->
+            gas_check_terop descr
+              (Script_ir_translator.big_map_update, key, maybe_value, map)
+              Gas.Cost_of.big_map_update rest
         (* timestamp operations *)
         | Add_seconds_to_timestamp, Item (n, Item (t, rest)) ->
             gas_check_binop descr
@@ -633,14 +648,16 @@ let rec interp
             Contract.get_manager ctxt contract >>=? fun manager ->
             logged_return (Item (manager, rest), gas, ctxt)
         | Transfer_tokens storage_type,
-          Item (p, Item (amount, Item ((tp, Unit_t, destination), Item (sto, Empty)))) -> begin
+          Item (p, Item (amount, Item ((tp, Unit_t, destination), Item (storage, Empty)))) -> begin
             let gas = Gas.consume gas Gas.Cost_of.transfer in
             Gas.check gas >>=? fun () ->
             Contract.spend_from_script ctxt source amount >>=? fun ctxt ->
             Contract.credit ctxt destination amount >>=? fun ctxt ->
             Contract.get_script ctxt destination >>=? fun destination_script ->
-            let sto = Micheline.strip_locations (unparse_data storage_type sto) in
+            let sto = Micheline.strip_locations (unparse_data storage_type storage) in
-            Contract.update_script_storage_and_fees ctxt source dummy_storage_fee sto >>=? fun ctxt ->
+            Contract.update_script_storage_and_fees ctxt source dummy_storage_fee sto
+              (Option.map ~f:Script_ir_translator.to_serializable_big_map
+                 (Script_ir_translator.extract_big_map storage_type storage)) >>=? fun ctxt ->
             begin match destination_script with
               | None ->
                   (* we see non scripted contracts as (unit, unit) contract *)
@@ -650,8 +667,9 @@ let rec interp
               | Some script ->
                   let p = unparse_data tp p in
                   execute origination source destination ctxt script amount p gas
-                  >>=? fun (csto, ret, gas, ctxt, origination) ->
+                  >>=? fun (csto, ret, gas, ctxt, origination, maybe_diff) ->
-                  Contract.update_script_storage_and_fees ctxt destination dummy_storage_fee csto >>=? fun ctxt ->
+                  Contract.update_script_storage_and_fees ctxt destination dummy_storage_fee csto
+                    (Option.map ~f:Script_ir_translator.to_serializable_big_map maybe_diff) >>=? fun ctxt ->
                   trace
                     (Invalid_contract (loc, destination))
                     (parse_data ctxt Unit_t ret) >>=? fun () ->
@@ -672,12 +690,16 @@ let rec interp
             Contract.get_script ctxt destination >>=? function
             | None -> fail (Invalid_contract (loc, destination))
             | Some script ->
+                let maybe_diff = Script_ir_translator.(
+                    Option.map ~f:to_serializable_big_map
+                    @@ extract_big_map storage_type sto) in
                 let sto = Micheline.strip_locations (unparse_data storage_type sto) in
-                Contract.update_script_storage_and_fees ctxt source dummy_storage_fee sto >>=? fun ctxt ->
+                Contract.update_script_storage_and_fees ctxt source dummy_storage_fee sto maybe_diff >>=? fun ctxt ->
                 let p = unparse_data tp p in
                 execute origination source destination ctxt script amount p gas
-                >>=? fun (sto, ret, gas, ctxt, origination) ->
+                >>=? fun (sto, ret, gas, ctxt, origination, maybe_diff) ->
-                Contract.update_script_storage_and_fees ctxt destination dummy_storage_fee sto >>=? fun ctxt ->
+                Contract.update_script_storage_and_fees ctxt destination dummy_storage_fee sto
+                  (Option.map ~f:Script_ir_translator.to_serializable_big_map maybe_diff) >>=? fun ctxt ->
                 trace
                   (Invalid_contract (loc, destination))
                   (parse_data ctxt tr ret) >>=? fun v ->
@@ -771,7 +793,9 @@ let rec interp
 
 (* ---- contract handling ---------------------------------------------------*)
 
-and execute ?log origination orig source ctxt script amount arg gas =
+and execute ?log origination orig source ctxt script amount arg gas :
+  (Script.expr * Script.node * Gas.t * context * Contract.origination_nonce *
+   Script_typed_ir.ex_big_map option) tzresult Lwt.t =
   parse_script ctxt script
   >>=? fun (Ex_script { code; arg_type; ret_type; storage; storage_type }) ->
   parse_data ctxt arg_type arg >>=? fun arg ->
@@ -781,15 +805,16 @@ and execute ?log origination orig source ctxt script amount arg gas =
   >>=? fun ((ret, storage), gas, ctxt, origination) ->
   return (Micheline.strip_locations (unparse_data storage_type storage),
           unparse_data ret_type ret,
-          gas, ctxt, origination)
+          gas, ctxt, origination,
+          Script_ir_translator.extract_big_map storage_type storage)
 
 let trace origination orig source ctxt script amount arg gas =
   let log = ref [] in
   execute ~log origination orig source ctxt script amount (Micheline.root arg) gas
-  >>=? fun (sto, res, gas, ctxt, origination) ->
+  >>=? fun (sto, res, gas, ctxt, origination, maybe_big_map) ->
-  return ((sto, Micheline.strip_locations res, gas, ctxt, origination), List.rev !log)
+  return ((sto, Micheline.strip_locations res, gas, ctxt, origination, maybe_big_map), List.rev !log)
 
 let execute origination orig source ctxt script amount arg gas =
   execute origination orig source ctxt script amount (Micheline.root arg) gas
-  >>=? fun (sto, res, gas, ctxt, origination) ->
+  >>=? fun (sto, res, gas, ctxt, origination, maybe_big_map) ->
-  return (sto, Micheline.strip_locations res, gas, ctxt, origination)
+  return (sto, Micheline.strip_locations res, gas, ctxt, origination, maybe_big_map)

src/proto_alpha/lib_protocol/src/script_interpreter.mli

@@ -21,12 +21,13 @@ val execute:
   Contract.t -> Contract.t -> Tezos_context.t ->
   Script.t -> Tez.t ->
   Script.expr -> Gas.t ->
-  (Script.expr * Script.expr * Gas.t * context * Contract.origination_nonce) tzresult Lwt.t
+  (Script.expr * Script.expr * Gas.t * context * Contract.origination_nonce *
+   Script_typed_ir.ex_big_map option) tzresult Lwt.t
 
 val trace:
   Contract.origination_nonce ->
   Contract.t -> Contract.t -> Tezos_context.t ->
   Script.t -> Tez.t ->
   Script.expr -> Gas.t ->
-  ((Script.expr * Script.expr * Gas.t * context * Contract.origination_nonce) *
+  ((Script.expr * Script.expr * Gas.t * context * Contract.origination_nonce * Script_typed_ir.ex_big_map option) *
    (Script.location * Gas.t * Script.expr list) list) tzresult Lwt.t

src/proto_alpha/lib_protocol/src/script_ir_translator.ml

@@ -74,6 +74,8 @@ let rec type_size : type t. t ty -> int = function
       1 + comparable_type_size k
   | Map_t (k, v) ->
       1 + comparable_type_size k + type_size v
+  | Big_map_t (k, v) ->
+      1 + comparable_type_size k + type_size v
   | Contract_t (arg, ret) ->
       1 + type_size arg + type_size ret
 
@@ -130,6 +132,9 @@ let number_of_generated_growing_types : type b a. (b, a) instr -> int = function
   | Map_get -> 0
   | Map_update -> 0
   | Map_size -> 0
+  | Big_map_get -> 0
+  | Big_map_update -> 0
+  | Big_map_mem -> 0
   | Concat -> 0
   | Add_seconds_to_timestamp -> 0
   | Add_timestamp_to_seconds -> 0
@@ -305,6 +310,7 @@ let namespace = function
   | T_lambda
   | T_list
   | T_map
+  | T_big_map
   | T_nat
   | T_option
   | T_or
@@ -447,6 +453,19 @@ let map_update
         | None -> (Box.OPS.remove k map, size - if contains then 1 else 0)
     end)
 
+let map_set
+  : type a b. a -> b -> (a, b) map -> (a, b) map
+  = fun k v (module Box) ->
+    (module struct
+      type key = a
+      type value = b
+      let key_ty = Box.key_ty
+      module OPS = Box.OPS
+      let boxed =
+        let (map, size) = Box.boxed in
+        (Box.OPS.add k v map, if Box.OPS.mem k map then size else size + 1)
+    end)
+
 let map_mem
   : type key value. key -> (key, value) map -> bool
   = fun k (module Box) ->
@@ -526,6 +545,10 @@ let rec unparse_ty
       let ta = unparse_comparable_ty uta in
       let tr = unparse_ty None utr in
       Prim (-1, T_map, [ ta; tr ], None)
+  | Big_map_t (uta, utr) ->
+      let ta = unparse_comparable_ty uta in
+      let tr = unparse_ty None utr in
+      Prim (-1, T_big_map, [ ta; tr ], None)
 
 let rec unparse_data
   : type a. a ty -> a -> Script.node
@@ -598,6 +621,8 @@ let rec unparse_data
               :: acc)
             map [] in
         Seq (-1, List.rev items, None)
+    | Big_map_t (_kt, _kv), _map ->
+        Seq (-1, [], None)
     | Lambda_t _, Lam (_, original_code) ->
         root original_code
 
@@ -638,6 +663,11 @@ let rec ty_eq
          ty_eq tar tbr >>? fun Eq ->
          (Ok Eq : (ta ty, tb ty) eq tzresult)) |>
         record_trace (Inconsistent_types (ta, tb))
+    | Big_map_t (tal, tar), Big_map_t (tbl, tbr) ->
+        (comparable_ty_eq tal tbl >>? fun Eq ->
+         ty_eq tar tbr >>? fun Eq ->
+         (Ok Eq : (ta ty, tb ty) eq tzresult)) |>
+        record_trace (Inconsistent_types (ta, tb))
     | Set_t ea, Set_t eb ->
         (comparable_ty_eq ea eb >>? fun Eq ->
          (Ok Eq : (ta ty, tb ty) eq tzresult)) |>
@@ -742,6 +772,10 @@ let merge_types :
           help tar tbr >>? fun value ->
           ty_eq tar value >>? fun Eq ->
           ok (Map_t (merge_comparable_types tal tbl, value))
+      | Big_map_t (tal, tar), Big_map_t (tbl, tbr) ->
+          help tar tbr >>? fun value ->
+          ty_eq tar value >>? fun Eq ->
+          ok (Big_map_t (merge_comparable_types tal tbl, value))
       | Set_t ea, Set_t eb ->
           ok (Set_t (merge_comparable_types ea eb))
       | Pair_t ((tal, left_annot1), (tar, right_annot1)),
@@ -842,7 +876,7 @@ let rec parse_comparable_ty : Script.node -> ex_comparable_ty tzresult = functio
   | Prim (loc, (T_pair | T_or | T_set | T_map
                | T_list | T_option  | T_lambda
                | T_unit | T_signature  | T_contract), _, _) as expr ->
-      parse_ty expr >>? fun (Ex_ty ty, _) ->
+      parse_ty false expr >>? fun (Ex_ty ty, _) ->
       error (Comparable_type_expected (loc, ty))
   | expr ->
       error @@ unexpected expr [] Type_namespace
@@ -850,7 +884,21 @@ let rec parse_comparable_ty : Script.node -> ex_comparable_ty tzresult = functio
           T_string ; T_tez ; T_bool ;
           T_key ; T_key_hash ; T_timestamp ]
 
-and parse_ty : Script.node -> (ex_ty * annot) tzresult = function
+and parse_ty : bool -> Script.node -> (ex_ty * annot) tzresult = fun big_map_possible -> function
+  | Prim (_, T_pair, [
+      Prim (big_map_loc, T_big_map, args, map_annot) ;
+      remaining_storage ], storage_annot)
+    when big_map_possible ->
+      begin match args with
+        | [ key_ty ; value_ty ] ->
+            parse_comparable_ty key_ty >>? fun (Ex_comparable_ty key_ty) ->
+            parse_ty false value_ty >>? fun (Ex_ty value_ty, right_annot) ->
+            error_unexpected_annot big_map_loc right_annot >>? fun () ->
+            parse_ty false remaining_storage >>? fun (Ex_ty remaining_storage, remaining_annot) ->
+            ok (Ex_ty (Pair_t ((Big_map_t (key_ty, value_ty), map_annot), (remaining_storage, remaining_annot))),
+                storage_annot)
+        | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args)
+      end
   | Prim (_, T_unit, [], annot) -> ok (Ex_ty Unit_t, annot)
   | Prim (_, T_int, [], annot) -> ok (Ex_ty (Int_t), annot)
   | Prim (_, T_nat, [], annot) -> ok (Ex_ty (Nat_t), annot)
@@ -862,29 +910,29 @@ and parse_ty : Script.node -> (ex_ty * annot) tzresult = function
   | Prim (_, T_timestamp, [], annot) -> ok (Ex_ty Timestamp_t, annot)
   | Prim (_, T_signature, [], annot) -> ok (Ex_ty Signature_t, annot)
   | Prim (loc, T_contract, [ utl; utr ], annot) ->
-      parse_ty utl >>? fun (Ex_ty tl, left_annot) ->
+      parse_ty false utl >>? fun (Ex_ty tl, left_annot) ->
-      parse_ty utr >>? fun (Ex_ty tr, right_annot) ->
+      parse_ty false utr >>? fun (Ex_ty tr, right_annot) ->
       error_unexpected_annot loc left_annot >>? fun () ->
       error_unexpected_annot loc right_annot >|? fun () ->
       (Ex_ty (Contract_t (tl, tr)), annot)
   | Prim (_, T_pair, [ utl; utr ], annot) ->
-      parse_ty utl >>? fun (Ex_ty tl, left_annot) ->
+      parse_ty false utl >>? fun (Ex_ty tl, left_annot) ->
-      parse_ty utr >>? fun (Ex_ty tr, right_annot) ->
+      parse_ty false utr >>? fun (Ex_ty tr, right_annot) ->
       ok (Ex_ty (Pair_t ((tl, left_annot), (tr, right_annot))), annot)
   | Prim (_, T_or, [ utl; utr ], annot) ->
-      parse_ty utl >>? fun (Ex_ty tl, left_annot) ->
+      parse_ty false utl >>? fun (Ex_ty tl, left_annot) ->
-      parse_ty utr >|? fun (Ex_ty tr, right_annot) ->
+      parse_ty false utr >|? fun (Ex_ty tr, right_annot) ->
       (Ex_ty (Union_t ((tl, left_annot), (tr, right_annot))), annot)
   | Prim (_, T_lambda, [ uta; utr ], annot) ->
-      parse_ty uta >>? fun (Ex_ty ta, _) ->
+      parse_ty false uta >>? fun (Ex_ty ta, _) ->
-      parse_ty utr >>? fun (Ex_ty tr, _) ->
+      parse_ty false utr >>? fun (Ex_ty tr, _) ->
       ok (Ex_ty (Lambda_t (ta, tr)), annot)
   | Prim (loc, T_option, [ ut ], annot) ->
-      parse_ty ut >>? fun (Ex_ty t, opt_annot) ->
+      parse_ty false ut >>? fun (Ex_ty t, opt_annot) ->
       error_unexpected_annot loc annot >|? fun () ->
       (Ex_ty (Option_t t), opt_annot)
   | Prim (loc, T_list, [ ut ], annot) ->
-      parse_ty ut >>? fun (Ex_ty t, list_annot) ->
+      parse_ty false ut >>? fun (Ex_ty t, list_annot) ->
       error_unexpected_annot loc list_annot >>? fun () ->
       (ok (Ex_ty (List_t t), annot))
   | Prim (_, T_set, [ ut ], annot) ->
@@ -892,8 +940,10 @@ and parse_ty : Script.node -> (ex_ty * annot) tzresult = function
       ok (Ex_ty (Set_t t), annot)
   | Prim (_, T_map, [ uta; utr ], annot) ->
       parse_comparable_ty uta >>? fun (Ex_comparable_ty ta) ->
-      parse_ty utr >>? fun (Ex_ty tr, _) ->
+      parse_ty false utr >>? fun (Ex_ty tr, _) ->
       ok (Ex_ty (Map_t (ta, tr)), annot)
+  | Prim (loc, T_big_map, _, _) ->
+      error (Unexpected_big_map loc)
   | Prim (loc, (T_unit | T_signature
                | T_int | T_nat
                | T_string | T_tez | T_bool
@@ -941,6 +991,30 @@ let rec parse_data
       Invalid_constant (location script_data, strip_locations script_data, ty) in
     let traced body =
       trace (error ()) body in
+    let parse_items ?type_logger loc ctxt expr key_type value_type items item_wrapper =
+      (fold_left_s
+         (fun (last_value, map) -> function
+            | Prim (_, D_Elt, [ k; v ], _) ->
+                parse_comparable_data ?type_logger ctxt key_type k >>=? fun k ->
+                parse_data ?type_logger ctxt value_type v >>=? fun v ->
+                begin match last_value with
+                  | Some value ->
+                      if Compare.Int.(0 <= (compare_comparable key_type value k))
+                      then
+                        if Compare.Int.(0 = (compare_comparable key_type value k))
+                        then fail (Duplicate_map_keys (loc, strip_locations expr))
+                        else fail (Unordered_map_keys (loc, strip_locations expr))
+                      else return ()
+                  | None -> return ()
+                end >>=? fun () ->
+                return (Some k, map_update k (Some (item_wrapper v)) map)
+            | Prim (loc, D_Elt, l, _) ->
+                fail @@ Invalid_arity (loc, D_Elt, 2, List.length l)
+            | Prim (loc, name, _, _) ->
+                fail @@ Invalid_primitive (loc, [ D_Elt ], name)
+            | Int _ | String _ | Seq _ ->
+                fail (error ()))
+         (None, empty_map key_type) items) >>|? snd |> traced in
     match ty, script_data with
     (* Unit *)
     | Unit_t, Prim (_, D_Unit, [], _) -> return ()
@@ -1115,31 +1189,15 @@ let rec parse_data
     (* Maps *)
     | Map_t (tk, tv), (Seq (loc, vs, annot) as expr) ->
         fail_unexpected_annot loc annot >>=? fun () ->
-        (fold_left_s
+        parse_items ?type_logger loc ctxt expr tk tv vs (fun x -> x)
-           (fun (last_value, map) -> function
-              | Prim (_, D_Elt, [ k; v ], _) ->
-                  parse_comparable_data ?type_logger ctxt tk k >>=? fun k ->
-                  parse_data ?type_logger ctxt tv v >>=? fun v ->
-                  begin match last_value with
-                    | Some value ->
-                        if Compare.Int.(0 <= (compare_comparable tk value k))
-                        then
-                          if Compare.Int.(0 = (compare_comparable tk value k))
-                          then fail (Duplicate_map_keys (loc, strip_locations expr))
-                          else fail (Unordered_map_keys (loc, strip_locations expr))
-                        else return ()
-                    | None -> return ()
-                  end >>=? fun () ->
-                  return (Some k, map_update k (Some v) map)
-              | Prim (loc, D_Elt, l, _) ->
-                  fail @@ Invalid_arity (loc, D_Elt, 2, List.length l)
-              | Prim (loc, name, _, _) ->
-                  fail @@ Invalid_primitive (loc, [ D_Elt ], name)
-              | Int _ | String _ | Seq _ ->
-                  fail (error ()))
-           (None, empty_map tk) vs) >>|? snd |> traced
     | Map_t _, expr ->
         traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr)))
+    | Big_map_t (tk, tv), (Seq (loc, vs, annot) as expr) ->
+        fail_unexpected_annot loc annot >>=? fun () ->
+        parse_items ?type_logger loc ctxt expr tk tv vs (fun x -> Some x) >>|? fun diff ->
+        { diff ; key_type = ty_of_comparable_ty tk ; value_type = tv }
+    | Big_map_t (_tk, _tv), expr ->
+        traced (fail (Invalid_kind (location expr, [ Seq_kind ], kind expr)))
 
 and parse_comparable_data
   : type a. ?type_logger:(int -> Script.expr list -> Script.expr list -> unit) ->
@@ -1154,7 +1212,7 @@ and parse_returning
   fun tc_context ctxt ?type_logger (arg, arg_annot) ret script_instr ->
     parse_instr tc_context ctxt ?type_logger
       script_instr (Item_t (arg, Empty_t, arg_annot)) >>=? function
-    | Typed ({ loc ; aft = (Item_t (ty, Empty_t, _) as stack_ty) } as descr) ->
+    | Typed ({ loc ; aft = (Item_t (ty, Empty_t, _) as stack_ty)} as descr) ->
         trace
           (Bad_return (loc, stack_ty, ret))
           (Lwt.return (ty_eq ty ret)) >>=? fun Eq ->
@@ -1218,7 +1276,7 @@ and parse_instr
         return (typed loc (Swap, Item_t (w, Item_t (v, rest, cur_top_annot), annot)))
     | Prim (loc, I_PUSH, [ t ; d ], instr_annot),
       stack ->
-        (Lwt.return (parse_ty t)) >>=? fun (Ex_ty t, _) ->
+        (Lwt.return (parse_ty false t)) >>=? fun (Ex_ty t, _) ->
         parse_data ?type_logger ctxt t d >>=? fun v ->
         return (typed loc (Const v, Item_t (t, stack, instr_annot)))
     | Prim (loc, I_UNIT, [], instr_annot),
@@ -1230,7 +1288,7 @@ and parse_instr
         return (typed loc (Cons_some, Item_t (Option_t t, rest, instr_annot)))
     | Prim (loc, I_NONE, [ t ], instr_annot),
       stack ->
-        (Lwt.return (parse_ty t)) >>=? fun (Ex_ty t, _) ->
+        (Lwt.return (parse_ty false t)) >>=? fun (Ex_ty t, _) ->
         return (typed loc (Cons_none t, Item_t (Option_t t, stack, instr_annot)))
     | Prim (loc, I_IF_NONE, [ bt ; bf ], instr_annot),
       (Item_t (Option_t t, rest, _) as bef) ->
@@ -1256,11 +1314,11 @@ and parse_instr
     (* unions *)
     | Prim (loc, I_LEFT, [ tr ], instr_annot),
       Item_t (tl, rest, stack_annot) ->
-        (Lwt.return (parse_ty tr)) >>=? fun (Ex_ty tr, _) ->
+        (Lwt.return (parse_ty false tr)) >>=? fun (Ex_ty tr, _) ->
         return (typed loc (Left, Item_t (Union_t ((tl, stack_annot), (tr, None)), rest, instr_annot)))
     | Prim (loc, I_RIGHT, [ tl ], instr_annot),
       Item_t (tr, rest, stack_annot) ->
-        (Lwt.return (parse_ty tl)) >>=? fun (Ex_ty tl, _) ->
+        (Lwt.return (parse_ty false tl)) >>=? fun (Ex_ty tl, _) ->
         return (typed loc (Right, Item_t (Union_t ((tl, None), (tr, stack_annot)), rest, instr_annot)))
     | Prim (loc, I_IF_LEFT, [ bt ; bf ], instr_annot),
       (Item_t (Union_t ((tl, left_annot), (tr, right_annot)), rest, _) as bef) ->
@@ -1275,7 +1333,7 @@ and parse_instr
     (* lists *)
     | Prim (loc, I_NIL, [ t ], instr_annot),
       stack ->
-        (Lwt.return (parse_ty t)) >>=? fun (Ex_ty t, _) ->
+        (Lwt.return (parse_ty false t)) >>=? fun (Ex_ty t, _) ->
         return (typed loc (Nil, Item_t (List_t t, stack, instr_annot)))
     | Prim (loc, I_CONS, [], instr_annot),
       Item_t (tv, Item_t (List_t t, rest, _), _) ->
@@ -1376,7 +1434,7 @@ and parse_instr
     | Prim (loc, I_EMPTY_MAP, [ tk ; tv ], instr_annot),
       stack ->
         (Lwt.return (parse_comparable_ty tk)) >>=? fun (Ex_comparable_ty tk) ->
-        (Lwt.return (parse_ty tv)) >>=? fun (Ex_ty tv, _) ->
+        (Lwt.return (parse_ty false tv)) >>=? fun (Ex_ty tv, _) ->
         return (typed loc (Empty_map (tk, tv), Item_t (Map_t (tk, tv), stack, instr_annot)))
     | Prim (loc, I_MAP, [], instr_annot),
       Item_t (Lambda_t (Pair_t ((pk, _), (pv, _)), ret),
@@ -1431,6 +1489,23 @@ and parse_instr
     | Prim (loc, I_SIZE, [], instr_annot),
       Item_t (Map_t (_, _), rest, _) ->
         return (typed loc (Map_size, Item_t (Nat_t, rest, instr_annot)))
+    (* big_map *)
+    | Prim (loc, I_MEM, [], instr_annot),
+      Item_t (set_key, Item_t (Big_map_t (map_key, _), rest, _), _) ->
+        let k = ty_of_comparable_ty map_key in
+        check_item_ty set_key k loc I_MEM 1 2 >>=? fun Eq ->
+        return (typed loc (Big_map_mem, Item_t (Bool_t, rest, instr_annot)))
+    | Prim (loc, I_GET, [], instr_annot),
+      Item_t (vk, Item_t (Big_map_t (ck, elt), rest, _), _) ->
+        let k = ty_of_comparable_ty ck in
+        check_item_ty vk k loc I_GET 1 2 >>=? fun Eq ->
+        return (typed loc (Big_map_get, Item_t (Option_t elt, rest, instr_annot)))
+    | Prim (loc, I_UPDATE, [], instr_annot),
+      Item_t (set_key, Item_t (Option_t set_value, Item_t (Big_map_t (map_key, map_value), rest, _), _), _) ->
+        let k = ty_of_comparable_ty map_key in
+        check_item_ty set_key k loc I_UPDATE 1 3 >>=? fun Eq ->
+        check_item_ty set_value map_value loc I_UPDATE 2 3 >>=? fun Eq ->
+        return (typed loc (Big_map_update, Item_t (Big_map_t (map_key, map_value), rest, instr_annot)))
     (* control *)
     | Seq (loc, [], annot),
       stack ->
@@ -1504,8 +1579,8 @@ and parse_instr
         end
     | Prim (loc, I_LAMBDA, [ arg ; ret ; code ], instr_annot),
       stack ->
-        (Lwt.return (parse_ty arg)) >>=? fun (Ex_ty arg, arg_annot) ->
+        (Lwt.return (parse_ty false arg)) >>=? fun (Ex_ty arg, arg_annot) ->
-        (Lwt.return (parse_ty ret)) >>=? fun (Ex_ty ret, _) ->
+        (Lwt.return (parse_ty false ret)) >>=? fun (Ex_ty ret, _) ->
         check_kind [ Seq_kind ] code >>=? fun () ->
         parse_returning Lambda ?type_logger ctxt
           (arg, default_annot ~default:default_arg_annot arg_annot)
@@ -1776,13 +1851,13 @@ and parse_instr
         Lwt.return (parse_toplevel cannonical_code) >>=? fun (arg_type, ret_type, storage_type, code_field) ->
         trace
           (Ill_formed_type (Some "parameter", cannonical_code, location arg_type))
-          (Lwt.return (parse_ty arg_type)) >>=? fun (Ex_ty arg_type, param_annot) ->
+          (Lwt.return (parse_ty false arg_type)) >>=? fun (Ex_ty arg_type, param_annot) ->
         trace
           (Ill_formed_type (Some "return", cannonical_code, location ret_type))
-          (Lwt.return (parse_ty ret_type)) >>=? fun (Ex_ty ret_type, _) ->
+          (Lwt.return (parse_ty false ret_type)) >>=? fun (Ex_ty ret_type, _) ->
         trace
           (Ill_formed_type (Some "storage", cannonical_code, location storage_type))
-          (Lwt.return (parse_ty storage_type)) >>=? fun (Ex_ty storage_type, storage_annot) ->
+          (Lwt.return (parse_ty true storage_type)) >>=? fun (Ex_ty storage_type, storage_annot) ->
         let arg_type_full = Pair_t ((arg_type, default_annot ~default:default_param_annot param_annot),
                                     (storage_type, default_annot ~default:default_storage_annot storage_annot)) in
         let ret_type_full = Pair_t ((ret_type, None), (storage_type, None)) in
@@ -1791,7 +1866,7 @@ and parse_instr
           (parse_returning (Toplevel { storage_type ; param_type = arg_type ; ret_type })
              ctxt ?type_logger (arg_type_full, None) ret_type_full code_field) >>=?
         fun (Lam ({ bef = Item_t (arg, Empty_t, _) ;
-                    aft = Item_t (ret, Empty_t, _) ; _ }, _) as lambda) ->
+                    aft = Item_t (ret, Empty_t, _) }, _) as lambda) ->
         Lwt.return @@ ty_eq arg arg_type_full >>=? fun Eq ->
         Lwt.return @@ ty_eq ret ret_type_full >>=? fun Eq ->
         Lwt.return @@ ty_eq storage_type ginit >>=? fun Eq ->
@@ -1820,15 +1895,15 @@ and parse_instr
         return (typed loc (Steps_to_quota, Item_t (Nat_t, stack, instr_annot)))
     | Prim (loc, I_SOURCE, [ ta; tb ], instr_annot),
       stack ->
-        (Lwt.return (parse_ty ta)) >>=? fun (Ex_ty ta, _) ->
+        (Lwt.return (parse_ty false ta)) >>=? fun (Ex_ty ta, _) ->
-        (Lwt.return (parse_ty tb)) >>=? fun (Ex_ty tb, _) ->
+        (Lwt.return (parse_ty false tb)) >>=? fun (Ex_ty tb, _) ->
         return (typed loc (Source (ta, tb), Item_t (Contract_t (ta, tb), stack, instr_annot)))
     | Prim (loc, I_SELF, [], instr_annot),
       stack ->
         let rec get_toplevel_type : tc_context -> bef judgement tzresult Lwt.t = function
           | Lambda -> fail (Self_in_lambda loc)
           | Dip (_, prev) -> get_toplevel_type prev
-          | Toplevel { param_type ; ret_type ; _ } ->
+          | Toplevel { param_type ; ret_type } ->
               return (typed loc (Self (param_type, ret_type),
                                  Item_t (Contract_t (param_type, ret_type), stack, instr_annot))) in
         get_toplevel_type tc_context
@@ -1860,7 +1935,7 @@ and parse_instr
                  as name), ([] | [ _ ]
                            | _ :: _ :: _ :: _ as l), _), _ ->
         fail (Invalid_arity (loc, name, 2, List.length l))
-    | Prim (loc, I_LAMBDA, ([] | [ _ ] | [ _ ; _ ]
+    | Prim (loc, I_LAMBDA, ([] | [ _ ]
                            | _ :: _ :: _ :: _ :: _ as l), _), _ ->
         fail (Invalid_arity (loc, I_LAMBDA, 3, List.length l))
     (* Stack errors *)
@@ -1939,11 +2014,11 @@ and parse_contract
                let contract : (arg, ret) typed_contract =
                  (arg, ret, contract) in
                ok contract)
-        | Some { code ; _ } ->
+        | Some { code } ->
             Lwt.return
               (parse_toplevel code >>? fun (arg_type, ret_type, _, _) ->
-               parse_ty arg_type >>? fun (Ex_ty targ, _) ->
+               parse_ty false arg_type >>? fun (Ex_ty targ, _) ->
-               parse_ty ret_type >>? fun (Ex_ty tret, _) ->
+               parse_ty false ret_type >>? fun (Ex_ty tret, _) ->
                ty_eq targ arg >>? fun Eq ->
                ty_eq tret ret >>? fun Eq ->
                let contract : (arg, ret) typed_contract =
@@ -2003,13 +2078,13 @@ let parse_script
     Lwt.return (parse_toplevel code) >>=? fun (arg_type, ret_type, storage_type, code_field) ->
     trace
       (Ill_formed_type (Some "parameter", code, location arg_type))
-      (Lwt.return (parse_ty arg_type)) >>=? fun (Ex_ty arg_type, param_annot) ->
+      (Lwt.return (parse_ty false arg_type)) >>=? fun (Ex_ty arg_type, param_annot) ->
     trace
       (Ill_formed_type (Some "return", code, location ret_type))
-      (Lwt.return (parse_ty ret_type)) >>=? fun (Ex_ty ret_type, _) ->
+      (Lwt.return (parse_ty false ret_type)) >>=? fun (Ex_ty ret_type, _) ->
     trace
       (Ill_formed_type (Some "storage", code, location storage_type))
-      (Lwt.return (parse_ty storage_type)) >>=? fun (Ex_ty storage_type, storage_annot) ->
+      (Lwt.return (parse_ty true storage_type)) >>=? fun (Ex_ty storage_type, storage_annot) ->
     let arg_type_full = Pair_t ((arg_type, default_annot ~default:default_param_annot param_annot),
                                 (storage_type, default_annot ~default:default_storage_annot storage_annot)) in
     let ret_type_full = Pair_t ((ret_type, None), (storage_type, None)) in
@@ -2031,13 +2106,13 @@ let typecheck_code
     (* TODO: annotation checking *)
     trace
       (Ill_formed_type (Some "parameter", code, location arg_type))
-      (Lwt.return (parse_ty arg_type)) >>=? fun (Ex_ty arg_type, param_annot) ->
+      (Lwt.return (parse_ty false arg_type)) >>=? fun (Ex_ty arg_type, param_annot) ->
     trace
       (Ill_formed_type (Some "return", code, location ret_type))
-      (Lwt.return (parse_ty ret_type)) >>=? fun (Ex_ty ret_type, _) ->
+      (Lwt.return (parse_ty false ret_type)) >>=? fun (Ex_ty ret_type, _) ->
     trace
       (Ill_formed_type (Some "storage", code, location storage_type))
-      (Lwt.return (parse_ty storage_type)) >>=? fun (Ex_ty storage_type, storage_annot) ->
+      (Lwt.return (parse_ty true storage_type)) >>=? fun (Ex_ty storage_type, storage_annot) ->
     let arg_type_full = Pair_t ((arg_type, default_annot ~default:default_param_annot param_annot),
                                 (storage_type, default_annot ~default:default_storage_annot storage_annot)) in
     let ret_type_full = Pair_t ((ret_type, None), (storage_type, None)) in
@@ -2058,7 +2133,7 @@ let typecheck_data
   = fun ?type_logger ctxt (data, exp_ty) ->
     trace
       (Ill_formed_type (None, exp_ty, 0))
-      (Lwt.return (parse_ty (root exp_ty))) >>=? fun (Ex_ty exp_ty, _) ->
+      (Lwt.return (parse_ty true (root exp_ty))) >>=? fun (Ex_ty exp_ty, _) ->
     trace
       (Ill_typed_data (None, data, exp_ty))
       (parse_data ?type_logger ctxt exp_ty (root data)) >>=? fun _ ->
@@ -2068,3 +2143,52 @@ let hash_data typ data =
   let unparsed = strip_annotations @@ unparse_data typ data in
   let bytes = Data_encoding.Binary.to_bytes expr_encoding (Micheline.strip_locations unparsed) in
   Tezos_hash.Script_expr_hash.(hash_bytes [ bytes ] |> to_b58check)
+
+(* ---------------- Big map -------------------------------------------------*)
+
+let big_map_mem ctx contract key { diff ; key_type } =
+  match map_get key diff with
+  | None -> Tezos_context.Contract.Big_map_storage.mem ctx contract (hash_data key_type key)
+  | Some None -> Lwt.return false
+  | Some (Some _) -> Lwt.return true
+
+let big_map_get ctx contract key { diff ; key_type ; value_type } =
+  match map_get key diff with
+  | Some x -> return x
+  | None ->
+      Tezos_context.Contract.Big_map_storage.get_opt
+        ctx contract
+        (hash_data key_type key) >>=? begin function
+        | None -> return None
+        | Some value -> parse_data ctx value_type (Micheline.root value) >>|? fun x -> Some x
+      end
+
+let big_map_update key value ({ diff } as map) =
+  { map with diff = map_set key value diff }
+
+let to_big_map_diff_list { key_type ; value_type ; diff } =
+  map_fold (fun key value acc ->
+      (hash_data key_type key,
+       Option.map ~f:(fun x -> Micheline.strip_locations @@ unparse_data value_type x) value) :: acc)
+    diff []
+
+(* Get the big map from a contract's storage if one exists *)
+let extract_big_map : type a. a ty -> a -> ex_big_map option = fun ty x ->
+  match (ty, x) with
+  | Pair_t ((Big_map_t (_, _), _), _), (map, _) -> Some (Ex_bm map)
+  | _, _ -> None
+
+let to_serializable_big_map (Ex_bm bm) =
+  to_big_map_diff_list bm
+
+let to_printable_big_map (Ex_bm { diff ; key_type ; value_type }) =
+  map_fold (fun key value acc ->
+      (Micheline.strip_locations @@ unparse_data key_type key,
+       Option.map ~f:(fun x -> Micheline.strip_locations @@ unparse_data value_type x) value) :: acc) diff []
+
+let erase_big_map_initialization ctxt ({ code ; storage } : Script.t) =
+  Lwt.return (parse_toplevel code) >>=? fun (_, _, storage_type, _) ->
+  Lwt.return @@ parse_ty true storage_type >>=? fun (Ex_ty ty, _) ->
+  parse_data ctxt ty (Micheline.root storage) >>|? fun data ->
+  ({ code ; storage = Micheline.strip_locations @@ unparse_data ty data },
+   Option.map ~f:to_serializable_big_map (extract_big_map ty data))

src/proto_alpha/lib_protocol/src/script_ir_translator.mli

@@ -17,7 +17,6 @@ type ex_ty = Ex_ty : 'a Script_typed_ir.ty -> ex_ty
 type ex_stack_ty = Ex_stack_ty : 'a Script_typed_ir.stack_ty -> ex_stack_ty
 type ex_script = Ex_script : ('a, 'b, 'c) Script_typed_ir.script -> ex_script
 
-
 (* ---- Sets and Maps -------------------------------------------------------*)
 
 val empty_set : 'a Script_typed_ir.comparable_ty -> 'a Script_typed_ir.set
@@ -39,6 +38,14 @@ val map_get : 'key -> ('key, 'value) Script_typed_ir.map -> 'value option
 val map_key_ty : ('a, 'b) Script_typed_ir.map -> 'a Script_typed_ir.comparable_ty
 val map_size : ('a, 'b) Script_typed_ir.map -> Script_int.n Script_int.num
 
+val big_map_mem : context -> Tezos_context.Contract.t -> 'key -> ('key, 'value) Script_typed_ir.big_map -> bool Lwt.t
+val big_map_get :
+  context -> Tezos_context.Contract.t -> 'key -> ('key, 'value) Script_typed_ir.big_map ->
+  'value option tzresult Lwt.t
+val big_map_update :
+  'key -> 'value option -> ('key, 'value) Script_typed_ir.big_map ->
+  ('key, 'value) Script_typed_ir.big_map
+
 val ty_eq :
   'ta Script_typed_ir.ty -> 'tb Script_typed_ir.ty ->
   ('ta Script_typed_ir.ty, 'tb Script_typed_ir.ty) eq tzresult
@@ -49,7 +56,7 @@ val parse_data :
 val unparse_data :
   'a Script_typed_ir.ty -> 'a -> Script.node
 
-val parse_ty :
+val parse_ty : bool ->
   Script.node -> (ex_ty * Script_typed_ir.annot) tzresult
 val unparse_ty :
   string option -> 'a Script_typed_ir.ty -> Script.node
@@ -69,3 +76,12 @@ val parse_script :
   context -> Script.t -> ex_script tzresult Lwt.t
 
 val hash_data : 'a Script_typed_ir.ty -> 'a -> string
+
+val extract_big_map : 'a Script_typed_ir.ty -> 'a -> Script_typed_ir.ex_big_map option
+
+val to_serializable_big_map : Script_typed_ir.ex_big_map -> Contract_storage.big_map_diff
+
+val to_printable_big_map : Script_typed_ir.ex_big_map -> (Script.expr * Script.expr option) list
+
+val erase_big_map_initialization : context -> Script.t ->
+  (Script.t * Contract_storage.big_map_diff option) tzresult Lwt.t

src/proto_alpha/lib_protocol/src/script_tc_errors.ml

@@ -26,6 +26,7 @@ type error += Invalid_primitive of Script.location * prim list * prim
 type error += Invalid_kind of Script.location * kind list * kind
 type error += Missing_field of prim
 type error += Duplicate_field of Script.location * prim
+type error += Unexpected_big_map of Script.location
 
 (* Instruction typing errors *)
 type error += Fail_not_in_tail_position of Script.location

src/proto_alpha/lib_protocol/src/script_tc_errors_registration.ml

@@ -30,7 +30,7 @@ let ex_ty_enc =
   Data_encoding.conv
     (fun (Ex_ty ty) -> strip_locations (unparse_ty None ty))
     (fun expr ->
-       match parse_ty (root expr) with
+       match parse_ty true (root expr) with
        | Ok (Ex_ty ty, _) -> Ex_ty ty
        | _ -> Ex_ty Unit_t (* FIXME: ? *))
     Script.expr_encoding
@@ -164,6 +164,18 @@ let () =
        (req "prim" prim_encoding))
     (function Duplicate_field (loc, prim) -> Some (loc, prim) | _ -> None)
     (fun (loc, prim) -> Duplicate_field (loc, prim)) ;
+  (* Unexpected big_map *)
+  register_error_kind
+    `Permanent
+    ~id:"unexpectedBigMap"
+    ~title: "Big map in unauthorized position (type error)"
+    ~description:
+      "When parsing script, a big_map type was found somewhere else \
+       than in the left component of the toplevel storage pair."
+    (obj1
+       (req "loc" location_encoding))
+    (function Unexpected_big_map loc -> Some loc | _ -> None)
+    (fun loc -> Unexpected_big_map loc) ;
   (* -- Value typing errors ---------------------- *)
   (* Unordered map keys *)
   register_error_kind

src/proto_alpha/lib_protocol/src/script_typed_ir.ml

@@ -41,6 +41,8 @@ end
 
 type ('key, 'value) map = (module Boxed_map with type key = 'key and type value = 'value)
 
+type annot = string option
+
 type ('arg, 'ret, 'storage) script =
   { code : (('arg, 'storage) pair, ('ret, 'storage) pair) lambda ;
     arg_type : 'arg ty ;
@@ -60,8 +62,6 @@ and ('arg, 'ret) lambda =
 and ('arg, 'ret) typed_contract =
   'arg ty * 'ret ty * Contract.t
 
-and annot = string option
-
 and 'ty ty =
   | Unit_t : unit ty
   | Int_t : z num ty
@@ -80,12 +80,17 @@ and 'ty ty =
   | List_t : 'v ty -> 'v list ty
   | Set_t : 'v comparable_ty -> 'v set ty
   | Map_t : 'k comparable_ty * 'v ty -> ('k, 'v) map ty
+  | Big_map_t : 'k comparable_ty * 'v ty -> ('k, 'v) big_map ty
   | Contract_t : 'arg ty * 'ret ty -> ('arg, 'ret) typed_contract ty
 
 and 'ty stack_ty =
   | Item_t : 'ty ty * 'rest stack_ty * annot -> ('ty * 'rest) stack_ty
   | Empty_t : end_of_stack stack_ty
 
+and ('key, 'value) big_map = { diff : ('key, 'value option) map ;
+                               key_type : 'key ty ;
+                               value_type : 'value ty }
+
 (* ---- Instructions --------------------------------------------------------*)
 
 (* The low-level, typed instructions, as a GADT whose parameters
@@ -176,6 +181,13 @@ and ('bef, 'aft) instr =
   | Map_update :
       ('a * ('v option * (('a, 'v) map * 'rest)), ('a, 'v) map * 'rest) instr
   | Map_size : (('a, 'b) map * 'rest, n num * 'rest) instr
+  (* big maps *)
+  | Big_map_mem :
+      ('a * (('a, 'v) big_map * 'rest), bool * 'rest) instr
+  | Big_map_get :
+      ('a * (('a, 'v) big_map * 'rest), 'v option * 'rest) instr
+  | Big_map_update :
+      ('key * ('value option * (('key, 'value) big_map * 'rest)), ('key, 'value) big_map * 'rest) instr
   (* string operations *)
   | Concat :
       (string * (string * 'rest), string * 'rest) instr
@@ -343,3 +355,5 @@ and ('bef, 'aft) descr =
     bef : 'bef stack_ty ;
     aft : 'aft stack_ty ;
     instr : ('bef, 'aft)  instr }
+
+type ex_big_map = Ex_bm : ('key, 'value) big_map -> ex_big_map

src/proto_alpha/lib_protocol/src/services.ml

@@ -445,9 +445,10 @@ module Helpers = struct
       ~query: RPC_query.empty
       ~input: run_code_input_encoding
       ~output: (wrap_tzerror
-                  (obj2
+                  (obj3
                      (req "storage" Script.expr_encoding)
-                     (req "output" Script.expr_encoding)))
+                     (req "output" Script.expr_encoding)
+                     (opt "big_map_diff" (list (tup2 Script.expr_encoding (option Script.expr_encoding))))))
       ~error: Data_encoding.empty
       RPC_path.(custom_root / "helpers" / "run_code")
 
@@ -473,14 +474,15 @@ module Helpers = struct
       ~query: RPC_query.empty
       ~input: run_code_input_encoding
       ~output: (wrap_tzerror
-                  (obj3
+                  (obj4
                      (req "storage" Script.expr_encoding)
                      (req "output" Script.expr_encoding)
                      (req "trace"
                         (list @@ obj3
                            (req "location" Script.location_encoding)
                            (req "gas" Gas.encoding)
-                           (req "stack" (list (Script.expr_encoding)))))))
+                           (req "stack" (list (Script.expr_encoding)))))
+                     (opt "big_map_diff" (list (tup2 Script.expr_encoding (option Script.expr_encoding))))))
       ~error: Data_encoding.empty
       RPC_path.(custom_root / "helpers" / "trace_code")
 
@@ -509,12 +511,12 @@ module Helpers = struct
     RPC_service.post_service
       ~description: "Computes the hash of some data expression \
                      using the same algorithm as script instruction H"
-      ~query: RPC_query.empty
       ~input: (obj2 (req "data" Script.expr_encoding)
                  (req "type" Script.expr_encoding))
       ~output: (wrap_tzerror @@
                 obj1 (req "hash" string))
       ~error: Data_encoding.empty
+      ~query: RPC_query.empty
       RPC_path.(custom_root / "helpers" / "hash_data")
 
   let level custom_root =

src/proto_alpha/lib_protocol/src/services_registration.ml

@@ -297,8 +297,8 @@ let () =
          contract (* transaction initiator *)
          contract (* script owner *)
          ctxt { storage ; code } amount input
-         (Gas.of_int gas) >>=? fun (sto, ret, _gas, _ctxt, _) ->
+         (Gas.of_int gas) >>=? fun (sto, ret, _gas, _ctxt, _, maybe_big_map_diff) ->
-       Error_monad.return (sto, ret)) ;
+       Error_monad.return (sto, ret, Option.map ~f:Script_ir_translator.to_printable_big_map maybe_big_map_diff)) ;
   register1 Services.Helpers.trace_code
     (fun ctxt () parameters ->
        let (code, storage, input, amount, contract, gas, origination_nonce) =
@@ -308,8 +308,8 @@ let () =
          contract (* transaction initiator *)
          contract (* script owner *)
          ctxt { storage ; code } amount input
-         (Gas.of_int gas) >>=? fun ((sto, ret, _gas, _ctxt, _), trace) ->
+         (Gas.of_int gas) >>=? fun ((sto, ret, _gas, _ctxt, _, maybe_big_map_diff), trace) ->
-       Error_monad.return (sto, ret, trace))
+       Error_monad.return (sto, ret, trace, Option.map ~f:Script_ir_translator.to_printable_big_map maybe_big_map_diff))
 
 let () =
   register1 Services.Helpers.typecheck_code
@@ -323,7 +323,7 @@ let () =
   register1 Services.Helpers.hash_data
     (fun ctxt () (expr, typ) ->
        let open Script_ir_translator in
-       Lwt.return @@ parse_ty (Micheline.root typ) >>=? fun (Ex_ty typ, _) ->
+       Lwt.return @@ parse_ty false (Micheline.root typ) >>=? fun (Ex_ty typ, _) ->
        parse_data ctxt typ (Micheline.root expr) >>=? fun data ->
        return (Script_ir_translator.hash_data typ data))
 

src/proto_alpha/lib_protocol/src/storage.ml

@@ -20,6 +20,15 @@ module Bool = struct
   let encoding = Data_encoding.bool
 end
 
+module String_index = struct
+  type t = string
+  let path_length = 1
+  let to_path c l = c :: l
+  let of_path = function
+    | [ c ] -> Some c
+    | [] | _ :: _ :: _ -> None
+end
+
 (** Contracts handling *)
 
 module Contract = struct
@@ -86,6 +95,18 @@ module Contract = struct
          type t = Script_repr.expr
          let encoding = Script_repr.expr_encoding
        end))
+  type bigmap_key = Raw_context.t * Contract_repr.t
+
+  module Big_map =
+    Storage_functors.Make_indexed_data_storage
+      (Make_subcontext
+         (Indexed_context.Raw_context)
+         (struct let name = ["big_map"] end))
+      (String_index)
+      (Make_value (struct
+         type t = Script_repr.expr
+         let encoding = Script_repr.expr_encoding
+       end))
 
   module Code_fees =
     Indexed_context.Make_map

src/proto_alpha/lib_protocol/src/storage.mli

@@ -147,6 +147,13 @@ module Contract : sig
      and type value = Tez_repr.t
      and type t := Raw_context.t
 
+  type bigmap_key = Raw_context.t * Contract_repr.t
+
+  module Big_map : Indexed_data_storage
+    with type key = string
+     and type value = Script_repr.expr
+     and type t := bigmap_key
+
 end
 
 (** Votes *)

src/proto_alpha/lib_protocol/src/tezos_context.ml

@@ -107,6 +107,14 @@ end
 module Contract = struct
   include Contract_repr
   include Contract_storage
+
+  module Big_map_storage = struct
+    let set ctx contract = Contract_storage.Big_map.set (ctx, contract)
+    let remove ctx contract = Contract_storage.Big_map.remove (ctx, contract)
+    let mem ctx contract = Contract_storage.Big_map.mem (ctx, contract)
+    let get_opt ctx contract = Contract_storage.Big_map.get_opt (ctx, contract)
+  end
+
 end
 module Roll = struct
   include Roll_repr

src/proto_alpha/lib_protocol/src/tezos_context.mli

@@ -216,6 +216,7 @@ module Script : sig
     | T_lambda
     | T_list
     | T_map
+    | T_big_map
     | T_nat
     | T_option
     | T_or
@@ -466,7 +467,8 @@ module Contract : sig
     context -> contract -> Tez.t -> context tzresult Lwt.t
 
   val update_script_storage_and_fees:
-    context -> contract -> Tez.t -> Script.expr -> context tzresult Lwt.t
+    context -> contract -> Tez.t -> Script.expr ->
+    (string * Script.expr option) list option -> context tzresult Lwt.t
 
   val increment_counter:
     context -> contract -> context tzresult Lwt.t
@@ -474,6 +476,17 @@ module Contract : sig
   val check_counter_increment:
     context -> contract -> int32 -> unit tzresult Lwt.t
 
+  module Big_map_storage : sig
+    val set :
+      context -> contract ->
+      string -> Script.expr -> context tzresult Lwt.t
+    val remove :
+      context -> contract -> string -> context tzresult Lwt.t
+    val mem : context -> contract -> string -> bool Lwt.t
+    val get_opt :
+      context -> contract -> string -> Script_repr.expr option tzresult Lwt.t
+  end
+
 end
 
 module Vote : sig

src/proto_alpha/lib_protocol/test/helpers/helpers_script.mli

@@ -13,6 +13,6 @@ open Tezos_context
 val init_amount : int
 val execute_code_pred :
   ?tc:Tezos_context.t -> Helpers_block.result -> Script.t -> Script.expr ->
-  (Script.expr * Script.expr * Gas.t * context * Contract.origination_nonce)
+  (Script.expr * Script.expr * Gas.t * context * Contract.origination_nonce * Script_typed_ir.ex_big_map option)
     proto_tzresult Lwt.t
 

src/proto_alpha/lib_protocol/test/jbuild

@@ -4,11 +4,13 @@
  ((name main)
   (libraries (tezos-base
               tezos-test-helpers
+              tezos-micheline
               tezos_proto_alpha_isolate_helpers
               tezos_proto_alpha_isolate_michelson_parser))
   (flags (:standard -w -9-32 -safe-string
                     -open Tezos_base__TzPervasives
                     -open Tezos_test_helpers
+                    -open Tezos_micheline
                     -open Tezos_proto_alpha_isolate_michelson_parser))))
 
 (alias

src/proto_alpha/lib_protocol/test/test_michelson.ml

@@ -25,8 +25,6 @@ open Shorthands
 let (>>??) = Assert.(>>??)
 let (>>=??) = Assert.(>>=??)
 
-open Tezos_micheline
-
 let parse_param s : Proto_alpha.Tezos_context.Script.expr =
   let (parsed, _) = Michelson_v1_parser.parse_expression s in
   parsed.expanded
@@ -50,9 +48,9 @@ let quote s = "\"" ^ s ^ "\""
 let parse_execute sb ?tc code_str param_str storage_str =
   let param = parse_param param_str in
   let script = parse_script code_str storage_str in
-  Script.execute_code_pred ?tc sb script param >>=?? fun (ret, st, _, tc, nonce) ->
+  Script.execute_code_pred ?tc sb script param >>=?? fun (ret, st, _, tc, nonce, bgm) ->
   let contracts = Contract.originated_contracts nonce in
-  return (ret, st, tc, contracts)
+  return (ret, st, tc, contracts, bgm)
 
 let test ctxt ?tc (file_name: string) (storage: string) (input: string) =
   let full_path = contract_path // file_name ^ ".tz" in
@@ -79,7 +77,7 @@ let string_of_canon output_prim =
   output
 
 let test_print ctxt fn s i =
-  test ctxt fn s i >>=? fun (sp, op, _, _) ->
+  test ctxt fn s i >>=? fun (sp, op, _, _, _bgm) ->
   let ss = string_of_canon sp in
   let os = string_of_canon op in
   debug "Storage : %s" ss ;
@@ -88,7 +86,7 @@ let test_print ctxt fn s i =
 
 
 let test_output ctxt ?location (file_name: string) (storage: string) (input: string) (expected_output: string) =
-  test ctxt file_name storage input >>=? fun (_storage_prim, output_prim, _tc, _contracts) ->
+  test ctxt file_name storage input >>=? fun (_storage_prim, output_prim, _tc, _contracts, _bgm) ->
   let output = string_of_canon output_prim in
   let msg = Option.unopt ~default:"strings aren't equal" location in
   Assert.equal_string ~msg expected_output output ;
@@ -96,18 +94,18 @@ let test_output ctxt ?location (file_name: string) (storage: string) (input: str
 
 
 let test_tc ctxt ?tc (file_name: string) (storage: string) (input: string) =
-  test ctxt ?tc file_name storage input >>=? fun (_storage_prim, _output_prim, tc, _contracts) ->
+  test ctxt ?tc file_name storage input >>=? fun (_storage_prim, _output_prim, tc, _contracts, _bgm) ->
   return (tc)
 
 
 let test_contract ctxt ?tc (file_name: string) (storage: string) (input: string) =
-  test ctxt ?tc file_name storage input >>=? fun (_storage_prim, _output_prim, tc, contracts) ->
+  test ctxt ?tc file_name storage input >>=? fun (_storage_prim, _output_prim, tc, contracts, _bgm) ->
   return (contracts, tc)
 
 
 
 let test_storage ctxt ?location (file_name: string) (storage: string) (input: string) (expected_storage: string) =
-  test ctxt file_name storage input >>=? fun (storage_prim, _output_prim, _tc, _contracts) ->
+  test ctxt file_name storage input >>=? fun (storage_prim, _output_prim, _tc, _contracts, _bgm) ->
   let storage = string_of_canon storage_prim in
   let msg = Option.unopt ~default:"strings aren't equal" location in
   Assert.equal_string ~msg expected_storage storage ;
@@ -439,7 +437,7 @@ let test_example () =
   let contract = List.hd cs in
   Proto_alpha.Tezos_context.Contract.get_script tc contract >>=?? fun res ->
   let script = Option.unopt_exn (Failure "get_script") res in
-  Script.execute_code_pred ~tc sb script (parse_param "\"abc\"") >>=?? fun (_, ret, _, _, _) ->
+  Script.execute_code_pred ~tc sb script (parse_param "\"abc\"") >>=?? fun (_, ret, _, _, _, _) ->
   Assert.equal_string ~msg: __LOC__ "\"abc\"" @@ string_of_canon ret ;
 
   (* Test DEFAULT_ACCOUNT *)