From 110e0206e7e31900a7f3758430676168c1270605 Mon Sep 17 00:00:00 2001
From: Milo Davis <davis.mil@husky.neu.edu>
Date: Thu, 13 Jul 2017 18:17:11 +0200
Subject: [PATCH] Michelson: allow CREATE_CONTRACT to set the spendable flag

---
 src/proto/alpha/script_interpreter.ml   |  6 +++---
 src/proto/alpha/script_ir_translator.ml | 15 ++++++++-------
 src/proto/alpha/script_typed_ir.ml      |  4 ++--
 3 files changed, 13 insertions(+), 12 deletions(-)

diff --git a/src/proto/alpha/script_interpreter.ml b/src/proto/alpha/script_interpreter.ml
index 089a5c0f0..8db3a0c07 100644
--- a/src/proto/alpha/script_interpreter.ml
+++ b/src/proto/alpha/script_interpreter.ml
@@ -459,8 +459,8 @@ let rec interp
               let contract = Contract.default_contract key in
               logged_return (Item ((Unit_t, Unit_t, contract), rest), qta - 1, ctxt)
           | Create_contract (g, p, r),
-            Item (manager, Item (delegate, Item (delegatable, Item (credit,
-                                                                    Item (Lam (_, code), Item (init, rest)))))) ->
+            Item (manager, Item (delegate, Item (spendable, Item (delegatable, Item (credit,
+                                                                    Item (Lam (_, code), Item (init, rest))))))) ->
               let code, storage =
                 { code; arg_type = unparse_ty p; ret_type = unparse_ty r; storage_type =  unparse_ty g },
                 { storage = unparse_data g init; storage_type =  unparse_ty g } in
@@ -470,7 +470,7 @@ let rec interp
                 origination
                 ~manager ~delegate ~balance
                 ~script:({ code ; storage }, (dummy_code_fee, dummy_storage_fee))
-                ~spendable:true ~delegatable
+                ~spendable ~delegatable
               >>=? fun (ctxt, contract, origination) ->
               logged_return ~origination (Item ((p, r, contract), rest), qta - 1, ctxt)
           | Balance, rest ->
diff --git a/src/proto/alpha/script_ir_translator.ml b/src/proto/alpha/script_ir_translator.ml
index a3ac777fd..9f134e76d 100644
--- a/src/proto/alpha/script_ir_translator.ml
+++ b/src/proto/alpha/script_ir_translator.ml
@@ -1273,12 +1273,13 @@ and parse_instr
         (Key_t, Item_t
            (Option_t Key_t, Item_t
               (Bool_t, Item_t
-                 (Tez_t, Item_t
-                    (Lambda_t (Pair_t (Pair_t (Tez_t, p), gp),
-                               Pair_t (r, gr)), Item_t
-                       (ginit, rest)))))) ->
-        check_item_ty gp gr loc "CREATE_CONTRACT" 5 6 >>=? fun (Eq _) ->
-        check_item_ty ginit gp loc "CREATE_CONTRACT" 6 6 >>=? fun (Eq _) ->
+                 (Bool_t, Item_t
+                    (Tez_t, Item_t
+                       (Lambda_t (Pair_t (Pair_t (Tez_t, p), gp),
+                                  Pair_t (r, gr)), Item_t
+                          (ginit, rest))))))) ->
+        check_item_ty gp gr loc "CREATE_CONTRACT" 5 7 >>=? fun (Eq _) ->
+        check_item_ty ginit gp loc "CREATE_CONTRACT" 6 7 >>=? fun (Eq _) ->
         return (typed loc (Create_contract (gp, p, r),
                            Item_t (Contract_t (p, r), rest)))
     | Prim (loc, "NOW", []),
@@ -1352,7 +1353,7 @@ and parse_instr
         fail (Bad_stack (loc, name, 3, stack))
     | Prim (loc, "CREATE_CONTRACT", []),
       stack ->
-        fail (Bad_stack (loc, "CREATE_CONTRACT", 6, stack))
+        fail (Bad_stack (loc, "CREATE_CONTRACT", 7, stack))
     | Prim (loc, "CREATE_ACCOUNT", []),
       stack ->
         fail (Bad_stack (loc, "CREATE_ACCOUNT", 4, stack))
diff --git a/src/proto/alpha/script_typed_ir.ml b/src/proto/alpha/script_typed_ir.ml
index a403813cf..4ac24f2f7 100644
--- a/src/proto/alpha/script_typed_ir.ml
+++ b/src/proto/alpha/script_typed_ir.ml
@@ -269,8 +269,8 @@ and ('bef, 'aft) instr =
        (unit, unit) typed_contract * 'rest) instr
   | Default_account : (public_key_hash * 'rest, (unit, unit) typed_contract * 'rest) instr
   | Create_contract : 'g ty * 'p ty * 'r ty ->
-    (public_key_hash * (public_key_hash option * (bool * (Tez.t *
-                                                          (((Tez.t * 'p) * 'g, 'r * 'g) lambda * ('g * 'rest))))),
+    (public_key_hash * (public_key_hash option * (bool * (bool * (Tez.t *
+                                                                 (((Tez.t * 'p) * 'g, 'r * 'g) lambda * ('g * 'rest)))))),
      ('p, 'r) typed_contract * 'rest) instr
   | Now :
       ('rest, Timestamp.t * 'rest) instr