Commit 9993553a authored by Alain Mebsout's avatar Alain Mebsout Committed by Benjamin Canou

Michelson: Propagate annotations in execution trace

Fixes #179
parent 703a12f6
......@@ -79,7 +79,13 @@ let print_trace_result (cctxt : #Client_context.printer) ~show_source ~parsed =
"- @[<v 0>location: %d (remaining gas: %a)@,\
[ @[<v 0>%a ]@]@]"
loc Gas.pp gas
(Format.pp_print_list print_expr)
(Format.pp_print_list
(fun ppf (e, annot) ->
Format.fprintf ppf
"@[<v 0>%a \t%s@]"
print_expr e
(match annot with None -> "" | Some a -> a)
))
stack))
trace >>= fun () ->
return ()
......
......@@ -76,7 +76,11 @@ module Scripts = struct
(list @@ obj3
(req "location" Script.location_encoding)
(req "gas" Gas.encoding)
(req "stack" (list (Script.expr_encoding)))))
(req "stack"
(list
(obj2
(req "item" (Script.expr_encoding))
(opt "annot" string))))))
(opt "big_map_diff" (list (tup2 string (option Script.expr_encoding)))))
RPC_path.(path / "trace_code")
......@@ -172,7 +176,7 @@ module Scripts = struct
begin match maybe_gas with
| None -> return (Gas.set_unlimited ctxt)
| Some gas -> Lwt.return (Gas.set_limit ctxt gas) end >>=? fun ctxt ->
Lwt.return (parse_ty ~allow_big_map:false ~allow_operation:false (Micheline.root typ)) >>=? fun (Ex_ty typ, _) ->
Lwt.return (parse_ty ~allow_big_map:false ~allow_operation:false (Micheline.root typ)) >>=? fun (Ex_ty typ) ->
parse_data ctxt typ (Micheline.root expr) >>=? fun (data, ctxt) ->
Script_ir_translator.hash_data ctxt typ data >>=? fun (hash, ctxt) ->
return (hash, Gas.level ctxt)
......
......@@ -77,19 +77,24 @@ let unparse_stack ctxt (stack, stack_ty) =
(* We drop the gas limit as this function is only used for debugging/errors. *)
let ctxt = Gas.set_unlimited ctxt in
let rec unparse_stack
: type a. a stack * a stack_ty -> Script.expr list tzresult Lwt.t
: type a. a stack * a stack_ty -> (Script.expr * string option) list tzresult Lwt.t
= function
| Empty, Empty_t -> return []
| Item (v, rest), Item_t (ty, rest_ty, _) ->
| Item (v, rest), Item_t (ty, rest_ty, annot) ->
unparse_data ctxt Readable ty v >>=? fun (data, _ctxt) ->
unparse_stack (rest, rest_ty) >>=? fun rest ->
return (Micheline.strip_locations data :: rest) in
let annot = match Script_ir_annot.unparse_var_annot annot with
| [] -> None
| [ a ] -> Some a
| _ -> assert false in
let data = Micheline.strip_locations data in
return ((data, annot) :: rest) in
unparse_stack (stack, stack_ty)
module Interp_costs = Michelson_v1_gas.Cost_of
type execution_trace =
(Script.location * Gas.t * Script.expr list) list
(Script.location * Gas.t * (Script.expr * string option) list) list
let rec interp
: type p r.
......
......@@ -31,7 +31,7 @@ val execute:
execution_result tzresult Lwt.t
type execution_trace =
(Script.location * Gas.t * Script.expr list) list
(Script.location * Gas.t * (Script.expr * string option) list) list
val trace:
Alpha_context.t ->
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment