From 5579d3cc975cf217fbbd4458a5111615c6e97dff Mon Sep 17 00:00:00 2001 From: Benjamin Canou Date: Wed, 11 Apr 2018 00:14:11 +0200 Subject: [PATCH] Michelson: add untyped address type, and instructions ADDRESS and CONTRACT --- docs/whitedoc/michelson.rst | 1 + .../lib_protocol/src/alpha_context.mli | 5 ++ .../lib_protocol/src/michelson_v1_gas.ml | 3 + .../lib_protocol/src/michelson_v1_gas.mli | 3 + .../src/michelson_v1_primitives.ml | 14 +++- .../src/michelson_v1_primitives.mli | 3 + .../lib_protocol/src/script_interpreter.ml | 21 +++++ .../lib_protocol/src/script_ir_translator.ml | 80 +++++++++++++++++-- .../lib_protocol/src/script_ir_translator.mli | 4 + .../lib_protocol/src/script_typed_ir.ml | 8 ++ 10 files changed, 134 insertions(+), 8 deletions(-) diff --git a/docs/whitedoc/michelson.rst b/docs/whitedoc/michelson.rst index a3bf26a0b..3cbd39ef6 100644 --- a/docs/whitedoc/michelson.rst +++ b/docs/whitedoc/michelson.rst @@ -1378,6 +1378,7 @@ Operations on contracts :: + :: address : 'S -> key_hash : 'S :: contract 'p : 'S -> key_hash : 'S - ``CREATE_CONTRACT``: Forge a new contract. diff --git a/src/proto_alpha/lib_protocol/src/alpha_context.mli b/src/proto_alpha/lib_protocol/src/alpha_context.mli index 881f21ae3..173f1f252 100644 --- a/src/proto_alpha/lib_protocol/src/alpha_context.mli +++ b/src/proto_alpha/lib_protocol/src/alpha_context.mli @@ -127,6 +127,8 @@ module Gas : sig val alloc_cost : int -> cost val alloc_bytes_cost : int -> cost val alloc_bits_cost : int -> cost + val read_bytes_cost : Z.t -> cost + val write_bytes_cost : Z.t -> cost val ( *@ ) : int -> cost -> cost val ( +@ ) : cost -> cost -> cost @@ -239,6 +241,8 @@ module Script : sig | I_XOR | I_ITER | I_LOOP_LEFT + | I_ADDRESS + | I_CONTRACT | T_bool | T_contract | T_int @@ -259,6 +263,7 @@ module Script : sig | T_timestamp | T_unit | T_operation + | T_address type location = Micheline.canonical_location diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml index 3d8194357..b94364d4f 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.ml @@ -169,6 +169,8 @@ module Cost_of = struct let compare_res = step_cost 1 (* TODO: protocol operations *) + let address = step_cost 3 + let contract = Gas.read_bytes_cost Z.zero +@ step_cost 3 let manager = step_cost 3 let transfer = step_cost 50 let create_account = step_cost 20 @@ -193,6 +195,7 @@ module Cost_of = struct let compare_nat = compare_int let compare_key_hash _ _ = alloc_bytes_cost 36 let compare_timestamp t1 t2 = compare_zint (Script_timestamp.to_zint t1) (Script_timestamp.to_zint t2) + let compare_address _ _ = step_cost 20 module Typechecking = struct let cycle = step_cost 1 diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli index 6c7192978..73c153e0b 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_gas.mli @@ -64,6 +64,8 @@ module Cost_of : sig val exec : Gas.cost val push : Gas.cost val compare_res : Gas.cost + val address : Gas.cost + val contract : Gas.cost val manager : Gas.cost val transfer : Gas.cost val create_account : Gas.cost @@ -86,6 +88,7 @@ module Cost_of : sig val compare_nat : 'a Script_int.num -> 'b Script_int.num -> Gas.cost val compare_key_hash : 'a -> 'b -> Gas.cost val compare_timestamp : Script_timestamp.t -> Script_timestamp.t -> Gas.cost + val compare_address : Contract.t -> Contract.t -> Gas.cost module Typechecking : sig val cycle : Gas.cost diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml index 4496ed596..1cea252fa 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.ml @@ -94,6 +94,8 @@ type prim = | I_XOR | I_ITER | I_LOOP_LEFT + | I_ADDRESS + | I_CONTRACT | T_bool | T_contract | T_int @@ -114,6 +116,7 @@ type prim = | T_timestamp | T_unit | T_operation + | T_address let valid_case name = let is_lower = function '_' | 'a'..'z' -> true | _ -> false in @@ -215,6 +218,8 @@ let string_of_prim = function | I_XOR -> "XOR" | I_ITER -> "ITER" | I_LOOP_LEFT -> "LOOP_LEFT" + | I_ADDRESS -> "ADDRESS" + | I_CONTRACT -> "CONTRACT" | T_bool -> "bool" | T_contract -> "contract" | T_int -> "int" @@ -235,6 +240,7 @@ let string_of_prim = function | T_timestamp -> "timestamp" | T_unit -> "unit" | T_operation -> "operation" + | T_address -> "address" let prim_of_string = function | "parameter" -> ok K_parameter @@ -317,6 +323,8 @@ let prim_of_string = function | "XOR" -> ok I_XOR | "ITER" -> ok I_ITER | "LOOP_LEFT" -> ok I_LOOP_LEFT + | "ADDRESS" -> ok I_ADDRESS + | "CONTRACT" -> ok I_CONTRACT | "bool" -> ok T_bool | "contract" -> ok T_contract | "int" -> ok T_int @@ -337,6 +345,7 @@ let prim_of_string = function | "timestamp" -> ok T_timestamp | "unit" -> ok T_unit | "operation" -> ok T_operation + | "address" -> ok T_address | n -> if valid_case n then error (Unknown_primitive_name n) @@ -463,6 +472,8 @@ let prim_encoding = ("XOR", I_XOR) ; ("ITER", I_ITER) ; ("LOOP_LEFT", I_LOOP_LEFT) ; + ("ADDRESS", I_ADDRESS) ; + ("CONTRACT", I_CONTRACT) ; ("bool", T_bool) ; ("contract", T_contract) ; ("int", T_int) ; @@ -482,7 +493,8 @@ let prim_encoding = ("tez", T_tez) ; ("timestamp", T_timestamp) ; ("unit", T_unit) ; - ("operation", T_operation) ] + ("operation", T_operation) ; + ("address", T_address) ] let () = register_error_kind diff --git a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli index d08ef261c..051e2a50d 100644 --- a/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli +++ b/src/proto_alpha/lib_protocol/src/michelson_v1_primitives.mli @@ -92,6 +92,8 @@ type prim = | I_XOR | I_ITER | I_LOOP_LEFT + | I_ADDRESS + | I_CONTRACT | T_bool | T_contract | T_int @@ -112,6 +114,7 @@ type prim = | T_timestamp | T_unit | T_operation + | T_address val prim_encoding : prim Data_encoding.encoding diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.ml b/src/proto_alpha/lib_protocol/src/script_interpreter.ml index d06c90a6a..b91131609 100644 --- a/src/proto_alpha/lib_protocol/src/script_interpreter.ml +++ b/src/proto_alpha/lib_protocol/src/script_interpreter.ml @@ -605,6 +605,8 @@ let rec interp Interp_costs.compare_key_hash a b rest | Compare Timestamp_key, Item (a, Item (b, rest)) -> consume_gaz_comparison descr Script_timestamp.compare Interp_costs.compare_timestamp a b rest + | Compare Address_key, Item (a, Item (b, rest)) -> + consume_gaz_comparison descr Contract.compare Interp_costs.compare_address a b rest (* comparators *) | Eq, Item (cmpres, rest) -> let cmpres = Script_int.compare cmpres Script_int.zero in @@ -637,10 +639,29 @@ let rec interp Lwt.return (Gas.consume ctxt Interp_costs.compare_res) >>=? fun ctxt -> logged_return (Item (cmpres, rest), ctxt) (* protocol *) + | Address, Item ((_, contract), rest) -> + Lwt.return (Gas.consume ctxt Interp_costs.address) >>=? fun ctxt -> + logged_return (Item (contract, rest), ctxt) + | Contract t, Item (contract, rest) -> + Lwt.return (Gas.consume ctxt Interp_costs.contract) >>=? fun ctxt -> + Contract.exists ctxt contract >>=? fun exists -> + if exists then + Script_ir_translator.parse_contract ctxt loc t contract >>=? fun (ctxt, contract) -> + logged_return (Item (Some contract, rest), ctxt) + else + logged_return (Item (None, rest), ctxt) | Manager, Item ((_, contract), rest) -> Lwt.return (Gas.consume ctxt Interp_costs.manager) >>=? fun ctxt -> Contract.get_manager ctxt contract >>=? fun manager -> logged_return (Item (manager, rest), ctxt) + | Address_manager, Item (contract, rest) -> + Lwt.return (Gas.consume ctxt Interp_costs.manager) >>=? fun ctxt -> + Contract.exists ctxt contract >>=? fun exists -> + if exists then + Contract.get_manager ctxt contract >>=? fun manager -> + logged_return (Item (Some manager, rest), ctxt) + else + logged_return (Item (None, rest), ctxt) | Transfer_tokens, Item (p, Item (amount, Item ((tp, destination), rest))) -> Lwt.return (Gas.consume ctxt Interp_costs.transfer) >>=? fun ctxt -> diff --git a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml index 6a8c7c665..2ff1cbb30 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -46,6 +46,7 @@ let comparable_type_size : type t. t comparable_ty -> int = function | Bool_key -> 1 | Key_hash_key -> 1 | Timestamp_key -> 1 + | Address_key -> 1 let rec type_size : type t. t ty -> int = function | Unit_t -> 1 @@ -57,6 +58,7 @@ let rec type_size : type t. t ty -> int = function | Key_hash_t -> 1 | Key_t -> 1 | Timestamp_t -> 1 + | Address_t -> 1 | Bool_t -> 1 | Operation_t -> 1 | Pair_t ((l, _), (r, _)) -> @@ -189,7 +191,10 @@ let number_of_generated_growing_types : type b a. (b, a) instr -> int = function | Gt -> 0 | Le -> 0 | Ge -> 0 + | Address -> 0 + | Contract _ -> 1 | Manager -> 0 + | Address_manager -> 0 | Transfer_tokens -> 1 | Create_account -> 0 | Implicit_account -> 0 @@ -299,7 +304,9 @@ let namespace = function | I_UPDATE | I_XOR | I_ITER - | I_LOOP_LEFT -> Instr_namespace + | I_LOOP_LEFT + | I_ADDRESS + | I_CONTRACT -> Instr_namespace | T_bool | T_contract | T_int @@ -319,7 +326,8 @@ let namespace = function | T_tez | T_timestamp | T_unit - | T_operation -> Type_namespace + | T_operation + | T_address -> Type_namespace let unexpected expr exp_kinds exp_ns exp_prims = @@ -365,6 +373,7 @@ let compare_comparable else if Compare.Int.(res > 0) then 1 else -1 | Timestamp_key -> Script_timestamp.compare x y + | Address_key -> Contract.compare x y let empty_set : type a. a comparable_ty -> a set @@ -491,6 +500,7 @@ let ty_of_comparable_ty | Bool_key -> Bool_t | Key_hash_key -> Key_hash_t | Timestamp_key -> Timestamp_t + | Address_key -> Address_t let unparse_comparable_ty : type a. a comparable_ty -> Script.node = function @@ -501,6 +511,7 @@ let unparse_comparable_ty | Bool_key -> Prim (-1, T_bool, [], None) | Key_hash_key -> Prim (-1, T_key_hash, [], None) | Timestamp_key -> Prim (-1, T_timestamp, [], None) + | Address_key -> Prim (-1, T_address, [], None) let rec unparse_ty : type a. annot -> a ty -> Script.node = fun annot -> @@ -514,6 +525,7 @@ let rec unparse_ty | Key_hash_t -> Prim (-1, T_key_hash, [], annot) | Key_t -> Prim (-1, T_key, [], annot) | Timestamp_t -> Prim (-1, T_timestamp, [], annot) + | Address_t -> Prim (-1, T_address, [], annot) | Signature_t -> Prim (-1, T_signature, [], annot) | Operation_t -> Prim (-1, T_operation, [], annot) | Contract_t ut -> @@ -581,6 +593,9 @@ let rec unparse_data | None -> ok @@ (Int (-1, Script_timestamp.to_zint t), gas) | Some s -> ok @@ (String (-1, s), gas) end + | Address_t, c -> + Gas.consume ctxt Unparse_costs.contract >|? fun gas -> + (String (-1, Contract.to_b58check c), gas) | Contract_t _, (_, c) -> Gas.consume ctxt Unparse_costs.contract >|? fun gas -> (String (-1, Contract.to_b58check c), gas) @@ -676,6 +691,7 @@ let comparable_ty_eq | Bool_key, Bool_key -> Ok Eq | Key_hash_key, Key_hash_key -> Ok Eq | Timestamp_key, Timestamp_key -> Ok Eq + | Address_key, Address_key -> Ok Eq | _, _ -> error (Inconsistent_types (ty_of_comparable_ty ta, ty_of_comparable_ty tb)) let rec ty_eq @@ -691,6 +707,7 @@ let rec ty_eq | Signature_t, Signature_t -> Ok Eq | Tez_t, Tez_t -> Ok Eq | Timestamp_t, Timestamp_t -> Ok Eq + | Address_t, Address_t -> Ok Eq | Bool_t, Bool_t -> Ok Eq | Operation_t, Operation_t -> Ok Eq | Map_t (tal, tar), Map_t (tbl, tbr) -> @@ -771,7 +788,8 @@ let merge_comparable_types | Bool_key, Bool_key -> ta | Key_hash_key, Key_hash_key -> ta | Timestamp_key, Timestamp_key -> ta - | _, _ -> assert false + | Address_key, Address_key -> ta + | _, _ -> assert false (* FIXME: fix injectivity of some types *) let error_unexpected_annot loc annot = match annot with @@ -801,6 +819,7 @@ let merge_types : | Signature_t, Signature_t -> ok Signature_t | Tez_t, Tez_t -> ok Tez_t | Timestamp_t, Timestamp_t -> ok Timestamp_t + | Address_t, Address_t -> ok Address_t | Bool_t, Bool_t -> ok Bool_t | Operation_t, Operation_t -> ok Operation_t | Map_t (tal, tar), Map_t (tbl, tbr) -> @@ -907,9 +926,10 @@ let rec parse_comparable_ty | Prim (_, T_bool, [], _) -> ok (Ex_comparable_ty Bool_key) | Prim (_, T_key_hash, [], _) -> ok (Ex_comparable_ty Key_hash_key) | Prim (_, T_timestamp, [], _) -> ok (Ex_comparable_ty Timestamp_key) + | Prim (_, T_address, [], _) -> ok (Ex_comparable_ty Address_key) | Prim (loc, (T_int | T_nat | T_string | T_tez | T_bool - | T_key | T_timestamp as prim), l, _) -> + | T_key | T_address | T_timestamp as prim), l, _) -> error (Invalid_arity (loc, prim, 0, List.length l)) | Prim (loc, (T_pair | T_or | T_set | T_map | T_list | T_option | T_lambda @@ -959,6 +979,8 @@ and parse_ty ok (Ex_ty Key_hash_t, annot) | Prim (_, T_timestamp, [], annot) -> ok (Ex_ty Timestamp_t, annot) + | Prim (_, T_address, [], annot) -> + ok (Ex_ty Address_t, annot) | Prim (_, T_signature, [], annot) -> ok (Ex_ty Signature_t, annot) | Prim (_, T_operation, [], annot) -> @@ -999,7 +1021,8 @@ and parse_ty | Prim (loc, (T_unit | T_signature | T_int | T_nat | T_string | T_tez | T_bool - | T_key | T_key_hash | T_timestamp as prim), l, _) -> + | T_key | T_key_hash + | T_timestamp | T_address as prim), l, _) -> error (Invalid_arity (loc, prim, 0, List.length l)) | Prim (loc, (T_set | T_list | T_option as prim), l, _) -> error (Invalid_arity (loc, prim, 1, List.length l)) @@ -1180,6 +1203,14 @@ let rec parse_data end | Operation_t, expr -> traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) + (* Addresses *) + | Address_t, String (_, s) -> + Lwt.return (Gas.consume ctxt Typecheck_costs.contract) >>=? fun ctxt -> + traced @@ + (Lwt.return (Contract.of_b58check s)) >>=? fun c -> + return (c, ctxt) + | Address_t, expr -> + traced (fail (Invalid_kind (location expr, [ String_kind ], kind expr))) (* Contracts *) | Contract_t ty1, String (loc, s) -> Lwt.return (Gas.consume ctxt Typecheck_costs.contract) >>=? fun ctxt -> @@ -1955,6 +1986,10 @@ and parse_instr Item_t (Timestamp_t, Item_t (Timestamp_t, rest, _), _) -> typed ctxt loc (Compare Timestamp_key) (Item_t (Int_t, rest, instr_annot)) + | Prim (loc, I_COMPARE, [], instr_annot), + Item_t (Address_t, Item_t (Address_t, rest, _), _) -> + typed ctxt loc (Compare Address_key) + (Item_t (Int_t, rest, instr_annot)) (* comparators *) | Prim (loc, I_EQ, [], instr_annot), Item_t (Int_t, rest, _) -> @@ -1981,10 +2016,24 @@ and parse_instr typed ctxt loc Ge (Item_t (Bool_t, rest, instr_annot)) (* protocol *) + | Prim (loc, I_ADDRESS, [], _), + Item_t (Contract_t _, rest, instr_annot) -> + typed ctxt loc Address + (Item_t (Address_t, rest, instr_annot)) + | Prim (loc, I_CONTRACT, [ ty ], _), + Item_t (Address_t, rest, instr_annot) -> + Lwt.return (parse_ty ~allow_big_map:false ty) >>=? fun (Ex_ty t, annot) -> + fail_unexpected_annot loc annot >>=? fun () -> + typed ctxt loc (Contract t) + (Item_t (Option_t (Contract_t t), rest, instr_annot)) | Prim (loc, I_MANAGER, [], instr_annot), Item_t (Contract_t _, rest, _) -> typed ctxt loc Manager (Item_t (Key_hash_t, rest, instr_annot)) + | Prim (loc, I_MANAGER, [], instr_annot), + Item_t (Address_t, rest, _) -> + typed ctxt loc Address_manager + (Item_t (Option_t Key_hash_t, rest, instr_annot)) | Prim (loc, I_TRANSFER_TOKENS, [], instr_annot), Item_t (p, Item_t (Tez_t, Item_t @@ -2105,11 +2154,11 @@ and parse_instr | I_CREATE_CONTRACT | I_NOW | I_IMPLICIT_ACCOUNT | I_AMOUNT | I_BALANCE | I_CHECK_SIGNATURE | I_HASH_KEY - | I_H | I_STEPS_TO_QUOTA + | I_H | I_STEPS_TO_QUOTA | I_ADDRESS as name), (_ :: _ as l), _), _ -> fail (Invalid_arity (loc, name, 0, List.length l)) | Prim (loc, (I_NONE | I_LEFT | I_RIGHT | I_NIL | I_MAP | I_ITER - | I_EMPTY_SET | I_DIP | I_LOOP | I_LOOP_LEFT + | I_EMPTY_SET | I_DIP | I_LOOP | I_LOOP_LEFT | I_CONTRACT as name), ([] | _ :: _ :: _ as l), _), _ -> fail (Invalid_arity (loc, name, 1, List.length l)) @@ -2269,6 +2318,23 @@ let parse_script ctxt ?type_logger ~check_operations (arg_type_full, None) ret_type_full code_field) >>=? fun (code, ctxt) -> return (Ex_script { code ; arg_type ; storage ; storage_type }, ctxt) +let parse_contract : + type t. context -> Script.location -> t Script_typed_ir.ty -> Contract.t -> + (context * t Script_typed_ir.typed_contract) tzresult Lwt.t + = fun ctxt loc ty contract -> + Contract.get_script ctxt contract >>=? fun (ctxt, script) -> match script with + | None -> + begin match ty with + | Unit_t -> return (ctxt, (ty, contract)) + | _ -> fail (Invalid_contract (loc, contract)) + end + | Some script -> + Lwt.return @@ parse_toplevel script.code >>=? fun (arg_type, _, _) -> + let arg_type = Micheline.strip_locations arg_type in + Lwt.return (parse_ty ~allow_big_map:false (Micheline.root arg_type)) >>=? fun (Ex_ty arg_type, _) -> + Lwt.return (ty_eq ty arg_type) >>=? fun Eq -> + return (ctxt, (ty, contract)) + let typecheck_code : context -> Script.expr -> (type_map * context) tzresult Lwt.t = fun ctxt code -> diff --git a/src/proto_alpha/lib_protocol/src/script_ir_translator.mli b/src/proto_alpha/lib_protocol/src/script_ir_translator.mli index e80351fd1..f925ce23e 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.mli +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.mli @@ -82,6 +82,10 @@ val parse_script : ?type_logger: (int -> Script.expr list -> Script.expr list -> unit) -> context -> check_operations: bool -> Script.t -> (ex_script * context) tzresult Lwt.t +val parse_contract : + context -> Script.location -> 'a Script_typed_ir.ty -> Contract.t -> + (context * 'a Script_typed_ir.typed_contract) tzresult Lwt.t + val hash_data : context -> 'a Script_typed_ir.ty -> 'a -> (string * context) tzresult val extract_big_map : 'a Script_typed_ir.ty -> 'a -> Script_typed_ir.ex_big_map option diff --git a/src/proto_alpha/lib_protocol/src/script_typed_ir.ml b/src/proto_alpha/lib_protocol/src/script_typed_ir.ml index f8475437d..eefb9f1d9 100644 --- a/src/proto_alpha/lib_protocol/src/script_typed_ir.ml +++ b/src/proto_alpha/lib_protocol/src/script_typed_ir.ml @@ -21,6 +21,7 @@ type 'ty comparable_ty = | Bool_key : bool comparable_ty | Key_hash_key : public_key_hash comparable_ty | Timestamp_key : Script_timestamp.t comparable_ty + | Address_key : Contract.t comparable_ty module type Boxed_set = sig type elt @@ -71,6 +72,7 @@ and 'ty ty = | Key_hash_t : public_key_hash ty | Key_t : public_key ty | Timestamp_t : Script_timestamp.t ty + | Address_t : Contract.t ty | Bool_t : bool ty | Pair_t : ('a ty * annot) * ('b ty * annot) -> ('a, 'b) pair ty | Union_t : ('a ty * annot) * ('b ty * annot) -> ('a, 'b) union ty @@ -315,8 +317,14 @@ and ('bef, 'aft) instr = (z num * 'rest, bool * 'rest) instr (* protocol *) + | Address : + (_ typed_contract * 'rest, Contract.t * 'rest) instr + | Contract : 'p ty -> + (Contract.t * 'rest, 'p typed_contract option * 'rest) instr | Manager : ('arg typed_contract * 'rest, public_key_hash * 'rest) instr + | Address_manager : + (Contract.t * 'rest, public_key_hash option * 'rest) instr | Transfer_tokens : ('arg * (Tez.t * ('arg typed_contract * 'rest)), internal_operation * 'rest) instr | Create_account :