Skip to content

Backend_impl / Compilenv changes for Flambda 2 #97

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 23, 2021
Merged
Show file tree
Hide file tree
Changes from all commits
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
2 changes: 2 additions & 0 deletions dune
Original file line number Diff line number Diff line change
Expand Up @@ -121,6 +121,7 @@
memtrace
flambda2
flambda2_to_cmm
flambda2_backend_intf
ocamloptcomp
ocamlcommon
stdlib)
Expand All @@ -139,6 +140,7 @@
memtrace
flambda2
flambda2_to_cmm
flambda2_backend_intf
ocamloptcomp
ocamlcommon
stdlib
Expand Down
9 changes: 9 additions & 0 deletions middle_end/compilenv.ml
Original file line number Diff line number Diff line change
Expand Up @@ -217,6 +217,11 @@ let get_global_info global_ident = (
end
)

let get_global_info' id =
match get_global_info id with
| None -> None
| Some ui -> Some ui.ui_export_info

let cache_unit_info ui =
Hashtbl.add global_infos_table ui.ui_name (Some ui)

Expand Down Expand Up @@ -296,6 +301,10 @@ let set_export_info export_info =
assert(Config.flambda);
current_unit.ui_export_info <- Flambda1 export_info

let flambda2_set_export_info export_info =
assert(Config.flambda2);
current_unit.ui_export_info <- Flambda2 (Some export_info)

let approx_for_global comp_unit =
let id = Compilation_unit.get_persistent_ident comp_unit in
if (Compilation_unit.equal
Expand Down
7 changes: 7 additions & 0 deletions middle_end/compilenv.mli
Original file line number Diff line number Diff line change
Expand Up @@ -95,6 +95,13 @@ val approx_for_global: Compilation_unit.t -> Export_info.t option
(* Loads the exported information declaring the compilation_unit
flambda-only *)

val get_global_info' : Ident.t -> Cmx_format.export_info option
(* Middle-end-agnostic means of getting the export info found in the
.cmx file of the given unit. *)

val flambda2_set_export_info : Flambda2.Flambda_cmx_format.t -> unit
(* Set the export information for the current unit (Flambda 2 only). *)

val need_curry_fun: int -> unit
val need_apply_fun: int -> unit
val need_send_fun: int -> unit
Expand Down
9 changes: 9 additions & 0 deletions middle_end/flambda2/backend_intf/dune
Original file line number Diff line number Diff line change
@@ -0,0 +1,9 @@
(include_subdirs no)

(library
(name flambda2_backend_intf)
(wrapped false)
(flags (:standard -principal -nostdlib -open Flambda2))
(libraries stdlib ocamlcommon ocamlbytecomp ocamloptcomp
flambda2_compilenv_deps flambda2)
)
126 changes: 126 additions & 0 deletions middle_end/flambda2/backend_intf/flambda2_backend_impl.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,126 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Pierre Chambart, OCamlPro *)
(* Mark Shinwell and Leo White, Jane Street Europe *)
(* *)
(* Copyright 2013--2021 OCamlPro SAS *)
(* Copyright 2014--2021 Jane Street Group LLC *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)

[@@@ocaml.warning "+a-30-40-41-42"]

module Flambda1_compilation_unit = Compilation_unit
module Flambda1_linkage_name = Linkage_name

module Compilation_unit = struct
include Flambda2_compilenv_deps.Compilation_unit

let of_flambda1_compilation_unit comp_unit =
let ident = Flambda1_compilation_unit.get_persistent_ident comp_unit in
let linkage_name =
comp_unit
|> Flambda1_compilation_unit.get_linkage_name
|> Flambda1_linkage_name.to_string
|> Flambda2_compilenv_deps.Linkage_name.create
in
create ident linkage_name
end

module Linkage_name = Flambda2_compilenv_deps.Linkage_name
module Symbol = Flambda2_compilenv_deps.Symbol

let symbol_for_module_block id =
assert (Ident.global id);
assert (not (Ident.is_predef id));
let comp_unit =
Compilenv.unit_for_global id
|> Compilation_unit.of_flambda1_compilation_unit
in
Symbol.unsafe_create
comp_unit
(Linkage_name.create (Compilenv.symbol_for_global id))

let symbol_for_global' ?comp_unit id =
if Ident.global id && not (Ident.is_predef id) then
symbol_for_module_block id
else
let comp_unit =
match comp_unit with
| Some comp_unit -> comp_unit
| None ->
if Ident.is_predef id then Compilation_unit.predefined_exception ()
else Compilation_unit.get_current_exn ()
in
Symbol.unsafe_create
comp_unit
(Linkage_name.create (Compilenv.symbol_for_global id))

let find_predef_exn name =
let matches ident = String.equal (Ident.name ident) name in
match List.find matches Predef.all_predef_exns with
| exception Not_found ->
Misc.fatal_errorf "Cannot find predef exn '%s'" name
| ident -> ident

let division_by_zero =
symbol_for_global'
~comp_unit:(Compilation_unit.predefined_exception ())
Predef.ident_division_by_zero

let invalid_argument =
symbol_for_global'
~comp_unit:(Compilation_unit.predefined_exception ())
(find_predef_exn "Invalid_argument")

