diff --git a/.depend b/.depend index fd18b7737..312caa339 100644 --- a/.depend +++ b/.depend @@ -350,16 +350,16 @@ typing/typedecl.cmo : utils/warnings.cmi typing/typetexp.cmi \ typing/predef.cmi typing/path.cmi parsing/parsetree.cmi utils/misc.cmi \ parsing/longident.cmi parsing/location.cmi typing/includecore.cmi \ typing/ident.cmi typing/env.cmi typing/ctype.cmi utils/config.cmi \ - utils/clflags.cmi typing/btype.cmi parsing/asttypes.cmi \ - parsing/ast_helper.cmi typing/typedecl.cmi + utils/clflags.cmi typing/btype.cmi parsing/attr_helper.cmi \ + parsing/asttypes.cmi parsing/ast_helper.cmi typing/typedecl.cmi typing/typedecl.cmx : utils/warnings.cmx typing/typetexp.cmx \ typing/types.cmx typing/typedtree.cmx parsing/syntaxerr.cmx \ typing/subst.cmx typing/printtyp.cmx typing/primitive.cmx \ typing/predef.cmx typing/path.cmx parsing/parsetree.cmi utils/misc.cmx \ parsing/longident.cmx parsing/location.cmx typing/includecore.cmx \ typing/ident.cmx typing/env.cmx typing/ctype.cmx utils/config.cmx \ - utils/clflags.cmx typing/btype.cmx parsing/asttypes.cmi \ - parsing/ast_helper.cmx typing/typedecl.cmi + utils/clflags.cmx typing/btype.cmx parsing/attr_helper.cmx \ + parsing/asttypes.cmi parsing/ast_helper.cmx typing/typedecl.cmi typing/typedtreeIter.cmo : typing/typedtree.cmi utils/misc.cmi \ parsing/asttypes.cmi typing/typedtreeIter.cmi typing/typedtreeIter.cmx : typing/typedtree.cmx utils/misc.cmx \ diff --git a/typing/typedecl.ml b/typing/typedecl.ml index 5e931881e..1024b8cf6 100644 --- a/typing/typedecl.ml +++ b/typing/typedecl.ml @@ -21,10 +21,6 @@ open Typetexp type native_repr_kind = Unboxed | Untagged -let string_of_native_repr_kind = function - | Unboxed -> "unboxed" - | Untagged -> "untagged" - type error = Repeated_parameter | Duplicate_constructor of string @@ -52,7 +48,6 @@ type error = | Unbound_type_var_ext of type_expr * extension_constructor | Varying_anonymous | Val_in_structure - | Invalid_native_repr_attribute_payload of native_repr_kind | Multiple_native_repr_attributes | Cannot_unbox_or_untag_type of native_repr_kind @@ -1367,25 +1362,16 @@ type native_repr_attribute = let get_native_repr_attribute core_type = match - List.filter - (fun (n, _) -> - match n.Location.txt with - | "unboxed" | "untagged" -> true - | _ -> false) - core_type.ptyp_attributes + let attrs = core_type.ptyp_attributes in + Attr_helper.get_no_payload_attribute "unboxed" attrs, + Attr_helper.get_no_payload_attribute "untagged" attrs with - | [] -> + | None, None -> Native_repr_attr_absent - | _ :: (n, _) :: _ -> - raise (Error (n.Location.loc, Multiple_native_repr_attributes)) - | [(n, payload)] -> - let kind = if n.txt = "unboxed" then Unboxed else Untagged in - match payload with - | PStr [] -> - Native_repr_attr_present kind - | _ -> - raise (Error (n.Location.loc, - Invalid_native_repr_attribute_payload kind)) + | Some _, None -> Native_repr_attr_present Unboxed + | None, Some _ -> Native_repr_attr_present Untagged + | Some { Location.loc }, _ -> + raise (Error (loc, Multiple_native_repr_attributes)) let native_repr_of_type env kind ty = match kind, (Ctype.expand_head_opt env ty).desc with @@ -1791,9 +1777,6 @@ let report_error ppf = function "cannot be checked" | Val_in_structure -> fprintf ppf "Value declarations are only allowed in signatures" - | Invalid_native_repr_attribute_payload kind -> - fprintf ppf "[@@%s] attribute does not accept a payload" - (string_of_native_repr_kind kind) | Multiple_native_repr_attributes -> fprintf ppf "Too many [@@unboxed]/[@@untagged] attributes" | Cannot_unbox_or_untag_type Unboxed -> diff --git a/typing/typedecl.mli b/typing/typedecl.mli index 7f3b96c20..7b0bdb6b6 100644 --- a/typing/typedecl.mli +++ b/typing/typedecl.mli @@ -85,7 +85,6 @@ type error = | Unbound_type_var_ext of type_expr * extension_constructor | Varying_anonymous | Val_in_structure - | Invalid_native_repr_attribute_payload of native_repr_kind | Multiple_native_repr_attributes | Cannot_unbox_or_untag_type of native_repr_kind