Skip to content

Commit

Permalink
Merge pull request #558 from rgrinberg/install-rules
Browse files Browse the repository at this point in the history 
Move installation and META rules to install_rules module
  • Loading branch information
@rgrinberg
rgrinberg committed Feb 28, 2018
2 parents 60b8c7c + 02c5b00 commit 4144823
Show file tree
Hide file tree
Showing 3 changed files with 333 additions and 290 deletions.
300 changes: 10 additions & 290 deletions src/gen_rules.ml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,11 +7,7 @@ open! No_io
| Utils |
+-----------------------------------------------------------------+ *)

module type Params = sig
val sctx : Super_context.t
end

module Gen(P : Params) = struct
module Gen(P : Install_rules.Params) = struct
module Alias = Build_system.Alias
module SC = Super_context
open P
Expand Down Expand Up @@ -361,13 +357,7 @@ module Gen(P : Params) = struct
| Library stuff |
+-----------------------------------------------------------------+ *)

let lib_archive (lib : Library.t) ~dir ~ext = Path.relative dir (lib.name ^ ext)

let stubs_archive lib ~dir =
Library.stubs_archive lib ~dir ~ext_lib:ctx.ext_lib

let dll (lib : Library.t) ~dir =
Path.relative dir (sprintf "dll%s_stubs%s" lib.name ctx.ext_dll)
include Install_rules.Archives(P)

let msvc_hack_cclibs cclibs =
let f lib =
Expand Down Expand Up @@ -925,284 +915,6 @@ module Gen(P : Params) = struct
) ~scope;
Modules_partitioner.emit_warnings modules_partitioner

(* +-----------------------------------------------------------------+
| META |
+-----------------------------------------------------------------+ *)

let lib_dune_file ~dir ~name =
Path.relative dir (name ^ ".dune")

let gen_lib_dune_file lib =
SC.add_rule sctx
(Build.arr (fun () ->
Format.asprintf "%a@." Sexp.pp
(Lib.Sub_system.dump_config lib |> Installed_dune_file.gen))
>>> Build.write_file_dyn
(lib_dune_file ~dir:(Lib.src_dir lib) ~name:(Lib.name lib)))

let init_meta () =
let public_libs = Lib.DB.all (SC.public_libs sctx) in
List.iter public_libs ~f:gen_lib_dune_file;
List.map public_libs ~f:(fun lib ->
(Findlib.root_package_name (Lib.name lib), lib))
|> String_map.of_list_multi
|> String_map.merge (SC.packages sctx) ~f:(fun _name pkg libs ->
let pkg = Option.value_exn pkg in
let libs = Option.value libs ~default:[] in
Some (pkg, libs))
|> String_map.iter ~f:(fun ((pkg : Package.t), libs) ->
let path = Path.append ctx.build_dir pkg.path in
SC.on_load_dir sctx ~dir:path ~f:(fun () ->
let meta_fn = "META." ^ pkg.name in

let meta_template = Path.relative path (meta_fn ^ ".template" ) in
let meta = Path.relative path meta_fn in

let version =
let get =
match pkg.version_from_opam_file with
| Some s -> Build.return (Some s)
| None ->
let rec loop = function
| [] -> Build.return None
| candidate :: rest ->
let p = Path.relative path candidate in
Build.if_file_exists p
~then_:(Build.lines_of p
>>^ function
| ver :: _ -> Some ver
| _ -> Some "")
~else_:(loop rest)
in
loop
[ pkg.name ^ ".version"
; "version"
; "VERSION"
]
in
Super_context.Pkg_version.set sctx pkg get
in

let template =
Build.if_file_exists meta_template
~then_:(Build.lines_of meta_template)
~else_:(Build.return ["# JBUILDER_GEN"])
in
let meta_contents =
version >>^ fun version ->
Gen_meta.gen
~package:pkg.name
~version
libs
in
SC.add_rule sctx
(Build.fanout meta_contents template
>>^ (fun ((meta : Meta.t), template) ->
let buf = Buffer.create 1024 in
let ppf = Format.formatter_of_buffer buf in
Format.pp_open_vbox ppf 0;
List.iter template ~f:(fun s ->
if String.is_prefix s ~prefix:"#" then
match
String.extract_blank_separated_words
(String.sub s ~pos:1 ~len:(String.length s - 1))
with
| ["JBUILDER_GEN"] -> Format.fprintf ppf "%a@," Meta.pp meta.entries
| _ -> Format.fprintf ppf "%s@," s
else
Format.fprintf ppf "%s@," s);
Format.pp_close_box ppf ();
Format.pp_print_flush ppf ();
Buffer.contents buf)
>>>
Build.write_file_dyn meta)))

