Skip to content

Make environment lazy in preparation for simd extension #1570

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 3 commits into from
Jul 17, 2023
Merged
Show file tree
Hide file tree
Changes from 1 commit
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
4 changes: 2 additions & 2 deletions ocaml/debugger/loadprinter.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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();
Expand Down
5 changes: 3 additions & 2 deletions ocaml/lambda/matching.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand Down Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion ocaml/lambda/transl_array_comprehension.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion ocaml/lambda/translcore.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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) =
Expand Down
2 changes: 1 addition & 1 deletion ocaml/testsuite/tests/compiler-libs/test_untypeast.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
2 changes: 1 addition & 1 deletion ocaml/typing/ctype.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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=
Expand Down
22 changes: 20 additions & 2 deletions ocaml/typing/env.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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.

It is important that [initial_safe_string] and [initial_unsafe_string] are
not forced until after the command line flags have been processed.
*)
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 =
Expand Down Expand Up @@ -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
Expand Down
9 changes: 7 additions & 2 deletions ocaml/typing/env.mli
Original file line number Diff line number Diff line change
Expand Up @@ -59,8 +59,13 @@ type address =
type t

val empty: t
val initial_safe_string: t
val initial_unsafe_string: t

(* Lazy: these should be forced only after command-line flags are parsed, as
construction consults the enabled language extensions.
*)
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 =
Expand Down
6 changes: 6 additions & 0 deletions ocaml/typing/predef.ml
Original file line number Diff line number Diff line change
Expand Up @@ -291,6 +291,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

Expand Down
7 changes: 7 additions & 0 deletions ocaml/typing/predef.mli
Original file line number Diff line number Diff line change
Expand Up @@ -78,6 +78,13 @@ val build_initial_env:
(Ident.t -> extension_constructor -> 'a -> 'a) ->
'a -> 'a * 'a

(* Add simd types to an environment. We can't do this in [build_initial_env]
because we'd like to only do it if the simd extension is on, and the initial
environment is constructed at startup before command-line flags can be
consulted. *)
val add_simd_extension_types :
(Ident.t -> type_declaration -> 'a -> 'a) -> 'a -> 'a

(* To initialize linker tables *)

val builtin_values: (string * Ident.t) list
Expand Down
7 changes: 4 additions & 3 deletions ocaml/typing/typemod.ml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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,
Expand Down