Permalink
Fetching contributors…
Cannot retrieve contributors at this time
164 lines (151 sloc) 6.21 KB
(******************************************************************************)
(* OASIS: architecture for building OCaml libraries and applications *)
(* *)
(* Copyright (C) 2011-2016, Sylvain Le Gall *)
(* Copyright (C) 2008-2011, OCamlCore SARL *)
(* *)
(* This library is free software; you can redistribute it and/or modify it *)
(* under the terms of the GNU Lesser General Public License as published by *)
(* the Free Software Foundation; either version 2.1 of the License, or (at *)
(* your option) any later version, with the OCaml static compilation *)
(* exception. *)
(* *)
(* This library is distributed in the hope that it will be useful, but *)
(* WITHOUT ANY WARRANTY; without even the implied warranty of MERCHANTABILITY *)
(* or FITNESS FOR A PARTICULAR PURPOSE. See the file COPYING for more *)
(* details. *)
(* *)
(* You should have received a copy of the GNU Lesser General Public License *)
(* along with this library; if not, write to the Free Software Foundation, *)
(* Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301 USA *)
(******************************************************************************)
module MapString = Map.Make(String)
module SetString = Set.Make(String)
open OASISTypes
open BaseEnv
let generated_fn = OASISHostPath.of_unix "src/cli/CLIPluginsLoaded.ml"
let post_configure pkg =
(* Compute build depends *)
let _, findlib_of_name, _ = OASISFindlib.findlib_mapping pkg in
let mp_int, set_ext =
(* Collect dependencies and external dependencies from the package. *)
List.fold_left
(fun (mp_int, set_ext) ->
function
| Library (cs, bs, _) when var_choose bs.bs_build ->
begin
let deps, set_ext =
List.fold_left
(fun (deps, set_ext) sct ->
let deps =
match sct with
| InternalLibrary nm ->
SetString.add (findlib_of_name nm) deps
| FindlibPackage (fndlb_pkg, _) ->
SetString.add fndlb_pkg deps
in
let set_ext =
match sct with
| InternalLibrary _ ->
set_ext
| FindlibPackage (fndlb_pkg, _) ->
SetString.add fndlb_pkg set_ext
in
deps, set_ext)
(SetString.empty, set_ext)
bs.bs_build_depends
in
MapString.add (findlib_of_name cs.cs_name) deps mp_int,
set_ext
end
| Executable (_, bs, _) when var_choose bs.bs_build ->
let set_ext =
List.fold_left
(fun set_ext ->
function
| InternalLibrary _ ->
set_ext
| FindlibPackage (fndlb_pkg, _) ->
SetString.add fndlb_pkg set_ext)
set_ext
bs.bs_build_depends
in
mp_int, set_ext
| _ ->
mp_int, set_ext)
(MapString.empty, SetString.empty)
pkg.sections
in
let mp =
(* Expand external dependencies. *)
SetString.fold
(fun fndlb_nm mp ->
let lst =
OASISExec.run_read_output ~ctxt:!BaseContext.default
"ocamlfind"
["query"; fndlb_nm; "-recursive"; "-p-format"]
in
let set_deps = List.fold_right SetString.add lst SetString.empty in
MapString.add fndlb_nm set_deps mp)
set_ext mp_int
in
let rec transitive_closure nm visited =
if not (SetString.mem nm visited) then
begin
let visited = SetString.add nm visited in
let set =
try
MapString.find nm mp
with Not_found ->
SetString.empty
in
SetString.fold transitive_closure set visited
end
else
visited
in
let chn = open_out generated_fn in
let fmt = Format.formatter_of_out_channel chn in
Format.fprintf fmt "@[<v>";
List.iter
(function
| Executable (cs, bs, _) ->
let st =
List.fold_left
(fun st ->
function
| InternalLibrary nm ->
transitive_closure (findlib_of_name nm) st
| FindlibPackage (fndlb_nm, _) ->
transitive_closure fndlb_nm st)
SetString.empty bs.bs_build_depends
in
let first = ref true in
Format.fprintf fmt
"let exec_%s_build_depends_rec = [@[<hv>"
(OASISUtils.varname_of_string cs.cs_name);
List.iter
(fun str ->
if !first then begin
Format.fprintf fmt "%S" str;
first := false
end else begin
Format.fprintf fmt ";@ %S" str
end)
(List.rev (SetString.elements st));
Format.fprintf fmt "@]]@,"
| _ ->
())
pkg.sections;
Format.fprintf fmt "@]@?";
close_out chn
let setup_t =
{setup_t with
BaseSetup.configure =
(fun pkg args ->
setup_t.BaseSetup.configure pkg args;
post_configure pkg);
BaseSetup.distclean =
(fun pkg args -> Sys.remove generated_fn)
:: setup_t.BaseSetup.distclean}
let setup () = BaseSetup.setup setup_t