(* +-----------------------------------------------------------------+
| Installation |
+-----------------------------------------------------------------+ *)

let lib_install_files ~dir ~sub_dir ~scope ~name (lib : Library.t) =
let obj_dir = Utils.library_object_directory ~dir lib.name in
let make_entry section ?dst fn =
Install.Entry.make section fn
~dst:(
let dst =
match dst with
| Some s -> s
| None -> Path.basename fn
in
match sub_dir with
| None -> dst
| Some dir -> sprintf "%s/%s" dir dst)
in
let { Mode.Dict. byte; native } = lib.modes in
let if_ cond l = if cond then l else [] in
let native = native && Option.is_some ctx.ocamlopt in
let files =
let modules = module_names_of_lib lib ~dir in
List.concat
[ List.concat_map modules ~f:(fun m ->
List.concat
[ [ Module.cm_file_unsafe m ~obj_dir Cmi ]
; if_ (native && Module.has_impl m)
[ Module.cm_file_unsafe m ~obj_dir Cmx ]
; List.filter_map Ml_kind.all ~f:(Module.cmt_file m ~obj_dir)
; List.filter_map [m.intf;m.impl] ~f:(function
| None -> None
| Some f -> Some (Path.relative dir f.name))
])
; if_ byte [ lib_archive ~dir lib ~ext:".cma" ]
; if_ (Library.has_stubs lib) [ stubs_archive ~dir lib ]
; if_ native
(let files =
[ lib_archive ~dir lib ~ext:".cmxa"
; lib_archive ~dir lib ~ext:ctx.ext_lib
]
in
if ctx.natdynlink_supported && lib.dynlink then
files @ [ lib_archive ~dir lib ~ext:".cmxs" ]
else
files)
; List.map lib.buildable.js_of_ocaml.javascript_files ~f:(Path.relative dir)
; List.map lib.install_c_headers ~f:(fun fn ->
Path.relative dir (fn ^ ".h"))
]
in
let dlls = if_ (byte && Library.has_stubs lib && lib.dynlink) [dll ~dir lib] in
let execs =
match lib.kind with
| Normal | Ppx_deriver -> []
| Ppx_rewriter ->
let pps = [(lib.buildable.loc, Pp.of_string lib.name)] in
let pps =
(* This is a temporary hack until we get a standard driver *)
let deps =
List.concat_map lib.buildable.libraries ~f:Lib_dep.to_lib_names
in
if List.exists deps ~f:(function
| "ppx_driver" | "ppx_type_conv" -> true
| _ -> false) then
pps @ [match Scope.name scope with
| Some "ppxlib" ->
Loc.none, Pp.of_string "ppxlib.runner"
| _ ->
Loc.none, Pp.of_string "ppx_driver.runner"]
else
pps
in
let ppx_exe = SC.PP.get_ppx_driver sctx ~scope pps in
[ppx_exe]
in
List.concat
[ List.map files ~f:(make_entry Lib )
; List.map execs ~f:(make_entry Libexec)
; List.map dlls ~f:(Install.Entry.make Stublibs)
; [make_entry Lib (lib_dune_file ~dir ~name)]
]

let is_odig_doc_file fn =
List.exists [ "README"; "LICENSE"; "CHANGE"; "HISTORY"]
~f:(fun prefix -> String.is_prefix fn ~prefix)

