File: deps.ml

package info (click to toggle)
oasis 0.4.11-1
  • links: PTS, VCS
  • area: main
  • in suites: bullseye
  • size: 4,272 kB
  • sloc: ml: 38,987; sh: 192; makefile: 122; ansic: 67
file content (163 lines) | stat: -rw-r--r-- 6,362 bytes parent folder | download | duplicates (4)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
(******************************************************************************)
(* 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