let all_predefined_exception_symbols =
Predef.all_predef_exns
|> List.map (fun ident ->
symbol_for_global' ~comp_unit:(Compilation_unit.predefined_exception ())
ident)
|> Symbol.Set.of_list

let () =
assert (Symbol.Set.mem division_by_zero all_predefined_exception_symbols);
assert (Symbol.Set.mem invalid_argument all_predefined_exception_symbols)

let symbol_for_global' id : Symbol.t = symbol_for_global' id

let size_int = Arch.size_int
let big_endian = Arch.big_endian

let max_sensible_number_of_arguments =
Proc.max_arguments_for_tailcalls - 1

let set_global_info info = Compilenv.flambda2_set_export_info info

let get_global_info comp_unit =
(* The Flambda simplifier should have returned the typing information
for the predefined exception compilation unit before getting here. *)
assert (not (Compilation_unit.is_predefined_exception comp_unit));
if Compilation_unit.is_external_symbols comp_unit then None
else
let id =
(* CR mshinwell: Unsure how to construct this properly. Also see CR
in Closure_conversion about the linkage names of module blocks *)
Compilation_unit.get_persistent_ident comp_unit
in
match Compilenv.get_global_info' id with
| None | Some (Flambda2 None) -> None
| Some (Flambda2 (Some info)) -> Some info
| Some (Clambda _) ->
(* CR mshinwell: This should be a user error, not a fatal error.
Same below. *)
Misc.fatal_errorf "The .cmx file for unit %a was compiled with \
the Closure middle-end, not Flambda 2, and cannot be loaded"
Compilation_unit.print comp_unit
| Some (Flambda1 _) ->
Misc.fatal_errorf "The .cmx file for unit %a was compiled with \
the Flambda 1 middle-end, not Flambda 2, and cannot be loaded"
Compilation_unit.print comp_unit
19 changes: 19 additions & 0 deletions middle_end/flambda2/backend_intf/flambda2_backend_impl.mli
Original file line number Diff line number Diff line change
@@ -0,0 +1,19 @@
(**************************************************************************)
(* *)
(* OCaml *)
(* *)
(* Pierre Chambart, OCamlPro *)
(* Mark Shinwell and Leo White, Jane Street Europe *)
(* *)
(* Copyright 2013--2021 OCamlPro SAS *)
(* Copyright 2014--2021 Jane Street Group LLC *)
(* *)
(* All rights reserved. This file is distributed under the terms of *)
(* the GNU Lesser General Public License version 2.1, with the *)
(* special exception on linking described in the file LICENSE. *)
(* *)
(**************************************************************************)

[@@@ocaml.warning "+a-30-40-41-42"]

include Flambda_backend_intf.S
24 changes: 4 additions & 20 deletions middle_end/flambda2/flambda_backend_intf.mli
Original file line number Diff line number Diff line change
Expand Up @@ -16,36 +16,18 @@

[@@@ocaml.warning "+a-4-9-30-40-41-42"]

(* XXX This shouldn't be needed once the Symbol refactoring is in; then we
can use the same Compilation unit and Symbol types for both Flambda 1 and 2.
*)

(** Knowledge that the middle end needs about the backend. *)
(** Knowledge that the Flambda 2 middle end needs about the backend. *)

module type S = sig
(** Compute the symbol for the given identifier. *)
val symbol_for_global' : (Ident.t -> Symbol.t)

(*
(** If the given approximation is that of a symbol (Value_symbol) or an
external (Value_extern), attempt to find a more informative
approximation from a previously-written compilation artifact. In the
native code backend, for example, this might consult a .cmx file. *)
val really_import_approx : Simple_value_approx.t -> Simple_value_approx.t
*)

val all_predefined_exception_symbols : Symbol.Set.t

val division_by_zero : Symbol.t

val invalid_argument : Symbol.t

(*
val import_symbol : Symbol.t -> Simple_value_approx.t
*)

val closure_symbol : Closure_id.t -> Symbol.t

(** The natural size of an integer on the target architecture
(cf. [Arch.size_int] in the native code backend). *)
val size_int : int
Expand All @@ -60,5 +42,7 @@ module type S = sig
val max_sensible_number_of_arguments : int

val set_global_info : Flambda_cmx_format.t -> unit
val get_global_info : Compilation_unit.t -> Flambda_cmx_format.t option
val get_global_info
: Flambda2_compilenv_deps.Compilation_unit.t
-> Flambda_cmx_format.t option
end
4 changes: 1 addition & 3 deletions middle_end/flambda2/to_cmm/un_cps.ml
Original file line number Diff line number Diff line change
Expand Up @@ -1511,9 +1511,7 @@ let unit (middle_end_result : Flambda_middle_end.middle_end_result) =
offsets *)
| Some cmx ->
let _cmx = Flambda_cmx_format.with_exported_offsets cmx offsets in
(* CR mshinwell: wire this in *)
Misc.fatal_error "To do"
(* Compilenv.set_global_info (Flambda (Some cmx)) *)
Compilenv.flambda2_set_export_info cmx
end;
let used_closure_vars = Flambda_unit.used_closure_vars unit in
let dummy_k = Continuation.create () in
Expand Down