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

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

@ -77,10 +77,12 @@ let pp_manager_operation_content
Option.unopt_exn
(Failure "ill-serialized storage")
(Data_encoding.force_decode storage) in
let { Michelson_v1_parser.source } =
Michelson_v1_printer.unparse_toplevel code in
Format.fprintf ppf
"@,@[<hv 2>Script:@ %a\
"@,@[<hv 2>Script:@ @[<h>%a@]\
@,@[<hv 2>Initial storage:@ %a@]"
Michelson_v1_printer.print_expr code
Format.pp_print_text source
Michelson_v1_printer.print_expr storage
end ;
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
| Error errs -> cctxt#error "%a" (Format.pp_print_list ~pp_sep:Format.pp_print_newline Alpha_environment.Error_monad.pp) errs
| Ok (code, _) ->
begin cctxt#answer "%a" Michelson_v1_printer.print_expr_unwrapped code >>= fun () ->
return_unit
end
let { Michelson_v1_parser.source } =
Michelson_v1_printer.unparse_toplevel code in
cctxt#answer "%a" Format.pp_print_text source >>= return
end ;
command ~group ~desc: "Get the manager of a contract."