1 |
|
(* setup.ml generated for the first time by OASIS v0.2.0 *)
|
2 |
|
|
3 |
|
(* OASIS_START *)
|
4 |
|
(* DO NOT EDIT (digest: cbef9780a942e499729218b6c22c21f0) *)
|
5 |
|
(*
|
6 |
|
Regenerated by OASIS v0.3.0
|
7 |
|
Visit http://oasis.forge.ocamlcore.org for more information and
|
8 |
|
documentation about functions used in this file.
|
9 |
|
*)
|
10 |
|
module OASISGettext = struct
|
11 |
|
(* # 21 "src/oasis/OASISGettext.ml" *)
|
12 |
|
|
13 |
|
let ns_ str =
|
14 |
|
str
|
15 |
|
|
16 |
|
let s_ str =
|
17 |
|
str
|
18 |
|
|
19 |
|
let f_ (str : ('a, 'b, 'c, 'd) format4) =
|
20 |
|
str
|
21 |
|
|
22 |
|
let fn_ fmt1 fmt2 n =
|
23 |
|
if n = 1 then
|
24 |
|
fmt1^^""
|
25 |
|
else
|
26 |
|
fmt2^^""
|
27 |
|
|
28 |
|
let init =
|
29 |
|
[]
|
30 |
|
|
31 |
|
end
|
32 |
|
|
33 |
|
module OASISContext = struct
|
34 |
|
(* # 21 "src/oasis/OASISContext.ml" *)
|
35 |
|
|
36 |
|
open OASISGettext
|
37 |
|
|
38 |
|
type level =
|
39 |
|
[ `Debug
|
40 |
|
| `Info
|
41 |
|
| `Warning
|
42 |
|
| `Error]
|
43 |
|
|
44 |
|
type t =
|
45 |
|
{
|
46 |
|
quiet: bool;
|
47 |
|
info: bool;
|
48 |
|
debug: bool;
|
49 |
|
ignore_plugins: bool;
|
50 |
|
ignore_unknown_fields: bool;
|
51 |
|
printf: level -> string -> unit;
|
52 |
|
}
|
53 |
|
|
54 |
|
let printf lvl str =
|
55 |
|
let beg =
|
56 |
|
match lvl with
|
57 |
|
| `Error -> s_ "E: "
|
58 |
|
| `Warning -> s_ "W: "
|
59 |
|
| `Info -> s_ "I: "
|
60 |
|
| `Debug -> s_ "D: "
|
61 |
|
in
|
62 |
|
prerr_endline (beg^str)
|
63 |
|
|
64 |
|
let default =
|
65 |
|
ref
|
66 |
|
{
|
67 |
|
quiet = false;
|
68 |
|
info = false;
|
69 |
|
debug = false;
|
70 |
|
ignore_plugins = false;
|
71 |
|
ignore_unknown_fields = false;
|
72 |
|
printf = printf;
|
73 |
|
}
|
74 |
|
|
75 |
|
let quiet =
|
76 |
|
{!default with quiet = true}
|
77 |
|
|
78 |
|
|
79 |
|
let args () =
|
80 |
|
["-quiet",
|
81 |
|
Arg.Unit (fun () -> default := {!default with quiet = true}),
|
82 |
|
(s_ " Run quietly");
|
83 |
|
|
84 |
|
"-info",
|
85 |
|
Arg.Unit (fun () -> default := {!default with info = true}),
|
86 |
|
(s_ " Display information message");
|
87 |
|
|
88 |
|
|
89 |
|
"-debug",
|
90 |
|
Arg.Unit (fun () -> default := {!default with debug = true}),
|
91 |
|
(s_ " Output debug message")]
|
92 |
|
end
|
93 |
|
|
94 |
|
module OASISString = struct
|
95 |
|
(* # 1 "src/oasis/OASISString.ml" *)
|
96 |
|
|
97 |
|
|
98 |
|
|
99 |
|
(** Various string utilities.
|
100 |
|
|
101 |
|
Mostly inspired by extlib and batteries ExtString and BatString libraries.
|
102 |
|
|
103 |
|
@author Sylvain Le Gall
|
104 |
|
*)
|
105 |
|
|
106 |
|
let nsplitf str f =
|
107 |
|
if str = "" then
|
108 |
|
[]
|
109 |
|
else
|
110 |
|
let buf = Buffer.create 13 in
|
111 |
|
let lst = ref [] in
|
112 |
|
let push () =
|
113 |
|
lst := Buffer.contents buf :: !lst;
|
114 |
|
Buffer.clear buf
|
115 |
|
in
|
116 |
|
let str_len = String.length str in
|
117 |
|
for i = 0 to str_len - 1 do
|
118 |
|
if f str.[i] then
|
119 |
|
push ()
|
120 |
|
else
|
121 |
|
Buffer.add_char buf str.[i]
|
122 |
|
done;
|
123 |
|
push ();
|
124 |
|
List.rev !lst
|
125 |
|
|
126 |
|
(** [nsplit c s] Split the string [s] at char [c]. It doesn't include the
|
127 |
|
separator.
|
128 |
|
*)
|
129 |
|
let nsplit str c =
|
130 |
|
nsplitf str ((=) c)
|
131 |
|
|
132 |
|
let find ~what ?(offset=0) str =
|
133 |
|
let what_idx = ref 0 in
|
134 |
|
let str_idx = ref offset in
|
135 |
|
while !str_idx < String.length str &&
|
136 |
|
!what_idx < String.length what do
|
137 |
|
if str.[!str_idx] = what.[!what_idx] then
|
138 |
|
incr what_idx
|
139 |
|
else
|
140 |
|
what_idx := 0;
|
141 |
|
incr str_idx
|
142 |
|
done;
|
143 |
|
if !what_idx <> String.length what then
|
144 |
|
raise Not_found
|
145 |
|
else
|
146 |
|
!str_idx - !what_idx
|
147 |
|
|
148 |
|
let sub_start str len =
|
149 |
|
let str_len = String.length str in
|
150 |
|
if len >= str_len then
|
151 |
|
""
|
152 |
|
else
|
153 |
|
String.sub str len (str_len - len)
|
154 |
|
|
155 |
|
let sub_end ?(offset=0) str len =
|
156 |
|
let str_len = String.length str in
|
157 |
|
if len >= str_len then
|
158 |
|
""
|
159 |
|
else
|
160 |
|
String.sub str 0 (str_len - len)
|
161 |
|
|
162 |
|
let starts_with ~what ?(offset=0) str =
|
163 |
|
let what_idx = ref 0 in
|
164 |
|
let str_idx = ref offset in
|
165 |
|
let ok = ref true in
|
166 |
|
while !ok &&
|
167 |
|
!str_idx < String.length str &&
|
168 |
|
!what_idx < String.length what do
|
169 |
|
if str.[!str_idx] = what.[!what_idx] then
|
170 |
|
incr what_idx
|
171 |
|
else
|
172 |
|
ok := false;
|
173 |
|
incr str_idx
|
174 |
|
done;
|
175 |
|
if !what_idx = String.length what then
|
176 |
|
true
|
177 |
|
else
|
178 |
|
false
|
179 |
|
|
180 |
|
let strip_starts_with ~what str =
|
181 |
|
if starts_with ~what str then
|
182 |
|
sub_start str (String.length what)
|
183 |
|
else
|
184 |
|
raise Not_found
|
185 |
|
|
186 |
|
let ends_with ~what ?(offset=0) str =
|
187 |
|
let what_idx = ref ((String.length what) - 1) in
|
188 |
|
let str_idx = ref ((String.length str) - 1) in
|
189 |
|
let ok = ref true in
|
190 |
|
while !ok &&
|
191 |
|
offset <= !str_idx &&
|
192 |
|
0 <= !what_idx do
|
193 |
|
if str.[!str_idx] = what.[!what_idx] then
|
194 |
|
decr what_idx
|
195 |
|
else
|
196 |
|
ok := false;
|
197 |
|
decr str_idx
|
198 |
|
done;
|
199 |
|
if !what_idx = -1 then
|
200 |
|
true
|
201 |
|
else
|
202 |
|
false
|
203 |
|
|
204 |
|
let strip_ends_with ~what str =
|
205 |
|
if ends_with ~what str then
|
206 |
|
sub_end str (String.length what)
|
207 |
|
else
|
208 |
|
raise Not_found
|
209 |
|
|
210 |
|
let replace_chars f s =
|
211 |
|
let buf = String.make (String.length s) 'X' in
|
212 |
|
for i = 0 to String.length s - 1 do
|
213 |
|
buf.[i] <- f s.[i]
|
214 |
|
done;
|
215 |
|
buf
|
216 |
|
|
217 |
|
end
|
218 |
|
|
219 |
|
module OASISUtils = struct
|
220 |
|
(* # 21 "src/oasis/OASISUtils.ml" *)
|
221 |
|
|
222 |
|
open OASISGettext
|
223 |
|
|
224 |
|
module MapString = Map.Make(String)
|
225 |
|
|
226 |
|
let map_string_of_assoc assoc =
|
227 |
|
List.fold_left
|
228 |
|
(fun acc (k, v) -> MapString.add k v acc)
|
229 |
|
MapString.empty
|
230 |
|
assoc
|
231 |
|
|
232 |
|
module SetString = Set.Make(String)
|
233 |
|
|
234 |
|
let set_string_add_list st lst =
|
235 |
|
List.fold_left
|
236 |
|
(fun acc e -> SetString.add e acc)
|
237 |
|
st
|
238 |
|
lst
|
239 |
|
|
240 |
|
let set_string_of_list =
|
241 |
|
set_string_add_list
|
242 |
|
SetString.empty
|
243 |
|
|
244 |
|
|
245 |
|
let compare_csl s1 s2 =
|
246 |
|
String.compare (String.lowercase s1) (String.lowercase s2)
|
247 |
|
|
248 |
|
module HashStringCsl =
|
249 |
|
Hashtbl.Make
|
250 |
|
(struct
|
251 |
|
type t = string
|
252 |
|
|
253 |
|
let equal s1 s2 =
|
254 |
|
(String.lowercase s1) = (String.lowercase s2)
|
255 |
|
|
256 |
|
let hash s =
|
257 |
|
Hashtbl.hash (String.lowercase s)
|
258 |
|
end)
|
259 |
|
|
260 |
|
let varname_of_string ?(hyphen='_') s =
|
261 |
|
if String.length s = 0 then
|
262 |
|
begin
|
263 |
|
invalid_arg "varname_of_string"
|
264 |
|
end
|
265 |
|
else
|
266 |
|
begin
|
267 |
|
let buf =
|
268 |
|
OASISString.replace_chars
|
269 |
|
(fun c ->
|
270 |
|
if ('a' <= c && c <= 'z')
|
271 |
|
||
|
272 |
|
('A' <= c && c <= 'Z')
|
273 |
|
||
|
274 |
|
('0' <= c && c <= '9') then
|
275 |
|
c
|
276 |
|
else
|
277 |
|
hyphen)
|
278 |
|
s;
|
279 |
|
in
|
280 |
|
let buf =
|
281 |
|
(* Start with a _ if digit *)
|
282 |
|
if '0' <= s.[0] && s.[0] <= '9' then
|
283 |
|
"_"^buf
|
284 |
|
else
|
285 |
|
buf
|
286 |
|
in
|
287 |
|
String.lowercase buf
|
288 |
|
end
|
289 |
|
|
290 |
|
let varname_concat ?(hyphen='_') p s =
|
291 |
|
let what = String.make 1 hyphen in
|
292 |
|
let p =
|
293 |
|
try
|
294 |
|
OASISString.strip_ends_with ~what p
|
295 |
|
with Not_found ->
|
296 |
|
p
|
297 |
|
in
|
298 |
|
let s =
|
299 |
|
try
|
300 |
|
OASISString.strip_starts_with ~what s
|
301 |
|
with Not_found ->
|
302 |
|
s
|
303 |
|
in
|
304 |
|
p^what^s
|
305 |
|
|
306 |
|
|
307 |
|
let is_varname str =
|
308 |
|
str = varname_of_string str
|
309 |
|
|
310 |
|
let failwithf fmt = Printf.ksprintf failwith fmt
|
311 |
|
|
312 |
|
end
|
313 |
|
|
314 |
|
module PropList = struct
|
315 |
|
(* # 21 "src/oasis/PropList.ml" *)
|
316 |
|
|
317 |
|
open OASISGettext
|
318 |
|
|
319 |
|
type name = string
|
320 |
|
|
321 |
|
exception Not_set of name * string option
|
322 |
|
exception No_printer of name
|
323 |
|
exception Unknown_field of name * name
|
324 |
|
|
325 |
|
let () =
|
326 |
|
Printexc.register_printer
|
327 |
|
(function
|
328 |
|
| Not_set (nm, Some rsn) ->
|
329 |
|
Some
|
330 |
|
(Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn)
|
331 |
|
| Not_set (nm, None) ->
|
332 |
|
Some
|
333 |
|
(Printf.sprintf (f_ "Field '%s' is not set") nm)
|
334 |
|
| No_printer nm ->
|
335 |
|
Some
|
336 |
|
(Printf.sprintf (f_ "No default printer for value %s") nm)
|
337 |
|
| Unknown_field (nm, schm) ->
|
338 |
|
Some
|
339 |
|
(Printf.sprintf (f_ "Field %s is not defined in schema %s") nm schm)
|
340 |
|
| _ ->
|
341 |
|
None)
|
342 |
|
|
343 |
|
module Data =
|
344 |
|
struct
|
345 |
|
|
346 |
|
type t =
|
347 |
|
(name, unit -> unit) Hashtbl.t
|
348 |
|
|
349 |
|
let create () =
|
350 |
|
Hashtbl.create 13
|
351 |
|
|
352 |
|
let clear t =
|
353 |
|
Hashtbl.clear t
|
354 |
|
|
355 |
|
(* # 71 "src/oasis/PropList.ml" *)
|
356 |
|
end
|
357 |
|
|
358 |
|
module Schema =
|
359 |
|
struct
|
360 |
|
|
361 |
|
type ('ctxt, 'extra) value =
|
362 |
|
{
|
363 |
|
get: Data.t -> string;
|
364 |
|
set: Data.t -> ?context:'ctxt -> string -> unit;
|
365 |
|
help: (unit -> string) option;
|
366 |
|
extra: 'extra;
|
367 |
|
}
|
368 |
|
|
369 |
|
type ('ctxt, 'extra) t =
|
370 |
|
{
|
371 |
|
name: name;
|
372 |
|
fields: (name, ('ctxt, 'extra) value) Hashtbl.t;
|
373 |
|
order: name Queue.t;
|
374 |
|
name_norm: string -> string;
|
375 |
|
}
|
376 |
|
|
377 |
|
let create ?(case_insensitive=false) nm =
|
378 |
|
{
|
379 |
|
name = nm;
|
380 |
|
fields = Hashtbl.create 13;
|
381 |
|
order = Queue.create ();
|
382 |
|
name_norm =
|
383 |
|
(if case_insensitive then
|
384 |
|
String.lowercase
|
385 |
|
else
|
386 |
|
fun s -> s);
|
387 |
|
}
|
388 |
|
|
389 |
|
let add t nm set get extra help =
|
390 |
|
let key =
|
391 |
|
t.name_norm nm
|
392 |
|
in
|
393 |
|
|
394 |
|
if Hashtbl.mem t.fields key then
|
395 |
|
failwith
|
396 |
|
(Printf.sprintf
|
397 |
|
(f_ "Field '%s' is already defined in schema '%s'")
|
398 |
|
nm t.name);
|
399 |
|
Hashtbl.add
|
400 |
|
t.fields
|
401 |
|
key
|
402 |
|
{
|
403 |
|
set = set;
|
404 |
|
get = get;
|
405 |
|
help = help;
|
406 |
|
extra = extra;
|
407 |
|
};
|
408 |
|
Queue.add nm t.order
|
409 |
|
|
410 |
|
let mem t nm =
|
411 |
|
Hashtbl.mem t.fields nm
|
412 |
|
|
413 |
|
let find t nm =
|
414 |
|
try
|
415 |
|
Hashtbl.find t.fields (t.name_norm nm)
|
416 |
|
with Not_found ->
|
417 |
|
raise (Unknown_field (nm, t.name))
|
418 |
|
|
419 |
|
let get t data nm =
|
420 |
|
(find t nm).get data
|
421 |
|
|
422 |
|
let set t data nm ?context x =
|
423 |
|
(find t nm).set
|
424 |
|
data
|
425 |
|
?context
|
426 |
|
x
|
427 |
|
|
428 |
|
let fold f acc t =
|
429 |
|
Queue.fold
|
430 |
|
(fun acc k ->
|
431 |
|
let v =
|
432 |
|
find t k
|
433 |
|
in
|
434 |
|
f acc k v.extra v.help)
|
435 |
|
acc
|
436 |
|
t.order
|
437 |
|
|
438 |
|
let iter f t =
|
439 |
|
fold
|
440 |
|
(fun () -> f)
|
441 |
|
()
|
442 |
|
t
|
443 |
|
|
444 |
|
let name t =
|
445 |
|
t.name
|
446 |
|
end
|
447 |
|
|
448 |
|
module Field =
|
449 |
|
struct
|
450 |
|
|
451 |
|
type ('ctxt, 'value, 'extra) t =
|
452 |
|
{
|
453 |
|
set: Data.t -> ?context:'ctxt -> 'value -> unit;
|
454 |
|
get: Data.t -> 'value;
|
455 |
|
sets: Data.t -> ?context:'ctxt -> string -> unit;
|
456 |
|
gets: Data.t -> string;
|
457 |
|
help: (unit -> string) option;
|
458 |
|
extra: 'extra;
|
459 |
|
}
|
460 |
|
|
461 |
|
let new_id =
|
462 |
|
let last_id =
|
463 |
|
ref 0
|
464 |
|
in
|
465 |
|
fun () -> incr last_id; !last_id
|
466 |
|
|
467 |
|
let create ?schema ?name ?parse ?print ?default ?update ?help extra =
|
468 |
|
(* Default value container *)
|
469 |
|
let v =
|
470 |
|
ref None
|
471 |
|
in
|
472 |
|
|
473 |
|
(* If name is not given, create unique one *)
|
474 |
|
let nm =
|
475 |
|
match name with
|
476 |
|
| Some s -> s
|
477 |
|
| None -> Printf.sprintf "_anon_%d" (new_id ())
|
478 |
|
in
|
479 |
|
|
480 |
|
(* Last chance to get a value: the default *)
|
481 |
|
let default () =
|
482 |
|
match default with
|
483 |
|
| Some d -> d
|
484 |
|
| None -> raise (Not_set (nm, Some (s_ "no default value")))
|
485 |
|
in
|
486 |
|
|
487 |
|
(* Get data *)
|
488 |
|
let get data =
|
489 |
|
(* Get value *)
|
490 |
|
try
|
491 |
|
(Hashtbl.find data nm) ();
|
492 |
|
match !v with
|
493 |
|
| Some x -> x
|
494 |
|
| None -> default ()
|
495 |
|
with Not_found ->
|
496 |
|
default ()
|
497 |
|
in
|
498 |
|
|
499 |
|
(* Set data *)
|
500 |
|
let set data ?context x =
|
501 |
|
let x =
|
502 |
|
match update with
|
503 |
|
| Some f ->
|
504 |
|
begin
|
505 |
|
try
|
506 |
|
f ?context (get data) x
|
507 |
|
with Not_set _ ->
|
508 |
|
x
|
509 |
|
end
|
510 |
|
| None ->
|
511 |
|
x
|
512 |
|
in
|
513 |
|
Hashtbl.replace
|
514 |
|
data
|
515 |
|
nm
|
516 |
|
(fun () -> v := Some x)
|
517 |
|
in
|
518 |
|
|
519 |
|
(* Parse string value, if possible *)
|
520 |
|
let parse =
|
521 |
|
match parse with
|
522 |
|
| Some f ->
|
523 |
|
f
|
524 |
|
| None ->
|
525 |
|
fun ?context s ->
|
526 |
|
failwith
|
527 |
|
(Printf.sprintf
|
528 |
|
(f_ "Cannot parse field '%s' when setting value %S")
|
529 |
|
nm
|
530 |
|
s)
|
531 |
|
in
|
532 |
|
|
533 |
|
(* Set data, from string *)
|
534 |
|
let sets data ?context s =
|
535 |
|
set ?context data (parse ?context s)
|
536 |
|
in
|
537 |
|
|
538 |
|
(* Output value as string, if possible *)
|
539 |
|
let print =
|
540 |
|
match print with
|
541 |
|
| Some f ->
|
542 |
|
f
|
543 |
|
| None ->
|
544 |
|
fun _ -> raise (No_printer nm)
|
545 |
|
in
|
546 |
|
|
547 |
|
(* Get data, as a string *)
|
548 |
|
let gets data =
|
549 |
|
print (get data)
|
550 |
|
in
|
551 |
|
|
552 |
|
begin
|
553 |
|
match schema with
|
554 |
|
| Some t ->
|
555 |
|
Schema.add t nm sets gets extra help
|
556 |
|
| None ->
|
557 |
|
()
|
558 |
|
end;
|
559 |
|
|
560 |
|
{
|
561 |
|
set = set;
|
562 |
|
get = get;
|
563 |
|
sets = sets;
|
564 |
|
gets = gets;
|
565 |
|
help = help;
|
566 |
|
extra = extra;
|
567 |
|
}
|
568 |
|
|
569 |
|
let fset data t ?context x =
|
570 |
|
t.set data ?context x
|
571 |
|
|
572 |
|
let fget data t =
|
573 |
|
t.get data
|
574 |
|
|
575 |
|
let fsets data t ?context s =
|
576 |
|
t.sets data ?context s
|
577 |
|
|
578 |
|
let fgets data t =
|
579 |
|
t.gets data
|
580 |
|
|
581 |
|
end
|
582 |
|
|
583 |
|
module FieldRO =
|
584 |
|
struct
|
585 |
|
|
586 |
|
let create ?schema ?name ?parse ?print ?default ?update ?help extra =
|
587 |
|
let fld =
|
588 |
|
Field.create ?schema ?name ?parse ?print ?default ?update ?help extra
|
589 |
|
in
|
590 |
|
fun data -> Field.fget data fld
|
591 |
|
|
592 |
|
end
|
593 |
|
end
|
594 |
|
|
595 |
|
module OASISMessage = struct
|
596 |
|
(* # 21 "src/oasis/OASISMessage.ml" *)
|
597 |
|
|
598 |
|
|
599 |
|
open OASISGettext
|
600 |
|
open OASISContext
|
601 |
|
|
602 |
|
let generic_message ~ctxt lvl fmt =
|
603 |
|
let cond =
|
604 |
|
if ctxt.quiet then
|
605 |
|
false
|
606 |
|
else
|
607 |
|
match lvl with
|
608 |
|
| `Debug -> ctxt.debug
|
609 |
|
| `Info -> ctxt.info
|
610 |
|
| _ -> true
|
611 |
|
in
|
612 |
|
Printf.ksprintf
|
613 |
|
(fun str ->
|
614 |
|
if cond then
|
615 |
|
begin
|
616 |
|
ctxt.printf lvl str
|
617 |
|
end)
|
618 |
|
fmt
|
619 |
|
|
620 |
|
let debug ~ctxt fmt =
|
621 |
|
generic_message ~ctxt `Debug fmt
|
622 |
|
|
623 |
|
let info ~ctxt fmt =
|
624 |
|
generic_message ~ctxt `Info fmt
|
625 |
|
|
626 |
|
let warning ~ctxt fmt =
|
627 |
|
generic_message ~ctxt `Warning fmt
|
628 |
|
|
629 |
|
let error ~ctxt fmt =
|
630 |
|
generic_message ~ctxt `Error fmt
|
631 |
|
|
632 |
|
end
|
633 |
|
|
634 |
|
module OASISVersion = struct
|
635 |
|
(* # 21 "src/oasis/OASISVersion.ml" *)
|
636 |
|
|
637 |
|
open OASISGettext
|
638 |
|
|
639 |
|
|
640 |
|
|
641 |
|
type s = string
|
642 |
|
|
643 |
|
type t = string
|
644 |
|
|
645 |
|
type comparator =
|
646 |
|
| VGreater of t
|
647 |
|
| VGreaterEqual of t
|
648 |
|
| VEqual of t
|
649 |
|
| VLesser of t
|
650 |
|
| VLesserEqual of t
|
651 |
|
| VOr of comparator * comparator
|
652 |
|
| VAnd of comparator * comparator
|
653 |
|
|
654 |
|
|
655 |
|
(* Range of allowed characters *)
|
656 |
|
let is_digit c =
|
657 |
|
'0' <= c && c <= '9'
|
658 |
|
|
659 |
|
let is_alpha c =
|
660 |
|
('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')
|
661 |
|
|
662 |
|
let is_special =
|
663 |
|
function
|
664 |
|
| '.' | '+' | '-' | '~' -> true
|
665 |
|
| _ -> false
|
666 |
|
|
667 |
|
let rec version_compare v1 v2 =
|
668 |
|
if v1 <> "" || v2 <> "" then
|
669 |
|
begin
|
670 |
|
(* Compare ascii string, using special meaning for version
|
671 |
|
* related char
|
672 |
|
*)
|
673 |
|
let val_ascii c =
|
674 |
|
if c = '~' then -1
|
675 |
|
else if is_digit c then 0
|
676 |
|
else if c = '\000' then 0
|
677 |
|
else if is_alpha c then Char.code c
|
678 |
|
else (Char.code c) + 256
|
679 |
|
in
|
680 |
|
|
681 |
|
let len1 = String.length v1 in
|
682 |
|
let len2 = String.length v2 in
|
683 |
|
|
684 |
|
let p = ref 0 in
|
685 |
|
|
686 |
|
(** Compare ascii part *)
|
687 |
|
let compare_vascii () =
|
688 |
|
let cmp = ref 0 in
|
689 |
|
while !cmp = 0 &&
|
690 |
|
!p < len1 && !p < len2 &&
|
691 |
|
not (is_digit v1.[!p] && is_digit v2.[!p]) do
|
692 |
|
cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]);
|
693 |
|
incr p
|
694 |
|
done;
|
695 |
|
if !cmp = 0 && !p < len1 && !p = len2 then
|
696 |
|
val_ascii v1.[!p]
|
697 |
|
else if !cmp = 0 && !p = len1 && !p < len2 then
|
698 |
|
- (val_ascii v2.[!p])
|
699 |
|
else
|
700 |
|
!cmp
|
701 |
|
in
|
702 |
|
|
703 |
|
(** Compare digit part *)
|
704 |
|
let compare_digit () =
|
705 |
|
let extract_int v p =
|
706 |
|
let start_p = !p in
|
707 |
|
while !p < String.length v && is_digit v.[!p] do
|
708 |
|
incr p
|
709 |
|
done;
|
710 |
|
let substr =
|
711 |
|
String.sub v !p ((String.length v) - !p)
|
712 |
|
in
|
713 |
|
let res =
|
714 |
|
match String.sub v start_p (!p - start_p) with
|
715 |
|
| "" -> 0
|
716 |
|
| s -> int_of_string s
|
717 |
|
in
|
718 |
|
res, substr
|
719 |
|
in
|
720 |
|
let i1, tl1 = extract_int v1 (ref !p) in
|
721 |
|
let i2, tl2 = extract_int v2 (ref !p) in
|
722 |
|
i1 - i2, tl1, tl2
|
723 |
|
in
|
724 |
|
|
725 |
|
match compare_vascii () with
|
726 |
|
| 0 ->
|
727 |
|
begin
|
728 |
|
match compare_digit () with
|
729 |
|
| 0, tl1, tl2 ->
|
730 |
|
if tl1 <> "" && is_digit tl1.[0] then
|
731 |
|
1
|
732 |
|
else if tl2 <> "" && is_digit tl2.[0] then
|
733 |
|
-1
|
734 |
|
else
|
735 |
|
version_compare tl1 tl2
|
736 |
|
| n, _, _ ->
|
737 |
|
n
|
738 |
|
end
|
739 |
|
| n ->
|
740 |
|
n
|
741 |
|
end
|
742 |
|
else
|
743 |
|
begin
|
744 |
|
0
|
745 |
|
end
|
746 |
|
|
747 |
|
|
748 |
|
let version_of_string str = str
|
749 |
|
|
750 |
|
let string_of_version t = t
|
751 |
|
|
752 |
|
let chop t =
|
753 |
|
try
|
754 |
|
let pos =
|
755 |
|
String.rindex t '.'
|
756 |
|
in
|
757 |
|
String.sub t 0 pos
|
758 |
|
with Not_found ->
|
759 |
|
t
|
760 |
|
|
761 |
|
let rec comparator_apply v op =
|
762 |
|
match op with
|
763 |
|
| VGreater cv ->
|
764 |
|
(version_compare v cv) > 0
|
765 |
|
| VGreaterEqual cv ->
|
766 |
|
(version_compare v cv) >= 0
|
767 |
|
| VLesser cv ->
|
768 |
|
(version_compare v cv) < 0
|
769 |
|
| VLesserEqual cv ->
|
770 |
|
(version_compare v cv) <= 0
|
771 |
|
| VEqual cv ->
|
772 |
|
(version_compare v cv) = 0
|
773 |
|
| VOr (op1, op2) ->
|
774 |
|
(comparator_apply v op1) || (comparator_apply v op2)
|
775 |
|
| VAnd (op1, op2) ->
|
776 |
|
(comparator_apply v op1) && (comparator_apply v op2)
|
777 |
|
|
778 |
|
let rec string_of_comparator =
|
779 |
|
function
|
780 |
|
| VGreater v -> "> "^(string_of_version v)
|
781 |
|
| VEqual v -> "= "^(string_of_version v)
|
782 |
|
| VLesser v -> "< "^(string_of_version v)
|
783 |
|
| VGreaterEqual v -> ">= "^(string_of_version v)
|
784 |
|
| VLesserEqual v -> "<= "^(string_of_version v)
|
785 |
|
| VOr (c1, c2) ->
|
786 |
|
(string_of_comparator c1)^" || "^(string_of_comparator c2)
|
787 |
|
| VAnd (c1, c2) ->
|
788 |
|
(string_of_comparator c1)^" && "^(string_of_comparator c2)
|
789 |
|
|
790 |
|
let rec varname_of_comparator =
|
791 |
|
let concat p v =
|
792 |
|
OASISUtils.varname_concat
|
793 |
|
p
|
794 |
|
(OASISUtils.varname_of_string
|
795 |
|
(string_of_version v))
|
796 |
|
in
|
797 |
|
function
|
798 |
|
| VGreater v -> concat "gt" v
|
799 |
|
| VLesser v -> concat "lt" v
|
800 |
|
| VEqual v -> concat "eq" v
|
801 |
|
| VGreaterEqual v -> concat "ge" v
|
802 |
|
| VLesserEqual v -> concat "le" v
|
803 |
|
| VOr (c1, c2) ->
|
804 |
|
(varname_of_comparator c1)^"_or_"^(varname_of_comparator c2)
|
805 |
|
| VAnd (c1, c2) ->
|
806 |
|
(varname_of_comparator c1)^"_and_"^(varname_of_comparator c2)
|
807 |
|
|
808 |
|
let version_0_3_or_after t =
|
809 |
|
comparator_apply t (VGreaterEqual (string_of_version "0.3"))
|
810 |
|
|
811 |
|
end
|
812 |
|
|
813 |
|
module OASISLicense = struct
|
814 |
|
(* # 21 "src/oasis/OASISLicense.ml" *)
|
815 |
|
|
816 |
|
(** License for _oasis fields
|
817 |
|
@author Sylvain Le Gall
|
818 |
|
*)
|
819 |
|
|
820 |
|
|
821 |
|
|
822 |
|
type license = string
|
823 |
|
|
824 |
|
type license_exception = string
|
825 |
|
|
826 |
|
type license_version =
|
827 |
|
| Version of OASISVersion.t
|
828 |
|
| VersionOrLater of OASISVersion.t
|
829 |
|
| NoVersion
|
830 |
|
|
831 |
|
|
832 |
|
type license_dep_5_unit =
|
833 |
|
{
|
834 |
|
license: license;
|
835 |
|
excption: license_exception option;
|
836 |
|
version: license_version;
|
837 |
|
}
|
838 |
|
|
839 |
|
|
840 |
|
type license_dep_5 =
|
841 |
|
| DEP5Unit of license_dep_5_unit
|
842 |
|
| DEP5Or of license_dep_5 list
|
843 |
|
| DEP5And of license_dep_5 list
|
844 |
|
|
845 |
|
|
846 |
|
type t =
|
847 |
|
| DEP5License of license_dep_5
|
848 |
|
| OtherLicense of string (* URL *)
|
849 |
|
|
850 |
|
|
851 |
|
end
|
852 |
|
|
853 |
|
module OASISExpr = struct
|
854 |
|
(* # 21 "src/oasis/OASISExpr.ml" *)
|
855 |
|
|
856 |
|
|
857 |
|
|
858 |
|
open OASISGettext
|
859 |
|
|
860 |
|
type test = string
|
861 |
|
|
862 |
|
type flag = string
|
863 |
|
|
864 |
|
type t =
|
865 |
|
| EBool of bool
|
866 |
|
| ENot of t
|
867 |
|
| EAnd of t * t
|
868 |
|
| EOr of t * t
|
869 |
|
| EFlag of flag
|
870 |
|
| ETest of test * string
|
871 |
|
|
872 |
|
|
873 |
|
type 'a choices = (t * 'a) list
|
874 |
|
|
875 |
|
let eval var_get t =
|
876 |
|
let rec eval' =
|
877 |
|
function
|
878 |
|
| EBool b ->
|
879 |
|
b
|
880 |
|
|
881 |
|
| ENot e ->
|
882 |
|
not (eval' e)
|
883 |
|
|
884 |
|
| EAnd (e1, e2) ->
|
885 |
|
(eval' e1) && (eval' e2)
|
886 |
|
|
887 |
|
| EOr (e1, e2) ->
|
888 |
|
(eval' e1) || (eval' e2)
|
889 |
|
|
890 |
|
| EFlag nm ->
|
891 |
|
let v =
|
892 |
|
var_get nm
|
893 |
|
in
|
894 |
|
assert(v = "true" || v = "false");
|
895 |
|
(v = "true")
|
896 |
|
|
897 |
|
| ETest (nm, vl) ->
|
898 |
|
let v =
|
899 |
|
var_get nm
|
900 |
|
in
|
901 |
|
(v = vl)
|
902 |
|
in
|
903 |
|
eval' t
|
904 |
|
|
905 |
|
let choose ?printer ?name var_get lst =
|
906 |
|
let rec choose_aux =
|
907 |
|
function
|
908 |
|
| (cond, vl) :: tl ->
|
909 |
|
if eval var_get cond then
|
910 |
|
vl
|
911 |
|
else
|
912 |
|
choose_aux tl
|
913 |
|
| [] ->
|
914 |
|
let str_lst =
|
915 |
|
if lst = [] then
|
916 |
|
s_ "<empty>"
|
917 |
|
else
|
918 |
|
String.concat
|
919 |
|
(s_ ", ")
|
920 |
|
(List.map
|
921 |
|
(fun (cond, vl) ->
|
922 |
|
match printer with
|
923 |
|
| Some p -> p vl
|
924 |
|
| None -> s_ "<no printer>")
|
925 |
|
lst)
|
926 |
|
in
|
927 |
|
match name with
|
928 |
|
| Some nm ->
|
929 |
|
failwith
|
930 |
|
(Printf.sprintf
|
931 |
|
(f_ "No result for the choice list '%s': %s")
|
932 |
|
nm str_lst)
|
933 |
|
| None ->
|
934 |
|
failwith
|
935 |
|
(Printf.sprintf
|
936 |
|
(f_ "No result for a choice list: %s")
|
937 |
|
str_lst)
|
938 |
|
in
|
939 |
|
choose_aux (List.rev lst)
|
940 |
|
|
941 |
|
end
|
942 |
|
|
943 |
|
module OASISTypes = struct
|
944 |
|
(* # 21 "src/oasis/OASISTypes.ml" *)
|
945 |
|
|
946 |
|
|
947 |
|
|
948 |
|
|
949 |
|
type name = string
|
950 |
|
type package_name = string
|
951 |
|
type url = string
|
952 |
|
type unix_dirname = string
|
953 |
|
type unix_filename = string
|
954 |
|
type host_dirname = string
|
955 |
|
type host_filename = string
|
956 |
|
type prog = string
|
957 |
|
type arg = string
|
958 |
|
type args = string list
|
959 |
|
type command_line = (prog * arg list)
|
960 |
|
|
961 |
|
type findlib_name = string
|
962 |
|
type findlib_full = string
|
963 |
|
|
964 |
|
type compiled_object =
|
965 |
|
| Byte
|
966 |
|
| Native
|
967 |
|
| Best
|
968 |
|
|
969 |
|
|
970 |
|
type dependency =
|
971 |
|
| FindlibPackage of findlib_full * OASISVersion.comparator option
|
972 |
|
| InternalLibrary of name
|
973 |
|
|
974 |
|
|
975 |
|
type tool =
|
976 |
|
| ExternalTool of name
|
977 |
|
| InternalExecutable of name
|
978 |
|
|
979 |
|
|
980 |
|
type vcs =
|
981 |
|
| Darcs
|
982 |
|
| Git
|
983 |
|
| Svn
|
984 |
|
| Cvs
|
985 |
|
| Hg
|
986 |
|
| Bzr
|
987 |
|
| Arch
|
988 |
|
| Monotone
|
989 |
|
| OtherVCS of url
|
990 |
|
|
991 |
|
|
992 |
|
type plugin_kind =
|
993 |
|
[ `Configure
|
994 |
|
| `Build
|
995 |
|
| `Doc
|
996 |
|
| `Test
|
997 |
|
| `Install
|
998 |
|
| `Extra
|
999 |
|
]
|
1000 |
|
|
1001 |
|
type plugin_data_purpose =
|
1002 |
|
[ `Configure
|
1003 |
|
| `Build
|
1004 |
|
| `Install
|
1005 |
|
| `Clean
|
1006 |
|
| `Distclean
|
1007 |
|
| `Install
|
1008 |
|
| `Uninstall
|
1009 |
|
| `Test
|
1010 |
|
| `Doc
|
1011 |
|
| `Extra
|
1012 |
|
| `Other of string
|
1013 |
|
]
|
1014 |
|
|
1015 |
|
type 'a plugin = 'a * name * OASISVersion.t option
|
1016 |
|
|
1017 |
|
type all_plugin = plugin_kind plugin
|
1018 |
|
|
1019 |
|
type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list
|
1020 |
|
|
1021 |
|
(* # 102 "src/oasis/OASISTypes.ml" *)
|
1022 |
|
|
1023 |
|
type 'a conditional = 'a OASISExpr.choices
|
1024 |
|
|
1025 |
|
type custom =
|
1026 |
|
{
|
1027 |
|
pre_command: (command_line option) conditional;
|
1028 |
|
post_command: (command_line option) conditional;
|
1029 |
|
}
|
1030 |
|
|
1031 |
|
|
1032 |
|
type common_section =
|
1033 |
|
{
|
1034 |
|
cs_name: name;
|
1035 |
|
cs_data: PropList.Data.t;
|
1036 |
|
cs_plugin_data: plugin_data;
|
1037 |
|
}
|
1038 |
|
|
1039 |
|
|
1040 |
|
type build_section =
|
1041 |
|
{
|
1042 |
|
bs_build: bool conditional;
|
1043 |
|
bs_install: bool conditional;
|
1044 |
|
bs_path: unix_dirname;
|
1045 |
|
bs_compiled_object: compiled_object;
|
1046 |
|
bs_build_depends: dependency list;
|
1047 |
|
bs_build_tools: tool list;
|
1048 |
|
bs_c_sources: unix_filename list;
|
1049 |
|
bs_data_files: (unix_filename * unix_filename option) list;
|
1050 |
|
bs_ccopt: args conditional;
|
1051 |
|
bs_cclib: args conditional;
|
1052 |
|
bs_dlllib: args conditional;
|
1053 |
|
bs_dllpath: args conditional;
|
1054 |
|
bs_byteopt: args conditional;
|
1055 |
|
bs_nativeopt: args conditional;
|
1056 |
|
}
|
1057 |
|
|
1058 |
|
|
1059 |
|
type library =
|
1060 |
|
{
|
1061 |
|
lib_modules: string list;
|
1062 |
|
lib_pack: bool;
|
1063 |
|
lib_internal_modules: string list;
|
1064 |
|
lib_findlib_parent: findlib_name option;
|
1065 |
|
lib_findlib_name: findlib_name option;
|
1066 |
|
lib_findlib_containers: findlib_name list;
|
1067 |
|
}
|
1068 |
|
|
1069 |
|
type executable =
|
1070 |
|
{
|
1071 |
|
exec_custom: bool;
|
1072 |
|
exec_main_is: unix_filename;
|
1073 |
|
}
|
1074 |
|
|
1075 |
|
type flag =
|
1076 |
|
{
|
1077 |
|
flag_description: string option;
|
1078 |
|
flag_default: bool conditional;
|
1079 |
|
}
|
1080 |
|
|
1081 |
|
type source_repository =
|
1082 |
|
{
|
1083 |
|
src_repo_type: vcs;
|
1084 |
|
src_repo_location: url;
|
1085 |
|
src_repo_browser: url option;
|
1086 |
|
src_repo_module: string option;
|
1087 |
|
src_repo_branch: string option;
|
1088 |
|
src_repo_tag: string option;
|
1089 |
|
src_repo_subdir: unix_filename option;
|
1090 |
|
}
|
1091 |
|
|
1092 |
|
type test =
|
1093 |
|
{
|
1094 |
|
test_type: [`Test] plugin;
|
1095 |
|
test_command: command_line conditional;
|
1096 |
|
test_custom: custom;
|
1097 |
|
test_working_directory: unix_filename option;
|
1098 |
|
test_run: bool conditional;
|
1099 |
|
test_tools: tool list;
|
1100 |
|
}
|
1101 |
|
|
1102 |
|
type doc_format =
|
1103 |
|
| HTML of unix_filename
|
1104 |
|
| DocText
|
1105 |
|
| PDF
|
1106 |
|
| PostScript
|
1107 |
|
| Info of unix_filename
|
1108 |
|
| DVI
|
1109 |
|
| OtherDoc
|
1110 |
|
|
1111 |
|
|
1112 |
|
type doc =
|
1113 |
|
{
|
1114 |
|
doc_type: [`Doc] plugin;
|
1115 |
|
doc_custom: custom;
|
1116 |
|
doc_build: bool conditional;
|
1117 |
|
doc_install: bool conditional;
|
1118 |
|
doc_install_dir: unix_filename;
|
1119 |
|
doc_title: string;
|
1120 |
|
doc_authors: string list;
|
1121 |
|
doc_abstract: string option;
|
1122 |
|
doc_format: doc_format;
|
1123 |
|
doc_data_files: (unix_filename * unix_filename option) list;
|
1124 |
|
doc_build_tools: tool list;
|
1125 |
|
}
|
1126 |
|
|
1127 |
|
type section =
|
1128 |
|
| Library of common_section * build_section * library
|
1129 |
|
| Executable of common_section * build_section * executable
|
1130 |
|
| Flag of common_section * flag
|
1131 |
|
| SrcRepo of common_section * source_repository
|
1132 |
|
| Test of common_section * test
|
1133 |
|
| Doc of common_section * doc
|
1134 |
|
|
1135 |
|
|
1136 |
|
type section_kind =
|
1137 |
|
[ `Library | `Executable | `Flag | `SrcRepo | `Test | `Doc ]
|
1138 |
|
|
1139 |
|
type package =
|
1140 |
|
{
|
1141 |
|
oasis_version: OASISVersion.t;
|
1142 |
|
ocaml_version: OASISVersion.comparator option;
|
1143 |
|
findlib_version: OASISVersion.comparator option;
|
1144 |
|
name: package_name;
|
1145 |
|
version: OASISVersion.t;
|
1146 |
|
license: OASISLicense.t;
|
1147 |
|
license_file: unix_filename option;
|
1148 |
|
copyrights: string list;
|
1149 |
|
maintainers: string list;
|
1150 |
|
authors: string list;
|
1151 |
|
homepage: url option;
|
1152 |
|
synopsis: string;
|
1153 |
|
description: string option;
|
1154 |
|
categories: url list;
|
1155 |
|
|
1156 |
|
conf_type: [`Configure] plugin;
|
1157 |
|
conf_custom: custom;
|
1158 |
|
|
1159 |
|
build_type: [`Build] plugin;
|
1160 |
|
build_custom: custom;
|
1161 |
|
|
1162 |
|
install_type: [`Install] plugin;
|
1163 |
|
install_custom: custom;
|
1164 |
|
uninstall_custom: custom;
|
1165 |
|
|
1166 |
|
clean_custom: custom;
|
1167 |
|
distclean_custom: custom;
|
1168 |
|
|
1169 |
|
files_ab: unix_filename list;
|
1170 |
|
sections: section list;
|
1171 |
|
plugins: [`Extra] plugin list;
|
1172 |
|
schema_data: PropList.Data.t;
|
1173 |
|
plugin_data: plugin_data;
|
1174 |
|
}
|
1175 |
|
|
1176 |
|
end
|
1177 |
|
|
1178 |
|
module OASISUnixPath = struct
|
1179 |
|
(* # 21 "src/oasis/OASISUnixPath.ml" *)
|
1180 |
|
|
1181 |
|
type unix_filename = string
|
1182 |
|
type unix_dirname = string
|
1183 |
|
|
1184 |
|
type host_filename = string
|
1185 |
|
type host_dirname = string
|
1186 |
|
|
1187 |
|
let current_dir_name = "."
|
1188 |
|
|
1189 |
|
let parent_dir_name = ".."
|
1190 |
|
|
1191 |
|
let is_current_dir fn =
|
1192 |
|
fn = current_dir_name || fn = ""
|
1193 |
|
|
1194 |
|
let concat f1 f2 =
|
1195 |
|
if is_current_dir f1 then
|
1196 |
|
f2
|
1197 |
|
else
|
1198 |
|
let f1' =
|
1199 |
|
try OASISString.strip_ends_with ~what:"/" f1 with Not_found -> f1
|
1200 |
|
in
|
1201 |
|
f1'^"/"^f2
|
1202 |
|
|
1203 |
|
let make =
|
1204 |
|
function
|
1205 |
|
| hd :: tl ->
|
1206 |
|
List.fold_left
|
1207 |
|
(fun f p -> concat f p)
|
1208 |
|
hd
|
1209 |
|
tl
|
1210 |
|
| [] ->
|
1211 |
|
invalid_arg "OASISUnixPath.make"
|
1212 |
|
|
1213 |
|
let dirname f =
|
1214 |
|
try
|
1215 |
|
String.sub f 0 (String.rindex f '/')
|
1216 |
|
with Not_found ->
|
1217 |
|
current_dir_name
|
1218 |
|
|
1219 |
|
let basename f =
|
1220 |
|
try
|
1221 |
|
let pos_start =
|
1222 |
|
(String.rindex f '/') + 1
|
1223 |
|
in
|
1224 |
|
String.sub f pos_start ((String.length f) - pos_start)
|
1225 |
|
with Not_found ->
|
1226 |
|
f
|
1227 |
|
|
1228 |
|
let chop_extension f =
|
1229 |
|
try
|
1230 |
|
let last_dot =
|
1231 |
|
String.rindex f '.'
|
1232 |
|
in
|
1233 |
|
let sub =
|
1234 |
|
String.sub f 0 last_dot
|
1235 |
|
in
|
1236 |
|
try
|
1237 |
|
let last_slash =
|
1238 |
|
String.rindex f '/'
|
1239 |
|
in
|
1240 |
|
if last_slash < last_dot then
|
1241 |
|
sub
|
1242 |
|
else
|
1243 |
|
f
|
1244 |
|
with Not_found ->
|
1245 |
|
sub
|
1246 |
|
|
1247 |
|
with Not_found ->
|
1248 |
|
f
|
1249 |
|
|
1250 |
|
let capitalize_file f =
|
1251 |
|
let dir = dirname f in
|
1252 |
|
let base = basename f in
|
1253 |
|
concat dir (String.capitalize base)
|
1254 |
|
|
1255 |
|
let uncapitalize_file f =
|
1256 |
|
let dir = dirname f in
|
1257 |
|
let base = basename f in
|
1258 |
|
concat dir (String.uncapitalize base)
|
1259 |
|
|
1260 |
|
end
|
1261 |
|
|
1262 |
|
module OASISHostPath = struct
|
1263 |
|
(* # 21 "src/oasis/OASISHostPath.ml" *)
|
1264 |
|
|
1265 |
|
|
1266 |
|
open Filename
|
1267 |
|
|
1268 |
|
module Unix = OASISUnixPath
|
1269 |
|
|
1270 |
|
let make =
|
1271 |
|
function
|
1272 |
|
| [] ->
|
1273 |
|
invalid_arg "OASISHostPath.make"
|
1274 |
|
| hd :: tl ->
|
1275 |
|
List.fold_left Filename.concat hd tl
|
1276 |
|
|
1277 |
|
let of_unix ufn =
|
1278 |
|
if Sys.os_type = "Unix" then
|
1279 |
|
ufn
|
1280 |
|
else
|
1281 |
|
make
|
1282 |
|
(List.map
|
1283 |
|
(fun p ->
|
1284 |
|
if p = Unix.current_dir_name then
|
1285 |
|
current_dir_name
|
1286 |
|
else if p = Unix.parent_dir_name then
|
1287 |
|
parent_dir_name
|
1288 |
|
else
|
1289 |
|
p)
|
1290 |
|
(OASISString.nsplit ufn '/'))
|
1291 |
|
|
1292 |
|
|
1293 |
|
end
|
1294 |
|
|
1295 |
|
module OASISSection = struct
|
1296 |
|
(* # 21 "src/oasis/OASISSection.ml" *)
|
1297 |
|
|
1298 |
|
open OASISTypes
|
1299 |
|
|
1300 |
|
let section_kind_common =
|
1301 |
|
function
|
1302 |
|
| Library (cs, _, _) ->
|
1303 |
|
`Library, cs
|
1304 |
|
| Executable (cs, _, _) ->
|
1305 |
|
`Executable, cs
|
1306 |
|
| Flag (cs, _) ->
|
1307 |
|
`Flag, cs
|
1308 |
|
| SrcRepo (cs, _) ->
|
1309 |
|
`SrcRepo, cs
|
1310 |
|
| Test (cs, _) ->
|
1311 |
|
`Test, cs
|
1312 |
|
| Doc (cs, _) ->
|
1313 |
|
`Doc, cs
|
1314 |
|
|
1315 |
|
let section_common sct =
|
1316 |
|
snd (section_kind_common sct)
|
1317 |
|
|
1318 |
|
let section_common_set cs =
|
1319 |
|
function
|
1320 |
|
| Library (_, bs, lib) -> Library (cs, bs, lib)
|
1321 |
|
| Executable (_, bs, exec) -> Executable (cs, bs, exec)
|
1322 |
|
| Flag (_, flg) -> Flag (cs, flg)
|
1323 |
|
| SrcRepo (_, src_repo) -> SrcRepo (cs, src_repo)
|
1324 |
|
| Test (_, tst) -> Test (cs, tst)
|
1325 |
|
| Doc (_, doc) -> Doc (cs, doc)
|
1326 |
|
|
1327 |
|
(** Key used to identify section
|
1328 |
|
*)
|
1329 |
|
let section_id sct =
|
1330 |
|
let k, cs =
|
1331 |
|
section_kind_common sct
|
1332 |
|
in
|
1333 |
|
k, cs.cs_name
|
1334 |
|
|
1335 |
|
let string_of_section sct =
|
1336 |
|
let k, nm =
|
1337 |
|
section_id sct
|
1338 |
|
in
|
1339 |
|
(match k with
|
1340 |
|
| `Library -> "library"
|
1341 |
|
| `Executable -> "executable"
|
1342 |
|
| `Flag -> "flag"
|
1343 |
|
| `SrcRepo -> "src repository"
|
1344 |
|
| `Test -> "test"
|
1345 |
|
| `Doc -> "doc")
|
1346 |
|
^" "^nm
|
1347 |
|
|
1348 |
|
let section_find id scts =
|
1349 |
|
List.find
|
1350 |
|
(fun sct -> id = section_id sct)
|
1351 |
|
scts
|
1352 |
|
|
1353 |
|
module CSection =
|
1354 |
|
struct
|
1355 |
|
type t = section
|
1356 |
|
|
1357 |
|
let id = section_id
|
1358 |
|
|
1359 |
|
let compare t1 t2 =
|
1360 |
|
compare (id t1) (id t2)
|
1361 |
|
|
1362 |
|
let equal t1 t2 =
|
1363 |
|
(id t1) = (id t2)
|
1364 |
|
|
1365 |
|
let hash t =
|
1366 |
|
Hashtbl.hash (id t)
|
1367 |
|
end
|
1368 |
|
|
1369 |
|
module MapSection = Map.Make(CSection)
|
1370 |
|
module SetSection = Set.Make(CSection)
|
1371 |
|
|
1372 |
|
end
|
1373 |
|
|
1374 |
|
module OASISBuildSection = struct
|
1375 |
|
(* # 21 "src/oasis/OASISBuildSection.ml" *)
|
1376 |
|
|
1377 |
|
end
|
1378 |
|
|
1379 |
|
module OASISExecutable = struct
|
1380 |
|
(* # 21 "src/oasis/OASISExecutable.ml" *)
|
1381 |
|
|
1382 |
|
open OASISTypes
|
1383 |
|
|
1384 |
|
let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program =
|
1385 |
|
let dir =
|
1386 |
|
OASISUnixPath.concat
|
1387 |
|
bs.bs_path
|
1388 |
|
(OASISUnixPath.dirname exec.exec_main_is)
|
1389 |
|
in
|
1390 |
|
let is_native_exec =
|
1391 |
|
match bs.bs_compiled_object with
|
1392 |
|
| Native -> true
|
1393 |
|
| Best -> is_native ()
|
1394 |
|
| Byte -> false
|
1395 |
|
in
|
1396 |
|
|
1397 |
|
OASISUnixPath.concat
|
1398 |
|
dir
|
1399 |
|
(cs.cs_name^(suffix_program ())),
|
1400 |
|
|
1401 |
|
if not is_native_exec &&
|