oxcaml
diff --git a/‎chamelon/compat.jst.ml
Lines changed: 1 addition & 1 deletion b/‎chamelon/compat.jst.ml
Lines changed: 1 addition & 1 deletion
diff --git a/‎ocaml/lambda/matching.ml
Lines changed: 1 addition & 1 deletion b/‎ocaml/lambda/matching.ml
Lines changed: 1 addition & 1 deletion
diff --git a/‎ocaml/parsing/builtin_attributes.ml
Lines changed: 20 additions & 0 deletions b/‎ocaml/parsing/builtin_attributes.ml
Lines changed: 20 additions & 0 deletions
diff --git a/‎ocaml/parsing/builtin_attributes.mli
Lines changed: 21 additions & 0 deletions b/‎ocaml/parsing/builtin_attributes.mli
Lines changed: 21 additions & 0 deletions
diff --git a/‎ocaml/parsing/location.ml
Lines changed: 6 additions & 2 deletions b/‎ocaml/parsing/location.ml
Lines changed: 6 additions & 2 deletions
diff --git a/‎ocaml/parsing/location.mli
Lines changed: 1 addition & 0 deletions b/‎ocaml/parsing/location.mli
Lines changed: 1 addition & 0 deletions
diff --git a/‎ocaml/testsuite/tests/typing-immediate/immediate.ml
Lines changed: 50 additions & 8 deletions b/‎ocaml/testsuite/tests/typing-immediate/immediate.ml
Lines changed: 50 additions & 8 deletions
diff --git a/‎ocaml/testsuite/tests/typing-layouts-err-msg/a.ml
Lines changed: 5 additions & 0 deletions b/‎ocaml/testsuite/tests/typing-layouts-err-msg/a.ml
Lines changed: 5 additions & 0 deletions
diff --git a/‎ocaml/testsuite/tests/typing-layouts-err-msg/annots.ml
Lines changed: 111 additions & 0 deletions b/‎ocaml/testsuite/tests/typing-layouts-err-msg/annots.ml
Lines changed: 111 additions & 0 deletions
diff --git a/‎ocaml/testsuite/tests/typing-layouts-err-msg/any.ml
Lines changed: 25 additions & 0 deletions b/‎ocaml/testsuite/tests/typing-layouts-err-msg/any.ml
Lines changed: 25 additions & 0 deletions
@@ -2,7 +2,7 @@ open Typedtree
 open Types
 open Mode
 
-let dummy_jkind = Jkind.value ~why:Type_argument
+let dummy_jkind = Jkind.value ~why:(Unknown "dummy_layout")
 let dummy_value_mode = Value.legacy
 let mkTvar name = Tvar { name; jkind = dummy_jkind }
 
 
@@ -4101,7 +4101,7 @@ let report_error ppf = function
       fprintf ppf
         "Non-value detected in translation:@ Please report this error to \
          the Jane Street compilers team.@ %a"
-        (Jkind.Violation.report_with_name ~name:"This expression") err
+        (Jkind.Violation.report_with_name ~name:"this expression") err
   | Illegal_record_field c ->
       fprintf ppf
         "Sort %s detected where value was expected in a record field:@ Please \
 
@@ -102,10 +102,15 @@ let builtin_attrs =
   ; "loop"; "ocaml.loop"
   ; "tail_mod_cons"; "ocaml.tail_mod_cons"
   ; "unaliasable"; "ocaml.unaliasable"
+<<<<<<< HEAD
   ; "builtin"; "ocaml.builtin"
   ; "no_effects"; "ocaml.no_effects"
   ; "no_coeffects"; "ocaml.no_coeffects"
   ; "only_generative_effects"; "ocaml.only_generative_effects";
