Restore a similar behavior to [legacy_immediate]

(so that we can allow `type t : value` and `type t : immediate`
even in layouts stable)

ocaml/parsing/builtin_attributes.mli

@@ -182,36 +182,8 @@ type jkind_attribute =
 val jkind_attribute_to_string : jkind_attribute -> string
 val jkind_attribute_of_string : string -> jkind_attribute option
 
-(* CR nroberts: comment surgery *)
-(* [jkind] gets the jkind in the attributes if one is present.  We always
-   allow the [value] annotation, even if the layouts extensions are disabled.
-   If [~legacy_immediate] is true, we allow [immediate] and [immediate64]
-   attributes even if the layouts extensions are disabled - this is used to
-   support the original immediacy attributes, which are now implemented in terms
-   of jkinds.
-
-   The return value is [Error <jkind>] if a jkind attribute is present but
-   not allowed by the current set of extensions.  Otherwise it is [Ok None] if
-   there is no jkind annotation and [Ok (Some jkind)] if there is one.
-
-   - If no layout extensions are on and [~legacy_immediate] is false, this will
-     always return [Ok None], [Ok (Some Value)], or [Error ...].
-   - If no layout extensions are on and [~legacy_immediate] is true, this will
-     error on [void], [float64], or [any], but allow [immediate], [immediate64],
-     and [value].
-   - If the [Layouts_beta] extension is on, this behaves like the previous case
-     regardless of the value of [~legacy_immediate], except that it allows
-     [float64] and [any].
-   - If the [Layouts_alpha] extension is on, this can return any jkind and
-     never errors.
-
-   Currently, the [Layouts] extension is ignored - it's no different than
-   turning on no layout extensions.
-
-   This is not the only place the layouts extension level is checked.  If you're
-   changing what's allowed in a given level, you may also need to make changes
-   in the parser, Jkind.get_required_layouts_level, and Typeopt.
+(* [jkind] gets the first jkind in the attributes if one is present.  All such
+   attributes can be provided even in the absence of the layouts extension
+   as the attribute mechanism predates layouts.
 *)
-(* CR layouts: we should eventually be able to delete ~legacy_immediate (after we
-   turn on layouts by default). *)
 val jkind : Parsetree.attributes -> jkind_attribute Location.loc option

ocaml/testsuite/tests/typing-layouts/user_errors.ml

@@ -0,0 +1,65 @@
+(* TEST
+   flags = "-extension layouts_alpha"
+   * expect
+*)
+
+(* This test makes sure that [type t : unboxed = manifest] doesn't get
+   (incorrectly) interpreted as [type t = manifest [@@unboxed]].
+ *)
+
+type t : unboxed = { single_field : string }
+
+[%%expect{|
+Line 1, characters 9-16:
+1 | type t : unboxed = { single_field : string }
+             ^^^^^^^
+Error: Unknown layout unboxed
+|}]
+
+(* The below tests make sure that a layout is given only as an
+   attribute or as an annotation, but not both, regardless
+   of whether the two sources match.
+ *)
+
+(* the two sources match *)
+type t : immediate = int [@@immediate]
+
+[%%expect{|
+Line 1, characters 0-38:
+1 | type t : immediate = int [@@immediate]
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: A type declaration's layout can be given at most once.
+       This declaration has an layout annotation (immediate) and a layout attribute ([@@immediate]).
+|}]
+
+(* the two sources don't match, but either is correct *)
+type t : immediate64 = int [@@immediate]
+
+[%%expect{|
+Line 1, characters 0-40:
+1 | type t : immediate64 = int [@@immediate]
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: A type declaration's layout can be given at most once.
+       This declaration has an layout annotation (immediate64) and a layout attribute ([@@immediate]).
+|}]
+
+(* the two sources don't match, and one or the other is incorrect *)
+type t : void = int [@@immediate]
+
+[%%expect{|
+Line 1, characters 0-33:
+1 | type t : void = int [@@immediate]
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: A type declaration's layout can be given at most once.
+       This declaration has an layout annotation (void) and a layout attribute ([@@immediate]).
+|}]
+
+type t : void = string [@@immediate]
+
+[%%expect{|
+Line 1, characters 0-36:
+1 | type t : void = string [@@immediate]
+    ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: A type declaration's layout can be given at most once.
+       This declaration has an layout annotation (void) and a layout attribute ([@@immediate]).
+|}]

ocaml/typing/jkind.ml

@@ -516,18 +516,31 @@ let sub_const (c1 : const) (c2 : const) =
 (******************************)
 (*** user errors ***)
 type error =
-  | Insufficient_level of annotation_context * const
+  | Insufficient_level of
+      { jkind : const;
+        required_layouts_level : Language_extension.maturity
+      }
   | Unknown_jkind of Jane_asttypes.const_jkind
 
 exception User_error of Location.t * error
 
 let raise ~loc err = raise (User_error (loc, err))
 
 (*** extension requirements ***)
-let get_required_layouts_level (context : annotation_context) (jkind : const) :
-    Language_extension.maturity =
+
+(* The need for [is_type_decl] comes from the fact that we want to allow
+   [type t : immediate] and [type t : immediate64] if *any* layouts extension
+   is enabled, because these are exactly equivalent to the pre-existing
+   and well-loved [@@immediate] and [@@immediate64] attributes.
+
+   Once immediate/immediate64 graduate from Beta to Stable, we can likely
+   delete the [is_type_decl] parameter.
+*)
+let get_required_layouts_level (context : annotation_context) (jkind : const)
+    ~is_type_decl : Language_extension.maturity =
   match context, jkind with
   | _, Value -> Stable
+  | _, (Immediate | Immediate64) when is_type_decl -> Stable
   | _, (Immediate | Immediate64 | Any | Float64) -> Beta
   | _, Void -> Alpha
 
@@ -550,46 +563,44 @@ let of_const ~why : const -> t = function
   | Void -> fresh_jkind (Sort Sort.void) ~why
   | Float64 -> fresh_jkind (Sort Sort.float64) ~why
 
-let const_of_user_written_annotation ?(legacy_immediate = false) ~context
+let const_of_user_written_annotation ~context ~is_type_decl
     Location.{ loc; txt = annot } =
   match Const.of_user_written_annotation_unchecked annot with
   | None -> raise ~loc (Unknown_jkind annot)
-  | Some ((Immediate | Immediate64 | Value) as const) when legacy_immediate ->
-    const
   | Some const ->
-    let required_layouts_level = get_required_layouts_level context const in
+    let required_layouts_level =
+      get_required_layouts_level context const ~is_type_decl
+    in
     if not (Language_extension.is_at_least Layouts required_layouts_level)
-    then raise ~loc (Insufficient_level (context, const));
+    then
+      raise ~loc (Insufficient_level { jkind = const; required_layouts_level });
     const
 
 let const_to_user_written_annotation = Const.to_user_written_annotation
 
 let of_annotated_const ~context Location.{ txt = const; loc = const_loc } =
   of_const ~why:(Annotated (context, const_loc)) const
 
-let of_annotation ?legacy_immediate ~context (annot : _ Location.loc) =
-  let const =
-    const_of_user_written_annotation ?legacy_immediate ~context annot
-  in
+let of_annotation ~context ~is_type_decl (annot : _ Location.loc) =
+  let const = const_of_user_written_annotation ~is_type_decl ~context annot in
   let jkind = of_annotated_const { txt = const; loc = annot.loc } ~context in
   jkind, const
 
-let of_annotation_option_default ?legacy_immediate ~default ~context =
+let of_annotation_option_default ~default ~context ~is_type_decl =
   Option.fold ~none:(default, None) ~some:(fun annot ->
-      let t, annot = of_annotation ?legacy_immediate ~context annot in
+      let t, annot = of_annotation ~context ~is_type_decl annot in
       t, Some annot)
 
 let of_attribute ~context
     (attribute : Builtin_attributes.jkind_attribute Location.loc) =
   let const = Const.of_attribute attribute.txt in
   of_annotated_const ~context { txt = const; loc = attribute.loc }, const
 
-let of_type_decl ~legacy_immediate ~context (decl : Parsetree.type_declaration)
-    =
+let of_type_decl ~context (decl : Parsetree.type_declaration) =
   let jkind_of_annotation =
     Jane_syntax.Layouts.of_type_declaration decl
     |> Option.map (fun (annot, attrs) ->
-           let t, const = of_annotation ~legacy_immediate ~context annot in
+           let t, const = of_annotation ~context ~is_type_decl:true annot in
            t, const, attrs)
   in
   let jkind_of_attribute =
@@ -601,11 +612,10 @@ let of_type_decl ~legacy_immediate ~context (decl : Parsetree.type_declaration)
   match jkind_of_annotation, jkind_of_attribute with
   | None, None -> None
   | (Some _ as x), None | None, (Some _ as x) -> x
-  | Some _, Some _ -> assert false (* CR nroberts *)
+  | Some (_, from_annotation, _), Some (_, from_attribute, _) -> assert false
 
-let of_type_decl_default ~legacy_immediate ~context ~default
-    (decl : Parsetree.type_declaration) =
-  match of_type_decl ~legacy_immediate ~context decl with
+let of_type_decl_default ~context ~default (decl : Parsetree.type_declaration) =
+  match of_type_decl ~context decl with
   | Some (t, const, attrs) -> t, Some const, attrs
   | None -> default, None, decl.ptype_attributes
 
@@ -1333,8 +1343,7 @@ let report_error ~loc = function
          When RAE tried this, some types got printed like [t/2], but the
          [/2] shouldn't be there. Investigate and fix. *)
       "@[<v>Unknown layout %a@]" Jane_syntax.Layouts.Pprint.const_jkind jkind
-  | Insufficient_level (context, jkind) -> (
-    let required_layouts_level = get_required_layouts_level context jkind in
+  | Insufficient_level { jkind; required_layouts_level } -> (
     let hint ppf =
       Format.fprintf ppf "You must enable -extension %s to use this feature."
         (Language_extension.to_command_line_string Layouts
@@ -1357,3 +1366,14 @@ let () =
   Location.register_error_of_exn (function
     | User_error (loc, err) -> Some (report_error ~loc err)
     | _ -> None)
+
+(* Drop [is_type_decl] from external API *)
+
+let const_of_user_written_annotation ~context t : const =
+  const_of_user_written_annotation ~context ~is_type_decl:false t
+
+let of_annotation ~context t : _ * _ =
+  of_annotation ~is_type_decl:false ~context t
+
+let of_annotation_option_default ~default ~context t : _ * _ =
+  of_annotation_option_default ~default ~context ~is_type_decl:false t

ocaml/typing/jkind.mli

@@ -330,10 +330,7 @@ type const =
 type 'a loc := 'a Location.loc
 
 val const_of_user_written_annotation :
-  ?legacy_immediate:bool ->
-  context:annotation_context ->
-  Jane_asttypes.const_jkind loc ->
-  const
+  context:annotation_context -> Jane_asttypes.const_jkind loc -> const
 
 val const_to_user_written_annotation : const -> Jane_asttypes.const_jkind
 
@@ -379,37 +376,39 @@ val of_sort_for_error : why:concrete_jkind_reason -> sort -> t
 
 val of_const : why:creation_reason -> const -> t
 
-(* CR layouts v1.5: remove legacy_immediate when the old attributes mechanism
-   is rerouted away from the new annotations mechanism *)
 val of_annotation :
-  ?legacy_immediate:bool ->
-  context:annotation_context ->
-  Jane_asttypes.jkind_annotation ->
-  t * const
+  context:annotation_context -> Jane_asttypes.jkind_annotation -> t * const
 
 val of_annotation_option_default :
-  ?legacy_immediate:bool ->
   default:t ->
   context:annotation_context ->
   Jane_asttypes.jkind_annotation option ->
   t * const option
 
-(* CR nroberts: documentation, here and below *)
+(** Find a jkind from a type declaration. Type declarations are special because
+    the jkind may have been provided via [: jkind] syntax (which goes through
+    Jane Syntax) or via the old-style [[@@immediate]] or [[@@immediate64]]
+    attributes, and [of_type_decl] needs to look in two different places on the
+    [type_declaration] to account for these two alternatives.
+
+    Returns the jkind, the user-written annotation, and the remaining unconsumed
+    attributes. (The attributes include old-style [[@@immediate]] or
+    [[@@immediate64]] attributes if those are present, but excludes any
+    attribute used by Jane Syntax to encode a [: jkind]-style jkind.)
 
-(** Find a jkind in attributes.  Returns error if a disallowed jkind is
-    present, but always allows immediate attributes if ~legacy_immediate is
-    true.  See comment on [Builtin_attributes.jkind].  *)
+    Raises if a disallowed or unknown jkind is present.
+*)
 val of_type_decl :
-  legacy_immediate:bool ->
   context:annotation_context ->
   Parsetree.type_declaration ->
   (t * const * Parsetree.attributes) option
 
-(** Find a jkind in attributes, defaulting to ~default.  Returns error if a
-    disallowed jkind is present, but always allows immediate if
-    ~legacy_immediate is true.  See comment on [Builtin_attributes.jkind]. *)
+(** Find a jkind from a type declaration in the same way as [of_type_decl],
+    defaulting to ~default.
+
+    Raises if a disallowed or unknown jkind is present.
+*)
 val of_type_decl_default :
-  legacy_immediate:bool ->
   context:annotation_context ->
   default:t ->
   Parsetree.type_declaration ->

ocaml/typing/typedecl.ml

@@ -190,10 +190,8 @@ let enter_type ?abstract_abbrevs rec_flag env sdecl (id, uid) =
      are checked and then unified with the real manifest and checked against the
      kind. *)
   let type_jkind, type_jkind_annotation, sdecl_attributes =
-    (* We set ~legacy_immediate to true because we're looking at a declaration
-       that was already allowed to be [@@immediate] *)
     Jkind.of_type_decl_default
-      ~legacy_immediate:true ~context:(Type_declaration path)
+      ~context:(Type_declaration path)
       ~default:(Jkind.any ~why:Initial_typedecl_env)
       sdecl
   in
@@ -633,12 +631,7 @@ let transl_declaration env sdecl (id, uid) =
   in
   verify_unboxed_attr unboxed_attr sdecl;
   let jkind_from_annotation, jkind_annotation, sdecl_attributes =
-    (* We set legacy_immediate to true because you were already allowed to write
-       [@@immediate] on declarations.  *)
-    match
-      Jkind.of_type_decl
-        ~legacy_immediate:true ~context:(Type_declaration path) sdecl
-    with
+    match Jkind.of_type_decl ~context:(Type_declaration path) sdecl with
     | Some (jkind, jkind_annotation, sdecl_attributes) ->
         Some jkind, Some jkind_annotation, sdecl_attributes
     | None -> None, None, sdecl.ptype_attributes
@@ -2326,9 +2319,7 @@ let approx_type_decl sdecl_list =
        let path = Path.Pident id in
        let injective = sdecl.ptype_kind <> Ptype_abstract in
        let jkind, jkind_annotation, _sdecl_attributes =
-         (* We set legacy_immediate to true because you were already allowed
-            to write [@@immediate] on declarations. *)
-         Jkind.of_type_decl_default ~legacy_immediate:true
+         Jkind.of_type_decl_default
            ~context:(Type_declaration path)
            ~default:(Jkind.value ~why:Default_type_jkind)
            sdecl