Backend_impl / Compilenv changes for Flambda 2 (#97)

Author: mshinwell

dune

@@ -121,6 +121,7 @@
    memtrace
    flambda2
    flambda2_to_cmm
+   flambda2_backend_intf
    ocamloptcomp
    ocamlcommon
    stdlib)
@@ -139,6 +140,7 @@
    memtrace
    flambda2
    flambda2_to_cmm
+   flambda2_backend_intf
    ocamloptcomp
    ocamlcommon
    stdlib

middle_end/compilenv.ml

@@ -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)
 
@@ -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

middle_end/compilenv.mli

@@ -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

middle_end/flambda2/backend_intf/dune

@@ -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)
+)

middle_end/flambda2/backend_intf/flambda2_backend_impl.ml

@@ -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

middle_end/flambda2/backend_intf/flambda2_backend_impl.mli

@@ -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

middle_end/flambda2/flambda_backend_intf.mli

@@ -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
@@ -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

middle_end/flambda2/to_cmm/un_cps.ml

@@ -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