diff --git a/docs/whitedoc/michelson.rst b/docs/whitedoc/michelson.rst index 3ccf4b932..338ca0bfe 100644 --- a/docs/whitedoc/michelson.rst +++ b/docs/whitedoc/michelson.rst @@ -2149,7 +2149,7 @@ Syntax Primitive applications can receive one or many annotations. An annotation is a sequence of characters that matches the regular -expression ``[@:%](|[@%]|[_a-ZA-Z][_0-9a-zA-Z\.]*)``. They come after +expression ``[@:%](|@|%|%%|[_a-ZA-Z][_0-9a-zA-Z\.]*)``. They come after the primitive name and before its potential arguments. :: @@ -2310,24 +2310,32 @@ type (which can be changed). For instance the annotated typing rule for Special Annotations ~~~~~~~~~~~~~~~~~~~ -The special variable annotation ``@%`` can be used on instructions +The special variable annotations ``@%%`` can be used on instructions ``CAR`` and ``CDR``. It means to use the accessed field name (if any) as -a name for the value on the stack. +a name for the value on the stack. The following typing rule +demonstrates their use for instruction ``CAR``. :: CAR @% - :: (pair ('a %fst) ('b %snd)) : 'S -> @fst 'a : 'S + :: @p (pair ('a %fst) ('b %snd)) : 'S -> @fst 'a : 'S + CAR @%% + :: @p (pair ('a %fst) ('b %snd)) : 'S -> @p.fst 'a : 'S The special variable annotation ``%@`` can be used on instructions ``PAIR``, ``SOME``, ``LEFT``, ``RIGHT``. It means to use the variable name annotation in the stack as a field name for the constructed -element. An example with ``PAIR`` follows, +element. Two examples with ``PAIR`` follows, notice the special +treatment of annotations with `.`. :: PAIR %@ %@ :: @x 'a : @y 'b : 'S -> (pair ('a %x) ('b %y)) : 'S + PAIR %@ %@ + :: @p.x 'a : @p.y 'b : 'S -> @p (pair ('a %x) ('b %y)) : 'S + :: @p.x 'a : @q.y 'b : 'S -> (pair ('a %x) ('b %y)) : 'S + XI - JSON syntax --------------- diff --git a/emacs/michelson-mode.el b/emacs/michelson-mode.el index 7e14fbfdf..271999f50 100644 --- a/emacs/michelson-mode.el +++ b/emacs/michelson-mode.el @@ -172,7 +172,7 @@ Overrides `michelson-print-errors' and `michelson-highlight-errors'" (defconst michelson-font-lock-defaults (list (list - '("\\<[@]\\(\\|%\\|[A-Za-z-_][A-Za-z-_0-9\.]*\\)\\>" . michelson-face-var-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) @@ -501,7 +501,7 @@ If `DO-NOT-OVERWRITE' is non-nil, the existing contents of the buffer are mainta (lexical-let* ((pp-no-trailing-newline (lambda (sexp) - (let* ((str (pp-to-string sexp)) + (let* ((str (replace-regexp-in-string "\\\\\." "." (pp-to-string sexp))) (len (length str))) (if (equal "\n" (substring str (- len 1) len)) (substring str 0 (- len 1)) diff --git a/src/bin_client/test/contracts/vote_for_delegate.tz b/src/bin_client/test/contracts/vote_for_delegate.tz index 43a68338a..f012f5850 100644 --- a/src/bin_client/test/contracts/vote_for_delegate.tz +++ b/src/bin_client/test/contracts/vote_for_delegate.tz @@ -1,14 +1,14 @@ parameter (option key_hash) ; storage (pair - (pair %mgr1 (address %addr) (option key_hash)) - (pair %mgr2 (address %addr) (option key_hash))) ; + (pair %mgr1 (address %addr) (option %key key_hash)) + (pair %mgr2 (address %addr) (option %key key_hash))) ; code { # Update the storage DUP ; CDAAR %addr @%; SOURCE ; PAIR %@ %@; UNPAIR; IFCMPEQ - { UNPAIR ; SWAP ; SET_CADR } + { UNPAIR ; SWAP ; SET_CADR %key @changed_mgr1_key } { DUP ; CDDAR ; SOURCE ; IFCMPEQ - { UNPAIR ; SWAP ; SET_CDDR } + { UNPAIR ; SWAP ; SET_CDDR %key } { FAIL } } ; # Now compare the proposals DUP ; CADR ; diff --git a/src/proto_alpha/lib_client/michelson_v1_macros.ml b/src/proto_alpha/lib_client/michelson_v1_macros.ml index 833fc4541..5256e31c8 100644 --- a/src/proto_alpha/lib_client/michelson_v1_macros.ml +++ b/src/proto_alpha/lib_client/michelson_v1_macros.ml @@ -61,7 +61,7 @@ let extract_first_annot annot char = extract_first_annot [] annot let extract_first_field_annot annot = extract_first_annot annot '%' -let extract_first_bind_annot annot = extract_first_annot annot '$' +let extract_first_var_annot annot = extract_first_annot annot '@' let extract_field_annots annot = List.partition (fun a -> @@ -84,7 +84,11 @@ let expand_set_caddadr original = | [] -> ok () | _ :: _ -> error (Invalid_arity (str, List.length args, 0)) end >>? fun () -> - let field_annot, annot = extract_first_field_annot annot in + begin match extract_field_annots annot with + | [], annot -> ok (None, annot) + | [f], annot -> ok (Some f, annot) + | _, _ -> error (Unexpected_macro_annotation str) + end >>? fun (field_annot, annot) -> let rec parse i acc = if i = 4 then acc @@ -97,11 +101,11 @@ let expand_set_caddadr original = [ Prim (loc, "DUP", [], []) ; Prim (loc, "DIP", [ Seq (loc, - [ Prim (loc, "CAR", [], []) ; + [ Prim (loc, "CAR", [], [ "@%%" ]) ; acc ]) ], []) ; - Prim (loc, "CDR", [], []) ; + Prim (loc, "CDR", [], [ "@%%" ]) ; Prim (loc, "SWAP", [], []) ; - Prim (loc, "PAIR", [], annot) ]) in + Prim (loc, "PAIR", [], "%@" :: "%@" :: annot) ]) in parse (i - 1) acc | 'D' -> let acc = @@ -109,10 +113,10 @@ let expand_set_caddadr original = [ Prim (loc, "DUP", [], []) ; Prim (loc, "DIP", [ Seq (loc, - [ Prim (loc, "CDR", [], []) ; + [ Prim (loc, "CDR", [], [ "@%%" ]) ; acc ]) ], []) ; - Prim (loc, "CAR", [], []) ; - Prim (loc, "PAIR", [], annot) ]) in + Prim (loc, "CAR", [], [ "@%%" ]) ; + Prim (loc, "PAIR", [], "%@" :: "%@" :: annot) ]) in parse (i - 1) acc | _ -> assert false in match String.get str (len - 2) with @@ -123,9 +127,10 @@ let expand_set_caddadr original = Prim (loc, "CAR", [], [ f ]) ; Prim (loc, "DROP", [], []) ; ] in - let encoding = [ Prim (loc, "CDR", [], []) ; + let encoding = [ Prim (loc, "CDR", [], [ "@%%" ]) ; Prim (loc, "SWAP", [], []) ] in - let pair = [ Prim (loc, "PAIR", [], []) ] in + let pair = [ Prim (loc, "PAIR", [], + [ Option.unopt field_annot ~default:"%" ; "%@" ]) ] in let init = Seq (loc, access_check @ encoding @ pair) in ok (Some (parse (len - 3) init)) | 'D' -> @@ -135,8 +140,9 @@ let expand_set_caddadr original = Prim (loc, "CDR", [], [ f ]) ; Prim (loc, "DROP", [], []) ; ] in - let encoding = [ Prim (loc, "CAR", [], []) ] in - let pair = [ Prim (loc, "PAIR", [], []) ] in + let encoding = [ Prim (loc, "CAR", [], [ "@%%" ]) ] in + let pair = [ Prim (loc, "PAIR", [], + [ "%@" ; Option.unopt field_annot ~default:"%" ]) ] in let init = Seq (loc, access_check @ encoding @ pair) in ok (Some (parse (len - 3) init)) | _ -> assert false @@ -158,8 +164,11 @@ let expand_map_caddadr original = | [ _ ] -> error (Sequence_expected str) | [] | _ :: _ :: _ -> error (Invalid_arity (str, List.length args, 1)) end >>? fun code -> - let field_annot, annot = extract_first_field_annot annot in - let bind_annot, annot = extract_first_bind_annot annot in + begin match extract_field_annots annot with + | [], annot -> ok (None, annot) + | [f], annot -> ok (Some f, annot) + | _, _ -> error (Unexpected_macro_annotation str) + end >>? fun (field_annot, annot) -> let rec parse i acc = if i = 4 then acc @@ -172,11 +181,11 @@ let expand_map_caddadr original = [ Prim (loc, "DUP", [], []) ; Prim (loc, "DIP", [ Seq (loc, - [ Prim (loc, "CAR", [], []) ; + [ Prim (loc, "CAR", [], [ "@%%" ]) ; acc ]) ], []) ; - Prim (loc, "CDR", [], []) ; + Prim (loc, "CDR", [], [ "@%%" ]) ; Prim (loc, "SWAP", [], []) ; - Prim (loc, "PAIR", [], annot) ]) in + Prim (loc, "PAIR", [], "%@" :: "%@" :: annot) ]) in parse (i - 1) acc | 'D' -> let acc = @@ -184,30 +193,26 @@ let expand_map_caddadr original = [ Prim (loc, "DUP", [], []) ; Prim (loc, "DIP", [ Seq (loc, - [ Prim (loc, "CDR", [], []) ; + [ Prim (loc, "CDR", [], [ "@%%" ]) ; acc ]) ], []) ; - Prim (loc, "CAR", [], []) ; - Prim (loc, "PAIR", [], annot) ]) in + Prim (loc, "CAR", [], [ "@%%" ]) ; + Prim (loc, "PAIR", [], "%@" :: "%@" :: annot) ]) in parse (i - 1) acc | _ -> assert false in - let cr_annot = - let f = match field_annot with - | None -> [] - | Some f -> [ f ] in - let b = match bind_annot with - | None -> [] - | Some b -> [ "@" ^ String.sub b 1 (String.length b - 1) ] in - f @ b in + let cr_annot = match field_annot with + | None -> [] + | Some f -> [ "@" ^ String.sub f 1 (String.length f - 1) ] in match String.get str (len - 2) with | 'A' -> let init = Seq (loc, [ Prim (loc, "DUP", [], []) ; - Prim (loc, "CDR", [], []) ; + Prim (loc, "CDR", [], [ "@%%" ]) ; Prim (loc, "DIP", [ Seq (loc, [ Prim (loc, "CAR", [], cr_annot) ; code ]) ], []) ; Prim (loc, "SWAP", [], []) ; - Prim (loc, "PAIR", [], []) ]) in + Prim (loc, "PAIR", [], + [ Option.unopt field_annot ~default:"%" ; "%@"]) ]) in ok (Some (parse (len - 3) init)) | 'D' -> let init = @@ -216,8 +221,9 @@ let expand_map_caddadr original = Prim (loc, "CDR", [], cr_annot) ; code ; Prim (loc, "SWAP", [], []) ; - Prim (loc, "CAR", [], []) ; - Prim (loc, "PAIR", [], []) ]) in + Prim (loc, "CAR", [], [ "@%%" ]) ; + Prim (loc, "PAIR", [], + [ "%@" ; Option.unopt field_annot ~default:"%" ]) ]) in ok (Some (parse (len - 3) init)) | _ -> assert false else @@ -640,47 +646,49 @@ let unexpand_caddadr expanded = let unexpand_set_caddadr expanded = let rec steps acc annots = function | Seq (loc, - [ Prim (_, "CDR", [], []) ; - Prim (_, "SWAP", [], []) ; - Prim (_, "PAIR", [], []) ]) -> + [ Prim (_, "CDR", [], _) ; + Prim (_, "SWAP", [], _) ; + Prim (_, "PAIR", [], _) ]) -> Some (loc, "A" :: acc, annots) | Seq (loc, [ Prim (_, "DUP", [], []) ; Prim (_, "CAR", [], [ field_annot ]) ; Prim (_, "DROP", [], []) ; - Prim (_, "CDR", [], []) ; + Prim (_, "CDR", [], _) ; Prim (_, "SWAP", [], []) ; - Prim (_, "PAIR", [], []) ]) -> + Prim (_, "PAIR", [], _) ]) -> Some (loc, "A" :: acc, field_annot :: annots) | Seq (loc, - [ Prim (_, "CAR", [], []) ; - Prim (_, "PAIR", [], []) ]) -> + [ Prim (_, "CAR", [], _) ; + Prim (_, "PAIR", [], _) ]) -> Some (loc, "D" :: acc, annots) | Seq (loc, [ Prim (_, "DUP", [], []) ; Prim (_, "CDR", [], [ field_annot ]) ; Prim (_, "DROP", [], []) ; - Prim (_, "CAR", [], []) ; - Prim (_, "PAIR", [], []) ]) -> + Prim (_, "CAR", [], _) ; + Prim (_, "PAIR", [], _) ]) -> Some (loc, "D" :: acc, field_annot :: annots) | Seq (_, [ Prim (_, "DUP", [], []) ; Prim (_, "DIP", [ Seq (_, - [ Prim (_, "CAR", [], []) ; + [ Prim (_, "CAR", [], _) ; sub ]) ], []) ; - Prim (_, "CDR", [], []) ; + Prim (_, "CDR", [], _) ; Prim (_, "SWAP", [], []) ; Prim (_, "PAIR", [], pair_annots) ]) -> + let _, pair_annots = extract_field_annots pair_annots in steps ("A" :: acc) (List.rev_append pair_annots annots) sub | Seq (_, [ Prim (_, "DUP", [], []) ; Prim (_, "DIP", [ Seq (_, - [ Prim (_, "CDR", [], []) ; + [ Prim (_, "CDR", [], _) ; sub ]) ], []) ; - Prim (_, "CAR", [], []) ; + Prim (_, "CAR", [], _) ; Prim (_, "PAIR", [], pair_annots) ]) -> + let _, pair_annots = extract_field_annots pair_annots in steps ("D" :: acc) (List.rev_append pair_annots annots) sub | _ -> None in match steps [] [] expanded with @@ -693,49 +701,50 @@ let unexpand_map_caddadr expanded = let rec steps acc annots = function | Seq (loc, [ Prim (_, "DUP", [], []) ; - Prim (_, "CDR", [], []) ; + Prim (_, "CDR", [], _) ; Prim (_, "SWAP", [], []) ; Prim (_, "DIP", [ Seq (_, [ Prim (_, "CAR", [], []) ; code ]) ], []) ; - Prim (_, "PAIR", [], []) ]) -> + Prim (_, "PAIR", [], _) ]) -> Some (loc, "A" :: acc, annots, code) | Seq (loc, [ Prim (_, "DUP", [], []) ; - Prim (_, "CDR", [], []) ; + Prim (_, "CDR", [], _) ; Prim (_, "SWAP", [], []) ; Prim (_, "DIP", [ Seq (_, [ Prim (_, "CAR", [], [ field_annot ]) ; code ]) ], []) ; - Prim (_, "PAIR", [], []) ]) -> + Prim (_, "PAIR", [], _) ]) -> Some (loc, "A" :: acc, field_annot :: annots, code) | Seq (loc, [ Prim (_, "DUP", [], []) ; Prim (_, "CDR", [], []) ; code ; Prim (_, "SWAP", [], []) ; - Prim (_, "CAR", [], []) ; - Prim (_, "PAIR", [], []) ]) -> + Prim (_, "CAR", [], _) ; + Prim (_, "PAIR", [], _) ]) -> Some (loc, "D" :: acc, annots, code) | Seq (loc, [ Prim (_, "DUP", [], []) ; Prim (_, "CDR", [], [ field_annot ]) ; code ; Prim (_, "SWAP", [], []) ; - Prim (_, "CAR", [], []) ; - Prim (_, "PAIR", [], []) ]) -> + Prim (_, "CAR", [], _) ; + Prim (_, "PAIR", [], _) ]) -> Some (loc, "D" :: acc, field_annot :: annots, code) | Seq (_, [ Prim (_, "DUP", [], []) ; Prim (_, "DIP", [ Seq (_, - [ Prim (_, "CAR", [], []) ; + [ Prim (_, "CAR", [], _) ; sub ]) ], []) ; - Prim (_, "CDR", [], []) ; + Prim (_, "CDR", [], _) ; Prim (_, "SWAP", [], []) ; Prim (_, "PAIR", [], pair_annots) ]) -> + let _, pair_annots = extract_field_annots pair_annots in steps ("A" :: acc) (List.rev_append pair_annots annots) sub | Seq (_, [ Prim (_, "DUP", [], []) ; @@ -745,6 +754,7 @@ let unexpand_map_caddadr expanded = sub ]) ], []) ; Prim (_, "CAR", [], []) ; Prim (_, "PAIR", [], pair_annots) ]) -> + let _, pair_annots = extract_field_annots pair_annots in steps ("D" :: acc) (List.rev_append pair_annots annots) sub | _ -> None in match steps [] [] expanded with 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 825e558c5..b0065f6ce 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_annot.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_annot.ml @@ -131,8 +131,14 @@ let parse_annots loc ?(allow_special_var = false) ?(allow_special_field = false) else match s.[1] with | 'a' .. 'z' | 'A' .. 'Z' | '_' -> ok @@ wrap (Some (String.sub s 1 (len - 1))) :: acc - | ('%' | '@' as c) when Compare.Int.(len = 2) && List.mem c specials -> - ok @@ wrap (Some (String.sub s 1 (len - 1))) :: acc + | '@' when Compare.Int.(len = 2) && List.mem '@' specials -> + ok @@ wrap (Some "@") :: acc + | '%' when List.mem '%' specials -> + if Compare.Int.(len = 2) + then ok @@ wrap (Some "%") :: acc + else if Compare.Int.(len = 3) && Compare.Char.(s.[2] = '%') + then ok @@ wrap (Some "%%") :: acc + else error (Unexpected_annotation loc) | _ -> error (Unexpected_annotation loc) in List.fold_left (fun acc s -> match acc with @@ -300,6 +306,27 @@ let parse_var_annot | Some a -> a | None -> None +let split_last_dot = function + | None -> None, None + | Some `Field_annot s -> + try + let i = String.rindex s '.' in + let s1 = String.sub s 0 i in + let s2 = String.sub s (i + 1) (String.length s - i - 1) in + let f = + if Compare.String.equal s2 "car" || Compare.String.equal s2 "cdr" + then None + else Some (`Field_annot s2) in + Some (`Var_annot s1), f + with Not_found -> None, Some (`Field_annot s) + +let common_prefix v1 v2 = + match v1, v2 with + | Some (`Var_annot s1), Some (`Var_annot s2) when Compare.String.equal s1 s2 -> v1 + | Some _, None -> v1 + | None, Some _ -> v2 + | _, _ -> None + let parse_constr_annot : int -> ?if_special_first:field_annot option -> @@ -313,15 +340,20 @@ let parse_constr_annot get_one_annot loc types >>? fun t -> get_two_annot loc fields >>? fun (f1, f2) -> begin match if_special_first, f1 with - | Some special_var, Some `Field_annot "@" -> ok special_var + | Some special_var, Some `Field_annot "@" -> + ok (split_last_dot special_var) | None, Some `Field_annot "@" -> error (Unexpected_annotation loc) - | _, _ -> ok f1 - end >>? fun f1 -> + | _, _ -> ok (v, f1) + end >>? fun (v1, f1) -> begin match if_special_second, f2 with - | Some special_var, Some `Field_annot "@" -> ok special_var + | Some special_var, Some `Field_annot "@" -> + ok (split_last_dot special_var) | None, Some `Field_annot "@" -> error (Unexpected_annotation loc) - | _, _ -> ok f2 - end >|? fun f2 -> + | _, _ -> ok (v, f2) + end >|? fun (v2, f2) -> + let v = match v with + | None -> common_prefix v1 v2 + | Some _ -> v in (v, t, f1, f2) let parse_two_var_annot @@ -333,19 +365,24 @@ let parse_two_var_annot error_unexpected_annot loc fields >>? fun () -> get_two_annot loc vars -let parse_var_field_annot - : int -> ?if_special_var:var_annot option -> string list -> - (var_annot option * field_annot option) tzresult - = fun loc ?if_special_var annot -> +let parse_destr_annot + : int -> string list -> default_accessor:field_annot option -> + field_name:field_annot option -> + pair_annot:var_annot option -> value_annot:var_annot option -> + (var_annot option * field_annot option) tzresult + = fun loc annot ~default_accessor ~field_name ~pair_annot ~value_annot -> parse_annots loc ~allow_special_var:true 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 -> - match if_special_var, v with - | Some special_var, Some `Var_annot "%" -> ok (special_var, f) - | None, Some `Var_annot "%" -> error (Unexpected_annotation loc) - | _, _ -> ok (v, f) + get_one_annot loc fields >|? fun f -> + let default = gen_access_annot pair_annot field_name ~default:default_accessor in + let v = match v with + | Some `Var_annot "%" -> field_to_var_annot field_name + | Some `Var_annot "%%" -> default + | Some _ -> v + | None -> value_annot in + (v, f) let parse_var_type_annot : int -> string list -> (var_annot option * type_annot option) tzresult 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 ac39a8a18..e04b9eca0 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_annot.mli +++ b/src/proto_alpha/lib_protocol/src/script_ir_annot.mli @@ -129,8 +129,12 @@ val parse_constr_annot : val parse_two_var_annot : int -> string list -> (var_annot option * var_annot option) tzresult -val parse_var_field_annot : - int -> ?if_special_var:var_annot option -> string list -> +val parse_destr_annot : + int -> string list -> + default_accessor:field_annot option -> + field_name:field_annot option -> + pair_annot:var_annot option -> + value_annot:var_annot option -> (var_annot option * field_annot option) tzresult val parse_var_type_annot : 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 1ae911c9f..137633bf4 100644 --- a/src/proto_alpha/lib_protocol/src/script_ir_translator.ml +++ b/src/proto_alpha/lib_protocol/src/script_ir_translator.ml @@ -1077,8 +1077,8 @@ let parse_constr_annot loc ?if_special_first ?if_special_second annot = Lwt.return (parse_constr_annot loc ?if_special_first ?if_special_second annot) let parse_two_var_annot loc annot = Lwt.return (parse_two_var_annot loc annot) -let parse_var_field_annot loc ?if_special_var annot = - Lwt.return (parse_var_field_annot loc ?if_special_var annot) +let parse_destr_annot loc annot ~default_accessor ~field_name ~pair_annot ~value_annot = + Lwt.return (parse_destr_annot loc annot ~default_accessor ~field_name ~pair_annot ~value_annot) let parse_var_type_annot loc annot = Lwt.return (parse_var_type_annot loc annot) @@ -1526,22 +1526,22 @@ and parse_instr (Item_t (Pair_t((a, l_field, fst_annot), (b, r_field, snd_annot), ty_name), rest, annot)) | Prim (loc, I_CAR, [], annot), Item_t (Pair_t ((a, expected_field_annot, a_annot), _, _), rest, pair_annot) -> - parse_var_field_annot loc annot - ~if_special_var:(field_to_var_annot expected_field_annot) + parse_destr_annot loc annot + ~pair_annot + ~value_annot:a_annot + ~field_name:expected_field_annot + ~default_accessor:default_car_annot >>=? fun (annot, field_annot) -> - let annot = default_annot annot ~default:a_annot in - 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 () -> typed ctxt loc Car (Item_t (a, rest, annot)) | Prim (loc, I_CDR, [], annot), Item_t (Pair_t (_, (b, expected_field_annot, b_annot), _), rest, pair_annot) -> - parse_var_field_annot loc annot - ~if_special_var:(field_to_var_annot expected_field_annot) + parse_destr_annot loc annot + ~pair_annot + ~value_annot:b_annot + ~field_name:expected_field_annot + ~default_accessor:default_cdr_annot >>=? fun (annot, field_annot) -> - let annot = default_annot annot ~default:b_annot in - 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 () -> typed ctxt loc Cdr (Item_t (b, rest, annot)) (* unions *)