Alpha: originations from contracts are now internal operations

docs/whitedoc/michelson.rst

@@ -1382,15 +1382,15 @@ Operations on contracts
 
 ::
 
-    :: address : 'S   ->   key_hash : 'S
+    :: address : 'S   ->   key_hash option : 'S
     :: contract 'p : 'S   ->   key_hash : 'S
 
--  ``CREATE_CONTRACT``: Forge a new contract.
+-  ``CREATE_CONTRACT``: Forge a contract creation operation.
 
 ::
 
     :: key_hash : option key_hash : bool : bool : tez : lambda (pair 'p 'g) (pair (list operation) 'g) : 'g : 'S
-       -> contract 'p : 'S
+       -> operation : address : 'S
 
 As with non code-emitted originations the contract code takes as
 argument the transferred amount plus an ad-hoc argument and returns an
@@ -1401,7 +1401,8 @@ by another parameter. The calling convention for the code is as follows:
 the instruction type. The first parameters are the manager, optional
 delegate, then spendable and delegatable flags and finally the initial
 amount taken from the currently executed contract. The contract is
-returned as a first class value to be called immediately or stored.
+returned as a first class value (to be dropped, passed as parameter or stored).
+The ``CONTRACT 'p`` instruction will fail until it is actually originated.
 
 -  ``CREATE_CONTRACT { storage 'g ; parameter 'p ; code ... }``:
    Forge a new contract from a literal.
@@ -1409,20 +1410,20 @@ returned as a first class value to be called immediately or stored.
 ::
 
     :: key_hash : option key_hash : bool : bool : tez : 'g : 'S
-       -> contract 'p : 'S
+       -> operation : address : 'S
 
 Originate a contract based on a literal. This is currently the only way
 to include transfers inside of an originated contract. The first
 parameters are the manager, optional delegate, then spendable and
 delegatable flags and finally the initial amount taken from the
-currently executed contract. The contract is returned as a first class
+currently executed contract.
-value to be called immediately or stored.
 
--  ``CREATE_ACCOUNT``: Forge an account (a contract without code).
+-  ``CREATE_ACCOUNT``: Forge an account (a contract without code) creation operation.
 
 ::
 
-    :: key_hash : option key_hash : bool : tez : 'S   ->   contract unit : 'S
+    :: key_hash : option key_hash : bool : tez : 'S
+       ->   operation : contract unit : 'S
 
 Take as argument the manager, optional delegate, the delegatable flag
 and finally the initial amount taken from the currently executed

src/bin_client/test/contracts/create_account.tz

@@ -1,4 +1,12 @@
-parameter key_hash;
+parameter (or key_hash address) ;
-storage (contract unit);
+storage (option (contract unit)) ;
-code {CAR; DIP{PUSH tez "100.00"; PUSH bool False; NONE key_hash};
+code { CAR;
-      CREATE_ACCOUNT; NIL operation; PAIR};
+       IF_LEFT
+         { DIP { PUSH tez "100.00" ; PUSH bool False ; NONE key_hash };
+           CREATE_ACCOUNT ;
+           DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ;
+                 NIL operation ; SWAP ; CONS } ;
+           CONS ; NONE (contract unit) ; SWAP ; PAIR }
+         { SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ;
+           CONTRACT unit ; DUP ; IF_SOME { DROP } { FAIL } ;
+           NIL operation ; PAIR } } ;

src/bin_client/test/contracts/create_add1_lists.tz

@@ -1,5 +1,5 @@
 parameter unit;
-storage (contract (list int));
+storage address;
 code { DROP; NIL int; # starting storage for contract
        LAMBDA (pair (list int) (list int)) # Start of stack for contract (see above)
               (pair (list operation) (list int)) # End of stack for contract (see above)
@@ -15,4 +15,4 @@ code { DROP; NIL int; # starting storage for contract
        NONE key_hash;                 # No delegate
        PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5";
        CREATE_CONTRACT;          # Create the contract
-       NIL operation; PAIR}      # Ending calling convention stuff
+       NIL operation; SWAP; CONS; PAIR} # Ending calling convention stuff

src/bin_client/test/contracts/create_contract.tz

