From fcd9b6108475f1fdaadf6f9da4d57f51251373ba Mon Sep 17 00:00:00 2001 From: Alain Mebsout Date: Fri, 8 Jun 2018 17:27:20 +0200 Subject: [PATCH] Michelson: annotations must start with `_a-zA-Z` or be empty Empty annotations are used to mean no annotation, or as a wildcard when destructing pairs for instance. --- docs/whitedoc/michelson.rst | 19 +- emacs/michelson-mode.el | 4 +- src/bin_client/test/contracts/map_iter.tz | 4 +- src/bin_client/test/contracts/pair_macro.tz | 4 +- src/bin_client/test/contracts/unpair_macro.tz | 5 +- .../lib_client/michelson_v1_macros.ml | 1 - .../lib_protocol/src/script_ir_annot.ml | 208 ++++++++++-------- .../lib_protocol/src/script_ir_annot.mli | 20 +- .../lib_protocol/src/script_ir_translator.ml | 152 +++++++------ 9 files changed, 224 insertions(+), 193 deletions(-) diff --git a/docs/whitedoc/michelson.rst b/docs/whitedoc/michelson.rst index 3c07fbc84..4bda58fb4 100644 --- a/docs/whitedoc/michelson.rst +++ b/docs/whitedoc/michelson.rst @@ -2149,8 +2149,9 @@ Syntax Primitive applications can receive one or many annotations. An annotation is a sequence of characters that matches the regular -expression ``[\@\:\%\$][_0-9a-zA-Z\.]*``. They come after the primitive -name and before its potential arguments for primitive applications. +expression ``[@:%](|[_a-ZA-Z][_0-9a-zA-Z\.]*)``. They come after the +primitive name and before its potential arguments for primitive +applications. :: @@ -2169,6 +2170,12 @@ For instance these two annotated instructions are equivalent: PAIR %x %y :t @my_pair +An annotation can be empty, in this case is will mean *no annotation* +and can be used as a wildcard. For instance, it is useful to annotate +only the right field of a pair instruction ``PAIR % %right`` or to +ignore field access constraints, *e.g.* in the macro ``UNPPAIPAIR %x1 % +%x3 %x4``. + Annotations and Macros ~~~~~~~~~~~~~~~~~~~~~~ @@ -2320,11 +2327,11 @@ Micheline expressions are encoded in JSON like this: ``[ expr, ... ]`` -- A primitive application is an object with two fields ``"prim"`` for +- A primitive application is an object with two fields ``"prim"`` for the primitive name and ``"args"`` for the arguments (that must - contain an array). A third optional field ``"annots"`` contains - a list of annotations, including their leading ``@``, ``%``, ``%`` or - ``$`` sign. + contain an array). A third optional field ``"annots"`` contains a + list of annotations, including their leading ``@``, ``%`` or ``%`` + sign. ``{ "prim": "pair", "args": [ { "prim": "nat", "args": [] }, { "prim": "nat", "args": [] } ], "annots": [":t"] }`` diff --git a/emacs/michelson-mode.el b/emacs/michelson-mode.el index e27c1b27d..4c98d5a19 100644 --- a/emacs/michelson-mode.el +++ b/emacs/michelson-mode.el @@ -172,8 +172,8 @@ Overrides `michelson-print-errors' and `michelson-highlight-errors'" (defconst michelson-font-lock-defaults (list (list - '("\\<[\$@][A-Za-z-_0-9\.]*\\>" . michelson-face-var-annotation) - '("\\<[%:][A-Za-z-_0-9\.]*\\>" . michelson-face-type-annotation) + '("\\<[@]\\(\\|[A-Za-z-_][A-Za-z-_0-9\.]*\\)\\>" . michelson-face-var-annotation) + '("\\<[%:]\\(\\|[A-Za-z-_][A-Za-z-_0-9\.]*\\)\\>" . michelson-face-type-annotation) '("\\<[0-9]+\\>" . michelson-face-constant) '("\\<[A-Z][a-z_0-9]+\\>" . michelson-face-constant) '("\\<[A-Z][A-Z_0-9]*\\>" . michelson-face-instruction) diff --git a/src/bin_client/test/contracts/map_iter.tz b/src/bin_client/test/contracts/map_iter.tz index b6898b560..3ab5c35c7 100644 --- a/src/bin_client/test/contracts/map_iter.tz +++ b/src/bin_client/test/contracts/map_iter.tz @@ -1,7 +1,7 @@ parameter (map (int :k) (int :e)); storage (pair (int :k) (int :e)); -code { CAR; PUSH @acc_e (int :e) 0; PUSH @acc_k (int :k) 0; PAIR; SWAP; +code { CAR; PUSH @acc_e (int :e) 0; PUSH @acc_k (int :k) 0; PAIR % %r; SWAP; ITER { DIP {DUP; CAR; DIP{CDR}}; DUP; # Last instr - DIP{CAR; ADD}; SWAP; DIP{CDR; ADD}; PAIR }; + DIP{CAR; ADD}; SWAP; DIP{CDR; ADD}; PAIR % %r }; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/pair_macro.tz b/src/bin_client/test/contracts/pair_macro.tz index 614f8680b..55c70a3be 100644 --- a/src/bin_client/test/contracts/pair_macro.tz +++ b/src/bin_client/test/contracts/pair_macro.tz @@ -1,6 +1,6 @@ parameter unit; storage unit; code { UNIT; UNIT; UNIT; UNIT; UNIT; - PAPAPAPAIR @name %1 %2 %3 %4 %5; - CDDDAR %4 @fourth; + PAPAPAPAIR @name %x1 %x2 %x3 %x4 %x5; + CDDDAR %x4 @fourth; DROP; CDR; NIL operation; PAIR} diff --git a/src/bin_client/test/contracts/unpair_macro.tz b/src/bin_client/test/contracts/unpair_macro.tz index 09b2749cf..384b6839d 100644 --- a/src/bin_client/test/contracts/unpair_macro.tz +++ b/src/bin_client/test/contracts/unpair_macro.tz @@ -1,10 +1,9 @@ parameter (unit :param_unit); storage (unit :u1); code { DROP ; - UNIT :u4 @4; UNIT :u3 @3; UNIT :u2 @2; UNIT :u1 @1; - CAST unit ; CAST (unit :u1); + UNIT :u4 @a4; UNIT :u3 @a3; UNIT :u2 @a2; UNIT :u1 @a1; PAIR; UNPAIR @x1 @x2; - PPAIPAIR @p1 %x1 %x2 %x3 %x4; UNPPAIPAIR @uno @due @tre @quattro; + PPAIPAIR @p1 %x1 %x2 %x3 %x4; UNPPAIPAIR %x1 % %x3 %x4 @uno @due @tre @quattro; PAPAPAIR @p2 %x1 %x2 %x3 %x4; UNPAPAPAIR @un @deux @trois @quatre; PAPPAIIR @p3 %x1 %x2 %x3 %x4; UNPAPPAIIR @one @two @three @four; DIP { DROP; DROP; DROP }; NIL operation; PAIR } \ No newline at end of file diff --git a/src/proto_alpha/lib_client/michelson_v1_macros.ml b/src/proto_alpha/lib_client/michelson_v1_macros.ml index e53df7e50..833fc4541 100644 --- a/src/proto_alpha/lib_client/michelson_v1_macros.ml +++ b/src/proto_alpha/lib_client/michelson_v1_macros.ml @@ -350,7 +350,6 @@ let expand_pappaiir original = match i, IntMap.find_opt i field_annots_pos with | 0, None -> annot | _, None -> [] - (* XXX Hackish, cannot annotate cdr only with PAIR *) | 0, Some ([], cdr_annot) -> "%" :: cdr_annot @ annot | _, Some ([], cdr_annot) -> "%" :: cdr_annot | 0, Some (car_annot, cdr_annot) -> car_annot @ cdr_annot @ annot diff --git a/src/proto_alpha/lib_protocol/src/script_ir_annot.ml b/src/proto_alpha/lib_protocol/src/script_ir_annot.ml index a631263f8..c2450d6c6 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_annot.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_annot.ml @@ -123,13 +123,22 @@ let fail_unexpected_annot loc annot = Lwt.return (error_unexpected_annot loc annot) let parse_annots loc l = + (* allow emtpty annotations as wildcards but otherwise only accept + annotations that starto with [a-zA-Z_] *) + let sub_or_wildcard wrap s acc = + let len = String.length s in + if Compare.Int.(len = 1) then ok @@ wrap None :: acc + else match s.[1] with + | 'a' .. 'z' | 'A' .. 'Z' | '_' -> + ok @@ wrap (Some (String.sub s 1 (len - 1))) :: acc + | _ -> error (Unexpected_annotation loc) in List.fold_left (fun acc s -> match acc with | Ok acc -> begin match s.[0] with - | '@' -> ok (`Var_annot (String.sub s 1 @@ String.length s - 1) :: acc) - | ':' -> ok (`Type_annot (String.sub s 1 @@ String.length s - 1) :: acc) - | '%' -> ok (`Field_annot (String.sub s 1 @@ String.length s - 1) :: acc) + | '@' -> sub_or_wildcard (fun a -> `Var_annot a) s acc + | ':' -> sub_or_wildcard (fun a -> `Type_annot a) s acc + | '%' -> sub_or_wildcard (fun a -> `Field_annot a) s acc | _ -> error (Unexpected_annotation loc) | exception Invalid_argument _ -> error (Unexpected_annotation loc) end @@ -137,28 +146,75 @@ let parse_annots loc l = ) (ok []) l >|? List.rev +let opt_var_of_var_opt = function + | `Var_annot None -> None + | `Var_annot Some a -> Some (`Var_annot a) + +let opt_field_of_field_opt = function + | `Field_annot None -> None + | `Field_annot Some a -> Some (`Field_annot a) + +let opt_type_of_type_opt = function + | `Type_annot None -> None + | `Type_annot Some a -> Some (`Type_annot a) + +let classify_annot loc l + : (var_annot option list * type_annot option list * field_annot option list) tzresult + = + 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, opt_var_of_var_opt a :: rv, + false, rt, + false, rf + | (`Type_annot _ as a), _, _, true, _, _, _ + | (`Type_annot _ as a), _, _, false, [], _, _ -> + false, rv, + true, opt_type_of_type_opt a :: rt, + false, rf + | (`Field_annot _ as a), _, _, _, _, true, _ + | (`Field_annot _ as a), _, _, _, _, false, [] -> + false, rv, + false, rt, + true, opt_field_of_field_opt a :: rf + | _ -> raise Exit + ) (false, [], false, [], false, []) l in + ok (List.rev rv, List.rev rt, List.rev rf) + with Exit -> error (Ungrouped_annotations loc) + +let get_one_annot loc = function + | [] -> ok None + | [ a ] -> ok a + | _ -> error (Unexpected_annotation loc) + +let get_two_annot loc = function + | [] -> ok (None, None) + | [ a ] -> ok (a, None) + | [ a; b ] -> ok (a, b) + | _ -> error (Unexpected_annotation loc) + let parse_type_annot : int -> string list -> type_annot option tzresult = fun loc annot -> - parse_annots loc annot >>? function - | [] -> ok None - | [ `Type_annot _ as a ] -> ok (Some a) - | _ -> error (Unexpected_annotation loc) + parse_annots loc annot >>? + classify_annot loc >>? fun (vars, types, fields) -> + error_unexpected_annot loc vars >>? fun () -> + error_unexpected_annot loc fields >>? fun () -> + get_one_annot loc types let parse_composed_type_annot : int -> string list -> (type_annot option * field_annot option * field_annot option) tzresult = fun loc annot -> - parse_annots loc annot >>? function - | [] -> ok (None, None, None) - | [ `Type_annot _ as a ] -> ok (Some a, None, None) - | [ `Type_annot _ as a ; `Field_annot _ as b] -> ok (Some a, Some b, None) - | [ `Type_annot _ as a ; `Field_annot _ as b; `Field_annot _ as c ] -> - ok (Some a, Some b, Some c) - | [ `Field_annot _ as b ] -> - ok (None, Some b, None) - | [ `Field_annot _ as b; `Field_annot _ as c ] -> - ok (None, Some b, Some c) - | _ -> error (Unexpected_annotation loc) + parse_annots loc annot >>? + classify_annot loc >>? fun (vars, types, fields) -> + error_unexpected_annot loc vars >>? fun () -> + get_one_annot loc types >>? fun t -> + get_two_annot loc fields >|? fun (f1, f2) -> + (t, f1, f2) let check_const_type_annot : int -> string list -> type_annot option -> unit tzresult Lwt.t @@ -170,10 +226,10 @@ let parse_field_annot : int -> string list -> field_annot option tzresult = fun loc annot -> parse_annots loc annot >>? - function - | [] -> ok None - | [ `Field_annot _ as a ] -> ok (Some a) - | _ -> error (Unexpected_annotation loc) + classify_annot loc >>? fun (vars, types, fields) -> + error_unexpected_annot loc vars >>? fun () -> + error_unexpected_annot loc types >>? fun () -> + get_one_annot loc fields let extract_field_annot : Script.node -> (Script.node * field_annot option) tzresult @@ -198,97 +254,57 @@ let check_correct_field if String.equal s1 s2 then ok () else error (Inconsistent_field_annotations ("%" ^ s1, "%" ^ s2)) + let parse_var_annot : int -> ?default:var_annot option -> string list -> - var_annot option tzresult Lwt.t + var_annot option tzresult = fun loc ?default annot -> - Lwt.return (parse_annots loc annot) >>=? fun annot -> - begin match annot, default with - | [], None -> ok None - | [], Some d -> ok d - | [ `Var_annot _ as a ], _ -> ok (Some a) - | _ -> error (Unexpected_annotation loc) - end |> Lwt.return - -let parse_field_annot loc annot = - Lwt.return (parse_field_annot loc annot) - -let classify_annot - : 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) - | [ a ] -> Lwt.return (ok (Some a)) - | _ -> Lwt.return (error (Unexpected_annotation loc)) - -let get_two_annot loc = function - | [] -> Lwt.return (ok (None, None)) - | [ a ] -> Lwt.return (ok (Some a, None)) - | [ a; b ] -> Lwt.return (ok (Some a, Some b)) - | _ -> Lwt.return (error (Unexpected_annotation loc)) + parse_annots loc annot >>? + classify_annot loc >>? fun (vars, types, fields) -> + error_unexpected_annot loc types >>? fun () -> + error_unexpected_annot loc fields >>? fun () -> + get_one_annot loc vars >|? function + | Some _ as a -> a + | None -> match default with + | Some a -> a + | None -> None let parse_constr_annot : int -> string list -> - (var_annot option * type_annot option * field_annot option * field_annot option) tzresult Lwt.t + (var_annot option * type_annot option * field_annot option * field_annot option) tzresult = fun loc annot -> - Lwt.return (parse_annots loc annot) >>=? fun annot -> - 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) -> + parse_annots loc annot >>? + classify_annot loc >>? 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) -> (v, t, f1, f2) let parse_two_var_annot - : int -> string list -> (var_annot option * var_annot option) tzresult Lwt.t + : int -> string list -> (var_annot option * var_annot option) tzresult = fun loc annot -> - Lwt.return (parse_annots loc annot) >>=? fun annot -> - classify_annot loc annot >>=? fun (vars, types, fields) -> - fail_unexpected_annot loc types >>=? fun () -> - fail_unexpected_annot loc fields >>=? fun () -> + parse_annots loc annot >>? + classify_annot loc >>? fun (vars, types, fields) -> + error_unexpected_annot loc types >>? fun () -> + error_unexpected_annot loc fields >>? fun () -> get_two_annot loc vars let parse_var_field_annot - : int -> string list -> (var_annot option * field_annot option) tzresult Lwt.t + : int -> string list -> (var_annot option * field_annot option) tzresult = fun loc annot -> - Lwt.return (parse_annots loc annot) >>=? fun annot -> - 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 -> + parse_annots loc annot >>? + classify_annot loc >>? fun (vars, types, fields) -> + error_unexpected_annot loc types >>? fun () -> + get_one_annot loc vars >>? fun v -> + get_one_annot loc fields >|? fun f -> (v, f) let parse_var_type_annot - : int -> string list -> (var_annot option * type_annot option) tzresult Lwt.t + : int -> string list -> (var_annot option * type_annot option) tzresult = fun loc annot -> - Lwt.return (parse_annots loc annot) >>=? fun annot -> - 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 -> + parse_annots loc annot >>? + classify_annot loc >>? fun (vars, types, fields) -> + error_unexpected_annot loc fields >>? fun () -> + get_one_annot loc vars >>? fun v -> + get_one_annot loc types >|? fun t -> (v, t) diff --git a/src/proto_alpha/lib_protocol/src/script_ir_annot.mli b/src/proto_alpha/lib_protocol/src/script_ir_annot.mli index ef5f72b2c..13a19d143 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_annot.mli +++ b/src/proto_alpha/lib_protocol/src/script_ir_annot.mli @@ -79,12 +79,12 @@ val error_unexpected_annot : int -> 'a list -> unit tzresult (** Same as {!error_unexpected_annot} in Lwt. *) val fail_unexpected_annot : int -> 'a list -> unit tzresult Lwt.t -(** Parse string annotations. *) -val parse_annots : int -> string list -> annot list tzresult - (** Parse a type annotation only. *) val parse_type_annot : int -> string list -> type_annot option tzresult +val parse_field_annot : + int -> string list -> field_annot option tzresult + (** Parse an annotation for composed types, of the form [:ty_name %field1 %field2] in any order. *) val parse_composed_type_annot : @@ -109,20 +109,18 @@ val check_correct_field : val parse_var_annot : int -> ?default:var_annot option -> - string list -> var_annot option tzresult Lwt.t - -val parse_field_annot : - int -> string list -> field_annot option tzresult Lwt.t + string list -> var_annot option tzresult val parse_constr_annot : int -> string list -> - (var_annot option * type_annot option * field_annot option * field_annot option) tzresult Lwt.t + (var_annot option * type_annot option * + field_annot option * field_annot option) tzresult val parse_two_var_annot : - int -> string list -> (var_annot option * var_annot option) tzresult Lwt.t + int -> string list -> (var_annot option * var_annot option) tzresult val parse_var_field_annot : - int -> string list -> (var_annot option * field_annot option) tzresult Lwt.t + int -> string list -> (var_annot option * field_annot option) tzresult val parse_var_type_annot : - int -> string list -> (var_annot option * type_annot option) tzresult Lwt.t + int -> string list -> (var_annot option * type_annot option) tzresult diff --git a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml index 3d5f4f255..83879d995 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -1068,6 +1068,18 @@ let address_size = | None -> assert false | Some size -> size +(* Lwt versions *) +let parse_var_annot loc ?default annot = + Lwt.return (parse_var_annot loc ?default annot) +let parse_constr_annot loc annot = + Lwt.return (parse_constr_annot loc annot) +let parse_two_var_annot loc annot = + Lwt.return (parse_two_var_annot loc annot) +let parse_var_field_annot loc annot = + Lwt.return (parse_var_field_annot loc annot) +let parse_var_type_annot loc annot = + Lwt.return (parse_var_type_annot loc annot) + let rec parse_data : type a. ?type_logger: type_logger -> @@ -1468,7 +1480,7 @@ and parse_instr | Prim (loc, I_PUSH, [ t ; d ], annot), stack -> parse_var_annot loc annot >>=? fun annot -> - (Lwt.return (parse_ty ~allow_big_map:false ~allow_operation:false t)) >>=? fun (Ex_ty t) -> + Lwt.return @@ parse_ty ~allow_big_map:false ~allow_operation:false t >>=? fun (Ex_ty t) -> parse_data ?type_logger ctxt t d >>=? fun (v, ctxt) -> typed ctxt loc (Const v) (Item_t (t, stack, annot)) | Prim (loc, I_UNIT, [], annot), @@ -1483,7 +1495,7 @@ and parse_instr (Item_t (Option_t ((t, some_field), none_field, ty_name), rest, annot)) | Prim (loc, I_NONE, [ t ], annot), stack -> - (Lwt.return (parse_ty ~allow_big_map:false ~allow_operation:true t)) >>=? fun (Ex_ty t) -> + Lwt.return @@ parse_ty ~allow_big_map:false ~allow_operation:true t >>=? fun (Ex_ty t) -> parse_constr_annot loc annot >>=? fun (annot, ty_name, some_field, none_field) -> typed ctxt loc (Cons_none t) (Item_t (Option_t ((t, some_field), none_field, ty_name), stack, annot)) @@ -1510,24 +1522,24 @@ and parse_instr parse_var_field_annot loc annot >>=? fun (annot, field_annot) -> let annot = default_annot annot ~default:(gen_access_annot pair_annot expected_field_annot ~default:default_car_annot) in - Lwt.return (check_correct_field field_annot expected_field_annot) >>=? fun () -> + Lwt.return @@ check_correct_field field_annot expected_field_annot >>=? fun () -> typed ctxt loc Car (Item_t (a, rest, annot)) | Prim (loc, I_CDR, [], annot), Item_t (Pair_t (_, (b, expected_field_annot), _), rest, pair_annot) -> parse_var_field_annot loc annot >>=? fun (annot, field_annot) -> let annot = default_annot annot ~default:(gen_access_annot pair_annot expected_field_annot ~default:default_cdr_annot) in - Lwt.return (check_correct_field field_annot expected_field_annot) >>=? fun () -> + Lwt.return @@ check_correct_field field_annot expected_field_annot >>=? fun () -> typed ctxt loc Cdr (Item_t (b, rest, annot)) (* unions *) | Prim (loc, I_LEFT, [ tr ], annot), Item_t (tl, rest, _stack_annot) -> - (Lwt.return (parse_ty ~allow_big_map:false ~allow_operation:true tr)) >>=? fun (Ex_ty tr) -> + Lwt.return @@ parse_ty ~allow_big_map:false ~allow_operation:true tr >>=? fun (Ex_ty tr) -> parse_constr_annot loc annot >>=? fun (annot, tname, l_field, r_field) -> typed ctxt loc Left (Item_t (Union_t ((tl, l_field), (tr, r_field), tname), rest, annot)) | Prim (loc, I_RIGHT, [ tl ], annot), Item_t (tr, rest, _stack_annot) -> - (Lwt.return (parse_ty ~allow_big_map:false ~allow_operation:true tl)) >>=? fun (Ex_ty tl) -> + Lwt.return @@ parse_ty ~allow_big_map:false ~allow_operation:true tl >>=? fun (Ex_ty tl) -> parse_constr_annot loc annot >>=? fun (annot, tname, l_field, r_field) -> typed ctxt loc Right (Item_t (Union_t ((tl, l_field), (tr, r_field), tname), rest, annot)) | Prim (loc, I_IF_LEFT, [ bt ; bf ], annot), @@ -1546,7 +1558,7 @@ and parse_instr (* lists *) | Prim (loc, I_NIL, [ t ], annot), stack -> - (Lwt.return (parse_ty ~allow_big_map:false ~allow_operation:true t)) >>=? fun (Ex_ty t) -> + Lwt.return @@ parse_ty ~allow_big_map:false ~allow_operation:true t >>=? fun (Ex_ty t) -> parse_var_type_annot loc annot >>=? fun (annot, ty_name) -> typed ctxt loc Nil (Item_t (List_t (t, ty_name), stack, annot)) | Prim (loc, I_CONS, [], annot), @@ -1586,8 +1598,8 @@ and parse_instr | Typed ({ aft = Item_t (ret, rest, _) ; _ } as ibody) -> let invalid_map_body = Invalid_map_body (loc, ibody.aft) in trace invalid_map_body - (Lwt.return (stack_ty_eq 1 rest starting_rest) >>=? fun Eq -> - Lwt.return (merge_stacks loc rest starting_rest) >>=? fun rest -> + (Lwt.return @@ stack_ty_eq 1 rest starting_rest >>=? fun Eq -> + Lwt.return @@ merge_stacks loc rest starting_rest >>=? fun rest -> typed ctxt loc (List_map ibody) (Item_t (List_t (ret, list_ty_name), rest, ret_annot))) | Typed { aft ; _ } -> fail (Invalid_map_body (loc, aft)) @@ -1604,8 +1616,8 @@ and parse_instr | Typed ({ aft ; _ } as ibody) -> let invalid_iter_body = Invalid_iter_body (loc, rest, ibody.aft) in trace invalid_iter_body - (Lwt.return (stack_ty_eq 1 aft rest) >>=? fun Eq -> - Lwt.return (merge_stacks loc aft rest) >>=? fun rest -> + (Lwt.return @@ stack_ty_eq 1 aft rest >>=? fun Eq -> + Lwt.return @@ merge_stacks loc aft rest >>=? fun rest -> typed ctxt loc (List_iter ibody) rest) | Failed { descr } -> typed ctxt loc (List_iter (descr rest)) rest @@ -1613,7 +1625,7 @@ and parse_instr (* sets *) | Prim (loc, I_EMPTY_SET, [ t ], annot), rest -> - (Lwt.return (parse_comparable_ty t)) >>=? fun (Ex_comparable_ty t) -> + Lwt.return @@ parse_comparable_ty t >>=? fun (Ex_comparable_ty t) -> parse_var_type_annot loc annot >>=? fun (annot, tname) -> typed ctxt loc (Empty_set t) (Item_t (Set_t (t, tname), rest, annot)) | Prim (loc, I_ITER, [ body ], annot), @@ -1628,8 +1640,8 @@ and parse_instr | Typed ({ aft ; _ } as ibody) -> let invalid_iter_body = Invalid_iter_body (loc, rest, ibody.aft) in trace invalid_iter_body - (Lwt.return (stack_ty_eq 1 aft rest) >>=? fun Eq -> - Lwt.return (merge_stacks loc aft rest) >>=? fun rest -> + (Lwt.return @@ stack_ty_eq 1 aft rest >>=? fun Eq -> + Lwt.return @@ merge_stacks loc aft rest >>=? fun rest -> typed ctxt loc (Set_iter ibody) rest) | Failed { descr } -> typed ctxt loc (Set_iter (descr rest)) rest @@ -1653,8 +1665,8 @@ and parse_instr (* maps *) | Prim (loc, I_EMPTY_MAP, [ tk ; tv ], annot), stack -> - (Lwt.return (parse_comparable_ty tk)) >>=? fun (Ex_comparable_ty tk) -> - (Lwt.return (parse_ty ~allow_big_map:false ~allow_operation:true tv)) >>=? fun (Ex_ty tv) -> + Lwt.return @@ parse_comparable_ty tk >>=? fun (Ex_comparable_ty tk) -> + Lwt.return @@ parse_ty ~allow_big_map:false ~allow_operation:true tv >>=? fun (Ex_ty tv) -> parse_var_type_annot loc annot >>=? fun (annot, ty_name) -> typed ctxt loc (Empty_map (tk, tv)) (Item_t (Map_t (tk, tv, ty_name), stack, annot)) | Prim (loc, I_MAP, [ body ], annot), @@ -1670,8 +1682,8 @@ and parse_instr | Typed ({ aft = Item_t (ret, rest, _) ; _ } as ibody) -> let invalid_map_body = Invalid_map_body (loc, ibody.aft) in trace invalid_map_body - (Lwt.return (stack_ty_eq 1 rest starting_rest) >>=? fun Eq -> - Lwt.return (merge_stacks loc rest starting_rest) >>=? fun rest -> + (Lwt.return @@ stack_ty_eq 1 rest starting_rest >>=? fun Eq -> + Lwt.return @@ merge_stacks loc rest starting_rest >>=? fun rest -> typed ctxt loc (Map_map ibody) (Item_t (Map_t (ck, ret, ty_name), rest, ret_annot))) | Typed { aft ; _ } -> fail (Invalid_map_body (loc, aft)) @@ -1690,8 +1702,8 @@ and parse_instr | Typed ({ aft ; _ } as ibody) -> let invalid_iter_body = Invalid_iter_body (loc, rest, ibody.aft) in trace invalid_iter_body - (Lwt.return (stack_ty_eq 1 aft rest) >>=? fun Eq -> - Lwt.return (merge_stacks loc aft rest) >>=? fun rest -> + (Lwt.return @@ stack_ty_eq 1 aft rest >>=? fun Eq -> + Lwt.return @@ merge_stacks loc aft rest >>=? fun rest -> typed ctxt loc (Map_iter ibody) rest) | Failed { descr } -> typed ctxt loc (Map_iter (descr rest)) rest @@ -1801,8 +1813,8 @@ and parse_instr | Typed ibody -> let unmatched_branches = Unmatched_branches (loc, ibody.aft, stack) in trace unmatched_branches - (Lwt.return (stack_ty_eq 1 ibody.aft stack) >>=? fun Eq -> - Lwt.return (merge_stacks loc ibody.aft stack) >>=? fun _stack -> + (Lwt.return @@ stack_ty_eq 1 ibody.aft stack >>=? fun Eq -> + Lwt.return @@ merge_stacks loc ibody.aft stack >>=? fun _stack -> typed ctxt loc (Loop ibody) rest) | Failed { descr } -> let ibody = descr stack in @@ -1818,8 +1830,8 @@ and parse_instr | Typed ibody -> let unmatched_branches = Unmatched_branches (loc, ibody.aft, stack) in trace unmatched_branches - (Lwt.return (stack_ty_eq 1 ibody.aft stack) >>=? fun Eq -> - Lwt.return (merge_stacks loc ibody.aft stack) >>=? fun _stack -> + (Lwt.return @@ stack_ty_eq 1 ibody.aft stack >>=? fun Eq -> + Lwt.return @@ merge_stacks loc ibody.aft stack >>=? fun _stack -> typed ctxt loc (Loop_left ibody) (Item_t (tr, rest, annot))) | Failed { descr } -> let ibody = descr stack in @@ -1827,9 +1839,9 @@ and parse_instr end | Prim (loc, I_LAMBDA, [ arg ; ret ; code ], annot), stack -> - (Lwt.return (parse_ty ~allow_big_map:false ~allow_operation:true arg)) + Lwt.return @@ parse_ty ~allow_big_map:false ~allow_operation:true arg >>=? fun (Ex_ty arg) -> - (Lwt.return (parse_ty ~allow_big_map:false ~allow_operation:true ret)) + Lwt.return @@ parse_ty ~allow_big_map:false ~allow_operation:true ret >>=? fun (Ex_ty ret) -> check_kind [ Seq_kind ] code >>=? fun () -> parse_var_annot loc annot >>=? fun annot -> @@ -1861,45 +1873,45 @@ and parse_instr | Prim (loc, I_ADD, [], annot), Item_t (Timestamp_t tn1, Item_t (Int_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Add_timestamp_to_seconds (Item_t (Timestamp_t tname, rest, annot)) | Prim (loc, I_ADD, [], annot), Item_t (Int_t tn1, Item_t (Timestamp_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Add_seconds_to_timestamp (Item_t (Timestamp_t tname, rest, annot)) | Prim (loc, I_SUB, [], annot), Item_t (Timestamp_t tn1, Item_t (Int_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Sub_timestamp_seconds (Item_t (Timestamp_t tname, rest, annot)) | Prim (loc, I_SUB, [], annot), Item_t (Timestamp_t tn1, Item_t (Timestamp_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Diff_timestamps (Item_t (Int_t tname, rest, annot)) (* string operations *) | Prim (loc, I_CONCAT, [], annot), Item_t (String_t tn1, Item_t (String_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Concat (Item_t (String_t tname, rest, annot)) (* currency operations *) | Prim (loc, I_ADD, [], annot), Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Add_tez (Item_t (Mutez_t tname, rest, annot)) | Prim (loc, I_SUB, [], annot), Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Sub_tez (Item_t (Mutez_t tname, rest, annot)) | Prim (loc, I_MUL, [], annot), @@ -1916,19 +1928,19 @@ and parse_instr | Prim (loc, I_OR, [], annot), Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Or (Item_t (Bool_t tname, rest, annot)) | Prim (loc, I_AND, [], annot), Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc And (Item_t (Bool_t tname, rest, annot)) | Prim (loc, I_XOR, [], annot), Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Xor (Item_t (Bool_t tname, rest, annot)) | Prim (loc, I_NOT, [], annot), @@ -1965,7 +1977,7 @@ and parse_instr | Prim (loc, I_ADD, [], annot), Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Add_intint (Item_t (Int_t tname, rest, annot)) | Prim (loc, I_ADD, [], annot), @@ -1981,13 +1993,13 @@ and parse_instr | Prim (loc, I_ADD, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Add_natnat (Item_t (Nat_t tname, rest, annot)) | Prim (loc, I_SUB, [], annot), Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Sub_int (Item_t (Int_t tname, rest, annot)) | Prim (loc, I_SUB, [], annot), @@ -2003,13 +2015,13 @@ and parse_instr | Prim (loc, I_SUB, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun _tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun _tname -> typed ctxt loc Sub_int (Item_t (Int_t None, rest, annot)) | Prim (loc, I_MUL, [], annot), Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Mul_intint (Item_t (Int_t tname, rest, annot)) | Prim (loc, I_MUL, [], annot), @@ -2025,7 +2037,7 @@ and parse_instr | Prim (loc, I_MUL, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Mul_natnat (Item_t (Nat_t tname, rest, annot)) | Prim (loc, I_EDIV, [], annot), @@ -2038,14 +2050,14 @@ and parse_instr | Prim (loc, I_EDIV, [], annot), Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Ediv_tez (Item_t (Option_t ((Pair_t ((Nat_t None, None), (Mutez_t tname, None), None), None), None, None), rest, annot)) | Prim (loc, I_EDIV, [], annot), Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Ediv_intint (Item_t (Option_t ((Pair_t ((Int_t tname, None), (Nat_t None, None), None), None), @@ -2066,32 +2078,32 @@ and parse_instr | Prim (loc, I_EDIV, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Ediv_natnat (Item_t (Option_t ((Pair_t ((Nat_t tname, None), (Nat_t tname, None), None), None), None, None), rest, annot)) | Prim (loc, I_LSL, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Lsl_nat (Item_t (Nat_t tname, rest, annot)) | Prim (loc, I_LSR, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Lsr_nat (Item_t (Nat_t tname, rest, annot)) | Prim (loc, I_OR, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Or_nat (Item_t (Nat_t tname, rest, annot)) | Prim (loc, I_AND, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc And_nat (Item_t (Nat_t tname, rest, annot)) | Prim (loc, I_AND, [], annot), @@ -2102,7 +2114,7 @@ and parse_instr | Prim (loc, I_XOR, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc Xor_nat (Item_t (Nat_t tname, rest, annot)) | Prim (loc, I_NOT, [], annot), @@ -2119,49 +2131,49 @@ and parse_instr | Prim (loc, I_COMPARE, [], annot), Item_t (Int_t tn1, Item_t (Int_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc (Compare (Int_key tname)) (Item_t (Int_t None, rest, annot)) | Prim (loc, I_COMPARE, [], annot), Item_t (Nat_t tn1, Item_t (Nat_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc (Compare (Nat_key tname)) (Item_t (Int_t None, rest, annot)) | Prim (loc, I_COMPARE, [], annot), Item_t (Bool_t tn1, Item_t (Bool_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc (Compare (Bool_key tname)) (Item_t (Int_t None, rest, annot)) | Prim (loc, I_COMPARE, [], annot), Item_t (String_t tn1, Item_t (String_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc (Compare (String_key tname)) (Item_t (Int_t None, rest, annot)) | Prim (loc, I_COMPARE, [], annot), Item_t (Mutez_t tn1, Item_t (Mutez_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc (Compare (Mutez_key tname)) (Item_t (Int_t None, rest, annot)) | Prim (loc, I_COMPARE, [], annot), Item_t (Key_hash_t tn1, Item_t (Key_hash_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc (Compare (Key_hash_key tname)) (Item_t (Int_t None, rest, annot)) | Prim (loc, I_COMPARE, [], annot), Item_t (Timestamp_t tn1, Item_t (Timestamp_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc (Compare (Timestamp_key tname)) (Item_t (Int_t None, rest, annot)) | Prim (loc, I_COMPARE, [], annot), Item_t (Address_t tn1, Item_t (Address_t tn2, rest, _), _) -> parse_var_annot loc annot >>=? fun annot -> - Lwt.return (merge_type_annot tn1 tn2) >>=? fun tname -> + Lwt.return @@ merge_type_annot tn1 tn2 >>=? fun tname -> typed ctxt loc (Compare (Address_key tname)) (Item_t (Int_t None, rest, annot)) (* comparators *) @@ -2199,7 +2211,7 @@ and parse_instr | Prim (loc, I_CAST, [ cast_t ], annot), Item_t (t, stack, item_annot) -> parse_var_annot loc annot ~default:item_annot >>=? fun annot -> - (Lwt.return (parse_ty ~allow_big_map:true ~allow_operation:true cast_t)) + (Lwt.return @@ parse_ty ~allow_big_map:true ~allow_operation:true cast_t) >>=? fun (Ex_ty cast_t) -> Lwt.return @@ ty_eq cast_t t >>=? fun Eq -> Lwt.return @@ merge_types loc cast_t t >>=? fun _ -> @@ -2217,7 +2229,7 @@ and parse_instr (Item_t (Address_t None, rest, annot)) | Prim (loc, I_CONTRACT, [ ty ], annot), Item_t (Address_t _, rest, addr_annot) -> - Lwt.return (parse_ty ~allow_big_map:false ~allow_operation:false ty) >>=? fun (Ex_ty t) -> + Lwt.return @@ parse_ty ~allow_big_map:false ~allow_operation:false ty >>=? fun (Ex_ty t) -> parse_var_annot loc annot ~default:(gen_access_annot addr_annot default_contract_annot) >>=? fun annot -> typed ctxt loc (Contract t) @@ -2269,14 +2281,14 @@ and parse_instr (ginit, rest, _), _), _), _), _), _) -> parse_two_var_annot loc annot >>=? fun (op_annot, addr_annot) -> let cannonical_code = fst @@ Micheline.extract_locations code in - Lwt.return (parse_toplevel cannonical_code) >>=? fun (arg_type, storage_type, code_field) -> + Lwt.return @@ parse_toplevel cannonical_code >>=? fun (arg_type, storage_type, code_field) -> trace (Ill_formed_type (Some "parameter", cannonical_code, location arg_type)) - (Lwt.return (parse_ty ~allow_big_map:false ~allow_operation:false arg_type)) + (Lwt.return @@ parse_ty ~allow_big_map:false ~allow_operation:false arg_type) >>=? fun (Ex_ty arg_type) -> trace (Ill_formed_type (Some "storage", cannonical_code, location storage_type)) - (Lwt.return (parse_ty ~allow_big_map:true ~allow_operation:false storage_type)) + (Lwt.return @@ parse_ty ~allow_big_map:true ~allow_operation:false storage_type) >>=? fun (Ex_ty storage_type) -> let arg_field = default_annot (type_to_field_annot (name_of_ty arg_type)) ~default:default_param_annot in @@ -2442,11 +2454,11 @@ and parse_contract : type arg. context -> Script.location -> arg ty -> Contract.t -> (context * arg typed_contract) tzresult Lwt.t = fun ctxt loc arg contract -> - Lwt.return (Gas.consume ctxt Typecheck_costs.contract_exists) >>=? fun ctxt -> + Lwt.return @@ Gas.consume ctxt Typecheck_costs.contract_exists >>=? fun ctxt -> Contract.exists ctxt contract >>=? function | false -> fail (Invalid_contract (loc, contract)) | true -> - Lwt.return (Gas.consume ctxt Typecheck_costs.get_script) >>=? fun ctxt -> + Lwt.return @@ Gas.consume ctxt Typecheck_costs.get_script >>=? fun ctxt -> trace (Invalid_contract (loc, contract)) @@ Contract.get_script ctxt contract >>=? fun (ctxt, script) -> match script with @@ -2511,9 +2523,9 @@ let parse_script : ?type_logger: type_logger -> context -> Script.t -> (ex_script * context) tzresult Lwt.t = fun ?type_logger ctxt { code ; storage } -> - Lwt.return (Script.force_decode code) >>=? fun code -> - Lwt.return (Script.force_decode storage) >>=? fun storage -> - Lwt.return (parse_toplevel code) >>=? fun (arg_type, storage_type, code_field) -> + Lwt.return @@ Script.force_decode code >>=? fun code -> + Lwt.return @@ Script.force_decode storage >>=? fun storage -> + Lwt.return @@ parse_toplevel code >>=? fun (arg_type, storage_type, code_field) -> trace (Ill_formed_type (Some "parameter", code, location arg_type)) (Lwt.return (parse_ty ~allow_big_map:false ~allow_operation:false arg_type)) @@ -2541,7 +2553,7 @@ let parse_script let typecheck_code : context -> Script.expr -> (type_map * context) tzresult Lwt.t = fun ctxt code -> - Lwt.return (parse_toplevel code) >>=? fun (arg_type, storage_type, code_field) -> + Lwt.return @@ parse_toplevel code >>=? fun (arg_type, storage_type, code_field) -> let type_map = ref [] in (* TODO: annotation checking *) trace @@ -2576,7 +2588,7 @@ let typecheck_data = fun ?type_logger ctxt (data, exp_ty) -> trace (Ill_formed_type (None, exp_ty, 0)) - (Lwt.return (parse_ty ~allow_big_map:true ~allow_operation:false (root exp_ty))) + (Lwt.return @@ parse_ty ~allow_big_map:true ~allow_operation:false (root exp_ty)) >>=? fun (Ex_ty exp_ty) -> trace (Ill_typed_data (None, data, exp_ty))