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

Add annotations for inspecting values with ASSERT_SOME, ASSERT_LEFT, ASSERT_RIGHT

Browse Source
This commit is contained in:
Paul Laforgue 2018-11-06 16:04:01 +00:00 committed by Benjamin Canou
parent 5400984c36
commit 3441a85ff3
4 changed files with 52 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
src/lib_micheline/micheline.mli
View File

@ -26,7 +26,7 @@
type annot = string list type annot = string list
(** The abstract syntax tree of Micheline expressions. The first (** The abstract syntax tree of Micheline expressions. The first
parameter is used to conatin locations, but can also embed custom parameter is used to contain locations, but can also embed custom
data. The second parameter is the type of primitive names. *) data. The second parameter is the type of primitive names. *)
type ('l, 'p) node = type ('l, 'p) node =
| Int of 'l * Z.t | Int of 'l * Z.t

58
src/proto_alpha/lib_client/michelson_v1_macros.ml
View File

@ -530,26 +530,31 @@ let expand_compare original =
| _ -> ok None | _ -> ok None
let expand_asserts original = let expand_asserts original =
let fail_false loc = let may_rename loc = function
[ Seq(loc, []) ; Seq(loc, [ Prim (loc, "FAIL", [], []) ]) ] in | [] -> Seq (loc, [])
let fail_true loc = | annot -> Seq (loc, [ Prim (loc, "RENAME", [], annot) ])
[ Seq(loc, [ Prim (loc, "FAIL", [], []) ]) ; Seq(loc, []) ] in in
let fail_false ?(annot=[]) loc =
[may_rename loc annot; Seq (loc, [ Prim (loc, "FAIL", [], []) ])]
in
let fail_true ?(annot=[]) loc =
[Seq (loc, [ Prim (loc, "FAIL", [], []) ]); may_rename loc annot]
in
match original with match original with
| Prim (loc, "ASSERT", [], []) -> | Prim (loc, "ASSERT", [], []) ->
ok @@ Some (Seq (loc, [ Prim (loc, "IF", fail_false loc, []) ])) ok @@ Some (Seq (loc, [ Prim (loc, "IF", fail_false loc, []) ]))
| Prim (loc, "ASSERT_NONE", [], []) -> | Prim (loc, "ASSERT_NONE", [], []) ->
ok @@ Some (Seq (loc, [ Prim (loc, "IF_NONE", fail_false loc, []) ])) ok @@ Some (Seq (loc, [ Prim (loc, "IF_NONE", fail_false loc, []) ]))
| Prim (loc, "ASSERT_SOME", [], []) -> | Prim (loc, "ASSERT_SOME", [], annot) ->
ok @@ Some (Seq (loc, [ Prim (loc, "IF_NONE", fail_true loc, []) ])) ok @@ Some (Seq (loc, [ Prim (loc, "IF_NONE", fail_true ~annot loc, []) ]))
| Prim (loc, "ASSERT_LEFT", [], []) -> | Prim (loc, "ASSERT_LEFT", [], annot) ->
ok @@ Some (Seq (loc, [ Prim (loc, "IF_LEFT", fail_false loc, []) ])) ok @@ Some (Seq (loc, [ Prim (loc, "IF_LEFT", fail_false ~annot loc, []) ]))
| Prim (loc, "ASSERT_RIGHT", [], []) -> | Prim (loc, "ASSERT_RIGHT", [], annot) ->
ok @@ Some (Seq (loc, [ Prim (loc, "IF_LEFT", fail_true loc, []) ])) ok @@ Some (Seq (loc, [ Prim (loc, "IF_LEFT", fail_true ~annot loc, []) ]))
| Prim (_, ("ASSERT" | "ASSERT_NONE" | "ASSERT_SOME" | Prim (_, ("ASSERT" | "ASSERT_NONE" | "ASSERT_SOME"
| "ASSERT_LEFT" | "ASSERT_RIGHT" as str), args, []) -> | "ASSERT_LEFT" | "ASSERT_RIGHT" as str), args, []) ->
error (Invalid_arity (str, List.length args, 0)) error (Invalid_arity (str, List.length args, 0))
| Prim (_, ("ASSERT" | "ASSERT_NONE" | "ASSERT_SOME" | Prim (_, ( "ASSERT" | "ASSERT_NONE" as str), [], _ :: _) ->
| "ASSERT_LEFT" | "ASSERT_RIGHT" as str), [], _ :: _) ->
error (Unexpected_macro_annotation str) error (Unexpected_macro_annotation str)
| Prim (loc, s, args, annot) | Prim (loc, s, args, annot)
when String.(length s > 7 && equal (sub s 0 7) "ASSERT_") -> when String.(length s > 7 && equal (sub s 0 7) "ASSERT_") ->
@ -559,9 +564,10 @@ let expand_asserts original =
end >>? fun () -> end >>? fun () ->
begin match annot with begin match annot with
| _ :: _ -> (error (Unexpected_macro_annotation s)) | _ :: _ -> (error (Unexpected_macro_annotation s))
| [] -> ok () end >>? fun () -> | [] -> ok ()
end >>? fun () ->
begin begin
let remaining = String.(sub s 7 ((length s) - 7)) in let remaining = String.(sub s 7 (length s - 7)) in
let remaining_prim = Prim (loc, remaining, [], []) in let remaining_prim = Prim (loc, remaining, [], []) in
match remaining with match remaining with
| "EQ" | "NEQ" | "LT" | "LE" | "GE" | "GT" -> | "EQ" | "NEQ" | "LT" | "LE" | "GE" | "GT" ->
@ -1012,6 +1018,13 @@ let unexpand_asserts expanded =
Prim (_, "FAILWITH", [], []) ]) ]) ], Prim (_, "FAILWITH", [], []) ]) ]) ],
[]) ]) -> []) ]) ->
Some (Prim (loc, "ASSERT_" ^ comparison, [], [])) Some (Prim (loc, "ASSERT_" ^ comparison, [], []))
| Seq (loc, [ Prim (_, "IF_NONE", [ Seq (_, [ Prim (_, "RENAME", [], annot) ]) ;
Seq (_, [
Seq (_, [
Prim (_, "UNIT", [], []) ;
Prim (_, "FAILWITH", [], []) ]) ]) ],
[]) ]) ->
Some (Prim (loc, "ASSERT_NONE", [], annot))
| Seq (loc, [ Prim (_, "IF_NONE", [ Seq (_, []) ; | Seq (loc, [ Prim (_, "IF_NONE", [ Seq (_, []) ;
Seq (_, [ Seq (_, [
Seq (_, [ Seq (_, [
@ -1024,6 +1037,11 @@ let unexpand_asserts expanded =
Seq (_, [])], Seq (_, [])],
[]) ]) -> []) ]) ->
Some (Prim (loc, "ASSERT_SOME", [], [])) Some (Prim (loc, "ASSERT_SOME", [], []))
| Seq (loc, [ Prim (_, "IF_NONE", [ Seq (_, [ Seq (_, [ Prim (_, "UNIT", [], []) ;
Prim (_, "FAILWITH", [], []) ]) ]) ;
Seq (_, [ Prim (_, "RENAME", [], annot) ])],
[]) ]) ->
Some (Prim (loc, "ASSERT_SOME", [], annot))
| Seq (loc, [ Prim (_, "IF_LEFT", [ Seq (_, []) ; | Seq (loc, [ Prim (_, "IF_LEFT", [ Seq (_, []) ;
Seq (_, [ Seq (_, [
Seq (_, [ Seq (_, [
@ -1031,11 +1049,23 @@ let unexpand_asserts expanded =
Prim (_, "FAILWITH", [], []) ]) ]) ], Prim (_, "FAILWITH", [], []) ]) ]) ],
[]) ]) -> []) ]) ->
Some (Prim (loc, "ASSERT_LEFT", [], [])) Some (Prim (loc, "ASSERT_LEFT", [], []))
| Seq (loc, [ Prim (_, "IF_LEFT", [ Seq (_, [ Prim (_, "RENAME", [], annot) ]) ;
Seq (_, [
Seq (_, [
Prim (_, "UNIT", [], []) ;
Prim (_, "FAILWITH", [], []) ]) ]) ],
[]) ]) ->
Some (Prim (loc, "ASSERT_LEFT", [], annot))
| Seq (loc, [ Prim (_, "IF_LEFT", [ Seq (_, [ Seq (_, [ Prim (_, "UNIT", [], []) ; | Seq (loc, [ Prim (_, "IF_LEFT", [ Seq (_, [ Seq (_, [ Prim (_, "UNIT", [], []) ;
Prim (_, "FAILWITH", [], []) ]) ]) ; Prim (_, "FAILWITH", [], []) ]) ]) ;
Seq (_, []) ], Seq (_, []) ],
[]) ]) -> []) ]) ->
Some (Prim (loc, "ASSERT_RIGHT", [], [])) Some (Prim (loc, "ASSERT_RIGHT", [], []))
| Seq (loc, [ Prim (_, "IF_LEFT", [ Seq (_, [ Seq (_, [ Prim (_, "UNIT", [], []) ;
Prim (_, "FAILWITH", [], []) ]) ]) ;
Seq (_, [ Prim (_, "RENAME", [], annot) ]) ],
[]) ]) ->
Some (Prim (loc, "ASSERT_RIGHT", [], annot))
| _ -> None | _ -> None

6
src/proto_alpha/lib_client/operation_result.ml
View File

@ -77,10 +77,12 @@ let pp_manager_operation_content
Option.unopt_exn Option.unopt_exn
(Failure "ill-serialized storage") (Failure "ill-serialized storage")
(Data_encoding.force_decode storage) in (Data_encoding.force_decode storage) in
let { Michelson_v1_parser.source } =
Michelson_v1_printer.unparse_toplevel code in
Format.fprintf ppf Format.fprintf ppf
"@,@[<hv 2>Script:@ %a\ "@,@[<hv 2>Script:@ @[<h>%a@]\
@,@[<hv 2>Initial storage:@ %a@]" @,@[<hv 2>Initial storage:@ %a@]"
Michelson_v1_printer.print_expr code Format.pp_print_text source
Michelson_v1_printer.print_expr storage Michelson_v1_printer.print_expr storage
end ; end ;
begin match delegate with begin match delegate with

6
src/proto_alpha/lib_client_commands/client_proto_context_commands.ml
View File

@ -181,9 +181,9 @@ let commands version () =
match Script_repr.force_decode code with match Script_repr.force_decode code with
| Error errs -> cctxt#error "%a" (Format.pp_print_list ~pp_sep:Format.pp_print_newline Alpha_environment.Error_monad.pp) errs | Error errs -> cctxt#error "%a" (Format.pp_print_list ~pp_sep:Format.pp_print_newline Alpha_environment.Error_monad.pp) errs
| Ok (code, _) -> | Ok (code, _) ->
begin cctxt#answer "%a" Michelson_v1_printer.print_expr_unwrapped code >>= fun () -> let { Michelson_v1_parser.source } =
return_unit Michelson_v1_printer.unparse_toplevel code in
end cctxt#answer "%a" Format.pp_print_text source >>= return
end ; end ;
command ~group ~desc: "Get the manager of a contract." command ~group ~desc: "Get the manager of a contract."