@@ -1,12 +1,18 @@
-parameter key_hash;
+parameter (or key_hash address);
-storage string;
+storage unit;
-code {CAR;
+code { CAR;
-      DIP{PUSH string "dummy";
+       IF_LEFT
-          LAMBDA (pair string string)
+         { DIP { PUSH string "dummy";
-                 (pair (list operation) string)
+                 LAMBDA (pair string string)
-                 {CAR; NIL operation; PAIR};
+                        (pair (list operation) string)
-          PUSH tez "100.00"; PUSH bool False;
+                        { CAR ; NIL operation ; PAIR };
-          PUSH bool False; NONE key_hash};
+                 PUSH tez "100.00" ; PUSH bool False ;
-      CREATE_CONTRACT; DIP{PUSH string ""}; PUSH tez "0.00";
+                 PUSH bool False ; NONE key_hash } ;
-      PUSH string "abcdefg"; TRANSFER_TOKENS;
+           CREATE_CONTRACT ;
-      NIL operation; SWAP; CONS; PAIR};
+           DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ;
+                 NIL operation ; SWAP ; CONS } ;
+           CONS ; UNIT ; SWAP ; PAIR }
+         { SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ;
+           CONTRACT string ; IF_SOME {} { FAIL } ;
+           PUSH tez "0.00" ; PUSH string "abcdefg" ; TRANSFER_TOKENS ;
+           NIL operation; SWAP; CONS ; UNIT ; SWAP ; PAIR } };

src/bin_client/test/contracts/create_contract_literal.tz

@@ -1,12 +1,18 @@
-parameter key_hash;
+parameter (or key_hash address);
 storage unit;
 code { CAR;
-       DIP { PUSH string "dummy";
+       IF_LEFT
-             PUSH tez "100.00"; PUSH bool False;
+         { DIP { PUSH string "dummy";
-             PUSH bool False; NONE key_hash };
+                 PUSH tez "100.00" ; PUSH bool False ;
-       CREATE_CONTRACT { parameter string ;
+                 PUSH bool False ; NONE key_hash } ;
-                         storage string ;
+           CREATE_CONTRACT
-                         code {CAR; NIL operation; PAIR } } ;
+             { parameter string ;
-       DIP{PUSH string ""}; PUSH tez "0.00";
+               storage string ;
-       PUSH string "abcdefg"; TRANSFER_TOKENS;
+               code { CAR ; NIL operation ; PAIR } } ;
-       DIP{DROP}; NIL operation; SWAP; CONS; UNIT; SWAP; PAIR};
+           DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ;
+                 NIL operation ; SWAP ; CONS } ;
+           CONS ; UNIT ; SWAP ; PAIR }
+         { SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ;
+           CONTRACT string ; IF_SOME {} { FAIL } ;
+           PUSH tez "0.00" ; PUSH string "abcdefg" ; TRANSFER_TOKENS ;
+           NIL operation; SWAP; CONS ; UNIT ; SWAP ; PAIR } };

src/bin_client/test/contracts/originator.tz

@@ -1,16 +1,16 @@
 parameter nat ;
-storage (list (contract unit)) ;
+storage (list address) ;
 code
-  { CAR ; DUP ; PUSH nat 0 ; CMPNEQ ;
+  { DUP ; CAR ; PUSH nat 0 ; CMPNEQ ;
-    DIIP { NIL (contract unit) } ;
+    DIP { DUP ; CAR ; DIP { CDR ; NIL operation } } ;
     LOOP
       { PUSH tez "5.00" ;
         PUSH bool True ; # delegatable
         NONE key_hash ; # delegate
         PUSH key_hash "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ; # manager
         CREATE_ACCOUNT ;
-        SWAP ; DIP { CONS } ;
+        SWAP ; DIP { SWAP ; DIP { CONS } } ;
+        SWAP ; DIP { SWAP ; DIP { CONS } } ;
         PUSH nat 1 ; SWAP ; SUB ; ABS ;
         DUP ; PUSH nat 0 ; CMPNEQ } ;
-    DROP ;
+    DROP ; PAIR }
-    NIL operation ; PAIR }

src/bin_client/test/contracts/spawn_identities.tz

@@ -1,8 +1,8 @@
 parameter nat;
-storage (list (contract string));
+storage (list address);
 code { DUP;
        CAR;                     # Get the number
-       DIP{CDR};                # Put the accumulator on the stack
+       DIP{CDR; NIL operation}; # Put the accumulators on the stack
        PUSH bool True;          # Push true so we have a do while loop
        LOOP { DUP; PUSH nat 0; CMPEQ; # Check if the number is 0
               IF { PUSH bool False}   # End the loop
@@ -16,7 +16,7 @@ code { DUP;
                    NONE key_hash;
                    PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5";
                    CREATE_CONTRACT; # Make the contract
-                   SWAP;            # Add to the list
+                   SWAP ; DIP { SWAP ; DIP { CONS } } ; # emit the operation
-                   DIP{CONS};
+                   SWAP ; DIP { SWAP ; DIP { CONS } } ; # add to the list
                    PUSH bool True}}; # Continue the loop
-       DROP; NIL operation; PAIR}    # Calling convention
+       DROP; PAIR}    # Calling convention

