From 7ec877cbb5e44c89a8a278479225caace85d85ae Mon Sep 17 00:00:00 2001
From: Nicolas Ayache <nicolas.ayache@nomadic-labs.com>
Date: Wed, 16 Mar 2022 11:56:57 +0100
Subject: [PATCH 01/10] Proto/Michelson-Plugin: move script back from
 translator to ir.

Because we will use them in internal originations.

(This reverts and elaborates commit d0b4766c3da681e4dc50d5e143a5a1c2a27ccc5a.)
---
 src/proto_alpha/lib_plugin/plugin.ml          | 19 ++++----
 src/proto_alpha/lib_protocol/apply.ml         |  2 +-
 .../lib_protocol/contract_services.ml         |  4 +-
 src/proto_alpha/lib_protocol/main.ml          |  2 +-
 .../lib_protocol/script_interpreter.ml        | 26 +++++------
 .../lib_protocol/script_ir_translator.ml      | 43 +++++++------------
 .../lib_protocol/script_ir_translator.mli     | 17 +-------
 .../lib_protocol/script_typed_ir.ml           | 20 ++++++++-
 .../lib_protocol/script_typed_ir.mli          | 15 ++++++-
 .../lib_protocol/test/helpers/block.ml        |  2 +-
 .../integration/michelson/test_sapling.ml     |  2 +-
 .../michelson/test_script_cache.ml            |  6 +--
 .../michelson/test_ticket_manager.ml          |  3 +-
 .../ticket_balance_migration_for_j.ml         |  2 +-
 .../lib_protocol/ticket_operations_diff.ml    | 24 ++++++-----
 15 files changed, 98 insertions(+), 89 deletions(-)

diff --git a/src/proto_alpha/lib_plugin/plugin.ml b/src/proto_alpha/lib_plugin/plugin.ml
index 5d5426addd99..7a06931b2e2f 100644
--- a/src/proto_alpha/lib_plugin/plugin.ml
+++ b/src/proto_alpha/lib_plugin/plugin.ml
@@ -2537,15 +2537,16 @@ module RPC = struct
           >>=? fun (storage, _) ->
           let script =
             Script_ir_translator.Ex_script
-              {
-                code;
-                arg_type;
-                storage_type;
-                views;
-                entrypoints;
-                code_size;
-                storage;
-              }
+              (Script
+                 {
+                   code;
+                   arg_type;
+                   storage_type;
+                   views;
+                   entrypoints;
+                   code_size;
+                   storage;
+                 })
           in
           let (size, cost) = Script_ir_translator.script_size script in
           Gas.consume ctxt cost >>?= fun _ctxt -> return @@ size) ;
diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index 5cd883a31ac7..86de918830b0 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -1157,7 +1157,7 @@ let apply_origination ~consume_deserialization_gas ~ctxt ~script ~internal
     ~legacy:false
     ~allow_forged_in_storage:internal
     script
-  >>=? fun (Ex_script parsed_script, ctxt) ->
+  >>=? fun (Ex_script (Script parsed_script), ctxt) ->
   let views_result =
     Script_ir_translator.typecheck_views
       ctxt
diff --git a/src/proto_alpha/lib_protocol/contract_services.ml b/src/proto_alpha/lib_protocol/contract_services.ml
index 042fdc86d68c..784582bc518d 100644
--- a/src/proto_alpha/lib_protocol/contract_services.ml
+++ b/src/proto_alpha/lib_protocol/contract_services.ml
@@ -243,7 +243,7 @@ module S = struct
             ~allow_forged_in_storage:true
             script
           >|= fun tzresult ->
-          tzresult >>? fun (Ex_script script, ctxt) ->
+          tzresult >>? fun (Ex_script (Script script), ctxt) ->
           Script_ir_translator.get_single_sapling_state
             ctxt
             script.storage_type
@@ -454,7 +454,7 @@ let[@coq_axiom_with_reason "gadt"] register () =
           let ctxt = Gas.set_unlimited ctxt in
           let open Script_ir_translator in
           parse_script ctxt ~legacy:true ~allow_forged_in_storage:true script
-          >>=? fun (Ex_script script, ctxt) ->
+          >>=? fun (Ex_script (Script script), ctxt) ->
           Script_ir_translator.collect_lazy_storage
             ctxt
             script.storage_type
diff --git a/src/proto_alpha/lib_protocol/main.ml b/src/proto_alpha/lib_protocol/main.ml
index da097a31fc14..3301fa37610b 100644
--- a/src/proto_alpha/lib_protocol/main.ml
+++ b/src/proto_alpha/lib_protocol/main.ml
@@ -742,7 +742,7 @@ let init ctxt block_header =
       ~legacy:true
       ~allow_forged_in_storage
       script
-    >>=? fun (Ex_script parsed_script, ctxt) ->
+    >>=? fun (Ex_script (Script parsed_script), ctxt) ->
     Script_ir_translator.extract_lazy_storage_diff
       ctxt
       Optimized
diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 70fb97fca2c4..772de7148ca8 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -1055,8 +1055,8 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
                     ~allow_forged_in_storage:true
                     ctxt
                     script
-                  >>=? fun (Ex_script {storage; storage_type; views; _}, ctxt)
-                    ->
+                  >>=? fun ( Ex_script (Script {storage; storage_type; views; _}),
+                             ctxt ) ->
                   Gas.consume ctxt (Interp_costs.view_get name views)
                   >>?= fun ctxt ->
                   match Script_map.get name views with
@@ -1759,15 +1759,16 @@ let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal
         ~allow_forged_in_storage:true
   | Some ex_script -> return (ex_script, ctxt))
   >>=? fun ( Ex_script
-               {
-                 code_size;
-                 code;
-                 arg_type;
-                 storage = old_storage;
-                 storage_type;
-                 entrypoints;
-                 views;
-               },
+               (Script
+                 {
+                   code_size;
+                   code;
+                   arg_type;
+                   storage = old_storage;
+                   storage_type;
+                   entrypoints;
+                   views;
+                 }),
              ctxt ) ->
   Gas_monad.run
     ctxt
@@ -1819,7 +1820,8 @@ let execute_any_arg logger ctxt mode step_constants ~entrypoint ~internal
   in
   let script =
     Ex_script
-      {code_size; code; arg_type; storage; storage_type; entrypoints; views}
+      (Script
+         {code_size; code; arg_type; storage; storage_type; entrypoints; views})
   in
   Ticket_scanner.type_has_tickets ctxt arg_type
   >>?= fun (arg_type_has_tickets, ctxt) ->
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.ml b/src/proto_alpha/lib_protocol/script_ir_translator.ml
index 5e1d452a1be8..dcef099c0b7f 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.ml
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.ml
@@ -1801,23 +1801,7 @@ type ('arg, 'storage) code =
     }
       -> ('arg, 'storage) code
 
