Merge compiler changes (with conflicts)

Author: liam923

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)
@@ -125,6 +130,19 @@ let save_cms target modname binary_annots initial_env shape =
             cms_uid_to_loc;
             cms_uid_to_attributes;
             cms_impl_shape = shape;
+<<<<<<< janestreet/merlin-jst:merge-compiler-renaming-changes
+||||||| ocaml-flambda/flambda-backend:60158e06115c6fc6e30325bb720e65acf351dbce
+            cms_ident_occurrences
+          }
+        in
+        output_cms oc cms)
+=======
+            cms_ident_occurrences;
+            cms_declaration_dependencies;
+          }
+        in
+        output_cms oc cms)
+>>>>>>> ocaml-flambda/flambda-backend:87a4cecacc0e2f9afee93898f81f55b012c69214
                    `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

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,31 @@ 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
 
+<<<<<<< janestreet/merlin-jst:merge-compiler-renaming-changes
 (*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 = ()
+||||||| ocaml-flambda/flambda-backend:60158e06115c6fc6e30325bb720e65acf351dbce
+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
+>>>>>>> ocaml-flambda/flambda-backend:87a4cecacc0e2f9afee93898f81f55b012c69214
 
 let save_cmt target cu binary_annots initial_env cmi shape =
   if !Clflags.binary_annotations && not !Clflags.print_types then begin
@@ -516,8 +526,16 @@ let save_cmt target cu binary_annots initial_env cmi shape =
          let cmt = {
            cmt_modname = cu;
            cmt_annots;
+<<<<<<< janestreet/merlin-jst:merge-compiler-renaming-changes
            cmt_value_dependencies = !value_deps;
            cmt_comments = [];
+||||||| ocaml-flambda/flambda-backend:60158e06115c6fc6e30325bb720e65acf351dbce
+           cmt_value_dependencies = !value_deps;
+           cmt_comments = Lexer.comments ();
+=======
+           cmt_declaration_dependencies = !uids_deps;
+           cmt_comments = Lexer.comments ();
+>>>>>>> ocaml-flambda/flambda-backend:87a4cecacc0e2f9afee93898f81f55b012c69214
            cmt_args = Sys.argv;
            cmt_sourcefile = sourcefile;
            cmt_builddir = Location.rewrite_absolute_path (Sys.getcwd ());
@@ -535,3 +553,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
@@ -143,6 +142,19 @@ val iter_on_occurrences :
   f:(namespace:Shape.Sig_component_kind.t ->
     Env.t ->
     Path.t ->
+<<<<<<< janestreet/merlin-jst:merge-compiler-renaming-changes
     Longident.t Location.loc ->
     unit)
   -> Tast_iterator.iterator
+||||||| ocaml-flambda/flambda-backend:60158e06115c6fc6e30325bb720e65acf351dbce
+  val read_signature : 'a -> string -> Types.signature * 'b list * 'c list
+
+*)
+=======
+  val read_signature : 'a -> string -> Types.signature * 'b list * 'c list
+
+*)
+
+val get_declaration_dependencies :
+  unit -> (dependency_kind * Uid.t * Uid.t) list
+>>>>>>> ocaml-flambda/flambda-backend:87a4cecacc0e2f9afee93898f81f55b012c69214

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