flambda-backend: Make environment lazy in preparation for simd extens…

…ion (#1570)

debugger/loadprinter.ml

@@ -105,15 +105,15 @@ let match_printer_type desc typename =
   let printer_type =
     match
       Env.find_type_by_name
-        (Ldot(Lident "Topdirs", typename)) Env.initial_safe_string
+        (Ldot(Lident "Topdirs", typename)) (Lazy.force Env.initial_safe_string)
     with
     | path, _ -> path
     | exception Not_found ->
         raise (Error(Unbound_identifier(Ldot(Lident "Topdirs", typename))))
   in
   Ctype.begin_def();
   let ty_arg = Ctype.newvar Layout.(value ~why:Debug_printer_argument) in
-  Ctype.unify Env.initial_safe_string
+  Ctype.unify (Lazy.force Env.initial_safe_string)
     (Ctype.newconstr printer_type [ty_arg])
     (Ctype.instance desc.val_type);
   Ctype.end_def();

lambda/matching.ml

@@ -1898,7 +1898,8 @@ let get_mod_field modname field =
   lazy
     (let mod_ident = Ident.create_persistent modname in
      let env =
-       Env.add_persistent_structure mod_ident Env.initial_safe_string
+       Env.add_persistent_structure mod_ident
+         (Lazy.force Env.initial_safe_string)
      in
      match Env.open_pers_signature modname env with
      | Error `Not_found ->
@@ -3580,7 +3581,7 @@ let failure_handler ~scopes loc ~failer () =
     let sloc = Scoped_location.of_location ~scopes loc in
     let slot =
       transl_extension_path sloc
-        Env.initial_safe_string Predef.path_match_failure
+        (Lazy.force Env.initial_safe_string) Predef.path_match_failure
     in
     let fname, line, char =
       Location.get_pos_info loc.Location.loc_start in

lambda/transl_array_comprehension.ml

@@ -210,7 +210,7 @@ end = struct
     let slot =
       transl_extension_path
         loc
-        Env.initial_safe_string
+        (Lazy.force Env.initial_safe_string)
         Predef.path_invalid_argument
     in
     (* CR-someday aspectorzabusky: We might want to raise an event here for

lambda/translcore.ml

@@ -297,7 +297,7 @@ let event_function ~scopes exp lam =
 let assert_failed ~scopes exp =
   let slot =
     transl_extension_path Loc_unknown
-      Env.initial_safe_string Predef.path_assert_failure
+      (Lazy.force Env.initial_safe_string) Predef.path_assert_failure
   in
   let loc = exp.exp_loc in
   let (fname, line, char) =

testsuite/tests/compiler-libs/test_untypeast.ml

@@ -9,7 +9,7 @@
 let res =
   let s = {| match None with Some (Some _) -> () | _ -> () |} in
   let pe = Parse.expression (Lexing.from_string s) in
-  let te = Typecore.type_expression (Env.initial_safe_string) pe in
+  let te = Typecore.type_expression (Lazy.force Env.initial_safe_string) pe in
   let ute = Untypeast.untype_expression te in
   Format.asprintf "%a" Pprintast.expression ute
 

testsuite/tests/language-extensions/language_extensions.ml

@@ -22,7 +22,7 @@ let report ~name ~text =
 
 let typecheck_with_extension ?(full_name = false) name =
   let success =
-    match Typecore.type_expression Env.initial_safe_string
+    match Typecore.type_expression (Lazy.force Env.initial_safe_string)
             extension_parsed_expression
     with
     | _ -> true

typing/ctype.ml

@@ -373,7 +373,7 @@ let in_current_module = function
 
 let in_pervasives p =
   in_current_module p &&
-  try ignore (Env.find_type p Env.initial_safe_string); true
+  try ignore (Env.find_type p (Lazy.force Env.initial_safe_string)); true
   with Not_found -> false
 
 let is_datatype decl=

typing/env.ml

@@ -2677,13 +2677,31 @@ let save_signature_with_imports ~alerts sg modname filename imports =
   save_signature_with_transform with_imports
     ~alerts sg modname filename
 
-(* Make the initial environment *)
+(* Make the initial environment, without language extensions *)
 let (initial_safe_string, initial_unsafe_string) =
   Predef.build_initial_env
     (add_type ~check:false)
     (add_extension ~check:false ~rebind:false)
     empty
 
+let add_language_extension_types env =
+  lazy
+    ((* CR ccasinghino for mslater: Here, check the simd extension.  If it's on,
+        return [add_simd_extension_types (add_type ~check:false) env].
+        Otherwise, return env. *)
+      env)
+
+(* Some predefined types are part of language extensions, and we don't want to
+   make them available in the initial environment if those extensions are not
+   turned on.  We can't do this at startup because command line flags haven't
+   been parsed yet. So, we make the initial environment lazy.
+
+   If language extensions are adjusted after [initial_safe_string] and
+   [initial_unsafe_string] are forced, these environments may be inaccurate.
+*)
+let initial_safe_string = add_language_extension_types initial_safe_string
+let initial_unsafe_string = add_language_extension_types initial_unsafe_string
+
 (* Tracking usage *)
 
 let mark_module_used uid =
@@ -3174,7 +3192,7 @@ let lookup_all_dot_constructors ~errors ~use ~loc usage l s env =
   | Longident.Lident "*predef*" ->
       (* Hack to support compilation of default arguments *)
       lookup_all_ident_constructors
-        ~errors ~use ~loc usage s initial_safe_string
+        ~errors ~use ~loc usage s (Lazy.force initial_safe_string)
   | _ ->
       let (_, comps) = lookup_structure_components ~errors ~use ~loc l env in
       match NameMap.find s comps.comp_constrs with

typing/env.mli

@@ -59,8 +59,15 @@ type address =
 type t
 
 val empty: t
-val initial_safe_string: t
-val initial_unsafe_string: t
+
+(* These environments are lazy so that they may depend on the enabled
+   extensions, typically adjusted via command line flags.  If extensions are
+   changed after these environments are forced, they may be inaccurate.  This
+   could happen, for example, if extensions are adjusted via the
+   compiler-libs. *)
+val initial_safe_string: t Lazy.t
+val initial_unsafe_string: t Lazy.t
+
 val diff: t -> t -> Ident.t list
 
 type type_descr_kind =

typing/predef.ml

@@ -295,6 +295,12 @@ let build_initial_env add_type add_exception empty_env =
   let unsafe_string = add_type ident_bytes ~manifest:type_string common in
   (safe_string, unsafe_string)
 
+let add_simd_extension_types add_type env =
+  let add_type = mk_add_type add_type in
+  (* CR ccasinghino for mslater: Change the line below to [add_type ident_vec128
+     env]. *)
+  ignore add_type; env
+
 let builtin_values =
   List.map (fun id -> (Ident.name id, id)) all_predef_exns
 

typing/predef.mli

@@ -80,6 +80,11 @@ val build_initial_env:
   (Ident.t -> extension_constructor -> 'a -> 'a) ->
   'a -> 'a * 'a
 
+(* Add simd types to an environment.  This is separate from [build_initial_env]
+   because we'd like to only do it if the simd extension is on. *)
+val add_simd_extension_types :
+  (Ident.t -> type_declaration -> 'a -> 'a) -> 'a -> 'a
+
 (* To initialize linker tables *)
 
 val builtin_values: (string * Ident.t) list

typing/typemod.ml

@@ -193,9 +193,9 @@ let initial_env ~loc ~safe_string ~initially_opened_module
     ~open_implicit_modules =
   let env =
     if safe_string then
-      Env.initial_safe_string
+      Lazy.force Env.initial_safe_string
     else
-      Env.initial_unsafe_string
+      Lazy.force Env.initial_unsafe_string
   in
   let open_module env m =
     let open Asttypes in
@@ -3382,7 +3382,8 @@ let package_units initial_env objfiles cmifile modulename =
          let modname = Compilation_unit.create_child modulename unit in
          let sg = Env.read_signature modname (pref ^ ".cmi") in
          if Filename.check_suffix f ".cmi" &&
-            not(Mtype.no_code_needed_sig Env.initial_safe_string sg)
+            not(Mtype.no_code_needed_sig (Lazy.force Env.initial_safe_string)
+                  sg)
          then raise(Error(Location.none, Env.empty,
                           Implementation_is_required f));
          Compilation_unit.name modname,