Alpha/Michelson: allows big maps in genesis blocks

This patch allows to create a sandbox chain with bootstrap contracts
that uses big_maps. This change is mostly useful for testing in
sandbox mode or custom deployments.

This has no effect on mainnet.

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -1118,7 +1118,8 @@ end
 
 val prepare_first_block:
   Context.t ->
-  typecheck:(context -> Script.t -> context tzresult Lwt.t) ->
+  typecheck:(context -> Script.t ->
+             ((Script.t * Contract.big_map_diff option) * context) tzresult Lwt.t) ->
   level:Int32.t ->
   timestamp:Time.t ->
   fitness:Fitness.t ->

src/proto_alpha/lib_protocol/src/apply.ml

@@ -466,8 +466,8 @@ let apply_manager_operation_content :
               Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_storage)) >>=? fun ctxt ->
               Script.force_decode ctxt script.code >>=? fun (unparsed_code, ctxt) -> (* see [note] *)
               Lwt.return (Gas.consume ctxt (Script.deserialized_cost unparsed_code)) >>=? fun ctxt ->
-              Script_ir_translator.parse_script ctxt script >>=? fun (_, ctxt) ->
-              Script_ir_translator.erase_big_map_initialization ctxt Optimized script >>=? fun (script, big_map_diff, ctxt) ->
+              Script_ir_translator.parse_script ctxt script >>=? fun (ex_script, ctxt) ->
+              Script_ir_translator.big_map_initialization ctxt Optimized ex_script >>=? fun (big_map_diff, ctxt) ->
               return (Some (script, big_map_diff), ctxt)
         end >>=? fun (script, ctxt) ->
         spend ctxt source credit >>=? fun ctxt ->

src/proto_alpha/lib_protocol/src/bootstrap_storage.ml

@@ -39,12 +39,12 @@ let init_account ctxt
 let init_contract ~typecheck ctxt
     ({ delegate ; amount ; script }: Parameters_repr.bootstrap_contract) =
   Contract_storage.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) ->
-  typecheck ctxt script >>=? fun ctxt ->
+  typecheck ctxt script >>=? fun (script, ctxt) ->
   Contract_storage.originate ctxt contract
     ~balance:amount
     ~prepaid_bootstrap_storage:true
     ~manager:Signature.Public_key_hash.zero
-    ~script:(script, None)
+    ~script
     ~delegate:(Some delegate)
     ~spendable:false
     ~delegatable:false >>=? fun ctxt ->

src/proto_alpha/lib_protocol/src/bootstrap_storage.mli

@@ -25,7 +25,9 @@
 
 val init:
   Raw_context.t ->
-  typecheck:(Raw_context.t -> Script_repr.t -> Raw_context.t tzresult Lwt.t) ->
+  typecheck:(Raw_context.t -> Script_repr.t ->
+             ((Script_repr.t * Contract_storage.big_map_diff option) * Raw_context.t)
+               tzresult Lwt.t) ->
   ?ramp_up_cycles:int ->
   ?no_reward_cycles:int ->
   Parameters_repr.bootstrap_account list ->

src/proto_alpha/lib_protocol/src/main.ml

@@ -298,8 +298,9 @@ let init ctxt block_header =
   let fitness = block_header.fitness in
   let timestamp = block_header.timestamp in
   let typecheck (ctxt:Alpha_context.context) (script:Alpha_context.Script.t) =
-    Script_ir_translator.parse_script ctxt script >>=? fun (_ex_script, ctxt) ->
-    return ctxt
+    Script_ir_translator.parse_script ctxt script >>=? fun (ex_script, ctxt) ->
+    Script_ir_translator.big_map_initialization ctxt Optimized ex_script >>=? fun (big_map_diff, ctxt) ->
+    return ((script, big_map_diff), ctxt)
   in
   Alpha_context.prepare_first_block
     ~typecheck

src/proto_alpha/lib_protocol/src/script_ir_translator.ml

@@ -3229,19 +3229,8 @@ let extract_big_map : type a. a ty -> a -> ex_big_map option = fun ty x ->
   | Pair_t ((Big_map_t (_, _, _), _, _), _, _), (map, _) -> Some (Ex_bm map)
   | _, _ -> None
 
-let erase_big_map_initialization ctxt mode ({ code ; storage } : Script.t) =
-  Script.force_decode ctxt code >>=? fun (code, ctxt) ->
-  Script.force_decode ctxt storage >>=? fun (storage, ctxt) ->
-  Lwt.return @@ parse_toplevel code >>=? fun (_, storage_type, _) ->
-  Lwt.return @@ parse_storage_ty ctxt storage_type >>=? fun (Ex_ty ty, ctxt) ->
-  parse_data ctxt ty
-    (Micheline.root storage) >>=? fun (storage, ctxt) ->
-  begin
-    match extract_big_map ty storage with
-    | None -> return (None, ctxt)
-    | Some bm -> diff_of_big_map ctxt mode bm >>=? fun (bm, ctxt) ->
-        return (Some bm, ctxt)
-  end >>=? fun (bm, ctxt) ->
-  unparse_data ctxt mode ty storage >>=? fun (storage, ctxt) ->
-  return ({ code = Script.lazy_expr code ;
-            storage = Script.lazy_expr (Micheline.strip_locations storage) }, bm, ctxt)
+let big_map_initialization ctxt mode (Ex_script { storage ; storage_type; _ }) =
+  match extract_big_map storage_type storage with
+  | None -> return (None, ctxt)
+  | Some bm ->
+      diff_of_big_map ctxt mode bm >>=? fun (bm, ctxt) -> return (Some bm, ctxt)

src/proto_alpha/lib_protocol/src/script_ir_translator.mli

@@ -131,6 +131,6 @@ val diff_of_big_map :
   context -> unparsing_mode -> Script_typed_ir.ex_big_map ->
   (Contract.big_map_diff * context) tzresult Lwt.t
 
-val erase_big_map_initialization :
-  context -> unparsing_mode -> Script.t ->
-  (Script.t * Contract.big_map_diff option * context) tzresult Lwt.t
+val big_map_initialization :
+  context -> unparsing_mode -> ex_script ->
+  (Contract.big_map_diff option * context) tzresult Lwt.t