balsoft/ligo
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Michelson: cleaner naming in interpreter

Browse Source
This commit is contained in:
Benjamin Canou 2018-04-08 20:24:25 +02:00 committed by Grégoire Henry
parent 24deb10c8f
commit 59cccd53aa
10 changed files with 138 additions and 104 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
src/proto_alpha/lib_client/client_proto_programs.ml
View File

@ -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)

12
src/proto_alpha/lib_client/client_proto_programs.mli
View File

@ -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 :

19
src/proto_alpha/lib_protocol/src/apply.ml
View File

@ -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

35
src/proto_alpha/lib_protocol/src/helpers_services.ml
View File

@ -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

6
src/proto_alpha/lib_protocol/src/helpers_services.mli
View File

@ -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 ->

113
src/proto_alpha/lib_protocol/src/script_interpreter.ml
View File

@ -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 }

34
src/proto_alpha/lib_protocol/src/script_interpreter.mli
View File

@ -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

8
src/proto_alpha/lib_protocol/test/helpers/helpers_script.ml
View File

@ -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

3
src/proto_alpha/lib_protocol/test/helpers/helpers_script.mli
View File

@ -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

8
src/proto_alpha/lib_protocol/test/test_michelson.ml
View File

@ -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 *)