+||||||| parent of 114ab8b0 (Enable layout histories (#1823))
+=======
+  ; "error_message"; "ocaml.error_message"
+>>>>>>> 114ab8b0 (Enable layout histories (#1823))
   ]
 
 (* nroberts: When we upstream the builtin-attribute whitelisting, we shouldn't
@@ -696,3 +701,18 @@ let tailcall attr =
           (Warnings.Attribute_payload
              (t.attr_name.txt, "Only 'hint' is supported"));
         Ok (Some `Tail_if_possible)
+
+let error_message_attr l =
+  let inner x =
+    match x.attr_name.txt with
+    | "ocaml.error_message"|"error_message" ->
+      begin match string_of_payload x.attr_payload with
+      | Some _ as r ->
+        mark_used x.attr_name;
+        r
+      | None -> warn_payload x.attr_loc x.attr_name.txt
+                  "error_message attribute expects a string argument";
+        None
+      end
+    | _ -> None in
+  List.find_map inner l
@@ -192,6 +192,7 @@ val has_once : Parsetree.attributes -> (bool, unit) result
     [unique_], and [once_] mode annotation attributes from let-bindings to both
     the let-bound expression and its pattern.
 *)
+<<<<<<< HEAD
 val mode_annotation_attributes_filter : Attributes_filter.t
 
 (* CR layouts v1.5: Remove everything except for [Immediate64] and [Immediate]
@@ -208,3 +209,23 @@ val jkind_attribute_of_string : string -> jkind_attribute option
    as the attribute mechanism predates layouts.
 *)
 val jkind : Parsetree.attributes -> jkind_attribute Location.loc option
+||||||| parent of 114ab8b0 (Enable layout histories (#1823))
+(* CR layouts: we should eventually be able to delete ~legacy_immediate (after we
+   turn on layouts by default). *)
+val jkind : legacy_immediate:bool -> Parsetree.attributes ->
+  (Jane_asttypes.jkind_annotation option,
+   Jane_asttypes.jkind_annotation) result
+=======
+(* CR layouts: we should eventually be able to delete ~legacy_immediate (after we
+   turn on layouts by default). *)
+val jkind : legacy_immediate:bool -> Parsetree.attributes ->
+  (Jane_asttypes.jkind_annotation option,
+   Jane_asttypes.jkind_annotation) result
+
+(** Finds the first "error_message" attribute, marks it as used, and returns its
+    string payload. Returns [None] if no such attribute is present.
+
+    There should be at most one "error_message" attribute, additional ones are sliently
+    ignored. **)
+val error_message_attr : Parsetree.attributes -> string option
+>>>>>>> 114ab8b0 (Enable layout histories (#1823))
@@ -261,7 +261,7 @@ let print_filename ppf file =
    Some of the information (filename, line number or characters numbers) in the
    location might be invalid; in which case we do not print it.
  *)
-let print_loc ppf loc =
+let print_loc ~capitalize_first ppf loc =
   setup_colors ();
   let file_valid = function
     | "_none_" ->
@@ -287,7 +287,8 @@ let print_loc ppf loc =
 
   let first = ref true in
   let capitalize s =
-    if !first then (first := false; String.capitalize_ascii s)
+    if !first then (first := false;
+                    if capitalize_first then String.capitalize_ascii s else s)
     else s in
   let comma () =
     if !first then () else Format.fprintf ppf ", " in
@@ -316,6 +317,9 @@ let print_loc ppf loc =
 
   Format.fprintf ppf "@}"
 
+let print_loc_in_lowercase = print_loc ~capitalize_first:false
+let print_loc = print_loc ~capitalize_first:true
+
 (* Print a comma-separated list of locations *)
 let print_locs ppf locs =
   Format.pp_print_list ~pp_sep:(fun ppf () -> Format.fprintf ppf ",@ ")
 
@@ -202,6 +202,7 @@ val show_filename: string -> string
 val print_filename: formatter -> string -> unit
 
 val print_loc: formatter -> t -> unit
+val print_loc_in_lowercase: formatter -> t -> unit
 val print_locs: formatter -> t list -> unit
 
 
 
@@ -143,8 +143,14 @@ end;;
 Line 2, characters 2-31:
 2 |   type t = string [@@immediate]
       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Type string has layout value, which is not a sublayout of immediate.
+Error: The layout of type string is value, because
+         it is the primitive value type string.
+       But the layout of type string must be a sublayout of immediate, because
+         of the definition of t at line 2, characters 2-31.
 |}];;
+(* CR layouts v2.9: The "of the definition of t ..." part is not great and it
+   should only refer to definitions that type check. Fixing it will involve
+   building a second [final_env] in [transl_type_decl] which is costly.  *)
 
 (* Cannot directly declare a non-immediate type as immediate (variant) *)
 module B = struct
@@ -154,7 +160,10 @@ end;;
 Line 2, characters 2-41:
 2 |   type t = Foo of int | Bar [@@immediate]
       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Type t has layout value, which is not a sublayout of immediate.
+Error: The layout of type t is value, because
+         it's a boxed variant type.
+       But the layout of type t must be a sublayout of immediate, because
+         of the annotation on the declaration of the type t.
 |}];;
 
 (* Cannot directly declare a non-immediate type as immediate (record) *)
@@ -165,8 +174,13 @@ end;;
 Line 2, characters 2-38:
 2 |   type t = { foo : int } [@@immediate]
       ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Type t has layout value, which is not a sublayout of immediate.
+Error: The layout of type t is value, because
+         it's a boxed record type.
+       But the layout of type t must be a sublayout of immediate, because
+         of the annotation on the declaration of the type t/2.
 |}];;
+(* CR layouts v2.9: Investigate why the "/2" is here and check if it's only limited
+   to expect tests. *)
 
 (* Not guaranteed that t is immediate, so this is an invalid declaration *)
 module C = struct
@@ -177,7 +191,10 @@ end;;
 Line 3, characters 2-26:
 3 |   type s = t [@@immediate]
       ^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Type t has layout value, which is not a sublayout of immediate.
+Error: The layout of type t is value, because
+         of the definition of t at line 2, characters 2-8.
+       But the layout of type t must be a sublayout of immediate, because
+         of the definition of s at line 3, characters 2-26.
 |}];;
 
 (* Can't ascribe to an immediate type signature with a non-immediate type *)
@@ -198,12 +215,14 @@ Error: Signature mismatch:
          type t = string
        is not included in
          type t : immediate
-       the first has layout value, which is not a sublayout of immediate.
+       The layout of the first is value, because
+         it is the primitive value type string.
+       But the layout of the first must be a sublayout of immediate, because
+         of the definition of t at line 1, characters 15-35.
 |}];;
 
 (* Same as above but with explicit signature *)
 module M_invalid : S = struct type t = string end;;
-module FM_invalid = F (struct type t = string end);;
 [%%expect{|
 Line 1, characters 23-49:
 1 | module M_invalid : S = struct type t = string end;;
@@ -214,7 +233,27 @@ Error: Signature mismatch:
          type t = string
        is not included in
          type t : immediate
-       the first has layout value, which is not a sublayout of immediate.
+       The layout of the first is value, because
+         it is the primitive value type string.
+       But the layout of the first must be a sublayout of immediate, because
+         of the definition of t at line 1, characters 20-40.
+|}];;
+
+module FM_invalid = F (struct type t = string end);;
+[%%expect{|
+Line 1, characters 20-50:
+1 | module FM_invalid = F (struct type t = string end);;
+                        ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
+Error: Modules do not match: sig type t = string end is not included in
+       S
+     Type declarations do not match:
+       type t = string
+     is not included in
+       type t : immediate
+     The layout of the first is value, because
+       it is the primitive value type string.
+     But the layout of the first must be a sublayout of immediate, because
+       of the definition of t at line 1, characters 20-40.
 |}];;
 
 (* Can't use a non-immediate type even if mutually recursive *)
@@ -226,7 +265,10 @@ end;;
 Line 2, characters 2-26:
 2 |   type t = s [@@immediate]
       ^^^^^^^^^^^^^^^^^^^^^^^^
-Error: Type s has layout value, which is not a sublayout of immediate.
+Error: The layout of type s is value, because
+         it is the primitive value type string.
+       But the layout of type s must be a sublayout of immediate, because
+         of the definition of t at line 2, characters 2-26.
 |}];;
 
 
 
@@ -0,0 +1,5 @@
+type 'a t = 'a
+type ('a ,'b) t2 = 'a
+type ('a ,'b,'c,'d,'e) t5 = 'a
+let f x = x + 1
+let f2 x = x
@@ -0,0 +1,111 @@
+(* TEST
+   flags = "-extension layouts_alpha"
+   * expect
+*)
+
+(*********************)
+(* Annotation errors *)
+
+type ('a : value) value = unit
+
+(* Type_declaration *)
+type t_void : void
+and t = t_void value
+
+[%%expect{|
+type 'a value = unit
+Line 5, characters 8-14:
+5 | and t = t_void value
+            ^^^^^^
+Error: This type t_void = ('a : void) should be an instance of type
+         ('b : value)
+       The layout of t_void is void, because
+         of the annotation on the declaration of the type t_void.
+       But the layout of t_void must overlap with value, because
+         of the definition of value at line 1, characters 0-30.
+|}]
+
+(* Type_parameter *)
+type ('a : void) t = 'a value
+
+[%%expect{|
+Line 1, characters 21-23:
+1 | type ('a : void) t = 'a value
+                         ^^
+Error: This type ('a : value) should be an instance of type ('a0 : void)
+       The layout of 'a is void, because
+         of the annotation on 'a in the declaration of the type t.
+       But the layout of 'a must overlap with value, because
+         of the definition of value at line 1, characters 0-30.
+|}]
+
+(* Newtype_declaration *)
+let f (type a : void) (x: a value) = x
+
+[%%expect{|
+Line 1, characters 26-27:
+1 | let f (type a : void) (x: a value) = x
+                              ^
+Error: This type a should be an instance of type ('a : value)
+       The layout of a is void, because
+         of the annotation on the abstract type declaration for a.
+       But the layout of a must be a sublayout of value, because
+         of the definition of value at line 1, characters 0-30.
+|}]
+
+(* Constructor_type_parameter *)
+type _ g = A : ('a: void) . 'a value -> unit g
+
+[%%expect{|
+Line 1, characters 28-30:
+1 | type _ g = A : ('a: void) . 'a value -> unit g
+                                ^^
+Error: This type ('a : void) should be an instance of type ('b : value)
+       The layout of 'a is void, because
+         of the annotation on a in the declaration of constructor A.
+       But the layout of 'a must overlap with value, because
+         of the definition of value at line 1, characters 0-30.
+|}]
+
+(* Univar *)
+let f : ('a : void). 'a -> 'a value = assert false
+
+[%%expect{|
+Line 1, characters 27-29:
+1 | let f : ('a : void). 'a -> 'a value = assert false
+                               ^^
+Error: This type ('a : void) should be an instance of type ('b : value)
+       The layout of 'a is void, because
+         of the annotation on the universal variable 'a.
+       But the layout of 'a must overlap with value, because
+         of the definition of value at line 1, characters 0-30.
+|}]
+
+(* Type_variable *)
+type t = 'a -> int as ('b : void)
+
+[%%expect{|
+Line 1, characters 9-33:
+1 | type t = 'a -> int as ('b : void)
+             ^^^^^^^^^^^^^^^^^^^^^^^^
+Error: This alias is bound to type 'a -> int
+       but is used as an instance of type ('b : void)
+       The layout of 'a -> int is value, because
+         it's a function type.
+       But the layout of 'a -> int must be a sublayout of void, because
+         of the annotation on the type variable 'b.
+|}]
+
+(* Type_wildcard *)
+type t = 'a -> int as (_ : void)
+
+[%%expect{|
+Line 1, characters 27-31:
+1 | type t = 'a -> int as (_ : void)
+                               ^^^^
+Error: Bad layout annotation:
+         The layout of 'a -> int is value, because
+           it's a function type.
+         But the layout of 'a -> int must be a sublayout of void, because
+           of the annotation on the wildcard _ at line 1, characters 27-31.
+|}]
@@ -0,0 +1,25 @@
+(* TEST
+   flags = "-extension layouts_alpha"
+   * expect
+*)
+
+(*********************)
+(* Any layout errors *)
+
+(* Missing_cmi *)
+(* See [any_missing_cmi.ml] *)
+
+(* Wildcard *)
+(* Unable to produce this error *)
+
+(* Unification_var *)
+(* Unable to produce this error *)
+
+(* Initial_typedecl_env *)
+(* Unable to produce this error *)
+
+(* Dummy_layout *)
+(* Unable to produce this error *)
+
+(* Type_expression_call *)
+(* Unable to produce this error *)