Skip to content
Permalink
master
Switch branches/tags

Name already in use

A tag already exists with the provided branch name. Many Git commands accept both tag and branch names, so creating this branch may cause unexpected behavior. Are you sure you want to create this branch?
Go to file
 
 
Cannot retrieve contributors at this time
(******************************************************************************)
(* 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