-type ex_script =
-  | Ex_script : {
-      code :
-        (('arg, 'storage) pair, (operation boxed_list, 'storage) pair) lambda;
-      arg_type : ('arg, _) ty;
-      storage : 'storage;
-      storage_type : ('storage, _) ty;
-      views : view_map;
-      entrypoints : 'arg entrypoints;
-      code_size : Cache_memory_helpers.sint;
-          (* This is an over-approximation of the value size in memory, in
-             bytes, of the contract's static part, that is its source
-             code. This includes the code of the contract as well as the code
-             of the views. The storage size is not taken into account by this
-             field as it has a dynamic size. *)
-    }
-      -> ex_script
+type ex_script = Ex_script : ('a, 'c) Script_typed_ir.script -> ex_script
 
 type ex_code = Ex_code : ('a, 'c) code -> ex_code
 
@@ -5490,7 +5474,8 @@ let[@coq_axiom_with_reason "gadt"] parse_script :
     ~storage
   >|=? fun (storage, ctxt) ->
   ( Ex_script
-      {code_size; code; arg_type; storage; storage_type; views; entrypoints},
+      (Script
+         {code_size; code; arg_type; storage; storage_type; views; entrypoints}),
     ctxt )
 
 let typecheck_code :
@@ -5868,7 +5853,8 @@ and[@coq_axiom_with_reason "gadt"] unparse_code ctxt ~stack_depth mode code =
 (* TODO: https://gitlab.com/tezos/tezos/-/issues/1688
    Refactor the sharing part of unparse_script and create_contract *)
 let unparse_script ctxt mode
-    (Ex_script {code; arg_type; storage; storage_type; entrypoints; views; _}) =
+    (Ex_script
+      (Script {code; arg_type; storage; storage_type; entrypoints; views; _})) =
   let (Lam (_, original_code)) = code in
   Gas.consume ctxt Unparse_costs.unparse_script >>?= fun ctxt ->
   unparse_code ctxt ~stack_depth:0 mode original_code >>=? fun (code, ctxt) ->
@@ -6467,15 +6453,16 @@ let[@coq_axiom_with_reason "gadt"] get_single_sapling_state ctxt ty x =
 *)
 let script_size
     (Ex_script
-      {
-        code_size;
-        code = _;
-        arg_type = _;
-        storage;
-        storage_type;
-        entrypoints = _;
-        views = _;
-      }) =
+      (Script
+        {
+          code_size;
+          code = _;
+          arg_type = _;
+          storage;
+          storage_type;
+          entrypoints = _;
+          views = _;
+        })) =
   let (nodes, storage_size) =
     Script_typed_ir_size.value_size storage_type storage
   in
diff --git a/src/proto_alpha/lib_protocol/script_ir_translator.mli b/src/proto_alpha/lib_protocol/script_ir_translator.mli
index 975e66406b78..61bc87b46faa 100644
--- a/src/proto_alpha/lib_protocol/script_ir_translator.mli
+++ b/src/proto_alpha/lib_protocol/script_ir_translator.mli
@@ -82,22 +82,7 @@ type ex_parameter_ty_and_entrypoints =
 type ex_stack_ty =
   | Ex_stack_ty : ('a, 's) Script_typed_ir.stack_ty -> ex_stack_ty
 
-type ex_script =
-  | Ex_script : {
-      code :
-        ( ('arg, 'storage) Script_typed_ir.pair,
-          ( Script_typed_ir.operation Script_typed_ir.boxed_list,
-            'storage )
-          Script_typed_ir.pair )
-        Script_typed_ir.lambda;
-      arg_type : ('arg, _) Script_typed_ir.ty;
-      storage : 'storage;
-      storage_type : ('storage, _) Script_typed_ir.ty;
-      views : Script_typed_ir.view_map;
-      entrypoints : 'arg Script_typed_ir.entrypoints;
-      code_size : Cache_memory_helpers.sint;
-    }
-      -> ex_script
+type ex_script = Ex_script : ('a, 'b) Script_typed_ir.script -> ex_script
 
 type toplevel = {
   code_field : Script.node;
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml
index 8734cd25e5dc..2c984edbd1ee 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -468,8 +468,26 @@ and 'arg nested_entrypoints =
 
 let no_entrypoints = {name = None; nested = Entrypoints_None}
 
+type ('arg, 'storage) script =
+  | Script : {
+      code :
+        (('arg, 'storage) pair, (operation boxed_list, 'storage) pair) lambda;
+      arg_type : ('arg, _) ty;
+      storage : 'storage;
+      storage_type : ('storage, _) ty;
+      views : view_map;
+      entrypoints : 'arg entrypoints;
+      code_size : Cache_memory_helpers.sint;
+          (* This is an over-approximation of the value size in memory, in
+             bytes, of the contract's static part, that is its source
+             code. This includes the code of the contract as well as the code
+             of the views. The storage size is not taken into account by this
+             field as it has a dynamic size. *)
+    }
+      -> ('arg, 'storage) script
+
 (* ---- Instructions --------------------------------------------------------*)
-type ('before_top, 'before, 'result_top, 'result) kinstr =
+and ('before_top, 'before, 'result_top, 'result) kinstr =
   (*
      Stack
      -----
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli
index 102d0a36b48e..355030544476 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.mli
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli
@@ -335,6 +335,19 @@ and 'arg nested_entrypoints =
 (** [no_entrypoints] is [{name = None; nested = Entrypoints_None}] *)
 val no_entrypoints : _ entrypoints
 
+type ('arg, 'storage) script =
+  | Script : {
+      code :
+        (('arg, 'storage) pair, (operation boxed_list, 'storage) pair) lambda;
+      arg_type : ('arg, _) ty;
+      storage : 'storage;
+      storage_type : ('storage, _) ty;
+      views : view_map;
+      entrypoints : 'arg entrypoints;
+      code_size : Cache_memory_helpers.sint;
+    }
+      -> ('arg, 'storage) script
+
 (* ---- Instructions --------------------------------------------------------*)
 
 (*
@@ -436,7 +449,7 @@ val no_entrypoints : _ entrypoints
    [1]: http://www.complang.tuwien.ac.at/projects/interpreters.html
 
  *)
-type ('before_top, 'before, 'result_top, 'result) kinstr =
+and ('before_top, 'before, 'result_top, 'result) kinstr =
   (*
      Stack
      -----
diff --git a/src/proto_alpha/lib_protocol/test/helpers/block.ml b/src/proto_alpha/lib_protocol/test/helpers/block.ml
index d6452b8edf00..9cdf37f75e0b 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/block.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/block.ml
@@ -324,7 +324,7 @@ let initial_alpha_context ?(commitments = []) constants
       ~legacy:true
       ~allow_forged_in_storage
       script
-    >>=? fun (Ex_script parsed_script, ctxt) ->
+    >>=? fun (Ex_script (Script parsed_script), ctxt) ->
     Script_ir_translator.extract_lazy_storage_diff
       ctxt
       Optimized
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml
index 4e9918de5dbb..53da0dca16e0 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_sapling.ml
@@ -951,7 +951,7 @@ module Interpreter_tests = struct
         ~allow_forged_in_storage:true
         script
       >>= wrap
-      >>=? fun (Ex_script script, ctxt) ->
+      >>=? fun (Ex_script (Script script), ctxt) ->
       Script_ir_translator.get_single_sapling_state
         ctxt
         script.storage_type
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_cache.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_cache.ml
index cd0edb8952f0..9b4125d93baa 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_cache.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_script_cache.ml
@@ -206,17 +206,17 @@ let test_update_modifies_cached_contract () =
   originate_contract "contracts/int-store.tz" "36" src block baker
   >>=? fun (addr, block) ->
   ( make_block block @! fun ctxt ->
-    find ctxt addr >>=? fun (ctxt, identifier, script, Ex_script ir) ->
+    find ctxt addr >>=? fun (ctxt, identifier, script, Ex_script (Script ir)) ->
     match ir.storage_type with
     | Int_t ->
         let storage' = Script_int.(add ir.storage (Script_int.of_int 1)) in
         let cached_contract' =
-          (script, Ex_script {ir with storage = storage'})
+          (script, Ex_script (Script {ir with storage = storage'}))
         in
         Script_cache.update ctxt identifier cached_contract' 1
         |> Environment.wrap_tzresult
         >>?= fun ctxt ->
-        find ctxt addr >>=? fun (_, _, _, Ex_script ir') ->
+        find ctxt addr >>=? fun (_, _, _, Ex_script (Script ir')) ->
         let storage = value_as_int ir'.storage_type ir'.storage in
         fail_unless
           (Script_int.compare storage storage' = 0)
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_manager.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_manager.ml
index 5a7995413508..252e84bb0df6 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_manager.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_manager.ml
@@ -84,7 +84,8 @@ let ticket_balance_of_storage ctxt contract =
   match script with
   | None -> return ([], ctxt)
   | Some script ->
-      let* (Script_ir_translator.Ex_script {storage; storage_type; _}, ctxt) =
+      let* ( Script_ir_translator.Ex_script (Script {storage; storage_type; _}),
+             ctxt ) =
         wrap
           (Script_ir_translator.parse_script
              ctxt
diff --git a/src/proto_alpha/lib_protocol/ticket_balance_migration_for_j.ml b/src/proto_alpha/lib_protocol/ticket_balance_migration_for_j.ml
index 096d4efe96aa..e595f431b2fc 100644
--- a/src/proto_alpha/lib_protocol/ticket_balance_migration_for_j.ml
+++ b/src/proto_alpha/lib_protocol/ticket_balance_migration_for_j.ml
@@ -48,7 +48,7 @@ let update_contract_tickets ctxt contract =
         ~allow_forged_in_storage:true
         script
       >>=? fun (ex_script, ctxt) ->
-      let (Ex_script {storage_type; storage; _}) = ex_script in
+      let (Ex_script (Script {storage_type; storage; _})) = ex_script in
       Ticket_scanner.type_has_tickets ctxt storage_type
       >>?= fun (has_tickets, ctxt) ->
       Ticket_scanner.tickets_of_value
diff --git a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
index ef51b6aec250..9c9f69f3cb87 100644
--- a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
+++ b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
@@ -187,8 +187,9 @@ let tickets_of_transaction ctxt ~destination ~entrypoint ~location
           match script_opt with
           | None -> fail (Failed_to_get_script destination)
           | Some script -> return (script, ctxt))
-      >>=? fun (Script_ir_translator.Ex_script {arg_type; entrypoints; _}, ctxt)
-        ->
+      >>=? fun ( Script_ir_translator.Ex_script
+                   (Script {arg_type; entrypoints; _}),
+                 ctxt ) ->
       (* Find the entrypoint type for the given entrypoint. *)
       Gas_monad.run
         ctxt
@@ -235,15 +236,16 @@ let tickets_of_origination ctxt ~preorigination script =
         ~allow_forged_in_storage:true
         script
       >>=? fun ( Script_ir_translator.Ex_script
-                   {
-                     storage;
-                     storage_type;
-                     code = _;
-                     arg_type = _;
-                     views = _;
-                     entrypoints = _;
-                     code_size = _;
-                   },
+                   (Script
+                     {
+                       storage;
+                       storage_type;
+                       code = _;
+                       arg_type = _;
+                       views = _;
+                       entrypoints = _;
+                       code_size = _;
+                     }),
                  ctxt ) ->
       (* Extract any tickets from the storage. Note that if the type of the
          contract storage does not contain tickets, storage is not scanned. *)
-- 
GitLab


From 3fc29aa1e2bc8679573eed316ab0e48889dbe5d1 Mon Sep 17 00:00:00 2001
From: Nicolas Ayache <nicolas.ayache@nomadic-labs.com>
Date: Mon, 7 Mar 2022 11:44:30 +0100
Subject: [PATCH 02/10] Proto/Michelson: enrich the origination application
 with a parsed script.

---
 src/proto_alpha/lib_protocol/apply.ml | 19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index 86de918830b0..0c2c22c17e14 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -1140,8 +1140,8 @@ let apply_transaction_to_tx_rollup ~ctxt ~parameters_ty ~parameters ~amount
     return (ctxt, result, [])
   else fail (Script_tc_errors.No_such_entrypoint entrypoint)
 
-let apply_origination ~consume_deserialization_gas ~ctxt ~script ~internal
-    ~preorigination ~delegate ~source ~credit ~before_operation =
+let apply_origination ~consume_deserialization_gas ~ctxt ~parsed_script ~script
+    ~internal ~preorigination ~delegate ~source ~credit ~before_operation =
   Script.force_decode_in_context
     ~consume_deserialization_gas
     ctxt
@@ -1152,11 +1152,14 @@ let apply_origination ~consume_deserialization_gas ~ctxt ~script ~internal
     ctxt
     script.Script.code
   >>?= fun (unparsed_code, ctxt) ->
-  Script_ir_translator.parse_script
-    ctxt
-    ~legacy:false
-    ~allow_forged_in_storage:internal
-    script
+  (match parsed_script with
+  | None ->
+      Script_ir_translator.parse_script
+        ctxt
+        ~legacy:false
+        ~allow_forged_in_storage:internal
+        script
+  | Some parsed_script -> return (parsed_script, ctxt))
   >>=? fun (Ex_script (Script parsed_script), ctxt) ->
   let views_result =
     Script_ir_translator.typecheck_views
@@ -1339,6 +1342,7 @@ let apply_internal_manager_operation_content :
       apply_origination
         ~consume_deserialization_gas
         ~ctxt
+        ~parsed_script:None
         ~script
         ~internal
         ~preorigination
@@ -1554,6 +1558,7 @@ let apply_external_manager_operation_content :
       apply_origination
         ~consume_deserialization_gas
         ~ctxt
+        ~parsed_script:None
         ~script
         ~internal
         ~preorigination
-- 
GitLab


From 846b5ad2e79f89cb5d17d483ea43a77264e04573 Mon Sep 17 00:00:00 2001
From: Nicolas Ayache <nicolas.ayache@nomadic-labs.com>
Date: Wed, 16 Feb 2022 09:47:55 +0100
Subject: [PATCH 03/10] Proto/Michelson: enrich create_contract with a lambda.

That will be used to create a typed script.
---
 src/proto_alpha/lib_protocol/script_interpreter.ml   | 12 ++----------
 .../lib_protocol/script_interpreter_defs.ml          |  3 ++-
 2 files changed, 4 insertions(+), 11 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/script_interpreter.ml b/src/proto_alpha/lib_protocol/script_interpreter.ml
index 772de7148ca8..9fdafa8e9453 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter.ml
@@ -1138,15 +1138,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
                                     (EmptyCell, EmptyCell))))))
           | Tx_rollup _ -> (return_none [@ocaml.tailcall]) ctxt)
       | ICreate_contract
-          {
-            storage_type;
-            arg_type;
-            lambda = Lam (_, code);
-            views;
-            entrypoints;
-            k;
-            _;
-          } ->
+          {storage_type; arg_type; lambda; views; entrypoints; k; _} ->
           (* Removed the instruction's arguments manager, spendable and delegatable *)
           let delegate = accu in
           let (credit, (init, stack)) = stack in
@@ -1155,7 +1147,7 @@ and step : type a s b t r f. (a, s, b, t, r, f) step_type =
             gas
             storage_type
             arg_type
-            code
+            lambda
             views
             entrypoints
             delegate
diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index 7dbabb9d1c80..4020110058d5 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -591,7 +591,7 @@ let transfer (ctxt, sc) gas amount location parameters_ty parameters destination
 
 (* TODO: https://gitlab.com/tezos/tezos/-/issues/1688
    Refactor the sharing part of unparse_script and create_contract *)
-let create_contract (ctxt, sc) gas storage_type param_type code views
+let create_contract (ctxt, sc) gas storage_type param_type lambda views
     entrypoints delegate credit init =
   let ctxt = update_context gas ctxt in
   let loc = Micheline.dummy_location in
@@ -613,6 +613,7 @@ let create_contract (ctxt, sc) gas storage_type param_type code views
     :: views
   in
   let views = Script_map.fold view views [] |> List.rev in
+  let (Lam (_, code)) = lambda in
   let code =
     strip_locations
       (Seq
-- 
GitLab


From 09da053058bc560ea57464450cdc9745b3ff602a Mon Sep 17 00:00:00 2001
From: Nicolas Ayache <nicolas.ayache@nomadic-labs.com>
Date: Mon, 7 Feb 2022 13:51:54 +0100
Subject: [PATCH 04/10] Proto/Michelson: enrich the origination internal
 operation.

The fields are already available when creating a contract, and this allows other modules, like ticket_operations_diff, to use it without parsing it yet again.

Does not compile (tests to adapt).
---
 src/proto_alpha/lib_protocol/apply.ml         | 11 +++++--
 src/proto_alpha/lib_protocol/apply_results.ml |  2 +-
 .../lib_protocol/script_interpreter_defs.ml   | 31 +++++++++++++------
 .../lib_protocol/script_typed_ir.ml           |  6 ++--
 .../lib_protocol/script_typed_ir.mli          |  6 ++--
 .../lib_protocol/ticket_operations_diff.ml    |  3 +-
 6 files changed, 41 insertions(+), 18 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index 0c2c22c17e14..a83521b4a0b2 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -1159,7 +1159,8 @@ let apply_origination ~consume_deserialization_gas ~ctxt ~parsed_script ~script
         ~legacy:false
         ~allow_forged_in_storage:internal
         script
-  | Some parsed_script -> return (parsed_script, ctxt))
+  | Some parsed_script ->
+      return (Script_ir_translator.Ex_script parsed_script, ctxt))
   >>=? fun (Ex_script (Script parsed_script), ctxt) ->
   let views_result =
     Script_ir_translator.typecheck_views
@@ -1338,11 +1339,15 @@ let apply_internal_manager_operation_content :
         ~payer
         ~dst_rollup:dst
         ~since:before_operation
-  | Origination {delegate; script; preorigination; credit} ->
+  | Origination
+      {
+        origination = {delegate; script; preorigination; credit};
+        script = parsed_script;
+      } ->
       apply_origination
         ~consume_deserialization_gas
         ~ctxt
-        ~parsed_script:None
+        ~parsed_script:(Some parsed_script)
         ~script
         ~internal
         ~preorigination
diff --git a/src/proto_alpha/lib_protocol/apply_results.ml b/src/proto_alpha/lib_protocol/apply_results.ml
index 92c1f4a586b7..5df009134954 100644
--- a/src/proto_alpha/lib_protocol/apply_results.ml
+++ b/src/proto_alpha/lib_protocol/apply_results.ml
@@ -81,7 +81,7 @@ let contents_of_internal_operation (type kind)
   let operation : kind internal_manager_operation =
     match operation with
     | Transaction {transaction; _} -> Transaction transaction
-    | Origination origination -> Origination origination
+    | Origination {origination; _} -> Origination origination
     | Delegation delegate -> Delegation delegate
   in
   {source; operation; nonce}
diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index 4020110058d5..9b6c80346e29 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -612,7 +612,7 @@ let create_contract (ctxt, sc) gas storage_type param_type lambda views
         [] )
     :: views
   in
-  let views = Script_map.fold view views [] |> List.rev in
+  let view_list = Script_map.fold view views [] |> List.rev in
   let (Lam (_, code)) = lambda in
   let code =
     strip_locations
@@ -623,7 +623,7 @@ let create_contract (ctxt, sc) gas storage_type param_type lambda views
              Prim (loc, K_storage, [unparsed_storage_type], []);
              Prim (loc, K_code, [code], []);
            ]
-           @ views ))
+           @ view_list ))
   in
   collect_lazy_storage ctxt storage_type init >>?= fun (to_duplicate, ctxt) ->
   let to_update = no_lazy_storage_id in
@@ -640,16 +640,29 @@ let create_contract (ctxt, sc) gas storage_type param_type lambda views
   Gas.consume ctxt (Script.strip_locations_cost storage) >>?= fun ctxt ->
   let storage = strip_locations storage in
   Contract.fresh_contract_from_current_nonce ctxt >>?= fun (ctxt, contract) ->
-  let operation =
-    Origination
+  let origination =
+    {
+      credit;
+      delegate;
+      preorigination = Some contract;
+      script =
+        {code = Script.lazy_expr code; storage = Script.lazy_expr storage};
+    }
+  in
+  Script_ir_translator.code_size ctxt lambda views >>?= fun (code_size, ctxt) ->
+  let script =
+    Script
       {
-        credit;
-        delegate;
-        preorigination = Some contract;
-        script =
-          {code = Script.lazy_expr code; storage = Script.lazy_expr storage};
+        code = lambda;
+        arg_type = param_type;
+        storage = init;
+        storage_type;
+        views;
+        entrypoints;
+        code_size;
       }
   in
+  let operation = Origination {origination; script} in
   fresh_internal_nonce ctxt >>?= fun (ctxt, nonce) ->
   let piop = Internal_operation {source = sc.self; operation; nonce} in
   let res = {piop; lazy_storage_diff} in
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml
index 2c984edbd1ee..142fb615d9de 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -1395,8 +1395,10 @@ and 'kind manager_operation =
       parameters : 'a;
     }
       -> Kind.transaction manager_operation
-  | Origination :
-      Alpha_context.origination
+  | Origination : {
+      origination : Alpha_context.origination;
+      script : ('arg, 'storage) script;
+    }
       -> Kind.origination manager_operation
   | Delegation :
       Signature.Public_key_hash.t option
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli
index 355030544476..5ca8b7364cfa 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.mli
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli
@@ -1533,8 +1533,10 @@ and 'kind manager_operation =
       parameters : 'a;
     }
       -> Kind.transaction manager_operation
-  | Origination :
-      Alpha_context.origination
+  | Origination : {
+      origination : Alpha_context.origination;
+      script : ('arg, 'storage) script;
+    }
       -> Kind.origination manager_operation
   | Delegation :
       Signature.Public_key_hash.t option
diff --git a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
index 9c9f69f3cb87..b3a766fbddc8 100644
--- a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
+++ b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
@@ -306,7 +306,8 @@ let tickets_of_operation ctxt
               },
             ctxt )
       else return (None, ctxt)
-  | Origination {delegate = _; script; credit = _; preorigination} ->
+  | Origination
+      {origination = {delegate = _; script; credit = _; preorigination}; _} ->
       tickets_of_origination ctxt ~preorigination script
   | Delegation _ -> return (None, ctxt)
 
-- 
GitLab


From 80ae35f765725cf2dc23ec8ac4fbdab7117f9fe0 Mon Sep 17 00:00:00 2001
From: Nicolas Ayache <nicolas.ayache@nomadic-labs.com>
Date: Mon, 7 Mar 2022 14:17:01 +0100
Subject: [PATCH 05/10] Proto/Tests: typed scripts in originations.

---
 .../michelson/test_ticket_accounting.ml       | 56 ++++++++++++-------
 .../michelson/test_ticket_operations_diff.ml  | 22 ++++++--
 2 files changed, 54 insertions(+), 24 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
index 507558a49180..4a62229dc084 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
@@ -330,20 +330,36 @@ let originate_script block ~script ~storage ~src ~baker ~forges_tickets =
   in
   Incremental.finalize_block incr >|=? fun block -> (destination, script, block)
 
-let origination_operation ~src ~script ~orig_contract =
-  Internal_operation
-    {
-      source = src;
-      operation =
-        Origination
-          {
-            delegate = None;
-            script;
-            credit = Tez.one;
-            preorigination = Some orig_contract;
-          };
-      nonce = 1;
-    }
+let origination_operation ctxt ~src ~script ~orig_contract =
+  let open Lwt_tzresult_syntax in
+  let* (Script_ir_translator.Ex_script parsed_script, ctxt) =
+    wrap
+    @@ Script_ir_translator.parse_script
+         ctxt
+         ~legacy:true
+         ~allow_forged_in_storage:true
+         script
+  in
+  let operation =
+    Internal_operation
+      {
+        source = src;
+        operation =
+          Origination
+            {
+              origination =
+                {
+                  delegate = None;
+                  script;
+                  credit = Tez.one;
+                  preorigination = Some orig_contract;
+                };
+              script = parsed_script;
+            };
+        nonce = 1;
+      }
+  in
+  return (operation, ctxt)
 
 let originate block ~src ~baker ~script ~storage ~forges_tickets =
   let open Lwt_tzresult_syntax in
@@ -1140,8 +1156,8 @@ let test_update_invalid_origination () =
       ~forges_tickets:true
   in
   let ctxt = Incremental.alpha_ctxt incr in
-  let operation =
-    origination_operation ~src ~orig_contract:destination ~script
+  let* (operation, ctxt) =
+    origination_operation ctxt ~src ~orig_contract:destination ~script
   in
   assert_fail_with
     ~loc:__LOC__
@@ -1184,8 +1200,8 @@ let test_update_valid_origination () =
   let* (_, ctxt) =
     wrap @@ Ticket_balance.adjust_balance ctxt red_self_token_hash ~delta:Z.one
   in
-  let operation =
-    origination_operation ~src:self ~orig_contract:originated ~script
+  let* (operation, ctxt) =
+    origination_operation ctxt ~src:self ~orig_contract:originated ~script
   in
   let* (_, ctxt) =
     let* (ticket_diffs, ctxt) =
@@ -1236,8 +1252,8 @@ let test_update_self_origination () =
          ~owner:(Destination.Contract originated)
          red_token
   in
-  let operation =
-    origination_operation ~src:self ~orig_contract:originated ~script
+  let* (operation, ctxt) =
+    origination_operation ctxt ~src:self ~orig_contract:originated ~script
   in
   let* (_, ctxt) =
     wrap
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
index 36db4c333d5c..0fbb2dfe89e9 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
@@ -231,6 +231,15 @@ let origination_operation block ~src ~baker ~script ~storage ~forges_tickets =
   let* incr =
     Incremental.begin_construction ~policy:Block.(By_account baker) block
   in
+  let ctxt = Incremental.alpha_ctxt incr in
+  let* (Script_ir_translator.Ex_script parsed_script, ctxt) =
+    wrap
+    @@ Script_ir_translator.parse_script
+         ctxt
+         ~legacy:true
+         ~allow_forged_in_storage:true
+         script
+  in
   let operation =
     Script_typed_ir.Internal_operation
       {
@@ -238,14 +247,19 @@ let origination_operation block ~src ~baker ~script ~storage ~forges_tickets =
         operation =
           Origination
             {
-              delegate = None;
-              script;
-              credit = Tez.one;
-              preorigination = Some orig_contract;
+              origination =
+                {
+                  delegate = None;
+                  script;
+                  credit = Tez.one;
+                  preorigination = Some orig_contract;
+                };
+              script = parsed_script;
             };
         nonce = 1;
       }
   in
+  let incr = Incremental.set_alpha_ctxt incr ctxt in
   return (orig_contract, operation, incr)
 
 let delegation_operation ~src =
-- 
GitLab


From 8ec3785766790652aa747bd38b0efd330d82d244 Mon Sep 17 00:00:00 2001
From: Nicolas Ayache <nicolas.ayache@nomadic-labs.com>
Date: Wed, 16 Mar 2022 17:58:40 +0100
Subject: [PATCH 06/10] Proto/Michelson: optimize tickets_of_origination.

---
 .../lib_protocol/ticket_operations_diff.ml    | 40 +++++++------------
 1 file changed, 15 insertions(+), 25 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
index b3a766fbddc8..04a413557972 100644
--- a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
+++ b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
@@ -220,33 +220,20 @@ let tickets_of_transaction ctxt ~destination ~entrypoint ~location
       return (Some {destination = Contract destination; tickets}, ctxt)
 
 (** Extract tickets of an origination operation by scanning the storage. *)
-let tickets_of_origination ctxt ~preorigination script =
+let tickets_of_origination ctxt ~preorigination
+    (Script_typed_ir.Script
+      {
+        storage_type;
+        storage;
+        code = _;
+        arg_type = _;
+        views = _;
+        entrypoints = _;
+        code_size = _;
+      }) =
   match preorigination with
   | None -> fail Contract_not_originated
   | Some contract ->
-      (* TODO: #2351
-         Avoid having to parse the script here.
-         We're not able to rely on caching due to issues with lazy storage.
-         After internal operations are in place we should be able to use the
-         typed script directly.
-      *)
-      Script_ir_translator.parse_script
-        ctxt
-        ~legacy:true
-        ~allow_forged_in_storage:true
-        script
-      >>=? fun ( Script_ir_translator.Ex_script
-                   (Script
-                     {
-                       storage;
-                       storage_type;
-                       code = _;
-                       arg_type = _;
-                       views = _;
-                       entrypoints = _;
-                       code_size = _;
-                     }),
-                 ctxt ) ->
       (* Extract any tickets from the storage. Note that if the type of the
          contract storage does not contain tickets, storage is not scanned. *)
       Ticket_scanner.type_has_tickets ctxt storage_type
@@ -307,7 +294,10 @@ let tickets_of_operation ctxt
             ctxt )
       else return (None, ctxt)
   | Origination
-      {origination = {delegate = _; script; credit = _; preorigination}; _} ->
+      {
+        origination = {delegate = _; script = _; credit = _; preorigination};
+        script;
+      } ->
       tickets_of_origination ctxt ~preorigination script
   | Delegation _ -> return (None, ctxt)
 
-- 
GitLab


From 59e94ced4737310da47ce922d4ba15c956cf1b7f Mon Sep 17 00:00:00 2001
From: Nicolas Ayache <nicolas.ayache@nomadic-labs.com>
Date: Mon, 7 Mar 2022 14:41:54 +0100
Subject: [PATCH 07/10] Proto/Michelson: remove preoriginations from external
 originations.

Because this is what actually happens: preoriginations are only set for internal operations.
---
 .../lib_client/client_proto_context.ml        |  8 +-----
 .../lib_client/operation_result.ml            |  3 +-
 src/proto_alpha/lib_plugin/plugin.ml          |  8 +-----
 .../lib_protocol/alpha_context.mli            |  1 -
 src/proto_alpha/lib_protocol/apply.ml         | 28 +++++++++----------
 src/proto_alpha/lib_protocol/apply_results.ml | 16 ++---------
 .../lib_protocol/operation_repr.ml            | 15 ++--------
 .../lib_protocol/operation_repr.mli           |  1 -
 .../lib_protocol/script_interpreter_defs.ml   |  5 ++--
 .../lib_protocol/script_typed_ir.ml           |  1 +
 .../lib_protocol/script_typed_ir.mli          |  1 +
 .../lib_protocol/test/helpers/op.ml           |  6 ++--
 .../lib_protocol/test/helpers/op.mli          |  1 -
 .../michelson/test_ticket_accounting.ml       |  9 ++----
 .../michelson/test_ticket_operations_diff.ml  |  9 ++----
 .../lib_protocol/ticket_operations_diff.ml    | 24 ++++++----------
 16 files changed, 42 insertions(+), 94 deletions(-)

diff --git a/src/proto_alpha/lib_client/client_proto_context.ml b/src/proto_alpha/lib_client/client_proto_context.ml
index 6054f274554c..c2d7e384b84a 100644
--- a/src/proto_alpha/lib_client/client_proto_context.ml
+++ b/src/proto_alpha/lib_client/client_proto_context.ml
@@ -360,13 +360,7 @@ let build_origination_operation ?fee ?gas_limit ?storage_limit ~initial_storage
   >>=? fun {Michelson_v1_parser.expanded = storage; _} ->
   let code = Script.lazy_expr code and storage = Script.lazy_expr storage in
   let origination =
-    Origination
-      {
-        delegate;
-        script = {code; storage};
-        credit = balance;
-        preorigination = None;
-      }
+    Origination {delegate; script = {code; storage}; credit = balance}
   in
   return
     (Injection.prepare_manager_operation
diff --git a/src/proto_alpha/lib_client/operation_result.ml b/src/proto_alpha/lib_client/operation_result.ml
index 61d8654bbe34..e815e7589e52 100644
--- a/src/proto_alpha/lib_client/operation_result.ml
+++ b/src/proto_alpha/lib_client/operation_result.ml
@@ -58,8 +58,7 @@ let pp_manager_operation_content (type kind) source internal pp_result ppf
          expr) ;
       pp_result ppf result ;
       Format.fprintf ppf "@]"
-  | Origination {delegate; credit; script = {code; storage}; preorigination = _}
-    ->
+  | Origination {delegate; credit; script = {code; storage}} ->
       Format.fprintf
         ppf
         "@[<v 2>%s:@,From: %a@,Credit: %s%a"
diff --git a/src/proto_alpha/lib_plugin/plugin.ml b/src/proto_alpha/lib_plugin/plugin.ml
index 7a06931b2e2f..1f24ac2e8b91 100644
--- a/src/proto_alpha/lib_plugin/plugin.ml
+++ b/src/proto_alpha/lib_plugin/plugin.ml
@@ -3202,13 +3202,7 @@ module RPC = struct
           ~storage_limit
           [
             Manager
-              (Origination
-                 {
-                   delegate = delegatePubKey;
-                   script;
-                   credit = balance;
-                   preorigination = None;
-                 });
+              (Origination {delegate = delegatePubKey; script; credit = balance});
           ]
 
       let delegation ctxt block ~branch ~source ?sourcePubKey ~counter ~fee
diff --git a/src/proto_alpha/lib_protocol/alpha_context.mli b/src/proto_alpha/lib_protocol/alpha_context.mli
index 96cf61a34659..65c1ca14bab9 100644
--- a/src/proto_alpha/lib_protocol/alpha_context.mli
+++ b/src/proto_alpha/lib_protocol/alpha_context.mli
@@ -2688,7 +2688,6 @@ type origination = {
   delegate : Signature.Public_key_hash.t option;
   script : Script.t;
   credit : Tez.tez;
-  preorigination : Contract.t option;
 }
 
 type 'kind operation = {
diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index a83521b4a0b2..eb8b7e23d72f 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -1141,7 +1141,7 @@ let apply_transaction_to_tx_rollup ~ctxt ~parameters_ty ~parameters ~amount
   else fail (Script_tc_errors.No_such_entrypoint entrypoint)
 
 let apply_origination ~consume_deserialization_gas ~ctxt ~parsed_script ~script
-    ~internal ~preorigination ~delegate ~source ~credit ~before_operation =
+    ~internal ~preoriginate ~delegate ~source ~credit ~before_operation =
   Script.force_decode_in_context
     ~consume_deserialization_gas
     ctxt
@@ -1203,15 +1203,7 @@ let apply_origination ~consume_deserialization_gas ~ctxt ~parsed_script ~script
   Gas.consume ctxt (Script.strip_locations_cost code) >>?= fun ctxt ->
   let code = Script.lazy_expr (Micheline.strip_locations code) in
   let script = {Script.code; storage} in
-  (match preorigination with
-  | Some contract ->
-      assert internal ;
-      (* The preorigination field is only used to early return the address of
-         an originated contract in Michelson.
-         It cannot come from the outside. *)
-      ok (ctxt, contract)
-  | None -> Contract.fresh_contract_from_current_nonce ctxt)
-  >>?= fun (ctxt, contract) ->
+  preoriginate ctxt >>?= fun (contract, ctxt) ->
   Contract.raw_originate
     ctxt
     ~prepaid_bootstrap_storage:false
@@ -1341,7 +1333,8 @@ let apply_internal_manager_operation_content :
         ~since:before_operation
   | Origination
       {
-        origination = {delegate; script; preorigination; credit};
+        origination = {delegate; script; credit};
+        preorigination;
         script = parsed_script;
       } ->
       apply_origination
@@ -1350,7 +1343,7 @@ let apply_internal_manager_operation_content :
         ~parsed_script:(Some parsed_script)
         ~script
         ~internal
-        ~preorigination
+        ~preoriginate:(fun ctxt -> ok (preorigination, ctxt))
         ~delegate
         ~source
         ~credit
@@ -1559,14 +1552,21 @@ let apply_external_manager_operation_content :
           }
       in
       return (ctxt, result, [op])
-  | Origination {delegate; script; preorigination; credit} ->
+  | Origination {delegate; script; credit} ->
+      (* The preorigination field is only used to early return the address of
+         an originated contract in Michelson.
+         It cannot come from the outside. *)
+      let preoriginate ctxt =
+        Contract.fresh_contract_from_current_nonce ctxt
+        >|? fun (ctxt, contract) -> (contract, ctxt)
+      in
       apply_origination
         ~consume_deserialization_gas
         ~ctxt
         ~parsed_script:None
         ~script
         ~internal
-        ~preorigination
+        ~preoriginate
         ~delegate
         ~source
         ~credit
diff --git a/src/proto_alpha/lib_protocol/apply_results.ml b/src/proto_alpha/lib_protocol/apply_results.ml
index 5df009134954..623b28c9effc 100644
--- a/src/proto_alpha/lib_protocol/apply_results.ml
+++ b/src/proto_alpha/lib_protocol/apply_results.ml
@@ -926,22 +926,10 @@ module Internal_result = struct
           (function Manager (Origination _ as op) -> Some op | _ -> None);
         proj =
           (function
-          | Origination
-              {
-                credit;
-                delegate;
-                script;
-                preorigination =
-                  _
-                  (* the hash is only used internally
-                             when originating from smart
-                             contracts, don't serialize it *);
-                _;
-              } ->
-              (credit, delegate, script));
+          | Origination {credit; delegate; script} -> (credit, delegate, script));
         inj =
           (fun (credit, delegate, script) ->
-            Origination {credit; delegate; script; preorigination = None});
+            Origination {credit; delegate; script});
       }
 
   let[@coq_axiom_with_reason "gadt"] delegation_case =
diff --git a/src/proto_alpha/lib_protocol/operation_repr.ml b/src/proto_alpha/lib_protocol/operation_repr.ml
index 24cf9a937765..6fc002bf5aa2 100644
--- a/src/proto_alpha/lib_protocol/operation_repr.ml
+++ b/src/proto_alpha/lib_protocol/operation_repr.ml
@@ -207,7 +207,6 @@ type origination = {
   delegate : Signature.Public_key_hash.t option;
   script : Script_repr.t;
   credit : Tez_repr.tez;
-  preorigination : Contract_repr.t option;
 }
 
 type 'kind operation = {
@@ -547,21 +546,11 @@ module Encoding = struct
             (function Manager (Origination _ as op) -> Some op | _ -> None);
           proj =
             (function
-            | Origination
-                {
-                  credit;
-                  delegate;
-                  script;
-                  preorigination =
-                    _
-                    (* the hash is only used internally
-                               when originating from smart
-                               contracts, don't serialize it *);
-                } ->
+            | Origination {credit; delegate; script} ->
                 (credit, delegate, script));
           inj =
             (fun (credit, delegate, script) ->
-              Origination {credit; delegate; script; preorigination = None});
+              Origination {credit; delegate; script});
         }
 
     let delegation_tag = 3
diff --git a/src/proto_alpha/lib_protocol/operation_repr.mli b/src/proto_alpha/lib_protocol/operation_repr.mli
index 19d787633d9b..6eab5947cb1a 100644
--- a/src/proto_alpha/lib_protocol/operation_repr.mli
+++ b/src/proto_alpha/lib_protocol/operation_repr.mli
@@ -188,7 +188,6 @@ type origination = {
   delegate : Signature.Public_key_hash.t option;
   script : Script_repr.t;
   credit : Tez_repr.tez;
-  preorigination : Contract_repr.t option;
 }
 
 (** An [operation] contains the operation header information in [shell]
diff --git a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
index 9b6c80346e29..6a19b4143379 100644
--- a/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
+++ b/src/proto_alpha/lib_protocol/script_interpreter_defs.ml
@@ -644,7 +644,6 @@ let create_contract (ctxt, sc) gas storage_type param_type lambda views
     {
       credit;
       delegate;
-      preorigination = Some contract;
       script =
         {code = Script.lazy_expr code; storage = Script.lazy_expr storage};
     }
@@ -662,7 +661,9 @@ let create_contract (ctxt, sc) gas storage_type param_type lambda views
         code_size;
       }
   in
-  let operation = Origination {origination; script} in
+  let operation =
+    Origination {origination; preorigination = contract; script}
+  in
   fresh_internal_nonce ctxt >>?= fun (ctxt, nonce) ->
   let piop = Internal_operation {source = sc.self; operation; nonce} in
   let res = {piop; lazy_storage_diff} in
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.ml b/src/proto_alpha/lib_protocol/script_typed_ir.ml
index 142fb615d9de..ce2142c54a6f 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.ml
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.ml
@@ -1397,6 +1397,7 @@ and 'kind manager_operation =
       -> Kind.transaction manager_operation
   | Origination : {
       origination : Alpha_context.origination;
+      preorigination : Contract.t;
       script : ('arg, 'storage) script;
     }
       -> Kind.origination manager_operation
diff --git a/src/proto_alpha/lib_protocol/script_typed_ir.mli b/src/proto_alpha/lib_protocol/script_typed_ir.mli
index 5ca8b7364cfa..2caa8f18942d 100644
--- a/src/proto_alpha/lib_protocol/script_typed_ir.mli
+++ b/src/proto_alpha/lib_protocol/script_typed_ir.mli
@@ -1535,6 +1535,7 @@ and 'kind manager_operation =
       -> Kind.transaction manager_operation
   | Origination : {
       origination : Alpha_context.origination;
+      preorigination : Contract.t;
       script : ('arg, 'storage) script;
     }
       -> Kind.origination manager_operation
diff --git a/src/proto_alpha/lib_protocol/test/helpers/op.ml b/src/proto_alpha/lib_protocol/test/helpers/op.ml
index 8dcfec4200e8..b7971edb3c48 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/op.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/op.ml
@@ -310,15 +310,15 @@ let originated_contract op =
 
 exception Impossible
 
-let contract_origination ?counter ?delegate ~script ?(preorigination = None)
-    ?public_key ?credit ?fee ?gas_limit ?storage_limit ctxt source =
+let contract_origination ?counter ?delegate ~script ?public_key ?credit ?fee
+    ?gas_limit ?storage_limit ctxt source =
   Context.Contract.manager ctxt source >>=? fun account ->
   let default_credit = Tez.of_mutez @@ Int64.of_int 1000001 in
   let default_credit =
     WithExceptions.Option.to_exn ~none:Impossible default_credit
   in
   let credit = Option.value ~default:default_credit credit in
-  let operation = Origination {delegate; script; credit; preorigination} in
+  let operation = Origination {delegate; script; credit} in
   manager_operation
     ?counter
     ?public_key
diff --git a/src/proto_alpha/lib_protocol/test/helpers/op.mli b/src/proto_alpha/lib_protocol/test/helpers/op.mli
index 267f8579970d..f5ce02258258 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/op.mli
+++ b/src/proto_alpha/lib_protocol/test/helpers/op.mli
@@ -119,7 +119,6 @@ val contract_origination :
   ?counter:Z.t ->
   ?delegate:public_key_hash ->
   script:Script.t ->
-  ?preorigination:Contract.contract option ->
   ?public_key:public_key ->
   ?credit:Tez.tez ->
   ?fee:Tez.tez ->
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
index 4a62229dc084..dd0c4884842c 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_accounting.ml
@@ -347,13 +347,8 @@ let origination_operation ctxt ~src ~script ~orig_contract =
         operation =
           Origination
             {
-              origination =
-                {
-                  delegate = None;
-                  script;
-                  credit = Tez.one;
-                  preorigination = Some orig_contract;
-                };
+              origination = {delegate = None; script; credit = Tez.one};
+              preorigination = orig_contract;
               script = parsed_script;
             };
         nonce = 1;
diff --git a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
index 0fbb2dfe89e9..ccab86761563 100644
--- a/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
+++ b/src/proto_alpha/lib_protocol/test/integration/michelson/test_ticket_operations_diff.ml
@@ -247,13 +247,8 @@ let origination_operation block ~src ~baker ~script ~storage ~forges_tickets =
         operation =
           Origination
             {
-              origination =
-                {
-                  delegate = None;
-                  script;
-                  credit = Tez.one;
-                  preorigination = Some orig_contract;
-                };
+              origination = {delegate = None; script; credit = Tez.one};
+              preorigination = orig_contract;
               script = parsed_script;
             };
         nonce = 1;
diff --git a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
index 04a413557972..8109390b6e30 100644
--- a/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
+++ b/src/proto_alpha/lib_protocol/ticket_operations_diff.ml
@@ -231,20 +231,13 @@ let tickets_of_origination ctxt ~preorigination
         entrypoints = _;
         code_size = _;
       }) =
-  match preorigination with
-  | None -> fail Contract_not_originated
-  | Some contract ->
-      (* Extract any tickets from the storage. Note that if the type of the
-         contract storage does not contain tickets, storage is not scanned. *)
-      Ticket_scanner.type_has_tickets ctxt storage_type
-      >>?= fun (has_tickets, ctxt) ->
-      Ticket_scanner.tickets_of_value
-        ctxt
-        ~include_lazy:true
-        has_tickets
-        storage
-      >|=? fun (tickets, ctxt) ->
-      (Some {tickets; destination = Destination.Contract contract}, ctxt)
+  (* Extract any tickets from the storage. Note that if the type of the contract
+     storage does not contain tickets, storage is not scanned. *)
+  Ticket_scanner.type_has_tickets ctxt storage_type
+  >>?= fun (has_tickets, ctxt) ->
+  Ticket_scanner.tickets_of_value ctxt ~include_lazy:true has_tickets storage
+  >|=? fun (tickets, ctxt) ->
+  (Some {tickets; destination = Destination.Contract preorigination}, ctxt)
 
 let tickets_of_operation ctxt
     (Script_typed_ir.Internal_operation {source = _; operation; nonce = _}) =
@@ -295,7 +288,8 @@ let tickets_of_operation ctxt
       else return (None, ctxt)
   | Origination
       {
-        origination = {delegate = _; script = _; credit = _; preorigination};
+        origination = {delegate = _; script = _; credit = _};
+        preorigination;
         script;
       } ->
       tickets_of_origination ctxt ~preorigination script
-- 
GitLab


From 45bc4609aa0b9e1a39db2b026545fdd0a49c4893 Mon Sep 17 00:00:00 2001
From: Nicolas Ayache <nicolas.ayache@nomadic-labs.com>
Date: Tue, 15 Mar 2022 16:29:42 +0100
Subject: [PATCH 08/10] Tests: update regression tests gas.

---
 ...t_originate_contract_from_contract_transfer.out |  8 ++++----
 ...nit-(Some \"KT1Mjjcb6tmSsLm7Cb3.c3984fbc14.out" | 14 +++++++-------
 2 files changed, 11 insertions(+), 11 deletions(-)

diff --git a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestOriginateContractFromContract::test_originate_contract_from_contract_transfer.out b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestOriginateContractFromContract::test_originate_contract_from_contract_transfer.out
index c3db7f879e3b..42bff6c96faa 100644
--- a/tests_python/tests_alpha/_regtest_outputs/test_contract.TestOriginateContractFromContract::test_originate_contract_from_contract_transfer.out
+++ b/tests_python/tests_alpha/_regtest_outputs/test_contract.TestOriginateContractFromContract::test_originate_contract_from_contract_transfer.out
@@ -1,7 +1,7 @@
 tests_alpha/test_contract.py::TestOriginateContractFromContract::test_originate_contract_from_contract_transfer
 
 Node is bootstrapped.
-Estimated gas: 3477.065 units (will add 100 for safety)
+Estimated gas: 3470.319 units (will add 100 for safety)
 Estimated storage: 295 bytes added (will add 20 for safety)
 Operation successfully injected in the node.
 Operation hash is '[BLOCK_HASH]'
@@ -14,7 +14,7 @@ This sequence of operations was run:
     From: [CONTRACT_HASH]
     Fee to the baker: ꜩ0.000607
     Expected counter: [EXPECTED_COUNTER]
-    Gas limit: 3578
+    Gas limit: 3571
     Storage limit: 315 bytes
     Balance updates:
       [CONTRACT_HASH] ... -ꜩ0.000607
@@ -26,7 +26,7 @@ This sequence of operations was run:
       This transaction was successfully applied
       Updated storage: Unit
       Storage size: 93 bytes
-      Consumed gas: 2069.085
+      Consumed gas: 2066.252
     Internal operations:
       Origination:
         From: [CONTRACT_HASH]
@@ -40,7 +40,7 @@ This sequence of operations was run:
             [CONTRACT_HASH]
           Storage size: 38 bytes
           Paid storage size diff: 38 bytes
-          Consumed gas: 1407.980
+          Consumed gas: 1404.067
           Balance updates:
             [CONTRACT_HASH] ... -ꜩ0.0095
             storage fees ........................... +ꜩ0.0095
diff --git "a/tests_python/tests_alpha/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[create_contract.tz-None-Unit-(Some \"KT1Mjjcb6tmSsLm7Cb3.c3984fbc14.out" "b/tests_python/tests_alpha/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[create_contract.tz-None-Unit-(Some \"KT1Mjjcb6tmSsLm7Cb3.c3984fbc14.out"
index 4b98d5ac09ec..edceebcd1124 100644
--- "a/tests_python/tests_alpha/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[create_contract.tz-None-Unit-(Some \"KT1Mjjcb6tmSsLm7Cb3.c3984fbc14.out"	
+++ "b/tests_python/tests_alpha/_regtest_outputs/test_contract_opcodes.TestContractOpcodes::test_contract_input_output[create_contract.tz-None-Unit-(Some \"KT1Mjjcb6tmSsLm7Cb3.c3984fbc14.out"	
@@ -26,24 +26,24 @@ emitted operations
       [ None
         50000
         Unit ]
-    - location: 13 (remaining gas: 1039983.548 units remaining)
+    - location: 13 (remaining gas: 1039982.468 units remaining)
       [ 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000002d08603000000001c02000000170500036c0501036c050202000000080317053d036d034200000002030b
         "KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm" ]
-    - location: 25 (remaining gas: 1039983.533 units remaining)
+    - location: 25 (remaining gas: 1039982.453 units remaining)
       [ "KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm" ]
-    - location: 27 (remaining gas: 1039983.518 units remaining)
+    - location: 27 (remaining gas: 1039982.438 units remaining)
       [ (Some "KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm") ]
-    - location: 28 (remaining gas: 1039983.503 units remaining)
+    - location: 28 (remaining gas: 1039982.423 units remaining)
       [ {}
         (Some "KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm") ]
-    - location: 25 (remaining gas: 1039983.473 units remaining)
+    - location: 25 (remaining gas: 1039982.393 units remaining)
       [ 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000002d08603000000001c02000000170500036c0501036c050202000000080317053d036d034200000002030b
         {}
         (Some "KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm") ]
-    - location: 30 (remaining gas: 1039983.458 units remaining)
+    - location: 30 (remaining gas: 1039982.378 units remaining)
       [ { 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000002d08603000000001c02000000170500036c0501036c050202000000080317053d036d034200000002030b }
         (Some "KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm") ]
-    - location: 31 (remaining gas: 1039983.443 units remaining)
+    - location: 31 (remaining gas: 1039982.363 units remaining)
       [ (Pair { 0x011d23c1d3d2f8a4ea5e8784b8f7ecf2ad304c0fe600000002d08603000000001c02000000170500036c0501036c050202000000080317053d036d034200000002030b }
               (Some "KT1Mjjcb6tmSsLm7Cb3DSQszePjfchPM4Uxm")) ]
 
-- 
GitLab


From c3865a9609babf49de055c5f5d3a49ffb029923d Mon Sep 17 00:00:00 2001
From: Nicolas Ayache <nicolas.ayache@nomadic-labs.com>
Date: Thu, 17 Mar 2022 14:44:03 +0100
Subject: [PATCH 09/10] Proto/Michelson: simplify using the preorigination.

---
 src/proto_alpha/lib_protocol/apply.ml | 19 ++++++++-----------
 1 file changed, 8 insertions(+), 11 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index eb8b7e23d72f..77cdfc947df2 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -1141,7 +1141,7 @@ let apply_transaction_to_tx_rollup ~ctxt ~parameters_ty ~parameters ~amount
   else fail (Script_tc_errors.No_such_entrypoint entrypoint)
 
 let apply_origination ~consume_deserialization_gas ~ctxt ~parsed_script ~script
-    ~internal ~preoriginate ~delegate ~source ~credit ~before_operation =
+    ~internal ~contract ~delegate ~source ~credit ~before_operation =
   Script.force_decode_in_context
     ~consume_deserialization_gas
     ctxt
@@ -1203,7 +1203,6 @@ let apply_origination ~consume_deserialization_gas ~ctxt ~parsed_script ~script
   Gas.consume ctxt (Script.strip_locations_cost code) >>?= fun ctxt ->
   let code = Script.lazy_expr (Micheline.strip_locations code) in
   let script = {Script.code; storage} in
-  preoriginate ctxt >>?= fun (contract, ctxt) ->
   Contract.raw_originate
     ctxt
     ~prepaid_bootstrap_storage:false
@@ -1334,7 +1333,7 @@ let apply_internal_manager_operation_content :
   | Origination
       {
         origination = {delegate; script; credit};
-        preorigination;
+        preorigination = contract;
         script = parsed_script;
       } ->
       apply_origination
@@ -1343,7 +1342,7 @@ let apply_internal_manager_operation_content :
         ~parsed_script:(Some parsed_script)
         ~script
         ~internal
-        ~preoriginate:(fun ctxt -> ok (preorigination, ctxt))
+        ~contract
         ~delegate
         ~source
         ~credit
@@ -1553,20 +1552,18 @@ let apply_external_manager_operation_content :
       in
       return (ctxt, result, [op])
   | Origination {delegate; script; credit} ->
-      (* The preorigination field is only used to early return the address of
-         an originated contract in Michelson.
+      (* The contract is only used to early return the address of an originated
+         contract in Michelson.
          It cannot come from the outside. *)
-      let preoriginate ctxt =
-        Contract.fresh_contract_from_current_nonce ctxt
-        >|? fun (ctxt, contract) -> (contract, ctxt)
-      in
+      Contract.fresh_contract_from_current_nonce ctxt
+      >>?= fun (ctxt, contract) ->
       apply_origination
         ~consume_deserialization_gas
         ~ctxt
         ~parsed_script:None
         ~script
         ~internal
-        ~preoriginate
+        ~contract
         ~delegate
         ~source
         ~credit
-- 
GitLab


From fa9d3b2085a3f905fed02af4e797e88a57a0c74d Mon Sep 17 00:00:00 2001
From: Nicolas Ayache <nicolas.ayache@nomadic-labs.com>
Date: Fri, 18 Mar 2022 09:44:15 +0100
Subject: [PATCH 10/10] Proto/Michelson: fix a comment.

---
 src/proto_alpha/lib_protocol/apply.ml | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/src/proto_alpha/lib_protocol/apply.ml b/src/proto_alpha/lib_protocol/apply.ml
index 77cdfc947df2..d03767acb89d 100644
--- a/src/proto_alpha/lib_protocol/apply.ml
+++ b/src/proto_alpha/lib_protocol/apply.ml
@@ -921,8 +921,8 @@ let apply_transaction_to_smart_contract ~ctxt ~source ~contract ~amount
     ~entrypoint ~before_operation ~payer ~chain_id ~mode ~internal ~script_ir
     ~script ~parameter ~cache_key ~balance_updates
     ~allocated_destination_contract =
-  (* Token.transfer which is being called above already loads this
-     value into the Irmin cache, so no need to burn gas for it. *)
+  (* Token.transfer which is being called before already loads this value into
+     the Irmin cache, so no need to burn gas for it. *)
   Contract.get_balance ctxt contract >>=? fun balance ->
   let now = Script_timestamp.now ctxt in
   let level =
-- 
GitLab