Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 90 lines (72 sloc) 2.642 kb
fccc685 Initial open-source release
MLstate authored
1 (*
2 Copyright © 2011 MLstate
3
4 This file is part of OPA.
5
6 OPA is free software: you can redistribute it and/or modify it under the
7 terms of the GNU Affero General Public License, version 3, as published by
8 the Free Software Foundation.
9
10 OPA is distributed in the hope that it will be useful, but WITHOUT ANY
11 WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
12 FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
13 more details.
14
15 You should have received a copy of the GNU Affero General Public License
16 along with OPA. If not, see <http://www.gnu.org/licenses/>.
17 *)
18 (* CF mli *)
19
20 module BPI = BslPluginInterface
21
22 (* Need to do a topologic sort of plugin *)
23 module ItemPlugin =
24 struct
25 type t = BPI.plugin
26 let index t = t.BPI.basename
27 let depends t = t.BPI.depends
28 end
29
30 module PluginSort = TopologicSort.Make (ItemPlugin)
31
32 let debug fmt =
33 OManager.printf ("@{<cyan>[Bsl]@}@ @[<2>"^^fmt^^"@]@.")
34
35 let pp_list = Base.Format.pp_list
36
37 let table : (string, BPI.plugin) Hashtbl.t = Hashtbl.create 10
38
39 let private_last_finalize = ref None
40
41 let pp_item fmt t = Format.pp_print_string fmt (ItemPlugin.index t)
42
43 let finalize () =
44 let plugins = Hashtbl.fold (fun _ plugin acc -> plugin::acc) table [] in
45 let plugins, not_referenced = PluginSort.sort plugins in
46 match not_referenced with
47 | [] ->
48 private_last_finalize := Some plugins ;
49 plugins
50 | _ ->
51 let report fmt (name, deps) =
52 Format.fprintf fmt (
53 "@[<2>+ missing %s@\n@[<2>referenced in@\n%a@]@]@\n"^^
54 "@[<2>@{<bright>Hint@}:@\nAdd '@{<bright>import-plugin %s@}'@]"
55 )
56 name
57 (pp_list "@\n" pp_item) deps
58 name
59 in
60 OManager.error
61 "External primitives plugins dependancies are not satisfied:@\n%a"
62 (pp_list "@\n" report) not_referenced
63
64 let last_finalize () = !private_last_finalize
65
66 let store plugin =
67 let mname = plugin.BPI.basename in
68 let uniq_id = plugin.BPI.uniq_id in
69 match (try Some (Hashtbl.find table mname) with Not_found -> None) with
70
71 | Some plugin' ->
72 let uniq_id' = plugin'.BPI.uniq_id in
73 if String.compare uniq_id uniq_id' <> 0
74 then
75 let ml_runtime = plugin.BPI.ml_runtime in
76 OManager.error (
77 "@[<2>External plugin: conflicting versions for %S@\n"^^
78 "mismatch: <%s> / <%s>@]@\n"
79 )
80 ml_runtime mname uniq_id uniq_id'
81 else ()
82
83 | None ->
84 let _ =
85 #<If:BSL_LOADING $minlevel 1>
86 debug "loading plugin <%S>" uniq_id
87 #<End>
88 in
89 Hashtbl.add table mname plugin
Something went wrong with that request. Please try again.