Merge compiler renaming changes

src/ocaml/parsing/language_extension.ml

@@ -152,6 +152,7 @@ module Exist_pair = struct
     | "layouts_beta" -> Some (Pair (Layouts, Beta))
     | "simd" -> Some (Pair (SIMD, Stable))
     | "simd_beta" -> Some (Pair (SIMD, Beta))
+    | "simd_alpha" -> Some (Pair (SIMD, Alpha))
     | "labeled_tuples" -> Some (Pair (Labeled_tuples, ()))
     | "small_numbers" -> Some (Pair (Small_numbers, Stable))
     | "small_numbers_beta" -> Some (Pair (Small_numbers, Beta))

src/ocaml/parsing/parsetree.mli

@@ -1214,7 +1214,7 @@ and module_expr_desc =
       (** [Foo(Param1)(Arg1(Param2)(Arg2)) [@jane.non_erasable.instances]]
 
           The name of an instance module. Gets converted to [Global.Name.t] in
-          the flambda-backend compiler. *)
+          the OxCaml compiler. *)
 
 and module_instance =
   { pmod_instance_head : string;

src/ocaml/typing/cms_format.ml

@@ -17,6 +17,8 @@
 
 (** cms and cmsi files format. *)
 
+module Uid = Shape.Uid
+
 let read_magic_number ic =
   let len_magic_number = String.length Config.cms_magic_number in
   really_input_string ic len_magic_number
@@ -32,7 +34,9 @@ type cms_infos = {
   cms_uid_to_attributes : Parsetree.attributes Shape.Uid.Tbl.t;
   cms_impl_shape : Shape.t option; (* None for mli *)
   cms_ident_occurrences :
-    (Longident.t Location.loc * Shape_reduce.result) array
+    (Longident.t Location.loc * Shape_reduce.result) array;
+  cms_declaration_dependencies :
+    (Cmt_format.dependency_kind * Uid.t * Uid.t) list;
 }
 
 type error =
@@ -94,7 +98,8 @@ let uid_tables_of_binary_annots binary_annots =
     );
   cms_uid_to_loc, cms_uid_to_attributes
 
-let save_cms target modname binary_annots initial_env shape =
+let save_cms target modname binary_annots initial_env shape
+  cms_declaration_dependencies =
   if (!Clflags.binary_annotations_cms && not !Clflags.print_types) then begin
     Misc.output_to_file_via_temporary
        ~mode:[Open_binary] (Unit_info.Artifact.filename target)
@@ -116,28 +121,22 @@ let save_cms target modname binary_annots initial_env shape =
          in
          let cms = {
            cms_modname = modname;
-           cms_comments = [];
               (* XXX merlin: upstream does
-            cms_sourcefile = sourcefile;
-            cms_builddir = Location.rewrite_absolute_path (Sys.getcwd ());
-            cms_source_digest = source_digest;
-            cms_initial_env;
-            cms_uid_to_loc;
-            cms_uid_to_attributes;
-            cms_impl_shape = shape;
-                   `cms_comments = Lexer.comments ()`
+                 `cms_comments = Lexer.comments ()`
                  here.  But we don't seem to have the same lexer, so we can't
                  do that straightforwardly.  On the other hand, this function
                  should never be called by merlin, so it doesn't matter, right?
               *)
+           cms_comments = [];
            cms_sourcefile = sourcefile;
            cms_builddir = Location.rewrite_absolute_path (Sys.getcwd ());
            cms_source_digest = source_digest;
            cms_initial_env;
            cms_uid_to_loc;
            cms_uid_to_attributes;
            cms_impl_shape = shape;
-           cms_ident_occurrences
+           cms_ident_occurrences;
+           cms_declaration_dependencies;
          } in
          output_cms oc cms)
   end

src/ocaml/typing/cms_format.mli

@@ -17,6 +17,8 @@
 
 (** cms and cmsi files format. *)
 
