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
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
|
(**************************************************************************************)
(* Copyright (C) 2009 Pietro Abate <pietro.abate@pps.jussieu.fr> *)
(* Copyright (C) 2009 Mancoosi Project *)
(* *)
(* 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 3 of the *)
(* License, or (at your option) any later version. A special linking *)
(* exception to the GNU Lesser General Public License applies to this *)
(* library, see the COPYING file for more information. *)
(**************************************************************************************)
(** Eclipse Specific Cudf conversion routines *)
open ExtLib
open Common
open Packages
type tables = {
versions_table : (string, string list) Hashtbl.t;
reverse_table : ((string * int), string) Hashtbl.t
}
let create n = {
versions_table = Hashtbl.create n;
reverse_table = Hashtbl.create n;
}
type lookup = {
from_cudf : Cudf.package -> (string * string);
to_cudf : (string * string) -> Cudf.package
}
let clear tables =
Hashtbl.clear tables.versions_table;
Hashtbl.clear tables.reverse_table
;;
let init_versions_table table =
let add name version =
try
let l = Hashtbl.find table name in
Hashtbl.replace table name (version::l)
with Not_found -> Hashtbl.add table name [version]
in
let conj_iter =
List.iter (fun ((name,_),sel) ->
match CudfAdd.cudfop sel with
|None -> ()
|Some(_,version) -> add name version
)
in
let cnf_iter =
List.iter (fun disjunction ->
List.iter (fun ((name,_),sel) ->
match CudfAdd.cudfop sel with
|None -> ()
|Some(_,version) -> add name version
) disjunction
)
in
fun pkg ->
add pkg.name pkg.version;
conj_iter pkg.provides;
conj_iter pkg.conflicts ;
cnf_iter pkg.depends;
cnf_iter pkg.recommends;
conj_iter pkg.suggests
;;
let init_virtual_table table pkg =
let add name =
if not(Hashtbl.mem table name) then
Hashtbl.add table name ()
in
List.iter (fun (name,_) -> add name) pkg.provides
let init_unit_table table pkg =
if not(Hashtbl.mem table pkg.name) then
Hashtbl.add table pkg.name ()
let init_versioned_table table pkg =
let add name =
if not(Hashtbl.mem table name) then
Hashtbl.add table name ()
in
let add_iter_cnf =
List.iter (fun disjunction ->
List.iter (fun (name,_)-> add name) disjunction
)
in
List.iter (fun (name,_) -> add name) pkg.conflicts ;
add_iter_cnf pkg.depends
;;
let init_tables ?(compare=Version.compare) pkglist =
let n = 2 * List.length pkglist in
let tables = create n in
let temp_versions_table = Hashtbl.create n in
let ivt = init_versions_table temp_versions_table in
List.iter (fun pkg -> ivt pkg) pkglist ;
(* XXX I guess this could be a bit faster if implemented with Sets *)
Hashtbl.iter (fun k l ->
Hashtbl.add tables.versions_table k
(List.unique (List.sort ~cmp:compare l))
) temp_versions_table
;
Hashtbl.clear temp_versions_table ;
tables
(* versions start from 1 *)
let get_cudf_version tables (package,version) =
try
let l = Hashtbl.find tables.versions_table package in
let i = fst(List.findi (fun i a -> a = version) l) in
Hashtbl.replace tables.reverse_table (CudfAdd.encode package,i+1) version;
i+1
with Not_found -> assert false
let get_real_version tables (p,i) =
try Hashtbl.find tables.reverse_table (p,i)
with Not_found -> ((Printf.eprintf "%s - %d\n" p i) ; assert false)
let loadl tables l =
List.flatten (
List.map (fun ((name,_),sel) ->
match CudfAdd.cudfop sel with
|None -> [(CudfAdd.encode name, None)]
|Some(op,v) -> [(CudfAdd.encode name,Some(op,get_cudf_version tables (name,v)))]
) l
)
let loadlc tables name l = (loadl tables l)
let loadlp tables l =
List.map (fun ((name,_),sel) ->
match CudfAdd.cudfop sel with
|None -> (CudfAdd.encode name, None)
|Some(`Eq,v) -> (CudfAdd.encode name,Some(`Eq,get_cudf_version tables (name,v)))
|_ -> assert false
) l
let loadll tables ll = List.map (loadl tables) ll
(* ========================================= *)
type extramap = (string * (string * Cudf_types.typedecl1)) list
let preamble =
(* number is a mandatory property -- no default *)
let l = [
("suggests",(`Vpkglist (Some [])));
("recommends",(`Vpkgformula (Some [])));
("number",(`String None)) ]
in
CudfAdd.add_properties Cudf.default_preamble l
let add_extra extras tables pkg =
let number = ("number",`String pkg.version) in
let l =
List.filter_map (fun (debprop, (cudfprop,v)) ->
let debprop = String.lowercase debprop in
let cudfprop = String.lowercase cudfprop in
try
let s = List.assoc debprop pkg.extras in
let typ = Cudf_types.type_of_typedecl v in
Some (cudfprop, Cudf_types_pp.parse_value typ s)
with Not_found -> None
) extras
in
let recommends = ("recommends", `Vpkgformula (loadll tables pkg.recommends)) in
let suggests = ("suggests", `Vpkglist (loadl tables pkg.suggests)) in
List.filter_map (function
|(_,`Vpkglist []) -> None
|(_,`Vpkgformula []) -> None
|e -> Some e
)
[number; recommends ; suggests] @ l
;;
let tocudf tables ?(extras=[]) ?(inst=false) pkg =
{ Cudf.default_package with
Cudf.package = CudfAdd.encode pkg.name ;
Cudf.version = get_cudf_version tables (pkg.name,pkg.version) ;
Cudf.depends = loadll tables pkg.depends;
Cudf.conflicts = loadlc tables pkg.name pkg.conflicts;
Cudf.provides = loadlp tables pkg.provides ;
Cudf.pkg_extra = add_extra extras tables pkg ;
}
let lltocudf = loadll
let ltocudf = loadl
let load_list l =
let timer = Util.Timer.create "Eclipse.eclipsecudf.load_list" in
Util.Timer.start timer;
let tables = init_tables l in
let pkglist = List.map (tocudf tables) l in
clear tables;
Util.Timer.stop timer pkglist
let load_universe l =
let pkglist = load_list l in
let timer = Util.Timer.create "Eclipse.Eclipsecudf.load_universe" in
Util.Timer.start timer;
let univ = Cudf.load_universe pkglist in
Util.Timer.stop timer univ
|