src/bin_client/test/test_contracts.sh

@@ -384,17 +384,15 @@ assert_balance test_transfer_account2 "120 ꜩ" # Why isn't this 120 ꜩ? Baking
 
 
 # Tests create_account
-init_with_transfer $contract_dir/create_account.tz $key2 \
+init_with_transfer $contract_dir/create_account.tz $key2 None 1,000 bootstrap1
-                   "\"$(get_contract_addr test_transfer_account1)\"" 1,000 bootstrap1
 $client transfer 100 from bootstrap1 to create_account \
-           -arg '"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"' | assert_in_output "New contract"
+           -arg '(Left "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx")' | assert_in_output "New contract"
 bake
 
 # Creates a contract, transfers data to it and stores the data
-init_with_transfer $contract_dir/create_contract.tz $key2 \
+init_with_transfer $contract_dir/create_contract.tz $key2 Unit 1,000 bootstrap1
-                   "\"$(get_contract_addr test_transfer_account1)\"" 1,000 bootstrap1
 created_contract=\
-`$client transfer 0 from bootstrap1 to create_contract -arg '"tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx"' \
+`$client transfer 0 from bootstrap1 to create_contract -arg '(Left "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx")' \
 | grep 'New contract' \
 | sed -E 's/.*(TZ1[a-zA-Z0-9]+).*/\1/' \
 | head -1`

src/proto_alpha/lib_client/client_proto_context.ml

@@ -313,7 +313,7 @@ let pp_operation_result ppf ({ contents ; _ }, operation_result) =
           | Applied (Origination_result { balance_updates ; consumed_gas ;
                                           originated_contracts ; storage_fees_increment }) ->
               Format.fprintf ppf
-                "This transaction was successfully applied:" ;
+                "This origination was successfully applied" ;
               begin match originated_contracts with
                 | [] -> ()
                 | contracts ->

src/proto_alpha/lib_protocol/src/alpha_context.mli

@@ -511,18 +511,19 @@ module Contract : sig
 
   val init_origination_nonce: context -> Operation_hash.t -> context
   val unset_origination_nonce: context -> context
+  val fresh_contract_from_current_nonce : context -> (context * t) tzresult Lwt.t
   val originated_from_current_nonce: context -> contract list tzresult Lwt.t
 
   type big_map_diff = (string * Script.expr option) list
 
   val originate:
-    context ->
+    context -> contract ->
     balance: Tez.t ->
     manager: public_key_hash ->
     ?script: (Script.t * big_map_diff option) ->
     delegate: public_key_hash option ->
     spendable: bool ->
-    delegatable: bool -> (context * contract) tzresult Lwt.t
+    delegatable: bool -> context tzresult Lwt.t
 
   type error += Balance_too_low of contract * Tez.t * Tez.t
 
@@ -779,6 +780,7 @@ and manager_operation =
       spendable: bool ;
       delegatable: bool ;
       credit: Tez.t ;
+      preorigination: Contract.t option ;
     }
   | Delegation of public_key_hash option
 

src/proto_alpha/lib_protocol/src/apply.ml

@@ -389,14 +389,11 @@ let cleanup_balance_updates balance_updates =
 let apply_manager_operation_content ctxt ~payer ~source ~internal operation =
   let before_operation = ctxt in
   Contract.must_exist ctxt source >>=? fun () ->
+  let spend =
+    if internal then Contract.spend_from_script else Contract.spend in
   match operation with
   | Reveal _ -> return (ctxt, Reveal_result)
   | Transaction { amount ; parameters ; destination } -> begin
-      let spend =
-        if internal then
-          Contract.spend_from_script
-        else
-          Contract.spend in
       spend ctxt source amount >>=? fun ctxt ->
       Contract.credit ctxt destination amount >>=? fun ctxt ->
       Contract.get_script ctxt destination >>=? fun (ctxt, script) -> match script with
@@ -452,14 +449,13 @@ let apply_manager_operation_content ctxt ~payer ~source ~internal operation =
                   cleanup_balance_updates
                     [ Contract payer, Debited fees ;
                       Contract source, Debited amount ;
-                      Contract destination, Credited amount ;
+                      Contract destination, Credited amount ] ;
-                      (* FIXME: this is wrong until we have asynchronous orignations *) ] ;
                 originated_contracts ;
                 consumed_gas = gas_difference before_operation ctxt ;
                 storage_fees_increment = fees } in
           return (ctxt, result)
     end
-  | Origination { manager ; delegate ; script ;
+  | Origination { manager ; delegate ; script ; preorigination ;
                   spendable ; delegatable ; credit } ->
       begin match script with
         | None -> return (None, ctxt)
@@ -468,11 +464,15 @@ let apply_manager_operation_content ctxt ~payer ~source ~internal operation =
             Script_ir_translator.erase_big_map_initialization ctxt script >>=? fun (script, big_map_diff, ctxt) ->
             return (Some (script, big_map_diff), ctxt)
       end >>=? fun (script, ctxt) ->
-      Contract.spend ctxt source credit >>=? fun ctxt ->
+      spend ctxt source credit >>=? fun ctxt ->
-      Contract.originate ctxt
+      begin match preorigination with
+        | Some contract -> return (ctxt, contract)
+        | None -> Contract.fresh_contract_from_current_nonce ctxt
+      end >>=? fun (ctxt, contract) ->
+      Contract.originate ctxt contract
         ~manager ~delegate ~balance:credit
         ?script
-        ~spendable ~delegatable >>=? fun (ctxt, contract) ->
+        ~spendable ~delegatable >>=? fun ctxt ->
       Fees.origination_burn ctxt ~payer contract >>=? fun (ctxt, fees) ->
       let result =
         Origination_result

src/proto_alpha/lib_protocol/src/contract_storage.ml

@@ -241,13 +241,10 @@ let create_base c contract
        Storage.Contract.Paid_fees.init c contract Tez_repr.zero
    | None ->
        return c) >>=? fun c ->
-  return (c, contract)
+  return c
 
-let originate c ~balance ~manager ?script ~delegate ~spendable ~delegatable =
+let originate c contract ~balance ~manager ?script ~delegate ~spendable ~delegatable =
-  Lwt.return (Raw_context.increment_origination_nonce c) >>=? fun (c, nonce) ->
+  create_base c contract ~balance ~manager ~delegate ?script ~spendable ~delegatable
-  let contract = Contract_repr.originated_contract nonce in
-  create_base c contract ~balance ~manager ~delegate ?script ~spendable ~delegatable >>=? fun (ctxt, contract) ->
-  return (ctxt, contract)
 
 let create_implicit c manager ~balance =
   create_base c (Contract_repr.implicit_contract manager)
@@ -293,11 +290,17 @@ let must_be_allocated c contract =
 
 let list c = Storage.Contract.list c
 
+let fresh_contract_from_current_nonce c =
+  Lwt.return (Raw_context.increment_origination_nonce c) >>=? fun (c, nonce) ->
+  return (c, Contract_repr.originated_contract nonce)
+
 let originated_from_current_nonce ctxt =
   Lwt.return (Raw_context.origination_nonce ctxt) >>=? fun nonce ->
-  let contracts = Contract_repr.originated_contracts nonce in
+  filter_map_s
-  iter_s (fun contract -> must_exist ctxt contract) contracts >>=? fun () ->
+    (fun contract -> exists ctxt contract >>=? function
-  return contracts
+       | true -> return (Some contract)
+       | false -> return None)
+    (Contract_repr.originated_contracts nonce)
 
 let check_counter_increment c contract counter =
   Storage.Contract.Counter.get c contract >>=? fun contract_counter ->
@@ -435,8 +438,7 @@ let credit c contract amount =
       match Contract_repr.is_implicit contract with
       | None -> fail (Non_existing_contract contract)
       | Some manager ->
-          create_implicit c manager ~balance:amount >>=? fun (c, _) ->
+          create_implicit c manager ~balance:amount
-          return c
     end
   | Some balance ->
       Lwt.return Tez_repr.(amount +? balance) >>=? fun balance ->

src/proto_alpha/lib_protocol/src/contract_storage.mli

@@ -83,15 +83,17 @@ val spend_from_script:
 
 val originate:
   Raw_context.t ->
+  Contract_repr.t ->
   balance:Tez_repr.t ->
   manager:Signature.Public_key_hash.t ->
   ?script:(Script_repr.t * big_map_diff option) ->
   delegate:Signature.Public_key_hash.t option ->
   spendable:bool ->
   delegatable:bool ->
-  (Raw_context.t * Contract_repr.t) tzresult Lwt.t
+  Raw_context.t tzresult Lwt.t
-
 
+val fresh_contract_from_current_nonce :
+  Raw_context.t -> (Raw_context.t * Contract_repr.t) tzresult Lwt.t
 val originated_from_current_nonce :
   Raw_context.t -> Contract_repr.t list tzresult Lwt.t
 

src/proto_alpha/lib_protocol/src/helpers_services.ml

@@ -347,7 +347,8 @@ module Forge = struct
                         script ;
                         spendable ;
                         delegatable ;
-                        credit = balance }
+                        credit = balance ;
+                        preorigination = None }
         ]
 
     let delegation ctxt

src/proto_alpha/lib_protocol/src/operation_repr.ml

@@ -91,6 +91,7 @@ and manager_operation =
       spendable: bool ;
       delegatable: bool ;
       credit: Tez_repr.tez ;
+      preorigination: Contract_repr.t option ;
     }
   | Delegation of Signature.Public_key_hash.t option
 
@@ -155,7 +156,11 @@ module Encoding = struct
     case tag ~name:"Origination" origination_encoding
       (function
         | Origination { manager ; credit ; spendable ;
-                        delegatable ; delegate ; script } ->
+                        delegatable ; delegate ; script ;
+                        preorigination = _
+                        (* the hash is only used internally
+                           when originating from smart
+                           contracts, don't serialize it *) } ->
             Some ((), manager, credit, Some spendable,
                   Some delegatable, delegate, script)
         | _ -> None)
@@ -165,7 +170,8 @@ module Encoding = struct
          let spendable =
            match spendable with None -> true | Some b -> b in
          Origination
-           {manager ; credit ; spendable ; delegatable ; delegate ; script })
+           {manager ; credit ; spendable ; delegatable ;
+            delegate ; script ; preorigination = None })
 
   let delegation_encoding =
     describe ~title:"Delegation operation" @@

src/proto_alpha/lib_protocol/src/operation_repr.mli

@@ -91,6 +91,7 @@ and manager_operation =
       spendable: bool ;
       delegatable: bool ;
       credit: Tez_repr.tez ;
+      preorigination: Contract_repr.t option ;
     }
   | Delegation of Signature.Public_key_hash.t option
 

src/proto_alpha/lib_protocol/src/script_interpreter.ml

@@ -144,12 +144,12 @@ let rec interp
             logged_return descr (Item (Script_int.of_int @@ op x1 x2, rest), ctxt) in
         let create_contract :
           type param rest storage.
-          (_, param typed_contract * rest) descr ->
+          (_, internal_operation * (Contract.t * rest)) descr ->
           manager:public_key_hash -> delegate:public_key_hash option -> spendable:bool ->
           delegatable:bool -> credit:Tez.t -> code:prim Micheline.canonical ->
           init:storage -> param_type:param ty -> storage_type:storage ty ->
           rest:rest stack ->
-          ((param typed_contract * rest) stack * context) tzresult Lwt.t =
+          ((internal_operation * (Contract.t * rest)) stack * context) tzresult Lwt.t =
           fun descr ~manager ~delegate ~spendable ~delegatable
             ~credit ~code ~init ~param_type ~storage_type ~rest ->
             Lwt.return (Gas.consume ctxt Interp_costs.create_contract) >>=? fun ctxt ->
@@ -161,13 +161,13 @@ let rec interp
             Lwt.return @@ unparse_data ctxt storage_type init >>=? fun (storage, ctxt) ->
             let storage = Micheline.strip_locations storage in
             Contract.spend_from_script ctxt self credit >>=? fun ctxt ->
-            Contract.originate ctxt
+            Contract.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) ->
-              ~manager ~delegate ~balance:credit
+            let operation =
-              ~script:({ code ; storage }, None (* TODO: initialize a big map from a map *))
+              Origination
-              ~spendable ~delegatable
+                { credit ; manager ; delegate ; preorigination = Some contract ;
-            >>=? fun (ctxt, contract) ->
+                  delegatable ; script = Some { code ; storage } ; spendable } in
-            Fees.origination_burn ctxt ~payer contract >>=? fun (ctxt, _) ->
+            logged_return descr (Item ({ source = self ; operation ; signature = None },
-            logged_return descr (Item ((param_type, contract), rest), ctxt) in
+                                       Item (contract, rest)), ctxt) in
         let logged_return :
           a stack * context ->
           (a stack * context) tzresult Lwt.t =
@@ -671,13 +671,13 @@ let rec interp
         | Create_account,
           Item (manager, Item (delegate, Item (delegatable, Item (credit, rest)))) ->
             Lwt.return (Gas.consume ctxt Interp_costs.create_account) >>=? fun ctxt ->
-            Contract.spend_from_script ctxt self credit >>=? fun ctxt ->
+            Contract.fresh_contract_from_current_nonce ctxt >>=? fun (ctxt, contract) ->
-            Lwt.return Tez.(credit -? Constants.origination_burn ctxt) >>=? fun balance ->
+            let operation =
-            Contract.originate ctxt
+              Origination
-              ~manager ~delegate ~balance
+                { credit ; manager ; delegate ; preorigination = Some contract ;
-              ?script:None ~spendable:true ~delegatable >>=? fun (ctxt, contract) ->
+                  delegatable ; script = None ; spendable = true } in
-            Fees.origination_burn ctxt ~payer contract >>=? fun (ctxt, _) ->
+            logged_return (Item ({ source = self ; operation ; signature = None },
-            logged_return (Item ((Unit_t, contract), rest), ctxt)
+                                 Item (contract, rest)), ctxt)
         | Implicit_account, Item (key, rest) ->
             Lwt.return (Gas.consume ctxt Interp_costs.implicit_account) >>=? fun ctxt ->
             let contract = Contract.implicit_contract key in

src/proto_alpha/lib_protocol/src/script_ir_translator.ml

@@ -2062,7 +2062,7 @@ and parse_instr
               (Bool_t, Item_t
                  (Tez_t, rest, _), _), _), _) ->
         typed ctxt loc Create_account
-          (Item_t (Contract_t Unit_t, rest, instr_annot))
+          (Item_t (Operation_t, Item_t (Address_t, rest, None), instr_annot))
     | Prim (loc, I_IMPLICIT_ACCOUNT, [], instr_annot),
       Item_t (Key_hash_t, rest, _) ->
         typed ctxt loc Implicit_account
@@ -2080,7 +2080,7 @@ and parse_instr
         check_item_ty gp gr loc I_CREATE_CONTRACT 5 7 >>=? fun Eq ->
         check_item_ty ginit gp loc I_CREATE_CONTRACT 6 7 >>=? fun Eq ->
         typed ctxt loc (Create_contract (gp, p))
-          (Item_t (Contract_t p, rest, instr_annot))
+          (Item_t (Operation_t, Item_t (Address_t, rest, None), instr_annot))
     | Prim (loc, I_CREATE_CONTRACT, [ (Seq (seq_loc, _, annot) as code)], instr_annot),
       Item_t
         (Key_hash_t, Item_t
@@ -2111,7 +2111,7 @@ and parse_instr
         Lwt.return @@ ty_eq ret ret_type_full >>=? fun Eq ->
         Lwt.return @@ ty_eq storage_type ginit >>=? fun Eq ->
         typed ctxt loc (Create_contract_literal (storage_type, arg_type, lambda))
-          (Item_t (Contract_t arg_type, rest, instr_annot))
+          (Item_t (Operation_t, Item_t (Address_t, rest, None), instr_annot))
     | Prim (loc, I_NOW, [], instr_annot),
       stack ->
         typed ctxt loc Now

src/proto_alpha/lib_protocol/src/script_typed_ir.ml

@@ -333,17 +333,17 @@ and ('bef, 'aft) instr =
       ('arg * (Tez.t * ('arg typed_contract * 'rest)), internal_operation * 'rest) instr
   | Create_account :
       (public_key_hash * (public_key_hash option * (bool * (Tez.t * 'rest))),
-       unit typed_contract * 'rest) instr
+       internal_operation * (Contract.t * 'rest)) instr
   | Implicit_account :
       (public_key_hash * 'rest, unit typed_contract * 'rest) instr
   | Create_contract : 'g ty * 'p ty ->
     (public_key_hash * (public_key_hash option * (bool * (bool * (Tez.t *
                                                                   (('p * 'g, internal_operation list * 'g) lambda
                                                                    * ('g * 'rest)))))),
-     'p typed_contract * 'rest) instr
+     internal_operation * (Contract.t * 'rest)) instr
   | Create_contract_literal : 'g ty * 'p ty * ('p * 'g, internal_operation list * 'g) lambda  ->
     (public_key_hash * (public_key_hash option * (bool * (bool * (Tez.t * ('g * 'rest))))),
-     'p typed_contract * 'rest) instr
+     internal_operation * (Contract.t * 'rest)) instr
   | Now :
       ('rest, Script_timestamp.t * 'rest) instr
   | Balance :

src/proto_alpha/lib_protocol/test/contracts/create_account.tz

@@ -1,4 +1,12 @@
-parameter key_hash;
+parameter (or key_hash address) ;
-storage (contract unit);
+storage (option (contract unit)) ;
-code {CAR; DIP{PUSH tez "100.00"; PUSH bool False; NONE key_hash};
+code { CAR;
-      CREATE_ACCOUNT; NIL operation; PAIR};
+       IF_LEFT
+         { DIP { PUSH tez "100.00" ; PUSH bool False ; NONE key_hash };
+           CREATE_ACCOUNT ;
+           DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ;
+                 NIL operation ; SWAP ; CONS } ;
+           CONS ; NONE (contract unit) ; SWAP ; PAIR }
+         { SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ;
+           CONTRACT unit ; DUP ; IF_SOME { DROP } { FAIL } ;
+           NIL operation ; PAIR } } ;

src/proto_alpha/lib_protocol/test/contracts/create_add1_lists.tz

@@ -1,5 +1,5 @@
 parameter unit;
-storage (contract (list int));
+storage address;
 code { DROP; NIL int; # starting storage for contract
        LAMBDA (pair (list int) (list int)) # Start of stack for contract (see above)
               (pair (list operation) (list int)) # End of stack for contract (see above)
@@ -15,4 +15,4 @@ code { DROP; NIL int; # starting storage for contract
        NONE key_hash;                 # No delegate
        PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5";
        CREATE_CONTRACT;          # Create the contract
-       NIL operation; PAIR}      # Ending calling convention stuff
+       NIL operation; SWAP; CONS; PAIR} # Ending calling convention stuff

src/proto_alpha/lib_protocol/test/contracts/create_contract.tz

@@ -1,12 +1,18 @@
-parameter key_hash;
+parameter (or key_hash address);
-storage string;
+storage unit;
-code {CAR;
+code { CAR;
-      DIP{PUSH string "dummy";
+       IF_LEFT
-          LAMBDA (pair string string)
+         { DIP { PUSH string "dummy";
-                 (pair (list operation) string)
+                 LAMBDA (pair string string)
-                 {CAR; NIL operation; PAIR};
+                        (pair (list operation) string)
-          PUSH tez "100.00"; PUSH bool False;
+                        { CAR ; NIL operation ; PAIR };
-          PUSH bool False; NONE key_hash};
+                 PUSH tez "100.00" ; PUSH bool False ;
-      CREATE_CONTRACT; DIP{PUSH string ""}; PUSH tez "0.00";
+                 PUSH bool False ; NONE key_hash } ;
-      PUSH string "abcdefg"; TRANSFER_TOKENS;
+           CREATE_CONTRACT ;
-      NIL operation; SWAP; CONS; PAIR};
+           DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ;
+                 NIL operation ; SWAP ; CONS } ;
+           CONS ; UNIT ; SWAP ; PAIR }
+         { SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ;
+           CONTRACT string ; IF_SOME {} { FAIL } ;
+           PUSH tez "0.00" ; PUSH string "abcdefg" ; TRANSFER_TOKENS ;
+           NIL operation; SWAP; CONS ; UNIT ; SWAP ; PAIR } };

src/proto_alpha/lib_protocol/test/contracts/create_contract_literal.tz

@@ -1,12 +1,18 @@
-parameter key_hash;
+parameter (or key_hash address);
 storage unit;
 code { CAR;
-       DIP { PUSH string "dummy";
+       IF_LEFT
-             PUSH tez "100.00"; PUSH bool False;
+         { DIP { PUSH string "dummy";
-             PUSH bool False; NONE key_hash };
+                 PUSH tez "100.00" ; PUSH bool False ;
-       CREATE_CONTRACT { parameter string ;
+                 PUSH bool False ; NONE key_hash } ;
-                         storage string ;
+           CREATE_CONTRACT
-                         code {CAR; NIL operation; PAIR } } ;
+             { parameter string ;
-       DIP{PUSH string ""}; PUSH tez "0.00";
+               storage string ;
-       PUSH string "abcdefg"; TRANSFER_TOKENS;
+               code { CAR ; NIL operation ; PAIR } } ;
-       DIP{DROP}; NIL operation; SWAP; CONS; UNIT; SWAP; PAIR};
+           DIP { RIGHT key_hash ; DIP { SELF ; PUSH tez "0" } ; TRANSFER_TOKENS ;
+                 NIL operation ; SWAP ; CONS } ;
+           CONS ; UNIT ; SWAP ; PAIR }
+         { SELF ; ADDRESS ; SOURCE ; IFCMPNEQ { FAIL } {} ;
+           CONTRACT string ; IF_SOME {} { FAIL } ;
+           PUSH tez "0.00" ; PUSH string "abcdefg" ; TRANSFER_TOKENS ;
+           NIL operation; SWAP; CONS ; UNIT ; SWAP ; PAIR } };

src/proto_alpha/lib_protocol/test/contracts/originator.tz

@@ -1,16 +1,16 @@
 parameter nat ;
-storage (list (contract unit)) ;
+storage (list address) ;
 code
-  { CAR ; DUP ; PUSH nat 0 ; CMPNEQ ;
+  { DUP ; CAR ; PUSH nat 0 ; CMPNEQ ;
-    DIIP { NIL (contract unit) } ;
+    DIP { DUP ; CAR ; DIP { CDR ; NIL operation } } ;
     LOOP
       { PUSH tez "5.00" ;
         PUSH bool True ; # delegatable
         NONE key_hash ; # delegate
         PUSH key_hash "tz1KqTpEZ7Yob7QbPE4Hy4Wo8fHG8LhKxZSx" ; # manager
         CREATE_ACCOUNT ;
-        SWAP ; DIP { CONS } ;
+        SWAP ; DIP { SWAP ; DIP { CONS } } ;
+        SWAP ; DIP { SWAP ; DIP { CONS } } ;
         PUSH nat 1 ; SWAP ; SUB ; ABS ;
         DUP ; PUSH nat 0 ; CMPNEQ } ;
-    DROP ;
+    DROP ; PAIR }
-    NIL operation ; PAIR }

src/proto_alpha/lib_protocol/test/contracts/spawn_identities.tz

@@ -1,8 +1,8 @@
 parameter nat;
-storage (list (contract string));
+storage (list address);
 code { DUP;
        CAR;                     # Get the number
-       DIP{CDR};                # Put the accumulator on the stack
+       DIP{CDR; NIL operation}; # Put the accumulators on the stack
        PUSH bool True;          # Push true so we have a do while loop
        LOOP { DUP; PUSH nat 0; CMPEQ; # Check if the number is 0
               IF { PUSH bool False}   # End the loop
@@ -16,7 +16,7 @@ code { DUP;
                    NONE key_hash;
                    PUSH key_hash "tz1cxcwwnzENRdhe2Kb8ZdTrdNy4bFNyScx5";
                    CREATE_CONTRACT; # Make the contract
-                   SWAP;            # Add to the list
+                   SWAP ; DIP { SWAP ; DIP { CONS } } ; # emit the operation
-                   DIP{CONS};
+                   SWAP ; DIP { SWAP ; DIP { CONS } } ; # add to the list
                    PUSH bool True}}; # Continue the loop
-       DROP; NIL operation; PAIR}    # Calling convention
+       DROP; PAIR}    # Calling convention

src/proto_alpha/lib_protocol/test/helpers/helpers_operation.ml

@@ -52,7 +52,8 @@ let origination
     spendable ;
     delegatable ;
     script ;
-    credit
+    credit ;
+    preorigination = None ;
   }
 
 

src/proto_alpha/lib_protocol/test/test_michelson.ml

@@ -451,13 +451,12 @@ let test_example () =
   Assert.equal_cents_balance ~tc (account.contract, amount * 100) >>=?? fun _ ->
 
   (* Test CREATE_ACCOUNT *)
-  Account.make_account ~tc: sb.tezos_context >>=?? fun (account, tc) ->
+  Account.make_account ~tc: sb.tezos_context >>=?? fun (_, tc) ->
-  let account_str = quote @@ Signature.Public_key_hash.to_b58check account.hpub in
+  test_contract ~tc "create_account" "None" ("(Left " ^ account_str ^ ")") >>=? fun (cs, tc) ->
-  test_contract ~tc "create_account" account_str account_str >>=? fun (cs, tc) ->
   Assert.equal_int 1 @@ List.length cs ;
 
   (* Test CREATE_CONTRACT *)
-  test_contract ~tc "create_contract" account_str account_str >>=? fun (cs, tc) ->
+  test_contract ~tc "create_contract" "Unit" ("(Left " ^ account_str ^ ")") >>=? fun (cs, tc) ->
   Assert.equal_int 1 @@ List.length cs ;
   let contract = List.hd cs in
   Proto_alpha.Alpha_context.Contract.get_script tc contract >>=?? fun (_, res) ->