Import ocaml sources for oxcaml/oxcaml@87a4cecacc0e

Author: liam923

upstream/ocaml_flambda/base-rev.txt

@@ -1 +1 @@
-60158e06115c6fc6e30325bb720e65acf351dbce
+87a4cecacc0e2f9afee93898f81f55b012c69214

upstream/ocaml_flambda/file_formats/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)
@@ -125,7 +130,8 @@ let save_cms target modname binary_annots initial_env shape =
             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)

upstream/ocaml_flambda/file_formats/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 :

upstream/ocaml_flambda/file_formats/cmt_format.ml

@@ -45,11 +45,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;
@@ -453,19 +453,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_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
@@ -500,7 +500,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 = Lexer.comments ();
            cmt_args = Sys.argv;
            cmt_sourcefile = sourcefile;
@@ -519,3 +519,5 @@ let save_cmt target cu binary_annots initial_env cmi shape =
          output_cmt oc cmt)
   end;
   clear ()
+
+let get_declaration_dependencies () = !uids_deps

upstream/ocaml_flambda/file_formats/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
@@ -134,3 +133,6 @@ val need_to_clear_env : bool
   val read_signature : 'a -> string -> Types.signature * 'b list * 'c list
 
 *)
+
+val get_declaration_dependencies :
+  unit -> (dependency_kind * Uid.t * Uid.t) list

upstream/ocaml_flambda/file_formats/cmx_format.mli

@@ -32,7 +32,9 @@ open Misc
    of these infos *)
 
 (* Declare machtype here to avoid depending on [Cmm]. *)
-type machtype_component = Val | Addr | Int | Float | Vec128 | Float32 | Valx2
+type machtype_component =
+  Val | Addr | Int | Float | Vec128 | Vec256 | Vec512 | Float32 | Valx2
+
 type machtype = machtype_component array
 
 (* [alloc_mode] should be isomorphic to [Cmm.Alloc_mode.t],

upstream/ocaml_flambda/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))

upstream/ocaml_flambda/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;

upstream/ocaml_flambda/typing/ctype.ml

@@ -7197,8 +7197,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

upstream/ocaml_flambda/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