+module Uid = Shape.Uid
+
 type cms_infos = {
   cms_modname : Compilation_unit.t;
   cms_comments : (string * Location.t) list;
@@ -28,7 +30,9 @@ type cms_infos = {
   cms_uid_to_attributes : Parsetree.attributes Shape.Uid.Tbl.t;
   cms_impl_shape : Shape.t option; (* None for mli *)
   cms_ident_occurrences :
-    (Longident.t Location.loc * Shape_reduce.result) array
+    (Longident.t Location.loc * Shape_reduce.result) array;
+  cms_declaration_dependencies :
+    (Cmt_format.dependency_kind * Uid.t * Uid.t) list;
 }
 
 type error =
@@ -49,6 +53,7 @@ val save_cms :
   Cmt_format.binary_annots ->
   Env.t -> (* initial env *)
   Shape.t option ->
+  (Cmt_format.dependency_kind * Uid.t * Uid.t) list ->
   unit
 
 val register_toplevel_attributes :

src/ocaml/typing/cmt_format.ml

@@ -61,11 +61,11 @@ and binary_part =
   | Partial_signature_item of signature_item
   | Partial_module_type of module_type
 
+type dependency_kind =  Definition_to_declaration | Declaration_to_declaration
 type cmt_infos = {
   cmt_modname : Compilation_unit.t;
   cmt_annots : binary_annots;
-  cmt_value_dependencies :
-    (Types.value_description * Types.value_description) list;
+  cmt_declaration_dependencies : (dependency_kind * Uid.t * Uid.t) list;
   cmt_comments : (string * Location.t) list;
   cmt_args : string array;
   cmt_sourcefile : string option;
@@ -467,21 +467,19 @@ let read_cmi filename =
     | Some cmi, _ -> cmi
 
 let saved_types = ref []
-let value_deps = ref []
+let uids_deps : (dependency_kind * Uid.t * Uid.t) list ref = ref []
 
 let clear () =
   saved_types := [];
-  value_deps := []
+  uids_deps := []
 
 let add_saved_type b = saved_types := b :: !saved_types
 let get_saved_types () = !saved_types
 let set_saved_types l = saved_types := l
 
-(*let record_value_dependency vd1 vd2 =
-  if vd1.Types.val_loc <> vd2.Types.val_loc then
-    value_deps := (vd1, vd2) :: !value_deps*)
-
-let record_value_dependency _vd1 _vd2 = ()
+let record_declaration_dependency (rk, uid1, uid2) =
+  if not (Uid.equal uid1 uid2) then
+    uids_deps := (rk, uid1, uid2) :: !uids_deps
 
 let save_cmt target cu binary_annots initial_env cmi shape =
   if !Clflags.binary_annotations && not !Clflags.print_types then begin
@@ -516,7 +514,7 @@ let save_cmt target cu binary_annots initial_env cmi shape =
          let cmt = {
            cmt_modname = cu;
            cmt_annots;
-           cmt_value_dependencies = !value_deps;
+           cmt_declaration_dependencies = !uids_deps;
            cmt_comments = [];
            cmt_args = Sys.argv;
            cmt_sourcefile = sourcefile;
@@ -535,3 +533,5 @@ let save_cmt target cu binary_annots initial_env cmi shape =
          output_cmt oc cmt)
   end;
   clear ()
+
+let get_declaration_dependencies () = !uids_deps

src/ocaml/typing/cmt_format.mli

@@ -48,11 +48,11 @@ and binary_part =
   | Partial_signature_item of signature_item
   | Partial_module_type of module_type
 
+type dependency_kind = Definition_to_declaration | Declaration_to_declaration
 type cmt_infos = {
   cmt_modname : Compilation_unit.t;
   cmt_annots : binary_annots;
-  cmt_value_dependencies :
-    (Types.value_description * Types.value_description) list;
+  cmt_declaration_dependencies : (dependency_kind * Uid.t * Uid.t) list;
   cmt_comments : (string * Location.t) list;
   cmt_args : string array;
   cmt_sourcefile : string option;
@@ -108,8 +108,7 @@ val add_saved_type : binary_part -> unit
 val get_saved_types : unit -> binary_part list
 val set_saved_types : binary_part list -> unit
 
-val record_value_dependency:
-  Types.value_description -> Types.value_description -> unit
+val record_declaration_dependency: dependency_kind * Uid.t * Uid.t -> unit
 
 val index_occurrences :
   binary_annots -> (Longident.t Location.loc * Shape_reduce.result) array
@@ -135,6 +134,9 @@ val need_to_clear_env : bool
 
 *)
 
+val get_declaration_dependencies :
+  unit -> (dependency_kind * Uid.t * Uid.t) list
+
 val iter_on_declarations :
   f:(Types.Uid.t -> item_declaration -> unit)
   -> Tast_iterator.iterator

src/ocaml/typing/ctype.ml

@@ -7231,8 +7231,31 @@ let check_decl_jkind env decl jkind =
      to expand only as much as needed, but the l/l subtype algorithm is tricky,
      and so we leave this optimization for later. *)
   let type_equal = type_equal env in
-  let jkind_of_type ty = Some (type_jkind_purely env ty) in
-  match Jkind.sub_jkind_l ~type_equal ~jkind_of_type decl.type_jkind jkind with
+  let type_jkind_purely = type_jkind_purely env in
+  let jkind_of_type ty = Some (type_jkind_purely ty) in
+  (* CR layouts v2.8: When we have [layout_of], this logic should move to the
+     place where [type_jkind] is set. But for now, it has to be here, because we
+     want this in module inclusion but not other places (because substitutions
+     won't improve the layout) *)
+  (* CR layouts v2.8: This improvement ignores types with both [@@unboxed]
+     and [@@unsafe_allow_any_mode_crossing], because the stdlib didn't build
+     otherwise. But we really shouldn't allow mixing those two features, and
+     so instead of trying to get to the bottom of it, I'm just punting. *)
+  let decl_jkind = match decl.type_kind, decl.type_manifest with
+    | Type_abstract _, Some inner_ty
+    (* These next cases are more properly rule TK_UNBOXED from kind-inference.md
+       (not rule FIND_ABBREV, as documented with [Jkind.for_abbreviation]), but
+       they should be fine here. This will all get fixed up later with the
+       above CRs. *)
+    | Type_record ([{ ld_type = inner_ty }], Record_unboxed, None), _
+    | Type_record_unboxed_product ([{ ld_type = inner_ty }], _, None), _
+    | Type_variant ([{ cd_args = (Cstr_tuple [{ ca_type = inner_ty }] |
+                                  Cstr_record [{ ld_type = inner_ty }]) }],
+                    Variant_unboxed, None), _ ->
+      Jkind.for_abbreviation ~type_jkind_purely inner_ty
+    | _ -> decl.type_jkind
+  in
+  match Jkind.sub_jkind_l ~type_equal ~jkind_of_type decl_jkind jkind with
   | Ok () -> Ok ()
   | Error _ as err ->
     match decl.type_manifest with

src/ocaml/typing/datarepr.ml

@@ -284,7 +284,8 @@ let find_constr ~constant tag cstrs =
       (function
         | ({cstr_tag=Ordinary {runtime_tag=tag'}; cstr_constant},_) ->
           tag' = tag && cstr_constant = constant
-        | ({cstr_tag=Null; cstr_constant}, _) -> tag = -1 && cstr_constant = constant
+        | ({cstr_tag=Null; cstr_constant}, _) ->
+          tag = -1 && cstr_constant = constant
         | ({cstr_tag=Extension _},_) -> false)
       cstrs
   with

src/ocaml/typing/env.ml

@@ -323,13 +323,13 @@ type locality_context =
 
 type closure_context =
   | Function of locality_context option
+  | Functor
   | Lazy
 
 type escaping_context =
   | Letop
   | Probe
   | Class
-  | Module
 
 type shared_context =
   | For_loop
@@ -338,7 +338,6 @@ type shared_context =
   | Closure
   | Comprehension
   | Class
-  | Module
   | Probe
 
 type lock =
@@ -1548,7 +1547,7 @@ and find_type_unboxed_version path env seen =
 (* CR layouts v7.2: this should be reworked to expand abbrevations, e.g.
    in [type 'a id = 'a and f = float id], [f] can have an unboxed type.
    Parts of the logic looking at type kinds also belong in Ctype.
-   See https://github.com/ocaml-flambda/flambda-backend/pull/3526#discussion_r1957157050
+   See https://github.com/oxcaml/oxcaml/pull/3526#discussion_r1957157050
 *)
 and find_type_unboxed_version_data path env seen =
   let tda_declaration = find_type_unboxed_version path env seen in
@@ -3089,6 +3088,8 @@ let add_language_extension_types env =
   lazy
     Language_extension.(env
     |> add SIMD Stable Predef.add_simd_stable_extension_types
+    |> add SIMD Beta Predef.add_simd_beta_extension_types
+    |> add SIMD Alpha Predef.add_simd_alpha_extension_types
     |> add Small_numbers Stable Predef.add_small_number_extension_types
     |> add Small_numbers Beta Predef.add_small_number_beta_extension_types
     |> add Layouts Stable Predef.add_or_null)
@@ -4538,7 +4539,6 @@ let string_of_escaping_context : escaping_context -> string =
   | Letop -> "a letop"
   | Probe -> "a probe"
   | Class -> "a class"
-  | Module -> "a module"
 
 let string_of_shared_context : shared_context -> string =
   function
@@ -4548,7 +4548,6 @@ let string_of_shared_context : shared_context -> string =
   | Closure -> "a closure that is not once"
   | Comprehension -> "a comprehension"
   | Class -> "a class"
-  | Module -> "a module"
   | Probe -> "a probe"
 
 let sharedness_hint ppf : shared_context -> _ = function
@@ -4577,10 +4576,6 @@ let sharedness_hint ppf : shared_context -> _ = function
         "@[Hint: This identifier was defined outside of the current closure.@ \
           Either this closure has to be once, or the identifier can be used only@ \
           as aliased.@]"
-  | Module ->
-    Format.fprintf ppf
-        "@[Hint: This identifier cannot be used uniquely,@ \
-          because it is defined in a module.@]"
   | Probe ->
     Format.fprintf ppf
         "@[Hint: This identifier cannot be used uniquely,@ \
@@ -4790,6 +4785,13 @@ let report_lookup_error _loc env ppf = function
               | _ -> fun _ppf -> ()
             in
             "function that " ^ e1, hint
+        | Functor ->
+            let s =
+              match error with
+              | Error (Areality, _) -> "functor"
+              | _ -> "functor that " ^ e1
+            in
+            s, fun _ppf -> ()
         | Lazy ->
             let s =
               match error with

src/ocaml/typing/env.mli

@@ -188,13 +188,13 @@ type locality_context =
 
 type closure_context =
   | Function of locality_context option
+  | Functor
   | Lazy
 
 type escaping_context =
   | Letop
   | Probe
   | Class
-  | Module
 
 type shared_context =
   | For_loop
@@ -203,7 +203,6 @@ type shared_context =
   | Closure
   | Comprehension
   | Class
-  | Module
   | Probe
 
 type locks