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

Michelson: Force annotations of the same kind to be grouped

Browse Source
This commit is contained in:
Alain Mebsout 2018-06-08 13:43:40 +02:00 committed by Benjamin Canou
parent 1748f370fc
commit 6dacd8f6a5
5 changed files with 50 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
docs/whitedoc/michelson.rst
View File

@ -2158,7 +2158,8 @@ name and before its potential arguments for primitive applications.
Ordering between different kinds of annotations is not significant, but
ordering among annotations of the same kind is.
ordering among annotations of the same kind is. Annotations of a same
kind must be grouped together.
For instance these two annotated instructions are equivalent:
@ -2166,7 +2167,7 @@ For instance these two annotated instructions are equivalent:
PAIR :t @my_pair %x %y
PAIR %x :t %y @my_pair
PAIR %x %y :t @my_pair
Annotations and Macros
~~~~~~~~~~~~~~~~~~~~~~

5
src/proto_alpha/lib_client/michelson_v1_error_reporter.ml
View File

@ -72,6 +72,7 @@ let collect_error_locations errs =
(Invalid_arity (loc, _, _, _)
| Inconsistent_type_annotations (loc, _, _)
| Unexpected_annotation loc
| Ungrouped_annotations loc
| Type_too_large (loc, _, _)
| Invalid_namespace (loc, _, _, _)
| Invalid_primitive (loc, _, _)
@ -388,6 +389,10 @@ let report_errors ~details ~show_source ?parsed ppf errs =
Format.fprintf ppf
"@[<v 2>%aunexpected annotation."
print_loc loc
| Ungrouped_annotations loc ->
Format.fprintf ppf
"@[<v 2>%aAnnotations of the same kind must be grouped."
print_loc loc
| Type_too_large (loc, size, maximum_size) ->
Format.fprintf ppf
"@[<v 2>%atype size (%d) exceeded maximum type size (%d)."

43
src/proto_alpha/lib_protocol/src/script_ir_annot.ml
View File

@ -214,14 +214,33 @@ let parse_field_annot loc annot =
Lwt.return (parse_field_annot loc annot)
let classify_annot
: annot list -> var_annot list * type_annot list * field_annot list
= fun l ->
let rv, rt, rf = List.fold_left (fun (rv, rt, rf) -> function
| `Var_annot _ as a -> a :: rv, rt, rf
| `Type_annot _ as a -> rv, a :: rt, rf
| `Field_annot _ as a -> rv, rt, a :: rf
) ([], [], []) l in
List.rev rv, List.rev rt, List.rev rf
: int -> annot list ->
(var_annot list * type_annot list * field_annot list) tzresult Lwt.t
= fun loc l ->
try
let _, rv, _, rt, _, rf =
List.fold_left
(fun (in_v, rv, in_t, rt, in_f, rf) a ->
match a, in_v, rv, in_t, rt, in_f, rf with
| (`Var_annot _ as a), true, _, _, _, _, _
| (`Var_annot _ as a), false, [], _, _, _, _ ->
true, a :: rv,
false, rt,
false, rf
| (`Type_annot _ as a), _, _, true, _, _, _
| (`Type_annot _ as a), _, _, false, [], _, _ ->
false, rv,
true, a :: rt,
false, rf
| (`Field_annot _ as a), _, _, _, _, true, _
| (`Field_annot _ as a), _, _, _, _, false, [] ->
false, rv,
false, rt,
true, a :: rf
| _ -> raise Exit
) (false, [], false, [], false, []) l in
Lwt.return (ok (List.rev rv, List.rev rt, List.rev rf))
with Exit -> Lwt.return (error (Ungrouped_annotations loc))
let get_one_annot loc = function
| [] -> Lwt.return (ok None)
@ -239,7 +258,7 @@ let parse_constr_annot
(var_annot option * type_annot option * field_annot option * field_annot option) tzresult Lwt.t
= fun loc annot ->
Lwt.return (parse_annots loc annot) >>=? fun annot ->
let vars, types, fields = classify_annot annot in
classify_annot loc annot >>=? fun (vars, types, fields) ->
get_one_annot loc vars >>=? fun v ->
get_one_annot loc types >>=? fun t ->
get_two_annot loc fields >>|? fun (f1, f2) ->
@ -249,7 +268,7 @@ let parse_two_var_annot
: int -> string list -> (var_annot option * var_annot option) tzresult Lwt.t
= fun loc annot ->
Lwt.return (parse_annots loc annot) >>=? fun annot ->
let vars, types, fields = classify_annot annot in
classify_annot loc annot >>=? fun (vars, types, fields) ->
fail_unexpected_annot loc types >>=? fun () ->
fail_unexpected_annot loc fields >>=? fun () ->
get_two_annot loc vars
@ -258,7 +277,7 @@ let parse_var_field_annot
: int -> string list -> (var_annot option * field_annot option) tzresult Lwt.t
= fun loc annot ->
Lwt.return (parse_annots loc annot) >>=? fun annot ->
let vars, types, fields = classify_annot annot in
classify_annot loc annot >>=? fun (vars, types, fields) ->
fail_unexpected_annot loc types >>=? fun () ->
get_one_annot loc vars >>=? fun v ->
get_one_annot loc fields >>|? fun f ->
@ -268,7 +287,7 @@ let parse_var_type_annot
: int -> string list -> (var_annot option * type_annot option) tzresult Lwt.t
= fun loc annot ->
Lwt.return (parse_annots loc annot) >>=? fun annot ->
let vars, types, fields = classify_annot annot in
classify_annot loc annot >>=? fun (vars, types, fields) ->
fail_unexpected_annot loc fields >>=? fun () ->
get_one_annot loc vars >>=? fun v ->
get_one_annot loc types >>|? fun t ->

1
src/proto_alpha/lib_protocol/src/script_tc_errors.ml
View File

@ -43,6 +43,7 @@ type error += Inconsistent_annotations of string * string
type error += Inconsistent_type_annotations : Script.location * _ ty * _ ty -> error
type error += Inconsistent_field_annotations of string * string
type error += Unexpected_annotation of Script.location
type error += Ungrouped_annotations of Script.location
type error += Invalid_map_body : Script.location * _ stack_ty -> error
type error += Invalid_map_block_fail of Script.location
type error += Invalid_iter_body : Script.location * _ stack_ty * _ stack_ty -> error

10
src/proto_alpha/lib_protocol/src/script_tc_errors_registration.ml
View File

@ -370,6 +370,16 @@ let () =
(function Unexpected_annotation loc -> Some (loc, ())
| _ -> None)
(fun (loc, ()) -> Unexpected_annotation loc);
(* Unexpected annotation *)
register_error_kind
`Permanent
~id:"ungroupedAnnotations"
~title:"Annotations of the same kind were found spread apart"
~description:"Annotations of the same kind must be grouped"
(located empty)
(function Ungrouped_annotations loc -> Some (loc, ())
| _ -> None)
(fun (loc, ()) -> Ungrouped_annotations loc);
(* Unmatched branches *)
register_error_kind
`Permanent