From e80839efe18f9481566ba1470893a755467112b7 Mon Sep 17 00:00:00 2001
From: Pierre Chambart <pierre.chambart@ocamlpro.com>
Date: Wed, 18 Jul 2018 19:14:51 +0200
Subject: [PATCH] Alpha: really allow big maps in lambda

---
 .../lib_protocol/src/script_ir_translator.ml  | 46 +++++++++++--------
 1 file changed, 28 insertions(+), 18 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml
index 4514a54cb..f4101ab0e 100644
--- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml
@@ -1143,6 +1143,11 @@ and parse_ty :
         parse_type_annot loc annot >>? fun ty_name ->
         Gas.consume ctxt (Typecheck_costs.type_ 2) >|? fun ctxt ->
         Ex_ty (Map_t (ta, tr, ty_name)), ctxt
+    | Prim (loc, T_big_map, args, annot)
+      when allow_big_map ->
+        parse_big_map_ty ctxt loc args annot >>? fun (big_map_ty, ctxt) ->
+        Gas.consume ctxt (Typecheck_costs.type_ 2) >|? fun ctxt ->
+        big_map_ty, ctxt
     | Prim (loc, T_big_map, _, _) ->
         error (Unexpected_big_map loc)
     | Prim (loc, (T_unit | T_signature
@@ -1164,6 +1169,19 @@ and parse_ty :
             T_string ; T_bytes ; T_mutez ; T_bool ;
             T_key ; T_key_hash ; T_timestamp ]
 
+and parse_big_map_ty ctxt big_map_loc args map_annot =
+  Gas.consume ctxt Typecheck_costs.cycle >>? fun ctxt ->
+  begin match args with
+    | [ key_ty ; value_ty ] ->
+        parse_comparable_ty ctxt key_ty >>? fun (Ex_comparable_ty key_ty, ctxt) ->
+        parse_ty ctxt ~allow_big_map:false ~allow_operation:false value_ty
+        >>? fun (Ex_ty value_ty, ctxt) ->
+        parse_type_annot big_map_loc map_annot >|? fun map_name ->
+        let big_map_ty = Big_map_t (key_ty, value_ty, map_name) in
+        Ex_ty big_map_ty, ctxt
+    | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args)
+  end
+
 and parse_storage_ty :
   context -> Script.node -> (ex_ty * context) tzresult
   = fun ctxt node ->
@@ -1172,24 +1190,16 @@ and parse_storage_ty :
             [ Prim (big_map_loc, T_big_map, args, map_annot) ; remaining_storage ],
             storage_annot) ->
         Gas.consume ctxt Typecheck_costs.cycle >>? fun ctxt ->
-        begin match args with
-          | [ key_ty ; value_ty ] ->
-              parse_comparable_ty ctxt key_ty >>? fun (Ex_comparable_ty key_ty, ctxt) ->
-              parse_ty ctxt ~allow_big_map:false ~allow_operation:false value_ty
-              >>? fun (Ex_ty value_ty, ctxt) ->
-              parse_ty ctxt ~allow_big_map:false ~allow_operation:false remaining_storage
-              >>? fun (Ex_ty remaining_storage, ctxt) ->
-              parse_type_annot big_map_loc map_annot >>? fun map_name ->
-              parse_composed_type_annot loc storage_annot
-              >>? fun (ty_name, map_field, storage_field) ->
-              Gas.consume ctxt (Typecheck_costs.type_ 5) >|? fun ctxt ->
-              let big_map_ty = Big_map_t (key_ty, value_ty, map_name) in
-              Ex_ty (Pair_t ((big_map_ty, map_field, None),
-                             (remaining_storage, storage_field, None),
-                             ty_name)),
-              ctxt
-          | args -> error @@ Invalid_arity (big_map_loc, T_big_map, 2, List.length args)
-        end
+        parse_big_map_ty ctxt big_map_loc args map_annot >>? fun (Ex_ty big_map_ty, ctxt) ->
+        parse_ty ctxt ~allow_big_map:false ~allow_operation:false remaining_storage
+        >>? fun (Ex_ty remaining_storage, ctxt) ->
+        parse_composed_type_annot loc storage_annot
+        >>? fun (ty_name, map_field, storage_field) ->
+        Gas.consume ctxt (Typecheck_costs.type_ 5) >|? fun ctxt ->
+        Ex_ty (Pair_t ((big_map_ty, map_field, None),
+                       (remaining_storage, storage_field, None),
+                       ty_name)),
+        ctxt
     | _ ->
         parse_ty ctxt ~allow_big_map:false ~allow_operation:false node