Revision d1baac41
Added by Xavier Thirioux over 10 years ago
| setup.ml | ||
|---|---|---|
| 1 | 1 |
(* setup.ml generated for the first time by OASIS v0.2.0 *) |
| 2 | 2 |
|
| 3 | 3 |
(* OASIS_START *) |
| 4 |
(* DO NOT EDIT (digest: d0957d7fdd9eb6ce163190fb18a724b8) *)
|
|
| 4 |
(* DO NOT EDIT (digest: cbef9780a942e499729218b6c22c21f0) *)
|
|
| 5 | 5 |
(* |
| 6 |
Regenerated by OASIS v0.4.4
|
|
| 6 |
Regenerated by OASIS v0.3.0
|
|
| 7 | 7 |
Visit http://oasis.forge.ocamlcore.org for more information and |
| 8 | 8 |
documentation about functions used in this file. |
| 9 | 9 |
*) |
| 10 | 10 |
module OASISGettext = struct |
| 11 |
(* # 22 "src/oasis/OASISGettext.ml" *) |
|
| 12 |
|
|
| 11 |
(* # 21 "src/oasis/OASISGettext.ml" *) |
|
| 13 | 12 |
|
| 14 | 13 |
let ns_ str = |
| 15 | 14 |
str |
| 16 | 15 |
|
| 17 |
|
|
| 18 | 16 |
let s_ str = |
| 19 | 17 |
str |
| 20 | 18 |
|
| 21 |
|
|
| 22 |
let f_ (str: ('a, 'b, 'c, 'd) format4) =
|
|
| 19 |
let f_ (str : ('a, 'b, 'c, 'd) format4) =
|
|
| 23 | 20 |
str |
| 24 | 21 |
|
| 25 |
|
|
| 26 | 22 |
let fn_ fmt1 fmt2 n = |
| 27 | 23 |
if n = 1 then |
| 28 | 24 |
fmt1^^"" |
| 29 | 25 |
else |
| 30 | 26 |
fmt2^^"" |
| 31 | 27 |
|
| 32 |
|
|
| 33 | 28 |
let init = |
| 34 | 29 |
[] |
| 35 | 30 |
|
| 36 |
|
|
| 37 | 31 |
end |
| 38 | 32 |
|
| 39 | 33 |
module OASISContext = struct |
| 40 |
(* # 22 "src/oasis/OASISContext.ml" *) |
|
| 41 |
|
|
| 34 |
(* # 21 "src/oasis/OASISContext.ml" *) |
|
| 42 | 35 |
|
| 43 | 36 |
open OASISGettext |
| 44 | 37 |
|
| 45 |
|
|
| 46 | 38 |
type level = |
| 47 | 39 |
[ `Debug |
| 48 | 40 |
| `Info |
| 49 | 41 |
| `Warning |
| 50 | 42 |
| `Error] |
| 51 | 43 |
|
| 52 |
|
|
| 53 | 44 |
type t = |
| 54 | 45 |
{
|
| 55 |
(* TODO: replace this by a proplist. *) |
|
| 56 | 46 |
quiet: bool; |
| 57 | 47 |
info: bool; |
| 58 | 48 |
debug: bool; |
| ... | ... | |
| 61 | 51 |
printf: level -> string -> unit; |
| 62 | 52 |
} |
| 63 | 53 |
|
| 64 |
|
|
| 65 | 54 |
let printf lvl str = |
| 66 | 55 |
let beg = |
| 67 | 56 |
match lvl with |
| ... | ... | |
| 72 | 61 |
in |
| 73 | 62 |
prerr_endline (beg^str) |
| 74 | 63 |
|
| 75 |
|
|
| 76 | 64 |
let default = |
| 77 | 65 |
ref |
| 78 | 66 |
{
|
| ... | ... | |
| 84 | 72 |
printf = printf; |
| 85 | 73 |
} |
| 86 | 74 |
|
| 87 |
|
|
| 88 | 75 |
let quiet = |
| 89 | 76 |
{!default with quiet = true}
|
| 90 | 77 |
|
| 91 | 78 |
|
| 92 |
let fspecs () = |
|
| 93 |
(* TODO: don't act on default. *) |
|
| 94 |
let ignore_plugins = ref false in |
|
| 79 |
let args () = |
|
| 95 | 80 |
["-quiet", |
| 96 | 81 |
Arg.Unit (fun () -> default := {!default with quiet = true}),
|
| 97 |
s_ " Run quietly";
|
|
| 82 |
(s_ " Run quietly");
|
|
| 98 | 83 |
|
| 99 | 84 |
"-info", |
| 100 | 85 |
Arg.Unit (fun () -> default := {!default with info = true}),
|
| 101 |
s_ " Display information message";
|
|
| 86 |
(s_ " Display information message");
|
|
| 102 | 87 |
|
| 103 | 88 |
|
| 104 | 89 |
"-debug", |
| 105 | 90 |
Arg.Unit (fun () -> default := {!default with debug = true}),
|
| 106 |
s_ " Output debug message"; |
|
| 107 |
|
|
| 108 |
"-ignore-plugins", |
|
| 109 |
Arg.Set ignore_plugins, |
|
| 110 |
s_ " Ignore plugin's field."; |
|
| 111 |
|
|
| 112 |
"-C", |
|
| 113 |
(* TODO: remove this chdir. *) |
|
| 114 |
Arg.String (fun str -> Sys.chdir str), |
|
| 115 |
s_ "dir Change directory before running."], |
|
| 116 |
fun () -> {!default with ignore_plugins = !ignore_plugins}
|
|
| 91 |
(s_ " Output debug message")] |
|
| 117 | 92 |
end |
| 118 | 93 |
|
| 119 | 94 |
module OASISString = struct |
| 120 |
(* # 22 "src/oasis/OASISString.ml" *)
|
|
| 95 |
(* # 1 "src/oasis/OASISString.ml" *)
|
|
| 121 | 96 |
|
| 122 | 97 |
|
| 123 |
(** Various string utilities. |
|
| 124 | 98 |
|
| 99 |
(** Various string utilities. |
|
| 100 |
|
|
| 125 | 101 |
Mostly inspired by extlib and batteries ExtString and BatString libraries. |
| 126 | 102 |
|
| 127 | 103 |
@author Sylvain Le Gall |
| 128 | 104 |
*) |
| 129 | 105 |
|
| 130 |
|
|
| 131 | 106 |
let nsplitf str f = |
| 132 | 107 |
if str = "" then |
| 133 | 108 |
[] |
| ... | ... | |
| 148 | 123 |
push (); |
| 149 | 124 |
List.rev !lst |
| 150 | 125 |
|
| 151 |
|
|
| 152 | 126 |
(** [nsplit c s] Split the string [s] at char [c]. It doesn't include the |
| 153 | 127 |
separator. |
| 154 | 128 |
*) |
| 155 | 129 |
let nsplit str c = |
| 156 | 130 |
nsplitf str ((=) c) |
| 157 | 131 |
|
| 158 |
|
|
| 159 | 132 |
let find ~what ?(offset=0) str = |
| 160 | 133 |
let what_idx = ref 0 in |
| 161 |
let str_idx = ref offset in |
|
| 162 |
while !str_idx < String.length str && |
|
| 134 |
let str_idx = ref offset in
|
|
| 135 |
while !str_idx < String.length str &&
|
|
| 163 | 136 |
!what_idx < String.length what do |
| 164 | 137 |
if str.[!str_idx] = what.[!what_idx] then |
| 165 | 138 |
incr what_idx |
| ... | ... | |
| 169 | 142 |
done; |
| 170 | 143 |
if !what_idx <> String.length what then |
| 171 | 144 |
raise Not_found |
| 172 |
else |
|
| 145 |
else
|
|
| 173 | 146 |
!str_idx - !what_idx |
| 174 | 147 |
|
| 175 |
|
|
| 176 |
let sub_start str len = |
|
| 148 |
let sub_start str len = |
|
| 177 | 149 |
let str_len = String.length str in |
| 178 | 150 |
if len >= str_len then |
| 179 | 151 |
"" |
| 180 | 152 |
else |
| 181 | 153 |
String.sub str len (str_len - len) |
| 182 | 154 |
|
| 183 |
|
|
| 184 | 155 |
let sub_end ?(offset=0) str len = |
| 185 | 156 |
let str_len = String.length str in |
| 186 | 157 |
if len >= str_len then |
| ... | ... | |
| 188 | 159 |
else |
| 189 | 160 |
String.sub str 0 (str_len - len) |
| 190 | 161 |
|
| 191 |
|
|
| 192 | 162 |
let starts_with ~what ?(offset=0) str = |
| 193 | 163 |
let what_idx = ref 0 in |
| 194 | 164 |
let str_idx = ref offset in |
| 195 | 165 |
let ok = ref true in |
| 196 | 166 |
while !ok && |
| 197 |
!str_idx < String.length str && |
|
| 167 |
!str_idx < String.length str &&
|
|
| 198 | 168 |
!what_idx < String.length what do |
| 199 | 169 |
if str.[!str_idx] = what.[!what_idx] then |
| 200 | 170 |
incr what_idx |
| ... | ... | |
| 204 | 174 |
done; |
| 205 | 175 |
if !what_idx = String.length what then |
| 206 | 176 |
true |
| 207 |
else |
|
| 177 |
else
|
|
| 208 | 178 |
false |
| 209 | 179 |
|
| 210 |
|
|
| 211 | 180 |
let strip_starts_with ~what str = |
| 212 | 181 |
if starts_with ~what str then |
| 213 | 182 |
sub_start str (String.length what) |
| 214 | 183 |
else |
| 215 | 184 |
raise Not_found |
| 216 | 185 |
|
| 217 |
|
|
| 218 | 186 |
let ends_with ~what ?(offset=0) str = |
| 219 | 187 |
let what_idx = ref ((String.length what) - 1) in |
| 220 | 188 |
let str_idx = ref ((String.length str) - 1) in |
| 221 | 189 |
let ok = ref true in |
| 222 | 190 |
while !ok && |
| 223 |
offset <= !str_idx && |
|
| 191 |
offset <= !str_idx &&
|
|
| 224 | 192 |
0 <= !what_idx do |
| 225 | 193 |
if str.[!str_idx] = what.[!what_idx] then |
| 226 | 194 |
decr what_idx |
| ... | ... | |
| 230 | 198 |
done; |
| 231 | 199 |
if !what_idx = -1 then |
| 232 | 200 |
true |
| 233 |
else |
|
| 201 |
else
|
|
| 234 | 202 |
false |
| 235 | 203 |
|
| 236 |
|
|
| 237 | 204 |
let strip_ends_with ~what str = |
| 238 | 205 |
if ends_with ~what str then |
| 239 | 206 |
sub_end str (String.length what) |
| 240 | 207 |
else |
| 241 | 208 |
raise Not_found |
| 242 | 209 |
|
| 243 |
|
|
| 244 | 210 |
let replace_chars f s = |
| 245 | 211 |
let buf = String.make (String.length s) 'X' in |
| 246 | 212 |
for i = 0 to String.length s - 1 do |
| ... | ... | |
| 248 | 214 |
done; |
| 249 | 215 |
buf |
| 250 | 216 |
|
| 251 |
|
|
| 252 | 217 |
end |
| 253 | 218 |
|
| 254 | 219 |
module OASISUtils = struct |
| 255 |
(* # 22 "src/oasis/OASISUtils.ml" *) |
|
| 256 |
|
|
| 220 |
(* # 21 "src/oasis/OASISUtils.ml" *) |
|
| 257 | 221 |
|
| 258 | 222 |
open OASISGettext |
| 259 | 223 |
|
| 224 |
module MapString = Map.Make(String) |
|
| 260 | 225 |
|
| 261 |
module MapExt = |
|
| 262 |
struct |
|
| 263 |
module type S = |
|
| 264 |
sig |
|
| 265 |
include Map.S |
|
| 266 |
val add_list: 'a t -> (key * 'a) list -> 'a t |
|
| 267 |
val of_list: (key * 'a) list -> 'a t |
|
| 268 |
val to_list: 'a t -> (key * 'a) list |
|
| 269 |
end |
|
| 270 |
|
|
| 271 |
module Make (Ord: Map.OrderedType) = |
|
| 272 |
struct |
|
| 273 |
include Map.Make(Ord) |
|
| 274 |
|
|
| 275 |
let rec add_list t = |
|
| 276 |
function |
|
| 277 |
| (k, v) :: tl -> add_list (add k v t) tl |
|
| 278 |
| [] -> t |
|
| 279 |
|
|
| 280 |
let of_list lst = add_list empty lst |
|
| 281 |
|
|
| 282 |
let to_list t = fold (fun k v acc -> (k, v) :: acc) t [] |
|
| 283 |
end |
|
| 284 |
end |
|
| 285 |
|
|
| 286 |
|
|
| 287 |
module MapString = MapExt.Make(String) |
|
| 288 |
|
|
| 289 |
|
|
| 290 |
module SetExt = |
|
| 291 |
struct |
|
| 292 |
module type S = |
|
| 293 |
sig |
|
| 294 |
include Set.S |
|
| 295 |
val add_list: t -> elt list -> t |
|
| 296 |
val of_list: elt list -> t |
|
| 297 |
val to_list: t -> elt list |
|
| 298 |
end |
|
| 299 |
|
|
| 300 |
module Make (Ord: Set.OrderedType) = |
|
| 301 |
struct |
|
| 302 |
include Set.Make(Ord) |
|
| 303 |
|
|
| 304 |
let rec add_list t = |
|
| 305 |
function |
|
| 306 |
| e :: tl -> add_list (add e t) tl |
|
| 307 |
| [] -> t |
|
| 308 |
|
|
| 309 |
let of_list lst = add_list empty lst |
|
| 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 |
|
| 310 | 231 |
|
| 311 |
let to_list = elements |
|
| 312 |
end |
|
| 313 |
end |
|
| 232 |
module SetString = Set.Make(String) |
|
| 314 | 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 |
|
| 315 | 239 |
|
| 316 |
module SetString = SetExt.Make(String) |
|
| 240 |
let set_string_of_list = |
|
| 241 |
set_string_add_list |
|
| 242 |
SetString.empty |
|
| 317 | 243 |
|
| 318 | 244 |
|
| 319 | 245 |
let compare_csl s1 s2 = |
| 320 | 246 |
String.compare (String.lowercase s1) (String.lowercase s2) |
| 321 | 247 |
|
| 322 |
|
|
| 323 | 248 |
module HashStringCsl = |
| 324 | 249 |
Hashtbl.Make |
| 325 | 250 |
(struct |
| ... | ... | |
| 332 | 257 |
Hashtbl.hash (String.lowercase s) |
| 333 | 258 |
end) |
| 334 | 259 |
|
| 335 |
module SetStringCsl = |
|
| 336 |
SetExt.Make |
|
| 337 |
(struct |
|
| 338 |
type t = string |
|
| 339 |
let compare = compare_csl |
|
| 340 |
end) |
|
| 341 |
|
|
| 342 |
|
|
| 343 | 260 |
let varname_of_string ?(hyphen='_') s = |
| 344 | 261 |
if String.length s = 0 then |
| 345 | 262 |
begin |
| ... | ... | |
| 370 | 287 |
String.lowercase buf |
| 371 | 288 |
end |
| 372 | 289 |
|
| 373 |
|
|
| 374 | 290 |
let varname_concat ?(hyphen='_') p s = |
| 375 | 291 |
let what = String.make 1 hyphen in |
| 376 | 292 |
let p = |
| ... | ... | |
| 391 | 307 |
let is_varname str = |
| 392 | 308 |
str = varname_of_string str |
| 393 | 309 |
|
| 394 |
|
|
| 395 | 310 |
let failwithf fmt = Printf.ksprintf failwith fmt |
| 396 | 311 |
|
| 397 |
|
|
| 398 | 312 |
end |
| 399 | 313 |
|
| 400 | 314 |
module PropList = struct |
| 401 |
(* # 22 "src/oasis/PropList.ml" *) |
|
| 402 |
|
|
| 315 |
(* # 21 "src/oasis/PropList.ml" *) |
|
| 403 | 316 |
|
| 404 | 317 |
open OASISGettext |
| 405 | 318 |
|
| 406 |
|
|
| 407 | 319 |
type name = string |
| 408 | 320 |
|
| 409 |
|
|
| 410 | 321 |
exception Not_set of name * string option |
| 411 | 322 |
exception No_printer of name |
| 412 | 323 |
exception Unknown_field of name * name |
| 413 | 324 |
|
| 414 |
|
|
| 415 | 325 |
let () = |
| 416 | 326 |
Printexc.register_printer |
| 417 | 327 |
(function |
| 418 | 328 |
| Not_set (nm, Some rsn) -> |
| 419 |
Some |
|
| 329 |
Some
|
|
| 420 | 330 |
(Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn) |
| 421 | 331 |
| Not_set (nm, None) -> |
| 422 |
Some |
|
| 332 |
Some
|
|
| 423 | 333 |
(Printf.sprintf (f_ "Field '%s' is not set") nm) |
| 424 | 334 |
| No_printer nm -> |
| 425 | 335 |
Some |
| 426 | 336 |
(Printf.sprintf (f_ "No default printer for value %s") nm) |
| 427 | 337 |
| Unknown_field (nm, schm) -> |
| 428 |
Some |
|
| 429 |
(Printf.sprintf |
|
| 430 |
(f_ "Field %s is not defined in schema %s") nm schm) |
|
| 338 |
Some |
|
| 339 |
(Printf.sprintf (f_ "Field %s is not defined in schema %s") nm schm) |
|
| 431 | 340 |
| _ -> |
| 432 | 341 |
None) |
| 433 | 342 |
|
| 434 |
|
|
| 435 | 343 |
module Data = |
| 436 | 344 |
struct |
| 345 |
|
|
| 437 | 346 |
type t = |
| 438 | 347 |
(name, unit -> unit) Hashtbl.t |
| 439 | 348 |
|
| ... | ... | |
| 443 | 352 |
let clear t = |
| 444 | 353 |
Hashtbl.clear t |
| 445 | 354 |
|
| 446 |
|
|
| 447 |
(* # 78 "src/oasis/PropList.ml" *) |
|
| 355 |
(* # 71 "src/oasis/PropList.ml" *) |
|
| 448 | 356 |
end |
| 449 | 357 |
|
| 450 |
|
|
| 451 | 358 |
module Schema = |
| 452 | 359 |
struct |
| 360 |
|
|
| 453 | 361 |
type ('ctxt, 'extra) value =
|
| 454 | 362 |
{
|
| 455 | 363 |
get: Data.t -> string; |
| ... | ... | |
| 537 | 445 |
t.name |
| 538 | 446 |
end |
| 539 | 447 |
|
| 540 |
|
|
| 541 | 448 |
module Field = |
| 542 | 449 |
struct |
| 450 |
|
|
| 543 | 451 |
type ('ctxt, 'value, 'extra) t =
|
| 544 | 452 |
{
|
| 545 | 453 |
set: Data.t -> ?context:'ctxt -> 'value -> unit; |
| ... | ... | |
| 669 | 577 |
|
| 670 | 578 |
let fgets data t = |
| 671 | 579 |
t.gets data |
| 672 |
end |
|
| 673 | 580 |
|
| 581 |
end |
|
| 674 | 582 |
|
| 675 | 583 |
module FieldRO = |
| 676 | 584 |
struct |
| 585 |
|
|
| 677 | 586 |
let create ?schema ?name ?parse ?print ?default ?update ?help extra = |
| 678 | 587 |
let fld = |
| 679 | 588 |
Field.create ?schema ?name ?parse ?print ?default ?update ?help extra |
| 680 | 589 |
in |
| 681 | 590 |
fun data -> Field.fget data fld |
| 591 |
|
|
| 682 | 592 |
end |
| 683 | 593 |
end |
| 684 | 594 |
|
| 685 | 595 |
module OASISMessage = struct |
| 686 |
(* # 22 "src/oasis/OASISMessage.ml" *)
|
|
| 596 |
(* # 21 "src/oasis/OASISMessage.ml" *)
|
|
| 687 | 597 |
|
| 688 | 598 |
|
| 689 | 599 |
open OASISGettext |
| 690 | 600 |
open OASISContext |
| 691 | 601 |
|
| 692 |
|
|
| 693 | 602 |
let generic_message ~ctxt lvl fmt = |
| 694 | 603 |
let cond = |
| 695 | 604 |
if ctxt.quiet then |
| ... | ... | |
| 708 | 617 |
end) |
| 709 | 618 |
fmt |
| 710 | 619 |
|
| 711 |
|
|
| 712 | 620 |
let debug ~ctxt fmt = |
| 713 | 621 |
generic_message ~ctxt `Debug fmt |
| 714 | 622 |
|
| 715 |
|
|
| 716 | 623 |
let info ~ctxt fmt = |
| 717 | 624 |
generic_message ~ctxt `Info fmt |
| 718 | 625 |
|
| 719 |
|
|
| 720 | 626 |
let warning ~ctxt fmt = |
| 721 | 627 |
generic_message ~ctxt `Warning fmt |
| 722 | 628 |
|
| 723 |
|
|
| 724 | 629 |
let error ~ctxt fmt = |
| 725 | 630 |
generic_message ~ctxt `Error fmt |
| 726 | 631 |
|
| 727 | 632 |
end |
| 728 | 633 |
|
| 729 | 634 |
module OASISVersion = struct |
| 730 |
(* # 22 "src/oasis/OASISVersion.ml" *) |
|
| 731 |
|
|
| 635 |
(* # 21 "src/oasis/OASISVersion.ml" *) |
|
| 732 | 636 |
|
| 733 | 637 |
open OASISGettext |
| 734 | 638 |
|
| 735 | 639 |
|
| 736 | 640 |
|
| 737 |
|
|
| 738 |
|
|
| 739 | 641 |
type s = string |
| 740 | 642 |
|
| 741 |
|
|
| 742 |
type t = string |
|
| 743 |
|
|
| 643 |
type t = string |
|
| 744 | 644 |
|
| 745 | 645 |
type comparator = |
| 746 | 646 |
| VGreater of t |
| ... | ... | |
| 750 | 650 |
| VLesserEqual of t |
| 751 | 651 |
| VOr of comparator * comparator |
| 752 | 652 |
| VAnd of comparator * comparator |
| 753 |
|
|
| 754 |
|
|
| 653 |
|
|
| 755 | 654 |
|
| 756 | 655 |
(* Range of allowed characters *) |
| 757 | 656 |
let is_digit c = |
| 758 | 657 |
'0' <= c && c <= '9' |
| 759 | 658 |
|
| 760 |
|
|
| 761 | 659 |
let is_alpha c = |
| 762 | 660 |
('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')
|
| 763 | 661 |
|
| 764 |
|
|
| 765 | 662 |
let is_special = |
| 766 | 663 |
function |
| 767 | 664 |
| '.' | '+' | '-' | '~' -> true |
| 768 | 665 |
| _ -> false |
| 769 | 666 |
|
| 770 |
|
|
| 771 | 667 |
let rec version_compare v1 v2 = |
| 772 | 668 |
if v1 <> "" || v2 <> "" then |
| 773 | 669 |
begin |
| ... | ... | |
| 811 | 707 |
while !p < String.length v && is_digit v.[!p] do |
| 812 | 708 |
incr p |
| 813 | 709 |
done; |
| 814 |
let substr = |
|
| 710 |
let substr =
|
|
| 815 | 711 |
String.sub v !p ((String.length v) - !p) |
| 816 |
in |
|
| 817 |
let res = |
|
| 818 |
match String.sub v start_p (!p - start_p) with |
|
| 712 |
in
|
|
| 713 |
let res =
|
|
| 714 |
match String.sub v start_p (!p - start_p) with
|
|
| 819 | 715 |
| "" -> 0 |
| 820 | 716 |
| s -> int_of_string s |
| 821 | 717 |
in |
| ... | ... | |
| 851 | 747 |
|
| 852 | 748 |
let version_of_string str = str |
| 853 | 749 |
|
| 854 |
|
|
| 855 | 750 |
let string_of_version t = t |
| 856 | 751 |
|
| 857 |
|
|
| 858 |
let version_compare_string s1 s2 = |
|
| 859 |
version_compare (version_of_string s1) (version_of_string s2) |
|
| 860 |
|
|
| 861 |
|
|
| 862 | 752 |
let chop t = |
| 863 | 753 |
try |
| 864 | 754 |
let pos = |
| ... | ... | |
| 868 | 758 |
with Not_found -> |
| 869 | 759 |
t |
| 870 | 760 |
|
| 871 |
|
|
| 872 | 761 |
let rec comparator_apply v op = |
| 873 | 762 |
match op with |
| 874 | 763 |
| VGreater cv -> |
| ... | ... | |
| 886 | 775 |
| VAnd (op1, op2) -> |
| 887 | 776 |
(comparator_apply v op1) && (comparator_apply v op2) |
| 888 | 777 |
|
| 889 |
|
|
| 890 | 778 |
let rec string_of_comparator = |
| 891 | 779 |
function |
| 892 | 780 |
| VGreater v -> "> "^(string_of_version v) |
| ... | ... | |
| 899 | 787 |
| VAnd (c1, c2) -> |
| 900 | 788 |
(string_of_comparator c1)^" && "^(string_of_comparator c2) |
| 901 | 789 |
|
| 902 |
|
|
| 903 | 790 |
let rec varname_of_comparator = |
| 904 | 791 |
let concat p v = |
| 905 | 792 |
OASISUtils.varname_concat |
| ... | ... | |
| 918 | 805 |
| VAnd (c1, c2) -> |
| 919 | 806 |
(varname_of_comparator c1)^"_and_"^(varname_of_comparator c2) |
| 920 | 807 |
|
| 921 |
|
|
| 922 |
let rec comparator_ge v' = |
|
| 923 |
let cmp v = version_compare v v' >= 0 in |
|
| 924 |
function |
|
| 925 |
| VEqual v |
|
| 926 |
| VGreaterEqual v |
|
| 927 |
| VGreater v -> cmp v |
|
| 928 |
| VLesserEqual _ |
|
| 929 |
| VLesser _ -> false |
|
| 930 |
| VOr (c1, c2) -> comparator_ge v' c1 || comparator_ge v' c2 |
|
| 931 |
| VAnd (c1, c2) -> comparator_ge v' c1 && comparator_ge v' c2 |
|
| 932 |
|
|
| 808 |
let version_0_3_or_after t = |
|
| 809 |
comparator_apply t (VGreaterEqual (string_of_version "0.3")) |
|
| 933 | 810 |
|
| 934 | 811 |
end |
| 935 | 812 |
|
| 936 | 813 |
module OASISLicense = struct |
| 937 |
(* # 22 "src/oasis/OASISLicense.ml" *) |
|
| 938 |
|
|
| 814 |
(* # 21 "src/oasis/OASISLicense.ml" *) |
|
| 939 | 815 |
|
| 940 | 816 |
(** License for _oasis fields |
| 941 | 817 |
@author Sylvain Le Gall |
| ... | ... | |
| 943 | 819 |
|
| 944 | 820 |
|
| 945 | 821 |
|
| 822 |
type license = string |
|
| 946 | 823 |
|
| 947 |
|
|
| 948 |
type license = string |
|
| 949 |
|
|
| 950 |
|
|
| 951 |
type license_exception = string |
|
| 952 |
|
|
| 824 |
type license_exception = string |
|
| 953 | 825 |
|
| 954 | 826 |
type license_version = |
| 955 | 827 |
| Version of OASISVersion.t |
| 956 | 828 |
| VersionOrLater of OASISVersion.t |
| 957 | 829 |
| NoVersion |
| 958 |
|
|
| 959 |
|
|
| 830 |
|
|
| 960 | 831 |
|
| 961 | 832 |
type license_dep_5_unit = |
| 962 | 833 |
{
|
| ... | ... | |
| 964 | 835 |
excption: license_exception option; |
| 965 | 836 |
version: license_version; |
| 966 | 837 |
} |
| 967 |
|
|
| 968 |
|
|
| 838 |
|
|
| 969 | 839 |
|
| 970 | 840 |
type license_dep_5 = |
| 971 | 841 |
| DEP5Unit of license_dep_5_unit |
| 972 | 842 |
| DEP5Or of license_dep_5 list |
| 973 | 843 |
| DEP5And of license_dep_5 list |
| 974 |
|
|
| 844 |
|
|
| 975 | 845 |
|
| 976 | 846 |
type t = |
| 977 | 847 |
| DEP5License of license_dep_5 |
| 978 | 848 |
| OtherLicense of string (* URL *) |
| 979 |
|
|
| 980 |
|
|
| 849 |
|
|
| 981 | 850 |
|
| 982 | 851 |
end |
| 983 | 852 |
|
| 984 | 853 |
module OASISExpr = struct |
| 985 |
(* # 22 "src/oasis/OASISExpr.ml" *) |
|
| 986 |
|
|
| 987 |
|
|
| 854 |
(* # 21 "src/oasis/OASISExpr.ml" *) |
|
| 988 | 855 |
|
| 989 | 856 |
|
| 990 | 857 |
|
| 991 | 858 |
open OASISGettext |
| 992 | 859 |
|
| 860 |
type test = string |
|
| 993 | 861 |
|
| 994 |
type test = string |
|
| 995 |
|
|
| 996 |
|
|
| 997 |
type flag = string |
|
| 998 |
|
|
| 862 |
type flag = string |
|
| 999 | 863 |
|
| 1000 | 864 |
type t = |
| 1001 | 865 |
| EBool of bool |
| ... | ... | |
| 1004 | 868 |
| EOr of t * t |
| 1005 | 869 |
| EFlag of flag |
| 1006 | 870 |
| ETest of test * string |
| 871 |
|
|
| 1007 | 872 |
|
| 1008 |
|
|
| 1009 |
|
|
| 1010 |
type 'a choices = (t * 'a) list |
|
| 1011 |
|
|
| 873 |
type 'a choices = (t * 'a) list |
|
| 1012 | 874 |
|
| 1013 | 875 |
let eval var_get t = |
| 1014 | 876 |
let rec eval' = |
| ... | ... | |
| 1040 | 902 |
in |
| 1041 | 903 |
eval' t |
| 1042 | 904 |
|
| 1043 |
|
|
| 1044 | 905 |
let choose ?printer ?name var_get lst = |
| 1045 | 906 |
let rec choose_aux = |
| 1046 | 907 |
function |
| ... | ... | |
| 1077 | 938 |
in |
| 1078 | 939 |
choose_aux (List.rev lst) |
| 1079 | 940 |
|
| 1080 |
|
|
| 1081 |
end |
|
| 1082 |
|
|
| 1083 |
module OASISText = struct |
|
| 1084 |
(* # 22 "src/oasis/OASISText.ml" *) |
|
| 1085 |
|
|
| 1086 |
|
|
| 1087 |
|
|
| 1088 |
type elt = |
|
| 1089 |
| Para of string |
|
| 1090 |
| Verbatim of string |
|
| 1091 |
| BlankLine |
|
| 1092 |
|
|
| 1093 |
|
|
| 1094 |
type t = elt list |
|
| 1095 |
|
|
| 1096 | 941 |
end |
| 1097 | 942 |
|
| 1098 | 943 |
module OASISTypes = struct |
| 1099 |
(* # 22 "src/oasis/OASISTypes.ml" *) |
|
| 1100 |
|
|
| 1101 |
|
|
| 944 |
(* # 21 "src/oasis/OASISTypes.ml" *) |
|
| 1102 | 945 |
|
| 1103 | 946 |
|
| 1104 | 947 |
|
| 1105 |
type name = string |
|
| 1106 |
type package_name = string |
|
| 1107 |
type url = string |
|
| 1108 |
type unix_dirname = string |
|
| 1109 |
type unix_filename = string |
|
| 1110 |
type host_dirname = string |
|
| 1111 |
type host_filename = string |
|
| 1112 |
type prog = string |
|
| 1113 |
type arg = string |
|
| 1114 |
type args = string list |
|
| 1115 |
type command_line = (prog * arg list) |
|
| 1116 | 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) |
|
| 1117 | 960 |
|
| 1118 |
type findlib_name = string |
|
| 1119 |
type findlib_full = string |
|
| 1120 |
|
|
| 961 |
type findlib_name = string |
|
| 962 |
type findlib_full = string |
|
| 1121 | 963 |
|
| 1122 | 964 |
type compiled_object = |
| 1123 | 965 |
| Byte |
| 1124 | 966 |
| Native |
| 1125 | 967 |
| Best |
| 1126 |
|
|
| 1127 |
|
|
| 968 |
|
|
| 1128 | 969 |
|
| 1129 | 970 |
type dependency = |
| 1130 | 971 |
| FindlibPackage of findlib_full * OASISVersion.comparator option |
| 1131 | 972 |
| InternalLibrary of name |
| 1132 |
|
|
| 1133 |
|
|
| 973 |
|
|
| 1134 | 974 |
|
| 1135 | 975 |
type tool = |
| 1136 | 976 |
| ExternalTool of name |
| 1137 | 977 |
| InternalExecutable of name |
| 1138 |
|
|
| 1139 |
|
|
| 978 |
|
|
| 1140 | 979 |
|
| 1141 | 980 |
type vcs = |
| 1142 | 981 |
| Darcs |
| ... | ... | |
| 1148 | 987 |
| Arch |
| 1149 | 988 |
| Monotone |
| 1150 | 989 |
| OtherVCS of url |
| 1151 |
|
|
| 1152 |
|
|
| 990 |
|
|
| 1153 | 991 |
|
| 1154 | 992 |
type plugin_kind = |
| 1155 | 993 |
[ `Configure |
| ... | ... | |
| 1160 | 998 |
| `Extra |
| 1161 | 999 |
] |
| 1162 | 1000 |
|
| 1163 |
|
|
| 1164 | 1001 |
type plugin_data_purpose = |
| 1165 | 1002 |
[ `Configure |
| 1166 | 1003 |
| `Build |
| ... | ... | |
| 1175 | 1012 |
| `Other of string |
| 1176 | 1013 |
] |
| 1177 | 1014 |
|
| 1178 |
|
|
| 1179 |
type 'a plugin = 'a * name * OASISVersion.t option |
|
| 1180 |
|
|
| 1015 |
type 'a plugin = 'a * name * OASISVersion.t option |
|
| 1181 | 1016 |
|
| 1182 | 1017 |
type all_plugin = plugin_kind plugin |
| 1183 | 1018 |
|
| 1184 |
|
|
| 1185 | 1019 |
type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list |
| 1186 | 1020 |
|
| 1021 |
(* # 102 "src/oasis/OASISTypes.ml" *) |
|
| 1187 | 1022 |
|
| 1188 |
(* # 115 "src/oasis/OASISTypes.ml" *) |
|
| 1189 |
|
|
| 1190 |
|
|
| 1191 |
type 'a conditional = 'a OASISExpr.choices |
|
| 1192 |
|
|
| 1023 |
type 'a conditional = 'a OASISExpr.choices |
|
| 1193 | 1024 |
|
| 1194 | 1025 |
type custom = |
| 1195 | 1026 |
{
|
| 1196 | 1027 |
pre_command: (command_line option) conditional; |
| 1197 | 1028 |
post_command: (command_line option) conditional; |
| 1198 | 1029 |
} |
| 1199 |
|
|
| 1200 |
|
|
| 1030 |
|
|
| 1201 | 1031 |
|
| 1202 | 1032 |
type common_section = |
| 1203 | 1033 |
{
|
| ... | ... | |
| 1205 | 1035 |
cs_data: PropList.Data.t; |
| 1206 | 1036 |
cs_plugin_data: plugin_data; |
| 1207 | 1037 |
} |
| 1208 |
|
|
| 1209 |
|
|
| 1038 |
|
|
| 1210 | 1039 |
|
| 1211 | 1040 |
type build_section = |
| 1212 | 1041 |
{
|
| ... | ... | |
| 1225 | 1054 |
bs_byteopt: args conditional; |
| 1226 | 1055 |
bs_nativeopt: args conditional; |
| 1227 | 1056 |
} |
| 1228 |
|
|
| 1229 |
|
|
| 1057 |
|
|
| 1230 | 1058 |
|
| 1231 | 1059 |
type library = |
| 1232 | 1060 |
{
|
| ... | ... | |
| 1236 | 1064 |
lib_findlib_parent: findlib_name option; |
| 1237 | 1065 |
lib_findlib_name: findlib_name option; |
| 1238 | 1066 |
lib_findlib_containers: findlib_name list; |
| 1239 |
} |
|
| 1240 |
|
|
| 1241 |
|
|
| 1242 |
type object_ = |
|
| 1243 |
{
|
|
| 1244 |
obj_modules: string list; |
|
| 1245 |
obj_findlib_fullname: findlib_name list option; |
|
| 1246 |
} |
|
| 1247 |
|
|
| 1067 |
} |
|
| 1248 | 1068 |
|
| 1249 | 1069 |
type executable = |
| 1250 | 1070 |
{
|
| 1251 | 1071 |
exec_custom: bool; |
| 1252 | 1072 |
exec_main_is: unix_filename; |
| 1253 |
} |
|
| 1254 |
|
|
| 1073 |
} |
|
| 1255 | 1074 |
|
| 1256 | 1075 |
type flag = |
| 1257 | 1076 |
{
|
| 1258 | 1077 |
flag_description: string option; |
| 1259 | 1078 |
flag_default: bool conditional; |
| 1260 |
} |
|
| 1261 |
|
|
| 1079 |
} |
|
| 1262 | 1080 |
|
| 1263 | 1081 |
type source_repository = |
| 1264 | 1082 |
{
|
| ... | ... | |
| 1269 | 1087 |
src_repo_branch: string option; |
| 1270 | 1088 |
src_repo_tag: string option; |
| 1271 | 1089 |
src_repo_subdir: unix_filename option; |
| 1272 |
} |
|
| 1273 |
|
|
| 1090 |
} |
|
| 1274 | 1091 |
|
| 1275 | 1092 |
type test = |
| 1276 | 1093 |
{
|
| ... | ... | |
| 1280 | 1097 |
test_working_directory: unix_filename option; |
| 1281 | 1098 |
test_run: bool conditional; |
| 1282 | 1099 |
test_tools: tool list; |
| 1283 |
} |
|
| 1284 |
|
|
| 1100 |
} |
|
| 1285 | 1101 |
|
| 1286 | 1102 |
type doc_format = |
| 1287 | 1103 |
| HTML of unix_filename |
| ... | ... | |
| 1291 | 1107 |
| Info of unix_filename |
| 1292 | 1108 |
| DVI |
| 1293 | 1109 |
| OtherDoc |
| 1294 |
|
|
| 1295 |
|
|
| 1110 |
|
|
| 1296 | 1111 |
|
| 1297 | 1112 |
type doc = |
| 1298 |
{
|
|
| 1299 |
doc_type: [`Doc] plugin; |
|
| 1300 |
doc_custom: custom; |
|
| 1301 |
doc_build: bool conditional; |
|
| 1302 |
doc_install: bool conditional; |
|
| 1303 |
doc_install_dir: unix_filename; |
|
| 1304 |
doc_title: string; |
|
| 1305 |
doc_authors: string list; |
|
| 1306 |
doc_abstract: string option; |
|
| 1307 |
doc_format: doc_format; |
|
| 1308 |
doc_data_files: (unix_filename * unix_filename option) list; |
|
| 1309 |
doc_build_tools: tool list; |
|
| 1310 |
} |
|
| 1311 |
|
|
| 1312 |
|
|
| 1313 |
type section = |
|
| 1314 |
| Library of common_section * build_section * library |
|
| 1315 |
| Object of common_section * build_section * object_ |
|
| 1316 |
| Executable of common_section * build_section * executable |
|
| 1317 |
| Flag of common_section * flag |
|
| 1318 |
| SrcRepo of common_section * source_repository |
|
| 1319 |
| Test of common_section * test |
|
| 1320 |
| Doc of common_section * doc |
|
| 1321 |
|
|
| 1322 |
|
|
| 1323 |
|
|
| 1324 |
type section_kind = |
|
| 1325 |
[ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ] |
|
| 1326 |
|
|
| 1327 |
|
|
| 1328 |
type package = |
|
| 1329 |
{
|
|
| 1330 |
oasis_version: OASISVersion.t; |
|
| 1331 |
ocaml_version: OASISVersion.comparator option; |
|
| 1332 |
findlib_version: OASISVersion.comparator option; |
|
| 1333 |
alpha_features: string list; |
|
| 1334 |
beta_features: string list; |
|
| 1335 |
name: package_name; |
|
| 1336 |
version: OASISVersion.t; |
|
| 1337 |
license: OASISLicense.t; |
|
| 1338 |
license_file: unix_filename option; |
|
| 1339 |
copyrights: string list; |
|
| 1340 |
maintainers: string list; |
|
| 1341 |
authors: string list; |
|
| 1342 |
homepage: url option; |
|
| 1343 |
synopsis: string; |
|
| 1344 |
description: OASISText.t option; |
|
| 1345 |
categories: url list; |
|
| 1346 |
|
|
| 1347 |
conf_type: [`Configure] plugin; |
|
| 1348 |
conf_custom: custom; |
|
| 1349 |
|
|
| 1350 |
build_type: [`Build] plugin; |
|
| 1351 |
build_custom: custom; |
|
| 1352 |
|
|
| 1353 |
install_type: [`Install] plugin; |
|
| 1354 |
install_custom: custom; |
|
| 1355 |
uninstall_custom: custom; |
|
| 1356 |
|
|
| 1357 |
clean_custom: custom; |
|
| 1358 |
distclean_custom: custom; |
|
| 1359 |
|
|
| 1360 |
files_ab: unix_filename list; |
|
| 1361 |
sections: section list; |
|
| 1362 |
plugins: [`Extra] plugin list; |
|
| 1363 |
disable_oasis_section: unix_filename list; |
|
| 1364 |
schema_data: PropList.Data.t; |
|
| 1365 |
plugin_data: plugin_data; |
|
| 1366 |
} |
|
| 1367 |
|
|
| 1368 |
|
|
| 1369 |
end |
|
| 1370 |
|
|
| 1371 |
module OASISFeatures = struct |
|
| 1372 |
(* # 22 "src/oasis/OASISFeatures.ml" *) |
|
| 1373 |
|
|
| 1374 |
open OASISTypes |
|
| 1375 |
open OASISUtils |
|
| 1376 |
open OASISGettext |
|
| 1377 |
open OASISVersion |
|
| 1378 |
|
|
| 1379 |
module MapPlugin = |
|
| 1380 |
Map.Make |
|
| 1381 |
(struct |
|
| 1382 |
type t = plugin_kind * name |
|
| 1383 |
let compare = Pervasives.compare |
|
| 1384 |
end) |
|
| 1385 |
|
|
| 1386 |
module Data = |
|
| 1387 |
struct |
|
| 1388 |
type t = |
|
| 1389 |
{
|
|
| 1390 |
oasis_version: OASISVersion.t; |
|
| 1391 |
plugin_versions: OASISVersion.t option MapPlugin.t; |
|
| 1392 |
alpha_features: string list; |
|
| 1393 |
beta_features: string list; |
|
| 1394 |
} |
|
| 1395 |
|
|
| 1396 |
let create oasis_version alpha_features beta_features = |
|
| 1397 |
{
|
|
| 1398 |
oasis_version = oasis_version; |
|
| 1399 |
plugin_versions = MapPlugin.empty; |
|
| 1400 |
alpha_features = alpha_features; |
|
| 1401 |
beta_features = beta_features |
|
| 1402 |
} |
|
| 1403 |
|
|
| 1404 |
let of_package pkg = |
|
| 1405 |
create |
|
| 1406 |
pkg.OASISTypes.oasis_version |
|
| 1407 |
pkg.OASISTypes.alpha_features |
|
| 1408 |
pkg.OASISTypes.beta_features |
|
| 1409 |
|
|
| 1410 |
let add_plugin (plugin_kind, plugin_name, plugin_version) t = |
|
| 1411 |
{t with
|
|
| 1412 |
plugin_versions = MapPlugin.add |
|
| 1413 |
(plugin_kind, plugin_name) |
|
| 1414 |
plugin_version |
|
| 1415 |
t.plugin_versions} |
|
| 1416 |
|
|
| 1417 |
let plugin_version plugin_kind plugin_name t = |
|
| 1418 |
MapPlugin.find (plugin_kind, plugin_name) t.plugin_versions |
|
| 1419 |
|
|
| 1420 |
let to_string t = |
|
| 1421 |
Printf.sprintf |
|
| 1422 |
"oasis_version: %s; alpha_features: %s; beta_features: %s; \ |
|
| 1423 |
plugins_version: %s" |
|
| 1424 |
(OASISVersion.string_of_version t.oasis_version) |
|
| 1425 |
(String.concat ", " t.alpha_features) |
|
| 1426 |
(String.concat ", " t.beta_features) |
|
| 1427 |
(String.concat ", " |
|
| 1428 |
(MapPlugin.fold |
|
| 1429 |
(fun (_, plg) ver_opt acc -> |
|
| 1430 |
(plg^ |
|
| 1431 |
(match ver_opt with |
|
| 1432 |
| Some v -> |
|
| 1433 |
" "^(OASISVersion.string_of_version v) |
|
| 1434 |
| None -> "")) |
|
| 1435 |
:: acc) |
|
| 1436 |
t.plugin_versions [])) |
|
| 1437 |
end |
|
| 1438 |
|
|
| 1439 |
type origin = |
|
| 1440 |
| Field of string * string |
|
| 1441 |
| Section of string |
|
| 1442 |
| NoOrigin |
|
| 1443 |
|
|
| 1444 |
type stage = Alpha | Beta |
|
| 1445 |
|
|
| 1446 |
|
|
| 1447 |
let string_of_stage = |
|
| 1448 |
function |
|
| 1449 |
| Alpha -> "alpha" |
|
| 1450 |
| Beta -> "beta" |
|
| 1451 |
|
|
| 1452 |
|
|
| 1453 |
let field_of_stage = |
|
| 1454 |
function |
|
| 1455 |
| Alpha -> "AlphaFeatures" |
|
| 1456 |
| Beta -> "BetaFeatures" |
|
| 1457 |
|
|
| 1458 |
type publication = InDev of stage | SinceVersion of OASISVersion.t |
|
| 1459 |
|
|
| 1460 |
type t = |
|
| 1461 |
{
|
|
| 1462 |
name: string; |
|
| 1463 |
plugin: all_plugin option; |
|
| 1464 |
publication: publication; |
|
| 1465 |
description: unit -> string; |
|
| 1466 |
} |
|
| 1467 |
|
|
| 1468 |
(* TODO: mutex protect this. *) |
|
| 1469 |
let all_features = Hashtbl.create 13 |
|
| 1470 |
|
|
| 1471 |
|
|
| 1472 |
let since_version ver_str = SinceVersion (version_of_string ver_str) |
|
| 1473 |
let alpha = InDev Alpha |
|
| 1474 |
let beta = InDev Beta |
|
| 1475 |
|
|
| 1476 |
|
|
| 1477 |
let to_string t = |
|
| 1478 |
Printf.sprintf |
|
| 1479 |
"feature: %s; plugin: %s; publication: %s" |
|
| 1480 |
t.name |
|
| 1481 |
(match t.plugin with |
|
| 1482 |
| None -> "<none>" |
|
| 1483 |
| Some (_, nm, _) -> nm) |
|
| 1484 |
(match t.publication with |
|
| 1485 |
| InDev stage -> string_of_stage stage |
|
| 1486 |
| SinceVersion ver -> ">= "^(OASISVersion.string_of_version ver)) |
|
| 1487 |
|
|
| 1488 |
let data_check t data origin = |
|
| 1489 |
let no_message = "no message" in |
|
| 1490 |
|
|
| 1491 |
let check_feature features stage = |
|
| 1492 |
let has_feature = List.mem t.name features in |
|
| 1493 |
if not has_feature then |
|
| 1494 |
match origin with |
|
| 1495 |
| Field (fld, where) -> |
|
| 1496 |
Some |
|
| 1497 |
(Printf.sprintf |
|
| 1498 |
(f_ "Field %s in %s is only available when feature %s \ |
|
| 1499 |
is in field %s.") |
|
| 1500 |
fld where t.name (field_of_stage stage)) |
|
| 1501 |
| Section sct -> |
|
| 1502 |
Some |
|
| 1503 |
(Printf.sprintf |
|
| 1504 |
(f_ "Section %s is only available when features %s \ |
|
| 1505 |
is in field %s.") |
|
| 1506 |
sct t.name (field_of_stage stage)) |
|
| 1507 |
| NoOrigin -> |
|
| 1508 |
Some no_message |
|
| 1509 |
else |
|
| 1510 |
None |
|
| 1511 |
in |
|
| 1512 |
|
|
| 1513 |
let version_is_good ~min_version version fmt = |
|
| 1514 |
let version_is_good = |
|
| 1515 |
OASISVersion.comparator_apply |
|
| 1516 |
version (OASISVersion.VGreaterEqual min_version) |
|
| 1517 |
in |
|
| 1518 |
Printf.ksprintf |
|
| 1519 |
(fun str -> |
|
| 1520 |
if version_is_good then |
|
| 1521 |
None |
|
| 1522 |
else |
|
| 1523 |
Some str) |
|
| 1524 |
fmt |
|
| 1525 |
in |
|
| 1526 |
|
|
| 1527 |
match origin, t.plugin, t.publication with |
|
| 1528 |
| _, _, InDev Alpha -> check_feature data.Data.alpha_features Alpha |
|
| 1529 |
| _, _, InDev Beta -> check_feature data.Data.beta_features Beta |
|
| 1530 |
| Field(fld, where), None, SinceVersion min_version -> |
|
| 1531 |
version_is_good ~min_version data.Data.oasis_version |
|
| 1532 |
(f_ "Field %s in %s is only valid since OASIS v%s, update \ |
|
| 1533 |
OASISFormat field from '%s' to '%s' after checking \ |
|
| 1534 |
OASIS changelog.") |
|
| 1535 |
fld where (string_of_version min_version) |
|
| 1536 |
(string_of_version data.Data.oasis_version) |
|
| 1537 |
(string_of_version min_version) |
|
| 1538 |
|
|
| 1539 |
| Field(fld, where), Some(plugin_knd, plugin_name, _), |
|
| 1540 |
SinceVersion min_version -> |
|
| 1541 |
begin |
|
| 1542 |
try |
|
| 1543 |
let plugin_version_current = |
|
| 1544 |
try |
|
| 1545 |
match Data.plugin_version plugin_knd plugin_name data with |
|
| 1546 |
| Some ver -> ver |
|
| 1547 |
| None -> |
|
| 1548 |
failwithf |
|
| 1549 |
(f_ "Field %s in %s is only valid for the OASIS \ |
|
| 1550 |
plugin %s since v%s, but no plugin version is \ |
|
| 1551 |
defined in the _oasis file, change '%s' to \ |
|
| 1552 |
'%s (%s)' in your _oasis file.") |
|
| 1553 |
fld where plugin_name (string_of_version min_version) |
|
| 1554 |
plugin_name |
|
| 1555 |
plugin_name (string_of_version min_version) |
|
| 1556 |
with Not_found -> |
|
| 1557 |
failwithf |
|
| 1558 |
(f_ "Field %s in %s is only valid when the OASIS plugin %s \ |
|
| 1559 |
is defined.") |
|
| 1560 |
fld where plugin_name |
|
| 1561 |
in |
|
| 1562 |
version_is_good ~min_version plugin_version_current |
|
| 1563 |
(f_ "Field %s in %s is only valid for the OASIS plugin %s \ |
|
| 1564 |
since v%s, update your plugin from '%s (%s)' to \ |
|
| 1565 |
'%s (%s)' after checking the plugin's changelog.") |
|
| 1566 |
fld where plugin_name (string_of_version min_version) |
|
| 1567 |
plugin_name (string_of_version plugin_version_current) |
|
| 1568 |
plugin_name (string_of_version min_version) |
|
| 1569 |
with Failure msg -> |
|
| 1570 |
Some msg |
|
| 1571 |
end |
|
| 1572 |
|
|
| 1573 |
| Section sct, None, SinceVersion min_version -> |
|
| 1574 |
version_is_good ~min_version data.Data.oasis_version |
|
| 1575 |
(f_ "Section %s is only valid for since OASIS v%s, update \ |
|
| 1576 |
OASISFormat field from '%s' to '%s' after checking OASIS \ |
|
| 1577 |
changelog.") |
|
| 1578 |
sct (string_of_version min_version) |
|
| 1579 |
(string_of_version data.Data.oasis_version) |
|
| 1580 |
(string_of_version min_version) |
|
| 1581 |
|
|
| 1582 |
| Section sct, Some(plugin_knd, plugin_name, _), |
|
| 1583 |
SinceVersion min_version -> |
|
| 1584 |
begin |
|
| 1585 |
try |
|
| 1586 |
let plugin_version_current = |
|
| 1587 |
try |
|
| 1588 |
match Data.plugin_version plugin_knd plugin_name data with |
|
| 1589 |
| Some ver -> ver |
|
| 1590 |
| None -> |
|
| 1591 |
failwithf |
|
| 1592 |
(f_ "Section %s is only valid for the OASIS \ |
|
| 1593 |
plugin %s since v%s, but no plugin version is \ |
|
| 1594 |
defined in the _oasis file, change '%s' to \ |
|
| 1595 |
'%s (%s)' in your _oasis file.") |
|
| 1596 |
sct plugin_name (string_of_version min_version) |
|
| 1597 |
plugin_name |
|
| 1598 |
plugin_name (string_of_version min_version) |
|
| 1599 |
with Not_found -> |
|
| 1600 |
failwithf |
|
| 1601 |
(f_ "Section %s is only valid when the OASIS plugin %s \ |
|
| 1602 |
is defined.") |
|
| 1603 |
sct plugin_name |
|
| 1604 |
in |
|
| 1605 |
version_is_good ~min_version plugin_version_current |
|
| 1606 |
(f_ "Section %s is only valid for the OASIS plugin %s \ |
|
| 1607 |
since v%s, update your plugin from '%s (%s)' to \ |
|
| 1608 |
'%s (%s)' after checking the plugin's changelog.") |
|
| 1609 |
sct plugin_name (string_of_version min_version) |
|
| 1610 |
plugin_name (string_of_version plugin_version_current) |
|
| 1611 |
plugin_name (string_of_version min_version) |
|
| 1612 |
with Failure msg -> |
|
| 1613 |
Some msg |
|
| 1614 |
end |
|
| 1615 |
|
|
| 1616 |
| NoOrigin, None, SinceVersion min_version -> |
|
| 1617 |
version_is_good ~min_version data.Data.oasis_version "%s" no_message |
|
| 1618 |
|
|
| 1619 |
| NoOrigin, Some(plugin_knd, plugin_name, _), SinceVersion min_version -> |
|
| 1620 |
begin |
|
| 1621 |
try |
|
| 1622 |
let plugin_version_current = |
|
| 1623 |
match Data.plugin_version plugin_knd plugin_name data with |
|
| 1624 |
| Some ver -> ver |
|
| 1625 |
| None -> raise Not_found |
|
| 1626 |
in |
|
| 1627 |
version_is_good ~min_version plugin_version_current |
|
| 1628 |
"%s" no_message |
|
| 1629 |
with Not_found -> |
|
| 1630 |
Some no_message |
|
| 1631 |
end |
|
| 1632 |
|
|
| 1633 |
|
|
| 1634 |
let data_assert t data origin = |
|
| 1635 |
match data_check t data origin with |
|
| 1636 |
| None -> () |
|
| 1637 |
| Some str -> failwith str |
|
| 1638 |
|
|
| 1639 |
|
|
| 1640 |
let data_test t data = |
|
| 1641 |
match data_check t data NoOrigin with |
|
| 1642 |
| None -> true |
|
| 1643 |
| Some str -> false |
|
| 1644 |
|
|
| 1645 |
|
|
| 1646 |
let package_test t pkg = |
|
| 1647 |
data_test t (Data.of_package pkg) |
|
| 1648 |
|
|
| 1649 |
|
|
| 1650 |
let create ?plugin name publication description = |
|
| 1651 |
let () = |
|
| 1652 |
if Hashtbl.mem all_features name then |
|
| 1653 |
failwithf "Feature '%s' is already declared." name |
|
| 1654 |
in |
|
| 1655 |
let t = |
|
| 1656 |
{
|
|
| 1657 |
name = name; |
|
| 1658 |
plugin = plugin; |
|
| 1659 |
publication = publication; |
|
| 1660 |
description = description; |
|
| 1661 |
} |
|
| 1662 |
in |
|
| 1663 |
Hashtbl.add all_features name t; |
|
| 1664 |
t |
|
| 1665 |
|
|
| 1666 |
|
|
| 1667 |
let get_stage name = |
|
| 1668 |
try |
|
| 1669 |
(Hashtbl.find all_features name).publication |
|
| 1670 |
with Not_found -> |
|
| 1671 |
failwithf (f_ "Feature %s doesn't exist.") name |
|
| 1672 |
|
|
| 1673 |
|
|
| 1674 |
let list () = |
|
| 1675 |
Hashtbl.fold (fun _ v acc -> v :: acc) all_features [] |
|
| 1676 |
|
|
| 1677 |
(* |
|
| 1678 |
* Real flags. |
|
| 1679 |
*) |
|
| 1680 |
|
|
| 1681 |
|
|
| 1682 |
let features = |
|
| 1683 |
create "features_fields" |
|
| 1684 |
(since_version "0.4") |
|
| 1685 |
(fun () -> |
|
| 1686 |
s_ "Enable to experiment not yet official features.") |
|
| 1687 |
|
|
| 1688 |
|
|
| 1689 |
let flag_docs = |
|
| 1690 |
create "flag_docs" |
|
| 1691 |
(since_version "0.3") |
|
| 1692 |
(fun () -> |
|
| 1693 |
s_ "Building docs require '-docs' flag at configure.") |
|
| 1694 |
|
|
| 1695 |
|
|
| 1696 |
let flag_tests = |
|
| 1697 |
create "flag_tests" |
|
| 1698 |
(since_version "0.3") |
|
| 1699 |
(fun () -> |
|
| 1700 |
s_ "Running tests require '-tests' flag at configure.") |
|
| 1701 |
|
|
| 1702 |
|
|
| 1703 |
let pack = |
|
| 1704 |
create "pack" |
|
| 1705 |
(since_version "0.3") |
|
| 1706 |
(fun () -> |
|
| 1707 |
s_ "Allow to create packed library.") |
|
| 1708 |
|
|
| 1709 |
|
|
| 1710 |
let section_object = |
|
| 1711 |
create "section_object" beta |
|
| 1712 |
(fun () -> |
|
| 1713 |
s_ "Implement an object section.") |
|
| 1714 |
|
|
| 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 |
} |
|
| 1715 | 1126 |
|
| 1716 |
let dynrun_for_release = |
|
| 1717 |
create "dynrun_for_release" alpha |
|
| 1718 |
(fun () -> |
|
| 1719 |
s_ "Make '-setup-update dynamic' suitable for releasing project.") |
|
| 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 |
|
|
| 1720 | 1135 |
|
| 1136 |
type section_kind = |
|
| 1137 |
[ `Library | `Executable | `Flag | `SrcRepo | `Test | `Doc ] |
|
| 1721 | 1138 |
|
| 1722 |
let compiled_setup_ml = |
|
| 1723 |
create "compiled_setup_ml" alpha |
|
| 1724 |
(fun () -> |
|
| 1725 |
s_ "It compiles the setup.ml and speed-up actions done with it.") |
|
| 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 |
} |
|
| 1726 | 1175 |
|
| 1727 |
let disable_oasis_section = |
|
| 1728 |
create "disable_oasis_section" alpha |
|
| 1729 |
(fun () -> |
|
| 1730 |
s_ "Allows the OASIS section comments and digest to be omitted in \ |
|
| 1731 |
generated files.") |
|
| 1732 | 1176 |
end |
| 1733 | 1177 |
|
| 1734 | 1178 |
module OASISUnixPath = struct |
| 1735 |
(* # 22 "src/oasis/OASISUnixPath.ml" *) |
|
| 1736 |
|
|
| 1179 |
(* # 21 "src/oasis/OASISUnixPath.ml" *) |
|
| 1737 | 1180 |
|
| 1738 | 1181 |
type unix_filename = string |
| 1739 | 1182 |
type unix_dirname = string |
| 1740 | 1183 |
|
| 1741 |
|
|
| 1742 | 1184 |
type host_filename = string |
| 1743 | 1185 |
type host_dirname = string |
| 1744 | 1186 |
|
| 1745 |
|
|
| 1746 | 1187 |
let current_dir_name = "." |
| 1747 | 1188 |
|
| 1748 |
|
|
| 1749 | 1189 |
let parent_dir_name = ".." |
| 1750 | 1190 |
|
| 1751 |
|
|
| 1752 | 1191 |
let is_current_dir fn = |
| 1753 | 1192 |
fn = current_dir_name || fn = "" |
| 1754 | 1193 |
|
| 1755 |
|
|
| 1756 | 1194 |
let concat f1 f2 = |
| 1757 | 1195 |
if is_current_dir f1 then |
| 1758 | 1196 |
f2 |
| ... | ... | |
| 1762 | 1200 |
in |
| 1763 | 1201 |
f1'^"/"^f2 |
| 1764 | 1202 |
|
| 1765 |
|
|
| 1766 | 1203 |
let make = |
| 1767 | 1204 |
function |
| 1768 | 1205 |
| hd :: tl -> |
| ... | ... | |
| 1773 | 1210 |
| [] -> |
| 1774 | 1211 |
invalid_arg "OASISUnixPath.make" |
| 1775 | 1212 |
|
| 1776 |
|
|
| 1777 | 1213 |
let dirname f = |
| 1778 | 1214 |
try |
| 1779 | 1215 |
String.sub f 0 (String.rindex f '/') |
| 1780 | 1216 |
with Not_found -> |
| 1781 | 1217 |
current_dir_name |
| 1782 | 1218 |
|
| 1783 |
|
|
| 1784 | 1219 |
let basename f = |
| 1785 | 1220 |
try |
| 1786 | 1221 |
let pos_start = |
| ... | ... | |
| 1790 | 1225 |
with Not_found -> |
| 1791 | 1226 |
f |
| 1792 | 1227 |
|
| 1793 |
|
|
| 1794 | 1228 |
let chop_extension f = |
| 1795 | 1229 |
try |
| 1796 | 1230 |
let last_dot = |
| ... | ... | |
| 1813 | 1247 |
with Not_found -> |
Also available in: Unified diff
corrected a bug that made an error silent, confusing users...
git-svn-id: https://cavale.enseeiht.fr/svn/lustrec/lustre_compiler/trunk@370 041b043f-8d7c-46b2-b46e-ef0dd855326e