diff --git a/src/proto_alpha/lib_client/client_proto_programs.ml b/src/proto_alpha/lib_client/client_proto_programs.ml
index f0ff024dd..f1030326b 100644
--- a/src/proto_alpha/lib_client/client_proto_programs.ml
+++ b/src/proto_alpha/lib_client/client_proto_programs.ml
@@ -43,11 +43,11 @@ let print_big_map_diff ppf = function
(Format.pp_print_list
~pp_sep:Format.pp_print_space
(fun ppf (key, value) ->
- Format.fprintf ppf "%s %a%a"
+ Format.fprintf ppf "%s %s%a"
(match value with
| None -> "-"
| Some _ -> "+")
- print_expr key
+ key
(fun ppf -> function
| None -> ()
| Some x -> Format.fprintf ppf "-> %a" print_expr x)
diff --git a/src/proto_alpha/lib_client/client_proto_programs.mli b/src/proto_alpha/lib_client/client_proto_programs.mli
index 619499747..d50790e19 100644
--- a/src/proto_alpha/lib_client/client_proto_programs.mli
+++ b/src/proto_alpha/lib_client/client_proto_programs.mli
@@ -22,7 +22,7 @@ val run :
input:Michelson_v1_parser.parsed ->
Block_services.block ->
#Proto_alpha.rpc_context ->
- (Script.expr * Script.expr * (Script.expr * Script.expr option) list option) tzresult Lwt.t
+ (Script.expr * Script.expr * Contract.big_map_diff option) tzresult Lwt.t
val trace :
?contract:Contract.t ->
@@ -32,22 +32,24 @@ val trace :
input:Michelson_v1_parser.parsed ->
Block_services.block ->
#Proto_alpha.rpc_context ->
- (Script.expr * Script.expr * (int * Gas.t * Script.expr list) list * (Script.expr * Script.expr option) list option) tzresult Lwt.t
+ (Script.expr * Script.expr *
+ Script_interpreter.execution_trace *
+ Contract.big_map_diff option) tzresult Lwt.t
val print_run_result :
#Client_context.printer ->
show_source:bool ->
parsed:Michelson_v1_parser.parsed ->
(Script_repr.expr * Script_repr.expr *
- (Script_repr.expr * Script_repr.expr option) list option) tzresult -> unit tzresult Lwt.t
+ Contract.big_map_diff option) tzresult -> unit tzresult Lwt.t
val print_trace_result :
#Client_context.printer ->
show_source:bool ->
parsed:Michelson_v1_parser.parsed ->
(Script_repr.expr * Script_repr.expr *
- (int * Gas.t * Script_repr.expr list) list *
- (Script_repr.expr * Script_repr.expr option) list option)
+ Script_interpreter.execution_trace *
+ Contract.big_map_diff option)
tzresult -> unit tzresult Lwt.t
val hash_and_sign :
diff --git a/src/proto_alpha/lib_protocol/src/apply.ml b/src/proto_alpha/lib_protocol/src/apply.ml
index b73ad5b2a..90443f218 100644
--- a/src/proto_alpha/lib_protocol/src/apply.ml
+++ b/src/proto_alpha/lib_protocol/src/apply.ml
@@ -388,21 +388,16 @@ let apply_manager_operation_content
| _ -> fail (Bad_contract_parameter (destination, None, parameters))
end
| Some script ->
- let call_contract ctxt argument =
+ let call_contract ctxt parameter =
Script_interpreter.execute
- origination_nonce
- source destination ctxt script amount argument
+ ctxt origination_nonce
+ ~source ~self:(destination, script) ~amount ~parameter
>>= function
- | Ok (storage_res, _res, ctxt, origination_nonce, maybe_big_map_diff) ->
- begin match maybe_big_map_diff with
- | None -> return (None, ctxt)
- | Some map ->
- Script_ir_translator.to_serializable_big_map ctxt map >>=? fun (diff, ctxt) ->
- return (Some diff, ctxt) end >>=? fun (diff, ctxt) ->
+ | Ok { ctxt ; origination_nonce ; storage ; big_map_diff ; return_value = _ } ->
Contract.update_script_storage
- ctxt destination
- storage_res diff >>=? fun ctxt ->
- Fees.update_script_storage ctxt ~source destination >>=? fun (ctxt, fees) ->
+ ctxt destination storage big_map_diff >>=? fun ctxt ->
+ Fees.update_script_storage
+ ctxt ~source destination >>=? fun (ctxt, fees) ->
return (ctxt, origination_nonce, None, fees)
| Error err ->
return (ctxt, origination_nonce, Some err, Tez.zero) in
diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.ml b/src/proto_alpha/lib_protocol/src/helpers_services.ml
index bd7232daf..7d4b64a5d 100644
--- a/src/proto_alpha/lib_protocol/src/helpers_services.ml
+++ b/src/proto_alpha/lib_protocol/src/helpers_services.ml
@@ -40,7 +40,7 @@ module S = struct
~output: (obj3
(req "storage" Script.expr_encoding)
(req "output" Script.expr_encoding)
- (opt "big_map_diff" (list (tup2 Script.expr_encoding (option Script.expr_encoding)))))
+ (opt "big_map_diff" (list (tup2 string (option Script.expr_encoding)))))
RPC_path.(custom_root / "run_code")
let apply_operation =
@@ -71,7 +71,7 @@ module S = struct
(req "location" Script.location_encoding)
(req "gas" Gas.encoding)
(req "stack" (list (Script.expr_encoding)))))
- (opt "big_map_diff" (list (tup2 Script.expr_encoding (option Script.expr_encoding)))))
+ (opt "big_map_diff" (list (tup2 string (option Script.expr_encoding)))))
RPC_path.(custom_root / "trace_code")
let typecheck_code =
@@ -179,37 +179,34 @@ let () =
end ;
register0 S.apply_operation I.apply_operation ;
register0 S.run_code begin fun ctxt () parameters ->
- let (code, storage, input, amount, contract, gas, origination_nonce) =
+ let (code, storage, parameter, amount, contract, gas, origination_nonce) =
I.run_parameters ctxt parameters in
begin if Compare.Z.(gas > Z.zero) then
Lwt.return (Gas.set_limit ctxt gas)
else
return (Gas.set_unlimited ctxt) end >>=? fun ctxt ->
Script_interpreter.execute
- origination_nonce
- contract (* transaction initiator *)
- contract (* script owner *)
- ctxt { storage ; code } amount input >>=? fun (sto, ret, _ctxt, _, maybe_big_map_diff) ->
- return (sto, ret,
- Option.map maybe_big_map_diff
- ~f:(Script_ir_translator.to_printable_big_map ctxt))
+ ctxt origination_nonce
+ ~source:contract (* transaction initiator *)
+ ~self:(contract, { storage ; code }) (* script owner *)
+ ~amount ~parameter
+ >>=? fun { Script_interpreter.storage ; return_value ; big_map_diff ; _ } ->
+ return (storage, return_value, big_map_diff)
end ;
register0 S.trace_code begin fun ctxt () parameters ->
- let (code, storage, input, amount, contract, gas, origination_nonce) =
+ let (code, storage, parameter, amount, contract, gas, origination_nonce) =
I.run_parameters ctxt parameters in
begin if Compare.Z.(gas > Z.zero) then
Lwt.return (Gas.set_limit ctxt gas)
else
return (Gas.set_unlimited ctxt) end >>=? fun ctxt ->
Script_interpreter.trace
- origination_nonce
- contract (* transaction initiator *)
- contract (* script owner *)
- ctxt { storage ; code } amount input
- >>=? fun ((sto, ret, _ctxt, _, maybe_big_map_diff), trace) ->
- return (sto, ret, trace,
- Option.map maybe_big_map_diff
- ~f:(Script_ir_translator.to_printable_big_map ctxt))
+ ctxt origination_nonce
+ ~source:contract (* transaction initiator *)
+ ~self:(contract, { storage ; code }) (* script owner *)
+ ~amount ~parameter
+ >>=? fun ({ Script_interpreter.storage ; return_value ; big_map_diff ; _ }, trace) ->
+ return (storage, return_value, trace, big_map_diff)
end ;
register0 S.typecheck_code begin fun ctxt () (expr, maybe_gas) ->
begin match maybe_gas with
diff --git a/src/proto_alpha/lib_protocol/src/helpers_services.mli b/src/proto_alpha/lib_protocol/src/helpers_services.mli
index ba21f05b0..1295d8a08 100644
--- a/src/proto_alpha/lib_protocol/src/helpers_services.mli
+++ b/src/proto_alpha/lib_protocol/src/helpers_services.mli
@@ -25,15 +25,15 @@ val run_code:
'a #RPC_context.simple ->
'a -> Script.expr ->
(Script.expr * Script.expr * Tez.t * Contract.t) ->
- (Script.expr * Script.expr * (Script.expr * Script.expr option) list option) shell_tzresult Lwt.t
+ (Script.expr * Script.expr * Contract.big_map_diff option) shell_tzresult Lwt.t
val trace_code:
'a #RPC_context.simple ->
'a -> Script.expr ->
(Script.expr * Script.expr * Tez.t * Contract.t) ->
(Script.expr * Script.expr *
- (Script.location * Gas.t * Script.expr list) list *
- (Script.expr * Script.expr option) list option) shell_tzresult Lwt.t
+ Script_interpreter.execution_trace *
+ Contract.big_map_diff option) shell_tzresult Lwt.t
val typecheck_code:
'a #RPC_context.simple ->
diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.ml b/src/proto_alpha/lib_protocol/src/script_interpreter.ml
index fc02a22e9..b4251c878 100644
--- a/src/proto_alpha/lib_protocol/src/script_interpreter.ml
+++ b/src/proto_alpha/lib_protocol/src/script_interpreter.ml
@@ -76,13 +76,17 @@ let unparse_stack ctxt (stack, stack_ty) =
module Interp_costs = Michelson_v1_gas.Cost_of
+type execution_trace =
+ (Script.location * Gas.t * Script.expr list) list
+
let rec interp
: type p r.
- ?log: (Script.location * Gas.t * Script.expr list) list ref ->
- Contract.origination_nonce -> Contract.t -> Contract.t -> Tez.t ->
- context -> (p, r) lambda -> p ->
- (r * context * Contract.origination_nonce) tzresult Lwt.t
- = fun ?log origination orig source amount ctxt (Lam (code, _)) arg ->
+ (?log: execution_trace ref ->
+ context -> Contract.origination_nonce ->
+ source: Contract.t -> self: Contract.t -> Tez.t ->
+ (p, r) lambda -> p ->
+ (r * context * Contract.origination_nonce) tzresult Lwt.t)
+ = fun ?log ctxt origination ~source ~self amount (Lam (code, _)) arg ->
let rec step
: type b a.
Contract.origination_nonce -> context -> (b, a) descr -> b stack ->
@@ -165,14 +169,14 @@ let rec interp
Prim (0, K_code, [ Micheline.root code ], None) ], None)) in
Lwt.return @@ unparse_data ctxt storage_type init >>=? fun (storage, ctxt) ->
let storage = Micheline.strip_locations storage in
- Contract.spend_from_script ctxt source credit >>=? fun ctxt ->
+ Contract.spend_from_script ctxt self credit >>=? fun ctxt ->
Contract.originate ctxt
origination
~manager ~delegate ~balance:credit
~script:({ code ; storage }, None (* TODO: initialize a big map from a map *))
~spendable ~delegatable
>>=? fun (ctxt, contract, origination) ->
- Fees.origination_burn ctxt ~source:orig contract >>=? fun ctxt ->
+ Fees.origination_burn ctxt ~source contract >>=? fun ctxt ->
logged_return descr ~origination (Item ((param_type, return_type, contract), rest), ctxt) in
let logged_return : ?origination:Contract.origination_nonce ->
a stack * context ->
@@ -247,7 +251,7 @@ let rec interp
match l with
| [] -> return (List.rev acc, ctxt, origination)
| hd :: tl ->
- interp ?log origination orig source amount ctxt lam hd
+ interp ?log ctxt origination ~source ~self amount lam hd
>>=? fun (hd, ctxt, origination) ->
loop rest ctxt origination tl (hd :: acc)
in loop rest ctxt origination l [] >>=? fun (res, ctxt, origination) ->
@@ -269,7 +273,7 @@ let rec interp
match l with
| [] -> return (acc, ctxt, origination)
| hd :: tl ->
- interp ?log origination orig source amount ctxt lam (hd, acc)
+ interp ?log ctxt origination ~source ~self amount lam (hd, acc)
>>=? fun (acc, ctxt, origination) ->
loop rest ctxt origination tl acc
in loop rest ctxt origination l init >>=? fun (res, ctxt, origination) ->
@@ -306,7 +310,7 @@ let rec interp
match l with
| [] -> return (acc, ctxt, origination)
| hd :: tl ->
- interp ?log origination orig source amount ctxt lam (hd, acc)
+ interp ?log ctxt origination ~source ~self amount lam (hd, acc)
>>=? fun (acc, ctxt, origination) ->
loop rest ctxt origination tl acc
in loop rest ctxt origination l init >>=? fun (res, ctxt, origination) ->
@@ -342,7 +346,7 @@ let rec interp
match l with
| [] -> return (acc, ctxt, origination)
| (k, _) as hd :: tl ->
- interp ?log origination orig source amount ctxt lam hd
+ interp ?log ctxt origination ~source ~self amount lam hd
>>=? fun (hd, ctxt, origination) ->
loop rest ctxt origination tl (map_update k (Some hd) acc)
in loop rest ctxt origination l (empty_map (map_key_ty map)) >>=? fun (res, ctxt, origination) ->
@@ -355,7 +359,7 @@ let rec interp
match l with
| [] -> return (acc, ctxt, origination)
| hd :: tl ->
- interp ?log origination orig source amount ctxt lam (hd, acc)
+ interp ?log ctxt origination ~source ~self amount lam (hd, acc)
>>=? fun (acc, ctxt, origination) ->
loop rest ctxt origination tl acc
in loop rest ctxt origination l init >>=? fun (res, ctxt, origination) ->
@@ -384,11 +388,11 @@ let rec interp
(* Big map operations *)
| Big_map_mem, Item (key, Item (map, rest)) ->
Lwt.return (Gas.consume ctxt (Interp_costs.big_map_mem key map)) >>=? fun ctxt ->
- Script_ir_translator.big_map_mem ctxt source key map >>=? fun (res, ctxt) ->
+ Script_ir_translator.big_map_mem ctxt self key map >>=? fun (res, ctxt) ->
logged_return (Item (res, rest), ctxt)
| Big_map_get, Item (key, Item (map, rest)) ->
Lwt.return (Gas.consume ctxt (Interp_costs.big_map_get key map)) >>=? fun ctxt ->
- Script_ir_translator.big_map_get ctxt source key map >>=? fun (res, ctxt) ->
+ Script_ir_translator.big_map_get ctxt self key map >>=? fun (res, ctxt) ->
logged_return (Item (res, rest), ctxt)
| Big_map_update, Item (key, Item (maybe_value, Item (map, rest))) ->
consume_gas_terop descr
@@ -579,7 +583,7 @@ let rec interp
logged_return ~origination (Item (ign, res), ctxt)
| Exec, Item (arg, Item (lam, rest)) ->
Lwt.return (Gas.consume ctxt Interp_costs.exec) >>=? fun ctxt ->
- interp ?log origination orig source amount ctxt lam arg >>=? fun (res, ctxt, origination) ->
+ interp ?log ctxt origination ~source ~self amount lam arg >>=? fun (res, ctxt, origination) ->
logged_return ~origination (Item (res, rest), ctxt)
| Lambda lam, rest ->
Lwt.return (Gas.consume ctxt Interp_costs.push) >>=? fun ctxt ->
@@ -643,7 +647,7 @@ let rec interp
| Transfer_tokens storage_type,
Item (p, Item (amount, Item ((tp, Unit_t, destination), Item (storage, Empty)))) -> begin
Lwt.return (Gas.consume ctxt Interp_costs.transfer) >>=? fun ctxt ->
- Contract.spend_from_script ctxt source amount >>=? fun ctxt ->
+ Contract.spend_from_script ctxt self amount >>=? fun ctxt ->
Contract.credit ctxt destination amount >>=? fun ctxt ->
Contract.get_script ctxt destination >>=? fun (ctxt, destination_script) ->
Lwt.return (unparse_data ctxt storage_type storage) >>=? fun (sto, ctxt) ->
@@ -655,8 +659,8 @@ let rec interp
Script_ir_translator.to_serializable_big_map ctxt diff >>=? fun (diff, ctxt) ->
return (Some diff, ctxt)
end >>=? fun (diff, ctxt) ->
- Contract.update_script_storage ctxt source sto diff >>=? fun ctxt ->
- Fees.update_script_storage ctxt ~source:orig source >>=? fun (ctxt, _) ->
+ Contract.update_script_storage ctxt self sto diff >>=? fun ctxt ->
+ Fees.update_script_storage ctxt ~source self >>=? fun (ctxt, _) ->
begin match destination_script with
| None ->
(* we see non scripted contracts as (unit, unit) contract *)
@@ -665,7 +669,8 @@ let rec interp
return (ctxt, origination)
| Some script ->
Lwt.return @@ unparse_data ctxt tp p >>=? fun (p, ctxt) ->
- execute origination source destination ctxt script amount p
+ (* FIXME: add a sender parameter *)
+ execute ctxt origination ~source ~self:destination script amount p
>>=? fun (csto, ret, ctxt, origination, maybe_diff) ->
begin match maybe_diff with
| None ->
@@ -678,10 +683,10 @@ let rec interp
trace
(Invalid_contract (loc, destination))
(parse_data ctxt Unit_t ret) >>=? fun ((), ctxt) ->
- Fees.update_script_storage ctxt ~source:orig destination >>=? fun (ctxt, _) ->
+ Fees.update_script_storage ctxt ~source destination >>=? fun (ctxt, _) ->
return (ctxt, origination)
end >>=? fun (ctxt, origination) ->
- Contract.get_script ctxt source >>=? (fun (ctxt, script) -> match script with
+ Contract.get_script ctxt self >>=? (fun (ctxt, script) -> match script with
| None -> assert false
| Some { storage; _ } ->
parse_data ctxt storage_type (Micheline.root storage) >>=? fun (sto, ctxt) ->
@@ -690,7 +695,7 @@ let rec interp
| Transfer_tokens storage_type,
Item (p, Item (amount, Item ((tp, tr, destination), Item (sto, Empty)))) -> begin
Lwt.return (Gas.consume ctxt Interp_costs.transfer) >>=? fun ctxt ->
- Contract.spend_from_script ctxt source amount >>=? fun ctxt ->
+ Contract.spend_from_script ctxt self amount >>=? fun ctxt ->
Contract.credit ctxt destination amount >>=? fun ctxt ->
Contract.get_script ctxt destination >>=? fun (ctxt, script) -> match script with
| None -> fail (Invalid_contract (loc, destination))
@@ -704,10 +709,10 @@ let rec interp
end >>=? fun (maybe_diff, ctxt) ->
Lwt.return (unparse_data ctxt storage_type sto) >>=? fun (sto, ctxt) ->
let sto = Micheline.strip_locations sto in
- Contract.update_script_storage ctxt source sto maybe_diff >>=? fun ctxt ->
- Fees.update_script_storage ctxt ~source:orig source >>=? fun (ctxt, _) ->
+ Contract.update_script_storage ctxt self sto maybe_diff >>=? fun ctxt ->
+ Fees.update_script_storage ctxt ~source self >>=? fun (ctxt, _) ->
Lwt.return (unparse_data ctxt tp p) >>=? fun (p, ctxt) ->
- execute origination source destination ctxt script amount p
+ execute ctxt origination ~source ~self:destination script amount p
>>=? fun (sto, ret, ctxt, origination, maybe_diff) ->
begin match maybe_diff with
| None ->
@@ -717,11 +722,11 @@ let rec interp
return (Some diff, ctxt)
end >>=? fun (diff, ctxt) ->
Contract.update_script_storage ctxt destination sto diff >>=? fun ctxt ->
- Fees.update_script_storage ctxt ~source:orig destination >>=? fun (ctxt, _) ->
+ Fees.update_script_storage ctxt ~source destination >>=? fun (ctxt, _) ->
trace
(Invalid_contract (loc, destination))
(parse_data ctxt tr ret) >>=? fun (v, ctxt) ->
- Contract.get_script ctxt source >>=? (fun (ctxt, script) -> match script with
+ Contract.get_script ctxt self >>=? (fun (ctxt, script) -> match script with
| None -> assert false
| Some { storage ; _ } ->
parse_data ctxt storage_type (Micheline.root storage) >>=? fun (sto, ctxt) ->
@@ -730,7 +735,7 @@ 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 source credit >>=? fun ctxt ->
+ Contract.spend_from_script ctxt self credit >>=? fun ctxt ->
Lwt.return Tez.(credit -? Constants.origination_burn ctxt) >>=? fun balance ->
Contract.originate ctxt
origination
@@ -763,7 +768,7 @@ let rec interp
~param_type ~return_type ~storage_type ~rest
| Balance, rest ->
Lwt.return (Gas.consume ctxt Interp_costs.balance) >>=? fun ctxt ->
- Contract.get_balance ctxt source >>=? fun balance ->
+ Contract.get_balance ctxt self >>=? fun balance ->
logged_return (Item (balance, rest), ctxt)
| Now, rest ->
Lwt.return (Gas.consume ctxt Interp_costs.now) >>=? fun ctxt ->
@@ -789,10 +794,10 @@ let rec interp
logged_return (Item (Script_int.(abs (of_zint steps)), rest), ctxt)
| Source (ta, tb), rest ->
Lwt.return (Gas.consume ctxt Interp_costs.source) >>=? fun ctxt ->
- logged_return (Item ((ta, tb, orig), rest), ctxt)
+ logged_return (Item ((ta, tb, source), rest), ctxt)
| Self (ta, tb), rest ->
Lwt.return (Gas.consume ctxt Interp_costs.self) >>=? fun ctxt ->
- logged_return (Item ((ta, tb, source), rest), ctxt)
+ logged_return (Item ((ta, tb, self), rest), ctxt)
| Amount, rest ->
Lwt.return (Gas.consume ctxt Interp_costs.amount) >>=? fun ctxt ->
logged_return (Item (amount, rest), ctxt) in
@@ -807,28 +812,50 @@ let rec interp
(* ---- contract handling ---------------------------------------------------*)
-and execute ?log origination orig source ctxt script amount arg :
+and execute ?log ctxt origination_nonce ~source ~self script amount arg :
(Script.expr * Script.node * context * Contract.origination_nonce *
Script_typed_ir.ex_big_map option) tzresult Lwt.t =
parse_script ctxt script
>>=? fun ((Ex_script { code; arg_type; ret_type; storage; storage_type }), ctxt) ->
parse_data ctxt arg_type arg >>=? fun (arg, ctxt) ->
trace
- (Runtime_contract_error (source, script.code))
- (interp ?log origination orig source amount ctxt code (arg, storage))
+ (Runtime_contract_error (self, script.code))
+ (interp ?log ctxt origination_nonce ~source ~self amount code (arg, storage))
>>=? fun ((ret, sto), ctxt, origination) ->
Lwt.return @@ unparse_data ctxt storage_type sto >>=? fun (storage, ctxt) ->
Lwt.return @@ unparse_data ctxt ret_type ret >>=? fun (ret, ctxt) ->
return (Micheline.strip_locations storage, ret, ctxt, origination,
Script_ir_translator.extract_big_map storage_type sto)
-let trace origination orig source ctxt script amount arg =
- let log = ref [] in
- execute ~log origination orig source ctxt script amount (Micheline.root arg)
- >>=? fun (sto, res, ctxt, origination, maybe_big_map) ->
- return ((sto, Micheline.strip_locations res, ctxt, origination, maybe_big_map), List.rev !log)
+type execution_result =
+ { ctxt : context ;
+ origination_nonce : Contract.origination_nonce ;
+ storage : Script.expr ;
+ big_map_diff : Contract.big_map_diff option ;
+ return_value : Script.expr }
-let execute origination orig source ctxt script amount arg =
- execute origination orig source ctxt script amount (Micheline.root arg)
- >>=? fun (sto, res, ctxt, origination, maybe_big_map) ->
- return (sto, Micheline.strip_locations res, ctxt, origination, maybe_big_map)
+let trace ctxt origination_nonce ~source ~self:(self, script) ~parameter ~amount =
+ let log = ref [] in
+ execute ~log ctxt origination_nonce ~source ~self script amount (Micheline.root parameter)
+ >>=? fun (storage, return_value, ctxt, origination_nonce, big_map_diff) ->
+ let return_value = Micheline.strip_locations return_value in
+ begin match big_map_diff with
+ | None -> return (None, ctxt)
+ | Some big_map_diff ->
+ Script_ir_translator.to_serializable_big_map ctxt big_map_diff >>=? fun (big_map_diff, ctxt) ->
+ return (Some big_map_diff, ctxt)
+ end >>=? fun (big_map_diff, ctxt) ->
+ let trace = List.rev !log in
+ return ({ ctxt ; origination_nonce ; storage ; big_map_diff ; return_value }, trace)
+
+let execute ctxt origination_nonce ~source ~self:(self, script) ~parameter ~amount =
+ execute ctxt origination_nonce ~source ~self script amount (Micheline.root parameter)
+ >>=? fun (storage, return_value, ctxt, origination_nonce, big_map_diff) ->
+ let return_value = Micheline.strip_locations return_value in
+ begin match big_map_diff with
+ | None -> return (None, ctxt)
+ | Some big_map_diff ->
+ Script_ir_translator.to_serializable_big_map ctxt big_map_diff >>=? fun (big_map_diff, ctxt) ->
+ return (Some big_map_diff, ctxt)
+ end >>=? fun (big_map_diff, ctxt) ->
+ return { ctxt ; origination_nonce ; storage ; big_map_diff ; return_value }
diff --git a/src/proto_alpha/lib_protocol/src/script_interpreter.mli b/src/proto_alpha/lib_protocol/src/script_interpreter.mli
index 6b515767c..fe563660d 100644
--- a/src/proto_alpha/lib_protocol/src/script_interpreter.mli
+++ b/src/proto_alpha/lib_protocol/src/script_interpreter.mli
@@ -13,18 +13,28 @@ type error += Overflow of Script.location
type error += Reject of Script.location
type error += Runtime_contract_error : Contract.t * Script.expr -> error
+type execution_result =
+ { ctxt : context ;
+ origination_nonce : Contract.origination_nonce ;
+ storage : Script.expr ;
+ big_map_diff : Contract.big_map_diff option ;
+ return_value : Script.expr }
+
val execute:
- Contract.origination_nonce ->
- Contract.t -> Contract.t -> Alpha_context.t ->
- Script.t -> Tez.t ->
- Script.expr ->
- (Script.expr * Script.expr * context * Contract.origination_nonce *
- Script_typed_ir.ex_big_map option) tzresult Lwt.t
+ Alpha_context.t -> Contract.origination_nonce ->
+ source: Contract.t ->
+ self: (Contract.t * Script.t) ->
+ parameter: Script.expr ->
+ amount: Tez.t ->
+ execution_result tzresult Lwt.t
+
+type execution_trace =
+ (Script.location * Gas.t * Script.expr list) list
val trace:
- Contract.origination_nonce ->
- Contract.t -> Contract.t -> Alpha_context.t ->
- Script.t -> Tez.t ->
- Script.expr ->
- ((Script.expr * Script.expr * context * Contract.origination_nonce * Script_typed_ir.ex_big_map option) *
- (Script.location * Gas.t * Script.expr list) list) tzresult Lwt.t
+ Alpha_context.t -> Contract.origination_nonce ->
+ source: Contract.t ->
+ self: (Contract.t * Script.t) ->
+ parameter: Script.expr ->
+ amount: Tez.t ->
+ (execution_result * execution_trace) tzresult Lwt.t
diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_script.ml b/src/proto_alpha/lib_protocol/test/helpers/helpers_script.ml
index 0d98d734e..50ab3a118 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/helpers_script.ml
+++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_script.ml
@@ -14,7 +14,7 @@ open Alpha_context
let init_amount = 20000
let execute_code_pred
- ?tc (pred : Helpers_block.result) (script : Script.t) (argument : Script.expr) =
+ ?tc (pred : Helpers_block.result) (script : Script.t) (parameter : Script.expr) =
let op = List.nth Helpers_account.bootstrap_accounts 0 in
let tc = Option.unopt ~default:pred.tezos_context tc in
Helpers_apply.script_origination_pred ~tc ~pred (script, op, init_amount)
@@ -32,8 +32,10 @@ let execute_code_pred
let amount = Tez.zero in
Lwt.return (Proto_alpha.Alpha_context.Gas.set_limit tc gas) >>=? fun tc ->
let return = Script_interpreter.execute
- dummy_nonce op.contract dst
- tc script amount argument in
+ tc dummy_nonce
+ ~source: op.contract
+ ~self: (dst, script)
+ ~amount ~parameter in
return
diff --git a/src/proto_alpha/lib_protocol/test/helpers/helpers_script.mli b/src/proto_alpha/lib_protocol/test/helpers/helpers_script.mli
index b5d03573e..0ca097eb5 100644
--- a/src/proto_alpha/lib_protocol/test/helpers/helpers_script.mli
+++ b/src/proto_alpha/lib_protocol/test/helpers/helpers_script.mli
@@ -13,6 +13,5 @@ open Alpha_context
val init_amount : int
val execute_code_pred :
?tc:Alpha_context.t -> Helpers_block.result -> Script.t -> Script.expr ->
- (Script.expr * Script.expr * context * Contract.origination_nonce * Script_typed_ir.ex_big_map option)
- proto_tzresult Lwt.t
+ Script_interpreter.execution_result proto_tzresult Lwt.t
diff --git a/src/proto_alpha/lib_protocol/test/test_michelson.ml b/src/proto_alpha/lib_protocol/test/test_michelson.ml
index 030eeb242..8a0a7e81b 100644
--- a/src/proto_alpha/lib_protocol/test/test_michelson.ml
+++ b/src/proto_alpha/lib_protocol/test/test_michelson.ml
@@ -48,9 +48,11 @@ let quote s = "\"" ^ s ^ "\""
let parse_execute sb ?tc code_str param_str storage_str =
let param = parse_param param_str in
let script = parse_script code_str storage_str in
- Script.execute_code_pred ?tc sb script param >>=?? fun (ret, st, tc, nonce, bgm) ->
+ Script.execute_code_pred ?tc sb script param
+ >>=?? fun { return_value = ret ; storage = st ; ctxt = tc ;
+ origination_nonce = nonce ; big_map_diff = bgm } ->
let contracts = Contract.originated_contracts nonce in
- return (ret, st, tc, contracts, bgm)
+ return (st, ret, tc, contracts, bgm)
let test ctxt ?tc (file_name: string) (storage: string) (input: string) =
let full_path = contract_path // file_name ^ ".tz" in
@@ -436,7 +438,7 @@ let test_example () =
let contract = List.hd cs in
Proto_alpha.Alpha_context.Contract.get_script tc contract >>=?? fun (_, res) ->
let script = Option.unopt_exn (Failure "get_script") res in
- Script.execute_code_pred ~tc sb script (parse_param "\"abc\"") >>=?? fun (_, ret, _, _, _) ->
+ Script.execute_code_pred ~tc sb script (parse_param "\"abc\"") >>=?? fun { return_value = ret } ->
Assert.equal_string ~msg: __LOC__ "\"abc\"" @@ string_of_canon ret ;
(* Test IMPLICIT_ACCOUNT *)