let local_install_rules (entries : Install.Entry.t list) ~package =
let install_dir = Config.local_install_dir ~context:ctx.name in
List.map entries ~f:(fun entry ->
let dst =
Path.append install_dir (Install.Entry.relative_installed_path entry ~package)
in
SC.add_rule sctx (Build.symlink ~src:entry.src ~dst);
Install.Entry.set_src entry dst)

let promote_install_file =
not ctx.implicit &&
match ctx.kind with
| Default -> true
| Opam _ -> false

let install_file package_path package entries =
let entries =
let files = SC.source_files sctx ~src_path:Path.root in
String_set.fold files ~init:entries ~f:(fun fn acc ->
if is_odig_doc_file fn then
Install.Entry.make Doc (Path.relative ctx.build_dir fn) :: acc
else
acc)
in
let entries =
let opam = Path.relative package_path (package ^ ".opam") in
Install.Entry.make Lib opam ~dst:"opam" :: entries
in
let entries =
let meta_fn = "META." ^ package in
let meta = Path.append ctx.build_dir (Path.relative package_path meta_fn) in
Install.Entry.make Lib meta ~dst:"META" :: entries
in
let fn =
Path.relative (Path.append ctx.build_dir package_path)
(Utils.install_file ~package ~findlib_toolchain:ctx.findlib_toolchain)
in
let entries = local_install_rules entries ~package in
SC.add_rule sctx
~mode:(if promote_install_file then
Promote_but_delete_on_clean
else
(* We must ignore the source file since it might be
copied to the source tree by another context. *)
Ignore_source_files)
(Build.path_set (Install.files entries)
>>^ (fun () ->
let entries =
match ctx.findlib_toolchain with
| None -> entries
| Some toolchain ->
let prefix = Path.of_string (toolchain ^ "-sysroot") in
List.map entries
~f:(Install.Entry.add_install_prefix ~prefix ~package)
in
Install.gen_install_file entries)
>>>
Build.write_file_dyn fn)

let init_install () =
let entries_per_package =
List.concat_map (SC.stanzas_to_consider_for_install sctx)
~f:(fun (dir, scope, stanza) ->
match stanza with
| Library ({ public = Some { package; sub_dir; name; _ }; _ } as lib) ->
List.map (lib_install_files ~dir ~sub_dir ~scope ~name lib)
~f:(fun x -> package.name, x)
| Install { section; files; package}->
List.map files ~f:(fun { Install_conf. src; dst } ->
(package.name,
Install.Entry.make section (Path.relative dir src) ?dst))
| _ -> [])
|> String_map.of_list_multi
in
String_map.iter (SC.packages sctx) ~f:(fun (pkg : Package.t) ->
let stanzas =
Option.value (String_map.find entries_per_package pkg.name) ~default:[]
in
install_file pkg.path pkg.name stanzas)

let init_install_files () =
if not ctx.implicit then
String_map.iteri (SC.packages sctx)
~f:(fun pkg { Package.path = src_path; _ } ->
let install_fn =
Utils.install_file ~package:pkg
~findlib_toolchain:ctx.findlib_toolchain
in

let path = Path.append ctx.build_dir src_path in
let install_alias = Alias.install ~dir:path in
let install_file = Path.relative path install_fn in
SC.add_alias_deps sctx install_alias [install_file])

let init () =
init_meta ();
init_install ();
init_install_files ()

let gen_rules ~dir components : Build_system.extra_sub_directories_to_keep =
(match components with
| ".js" :: rest -> Js_of_ocaml_rules.setup_separate_compilation_rules
Expand All @@ -1222,6 +934,14 @@ module Gen(P : Params) = struct
| [] -> These (String_set.of_list [".js"; "_doc"; ".ppx"])
| [(".js"|"_doc"|".ppx")] -> All
| _ -> These String_set.empty

let init () =
let module Install_rules =
Install_rules.Gen(struct
include P
let module_names_of_lib = module_names_of_lib
end) in
Install_rules.init ()
end

module type Gen = sig
Expand Down

0 comments on commit 4144823

Please sign in to comment.