You can not select more than 25 topics
Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
6941 lines
177 KiB
6941 lines
177 KiB
3 years ago
|
(* setup.ml generated for the first time by OASIS v0.4.6 *)
|
||
|
|
||
|
(* OASIS_START *)
|
||
|
(* DO NOT EDIT (digest: e917c0324c290d1aa03c0a37379435b4) *)
|
||
|
(*
|
||
|
Regenerated by OASIS v0.4.6
|
||
|
Visit http://oasis.forge.ocamlcore.org for more information and
|
||
|
documentation about functions used in this file.
|
||
|
*)
|
||
|
module OASISGettext = struct
|
||
|
(* # 22 "src/oasis/OASISGettext.ml" *)
|
||
|
|
||
|
|
||
|
let ns_ str =
|
||
|
str
|
||
|
|
||
|
|
||
|
let s_ str =
|
||
|
str
|
||
|
|
||
|
|
||
|
let f_ (str: ('a, 'b, 'c, 'd) format4) =
|
||
|
str
|
||
|
|
||
|
|
||
|
let fn_ fmt1 fmt2 n =
|
||
|
if n = 1 then
|
||
|
fmt1^^""
|
||
|
else
|
||
|
fmt2^^""
|
||
|
|
||
|
|
||
|
let init =
|
||
|
[]
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISContext = struct
|
||
|
(* # 22 "src/oasis/OASISContext.ml" *)
|
||
|
|
||
|
|
||
|
open OASISGettext
|
||
|
|
||
|
|
||
|
type level =
|
||
|
[ `Debug
|
||
|
| `Info
|
||
|
| `Warning
|
||
|
| `Error]
|
||
|
|
||
|
|
||
|
type t =
|
||
|
{
|
||
|
(* TODO: replace this by a proplist. *)
|
||
|
quiet: bool;
|
||
|
info: bool;
|
||
|
debug: bool;
|
||
|
ignore_plugins: bool;
|
||
|
ignore_unknown_fields: bool;
|
||
|
printf: level -> string -> unit;
|
||
|
}
|
||
|
|
||
|
|
||
|
let printf lvl str =
|
||
|
let beg =
|
||
|
match lvl with
|
||
|
| `Error -> s_ "E: "
|
||
|
| `Warning -> s_ "W: "
|
||
|
| `Info -> s_ "I: "
|
||
|
| `Debug -> s_ "D: "
|
||
|
in
|
||
|
prerr_endline (beg^str)
|
||
|
|
||
|
|
||
|
let default =
|
||
|
ref
|
||
|
{
|
||
|
quiet = false;
|
||
|
info = false;
|
||
|
debug = false;
|
||
|
ignore_plugins = false;
|
||
|
ignore_unknown_fields = false;
|
||
|
printf = printf;
|
||
|
}
|
||
|
|
||
|
|
||
|
let quiet =
|
||
|
{!default with quiet = true}
|
||
|
|
||
|
|
||
|
let fspecs () =
|
||
|
(* TODO: don't act on default. *)
|
||
|
let ignore_plugins = ref false in
|
||
|
["-quiet",
|
||
|
Arg.Unit (fun () -> default := {!default with quiet = true}),
|
||
|
s_ " Run quietly";
|
||
|
|
||
|
"-info",
|
||
|
Arg.Unit (fun () -> default := {!default with info = true}),
|
||
|
s_ " Display information message";
|
||
|
|
||
|
|
||
|
"-debug",
|
||
|
Arg.Unit (fun () -> default := {!default with debug = true}),
|
||
|
s_ " Output debug message";
|
||
|
|
||
|
"-ignore-plugins",
|
||
|
Arg.Set ignore_plugins,
|
||
|
s_ " Ignore plugin's field.";
|
||
|
|
||
|
"-C",
|
||
|
(* TODO: remove this chdir. *)
|
||
|
Arg.String (fun str -> Sys.chdir str),
|
||
|
s_ "dir Change directory before running."],
|
||
|
fun () -> {!default with ignore_plugins = !ignore_plugins}
|
||
|
end
|
||
|
|
||
|
module OASISString = struct
|
||
|
(* # 22 "src/oasis/OASISString.ml" *)
|
||
|
|
||
|
|
||
|
(** Various string utilities.
|
||
|
|
||
|
Mostly inspired by extlib and batteries ExtString and BatString libraries.
|
||
|
|
||
|
@author Sylvain Le Gall
|
||
|
*)
|
||
|
|
||
|
|
||
|
let nsplitf str f =
|
||
|
if str = "" then
|
||
|
[]
|
||
|
else
|
||
|
let buf = Buffer.create 13 in
|
||
|
let lst = ref [] in
|
||
|
let push () =
|
||
|
lst := Buffer.contents buf :: !lst;
|
||
|
Buffer.clear buf
|
||
|
in
|
||
|
let str_len = String.length str in
|
||
|
for i = 0 to str_len - 1 do
|
||
|
if f str.[i] then
|
||
|
push ()
|
||
|
else
|
||
|
Buffer.add_char buf str.[i]
|
||
|
done;
|
||
|
push ();
|
||
|
List.rev !lst
|
||
|
|
||
|
|
||
|
(** [nsplit c s] Split the string [s] at char [c]. It doesn't include the
|
||
|
separator.
|
||
|
*)
|
||
|
let nsplit str c =
|
||
|
nsplitf str ((=) c)
|
||
|
|
||
|
|
||
|
let find ~what ?(offset=0) str =
|
||
|
let what_idx = ref 0 in
|
||
|
let str_idx = ref offset in
|
||
|
while !str_idx < String.length str &&
|
||
|
!what_idx < String.length what do
|
||
|
if str.[!str_idx] = what.[!what_idx] then
|
||
|
incr what_idx
|
||
|
else
|
||
|
what_idx := 0;
|
||
|
incr str_idx
|
||
|
done;
|
||
|
if !what_idx <> String.length what then
|
||
|
raise Not_found
|
||
|
else
|
||
|
!str_idx - !what_idx
|
||
|
|
||
|
|
||
|
let sub_start str len =
|
||
|
let str_len = String.length str in
|
||
|
if len >= str_len then
|
||
|
""
|
||
|
else
|
||
|
String.sub str len (str_len - len)
|
||
|
|
||
|
|
||
|
let sub_end ?(offset=0) str len =
|
||
|
let str_len = String.length str in
|
||
|
if len >= str_len then
|
||
|
""
|
||
|
else
|
||
|
String.sub str 0 (str_len - len)
|
||
|
|
||
|
|
||
|
let starts_with ~what ?(offset=0) str =
|
||
|
let what_idx = ref 0 in
|
||
|
let str_idx = ref offset in
|
||
|
let ok = ref true in
|
||
|
while !ok &&
|
||
|
!str_idx < String.length str &&
|
||
|
!what_idx < String.length what do
|
||
|
if str.[!str_idx] = what.[!what_idx] then
|
||
|
incr what_idx
|
||
|
else
|
||
|
ok := false;
|
||
|
incr str_idx
|
||
|
done;
|
||
|
if !what_idx = String.length what then
|
||
|
true
|
||
|
else
|
||
|
false
|
||
|
|
||
|
|
||
|
let strip_starts_with ~what str =
|
||
|
if starts_with ~what str then
|
||
|
sub_start str (String.length what)
|
||
|
else
|
||
|
raise Not_found
|
||
|
|
||
|
|
||
|
let ends_with ~what ?(offset=0) str =
|
||
|
let what_idx = ref ((String.length what) - 1) in
|
||
|
let str_idx = ref ((String.length str) - 1) in
|
||
|
let ok = ref true in
|
||
|
while !ok &&
|
||
|
offset <= !str_idx &&
|
||
|
0 <= !what_idx do
|
||
|
if str.[!str_idx] = what.[!what_idx] then
|
||
|
decr what_idx
|
||
|
else
|
||
|
ok := false;
|
||
|
decr str_idx
|
||
|
done;
|
||
|
if !what_idx = -1 then
|
||
|
true
|
||
|
else
|
||
|
false
|
||
|
|
||
|
|
||
|
let strip_ends_with ~what str =
|
||
|
if ends_with ~what str then
|
||
|
sub_end str (String.length what)
|
||
|
else
|
||
|
raise Not_found
|
||
|
|
||
|
|
||
|
let replace_chars f s =
|
||
|
let buf = Buffer.create (String.length s) in
|
||
|
String.iter (fun c -> Buffer.add_char buf (f c)) s;
|
||
|
Buffer.contents buf
|
||
|
|
||
|
let lowercase_ascii =
|
||
|
replace_chars
|
||
|
(fun c ->
|
||
|
if (c >= 'A' && c <= 'Z') then
|
||
|
Char.chr (Char.code c + 32)
|
||
|
else
|
||
|
c)
|
||
|
|
||
|
let uncapitalize_ascii s =
|
||
|
if s <> "" then
|
||
|
(lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
|
||
|
else
|
||
|
s
|
||
|
|
||
|
let uppercase_ascii =
|
||
|
replace_chars
|
||
|
(fun c ->
|
||
|
if (c >= 'a' && c <= 'z') then
|
||
|
Char.chr (Char.code c - 32)
|
||
|
else
|
||
|
c)
|
||
|
|
||
|
let capitalize_ascii s =
|
||
|
if s <> "" then
|
||
|
(uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1))
|
||
|
else
|
||
|
s
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISUtils = struct
|
||
|
(* # 22 "src/oasis/OASISUtils.ml" *)
|
||
|
|
||
|
|
||
|
open OASISGettext
|
||
|
|
||
|
|
||
|
module MapExt =
|
||
|
struct
|
||
|
module type S =
|
||
|
sig
|
||
|
include Map.S
|
||
|
val add_list: 'a t -> (key * 'a) list -> 'a t
|
||
|
val of_list: (key * 'a) list -> 'a t
|
||
|
val to_list: 'a t -> (key * 'a) list
|
||
|
end
|
||
|
|
||
|
module Make (Ord: Map.OrderedType) =
|
||
|
struct
|
||
|
include Map.Make(Ord)
|
||
|
|
||
|
let rec add_list t =
|
||
|
function
|
||
|
| (k, v) :: tl -> add_list (add k v t) tl
|
||
|
| [] -> t
|
||
|
|
||
|
let of_list lst = add_list empty lst
|
||
|
|
||
|
let to_list t = fold (fun k v acc -> (k, v) :: acc) t []
|
||
|
end
|
||
|
end
|
||
|
|
||
|
|
||
|
module MapString = MapExt.Make(String)
|
||
|
|
||
|
|
||
|
module SetExt =
|
||
|
struct
|
||
|
module type S =
|
||
|
sig
|
||
|
include Set.S
|
||
|
val add_list: t -> elt list -> t
|
||
|
val of_list: elt list -> t
|
||
|
val to_list: t -> elt list
|
||
|
end
|
||
|
|
||
|
module Make (Ord: Set.OrderedType) =
|
||
|
struct
|
||
|
include Set.Make(Ord)
|
||
|
|
||
|
let rec add_list t =
|
||
|
function
|
||
|
| e :: tl -> add_list (add e t) tl
|
||
|
| [] -> t
|
||
|
|
||
|
let of_list lst = add_list empty lst
|
||
|
|
||
|
let to_list = elements
|
||
|
end
|
||
|
end
|
||
|
|
||
|
|
||
|
module SetString = SetExt.Make(String)
|
||
|
|
||
|
|
||
|
let compare_csl s1 s2 =
|
||
|
String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2)
|
||
|
|
||
|
|
||
|
module HashStringCsl =
|
||
|
Hashtbl.Make
|
||
|
(struct
|
||
|
type t = string
|
||
|
let equal s1 s2 = (compare_csl s1 s2) = 0
|
||
|
let hash s = Hashtbl.hash (OASISString.lowercase_ascii s)
|
||
|
end)
|
||
|
|
||
|
module SetStringCsl =
|
||
|
SetExt.Make
|
||
|
(struct
|
||
|
type t = string
|
||
|
let compare = compare_csl
|
||
|
end)
|
||
|
|
||
|
|
||
|
let varname_of_string ?(hyphen='_') s =
|
||
|
if String.length s = 0 then
|
||
|
begin
|
||
|
invalid_arg "varname_of_string"
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
let buf =
|
||
|
OASISString.replace_chars
|
||
|
(fun c ->
|
||
|
if ('a' <= c && c <= 'z')
|
||
|
||
|
||
|
('A' <= c && c <= 'Z')
|
||
|
||
|
||
|
('0' <= c && c <= '9') then
|
||
|
c
|
||
|
else
|
||
|
hyphen)
|
||
|
s;
|
||
|
in
|
||
|
let buf =
|
||
|
(* Start with a _ if digit *)
|
||
|
if '0' <= s.[0] && s.[0] <= '9' then
|
||
|
"_"^buf
|
||
|
else
|
||
|
buf
|
||
|
in
|
||
|
OASISString.lowercase_ascii buf
|
||
|
end
|
||
|
|
||
|
|
||
|
let varname_concat ?(hyphen='_') p s =
|
||
|
let what = String.make 1 hyphen in
|
||
|
let p =
|
||
|
try
|
||
|
OASISString.strip_ends_with ~what p
|
||
|
with Not_found ->
|
||
|
p
|
||
|
in
|
||
|
let s =
|
||
|
try
|
||
|
OASISString.strip_starts_with ~what s
|
||
|
with Not_found ->
|
||
|
s
|
||
|
in
|
||
|
p^what^s
|
||
|
|
||
|
|
||
|
let is_varname str =
|
||
|
str = varname_of_string str
|
||
|
|
||
|
|
||
|
let failwithf fmt = Printf.ksprintf failwith fmt
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module PropList = struct
|
||
|
(* # 22 "src/oasis/PropList.ml" *)
|
||
|
|
||
|
|
||
|
open OASISGettext
|
||
|
|
||
|
|
||
|
type name = string
|
||
|
|
||
|
|
||
|
exception Not_set of name * string option
|
||
|
exception No_printer of name
|
||
|
exception Unknown_field of name * name
|
||
|
|
||
|
|
||
|
let () =
|
||
|
Printexc.register_printer
|
||
|
(function
|
||
|
| Not_set (nm, Some rsn) ->
|
||
|
Some
|
||
|
(Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn)
|
||
|
| Not_set (nm, None) ->
|
||
|
Some
|
||
|
(Printf.sprintf (f_ "Field '%s' is not set") nm)
|
||
|
| No_printer nm ->
|
||
|
Some
|
||
|
(Printf.sprintf (f_ "No default printer for value %s") nm)
|
||
|
| Unknown_field (nm, schm) ->
|
||
|
Some
|
||
|
(Printf.sprintf
|
||
|
(f_ "Field %s is not defined in schema %s") nm schm)
|
||
|
| _ ->
|
||
|
None)
|
||
|
|
||
|
|
||
|
module Data =
|
||
|
struct
|
||
|
type t =
|
||
|
(name, unit -> unit) Hashtbl.t
|
||
|
|
||
|
let create () =
|
||
|
Hashtbl.create 13
|
||
|
|
||
|
let clear t =
|
||
|
Hashtbl.clear t
|
||
|
|
||
|
|
||
|
(* # 78 "src/oasis/PropList.ml" *)
|
||
|
end
|
||
|
|
||
|
|
||
|
module Schema =
|
||
|
struct
|
||
|
type ('ctxt, 'extra) value =
|
||
|
{
|
||
|
get: Data.t -> string;
|
||
|
set: Data.t -> ?context:'ctxt -> string -> unit;
|
||
|
help: (unit -> string) option;
|
||
|
extra: 'extra;
|
||
|
}
|
||
|
|
||
|
type ('ctxt, 'extra) t =
|
||
|
{
|
||
|
name: name;
|
||
|
fields: (name, ('ctxt, 'extra) value) Hashtbl.t;
|
||
|
order: name Queue.t;
|
||
|
name_norm: string -> string;
|
||
|
}
|
||
|
|
||
|
let create ?(case_insensitive=false) nm =
|
||
|
{
|
||
|
name = nm;
|
||
|
fields = Hashtbl.create 13;
|
||
|
order = Queue.create ();
|
||
|
name_norm =
|
||
|
(if case_insensitive then
|
||
|
OASISString.lowercase_ascii
|
||
|
else
|
||
|
fun s -> s);
|
||
|
}
|
||
|
|
||
|
let add t nm set get extra help =
|
||
|
let key =
|
||
|
t.name_norm nm
|
||
|
in
|
||
|
|
||
|
if Hashtbl.mem t.fields key then
|
||
|
failwith
|
||
|
(Printf.sprintf
|
||
|
(f_ "Field '%s' is already defined in schema '%s'")
|
||
|
nm t.name);
|
||
|
Hashtbl.add
|
||
|
t.fields
|
||
|
key
|
||
|
{
|
||
|
set = set;
|
||
|
get = get;
|
||
|
help = help;
|
||
|
extra = extra;
|
||
|
};
|
||
|
Queue.add nm t.order
|
||
|
|
||
|
let mem t nm =
|
||
|
Hashtbl.mem t.fields nm
|
||
|
|
||
|
let find t nm =
|
||
|
try
|
||
|
Hashtbl.find t.fields (t.name_norm nm)
|
||
|
with Not_found ->
|
||
|
raise (Unknown_field (nm, t.name))
|
||
|
|
||
|
let get t data nm =
|
||
|
(find t nm).get data
|
||
|
|
||
|
let set t data nm ?context x =
|
||
|
(find t nm).set
|
||
|
data
|
||
|
?context
|
||
|
x
|
||
|
|
||
|
let fold f acc t =
|
||
|
Queue.fold
|
||
|
(fun acc k ->
|
||
|
let v =
|
||
|
find t k
|
||
|
in
|
||
|
f acc k v.extra v.help)
|
||
|
acc
|
||
|
t.order
|
||
|
|
||
|
let iter f t =
|
||
|
fold
|
||
|
(fun () -> f)
|
||
|
()
|
||
|
t
|
||
|
|
||
|
let name t =
|
||
|
t.name
|
||
|
end
|
||
|
|
||
|
|
||
|
module Field =
|
||
|
struct
|
||
|
type ('ctxt, 'value, 'extra) t =
|
||
|
{
|
||
|
set: Data.t -> ?context:'ctxt -> 'value -> unit;
|
||
|
get: Data.t -> 'value;
|
||
|
sets: Data.t -> ?context:'ctxt -> string -> unit;
|
||
|
gets: Data.t -> string;
|
||
|
help: (unit -> string) option;
|
||
|
extra: 'extra;
|
||
|
}
|
||
|
|
||
|
let new_id =
|
||
|
let last_id =
|
||
|
ref 0
|
||
|
in
|
||
|
fun () -> incr last_id; !last_id
|
||
|
|
||
|
let create ?schema ?name ?parse ?print ?default ?update ?help extra =
|
||
|
(* Default value container *)
|
||
|
let v =
|
||
|
ref None
|
||
|
in
|
||
|
|
||
|
(* If name is not given, create unique one *)
|
||
|
let nm =
|
||
|
match name with
|
||
|
| Some s -> s
|
||
|
| None -> Printf.sprintf "_anon_%d" (new_id ())
|
||
|
in
|
||
|
|
||
|
(* Last chance to get a value: the default *)
|
||
|
let default () =
|
||
|
match default with
|
||
|
| Some d -> d
|
||
|
| None -> raise (Not_set (nm, Some (s_ "no default value")))
|
||
|
in
|
||
|
|
||
|
(* Get data *)
|
||
|
let get data =
|
||
|
(* Get value *)
|
||
|
try
|
||
|
(Hashtbl.find data nm) ();
|
||
|
match !v with
|
||
|
| Some x -> x
|
||
|
| None -> default ()
|
||
|
with Not_found ->
|
||
|
default ()
|
||
|
in
|
||
|
|
||
|
(* Set data *)
|
||
|
let set data ?context x =
|
||
|
let x =
|
||
|
match update with
|
||
|
| Some f ->
|
||
|
begin
|
||
|
try
|
||
|
f ?context (get data) x
|
||
|
with Not_set _ ->
|
||
|
x
|
||
|
end
|
||
|
| None ->
|
||
|
x
|
||
|
in
|
||
|
Hashtbl.replace
|
||
|
data
|
||
|
nm
|
||
|
(fun () -> v := Some x)
|
||
|
in
|
||
|
|
||
|
(* Parse string value, if possible *)
|
||
|
let parse =
|
||
|
match parse with
|
||
|
| Some f ->
|
||
|
f
|
||
|
| None ->
|
||
|
fun ?context s ->
|
||
|
failwith
|
||
|
(Printf.sprintf
|
||
|
(f_ "Cannot parse field '%s' when setting value %S")
|
||
|
nm
|
||
|
s)
|
||
|
in
|
||
|
|
||
|
(* Set data, from string *)
|
||
|
let sets data ?context s =
|
||
|
set ?context data (parse ?context s)
|
||
|
in
|
||
|
|
||
|
(* Output value as string, if possible *)
|
||
|
let print =
|
||
|
match print with
|
||
|
| Some f ->
|
||
|
f
|
||
|
| None ->
|
||
|
fun _ -> raise (No_printer nm)
|
||
|
in
|
||
|
|
||
|
(* Get data, as a string *)
|
||
|
let gets data =
|
||
|
print (get data)
|
||
|
in
|
||
|
|
||
|
begin
|
||
|
match schema with
|
||
|
| Some t ->
|
||
|
Schema.add t nm sets gets extra help
|
||
|
| None ->
|
||
|
()
|
||
|
end;
|
||
|
|
||
|
{
|
||
|
set = set;
|
||
|
get = get;
|
||
|
sets = sets;
|
||
|
gets = gets;
|
||
|
help = help;
|
||
|
extra = extra;
|
||
|
}
|
||
|
|
||
|
let fset data t ?context x =
|
||
|
t.set data ?context x
|
||
|
|
||
|
let fget data t =
|
||
|
t.get data
|
||
|
|
||
|
let fsets data t ?context s =
|
||
|
t.sets data ?context s
|
||
|
|
||
|
let fgets data t =
|
||
|
t.gets data
|
||
|
end
|
||
|
|
||
|
|
||
|
module FieldRO =
|
||
|
struct
|
||
|
let create ?schema ?name ?parse ?print ?default ?update ?help extra =
|
||
|
let fld =
|
||
|
Field.create ?schema ?name ?parse ?print ?default ?update ?help extra
|
||
|
in
|
||
|
fun data -> Field.fget data fld
|
||
|
end
|
||
|
end
|
||
|
|
||
|
module OASISMessage = struct
|
||
|
(* # 22 "src/oasis/OASISMessage.ml" *)
|
||
|
|
||
|
|
||
|
open OASISGettext
|
||
|
open OASISContext
|
||
|
|
||
|
|
||
|
let generic_message ~ctxt lvl fmt =
|
||
|
let cond =
|
||
|
if ctxt.quiet then
|
||
|
false
|
||
|
else
|
||
|
match lvl with
|
||
|
| `Debug -> ctxt.debug
|
||
|
| `Info -> ctxt.info
|
||
|
| _ -> true
|
||
|
in
|
||
|
Printf.ksprintf
|
||
|
(fun str ->
|
||
|
if cond then
|
||
|
begin
|
||
|
ctxt.printf lvl str
|
||
|
end)
|
||
|
fmt
|
||
|
|
||
|
|
||
|
let debug ~ctxt fmt =
|
||
|
generic_message ~ctxt `Debug fmt
|
||
|
|
||
|
|
||
|
let info ~ctxt fmt =
|
||
|
generic_message ~ctxt `Info fmt
|
||
|
|
||
|
|
||
|
let warning ~ctxt fmt =
|
||
|
generic_message ~ctxt `Warning fmt
|
||
|
|
||
|
|
||
|
let error ~ctxt fmt =
|
||
|
generic_message ~ctxt `Error fmt
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISVersion = struct
|
||
|
(* # 22 "src/oasis/OASISVersion.ml" *)
|
||
|
|
||
|
|
||
|
open OASISGettext
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
type s = string
|
||
|
|
||
|
|
||
|
type t = string
|
||
|
|
||
|
|
||
|
type comparator =
|
||
|
| VGreater of t
|
||
|
| VGreaterEqual of t
|
||
|
| VEqual of t
|
||
|
| VLesser of t
|
||
|
| VLesserEqual of t
|
||
|
| VOr of comparator * comparator
|
||
|
| VAnd of comparator * comparator
|
||
|
|
||
|
|
||
|
|
||
|
(* Range of allowed characters *)
|
||
|
let is_digit c =
|
||
|
'0' <= c && c <= '9'
|
||
|
|
||
|
|
||
|
let is_alpha c =
|
||
|
('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')
|
||
|
|
||
|
|
||
|
let is_special =
|
||
|
function
|
||
|
| '.' | '+' | '-' | '~' -> true
|
||
|
| _ -> false
|
||
|
|
||
|
|
||
|
let rec version_compare v1 v2 =
|
||
|
if v1 <> "" || v2 <> "" then
|
||
|
begin
|
||
|
(* Compare ascii string, using special meaning for version
|
||
|
* related char
|
||
|
*)
|
||
|
let val_ascii c =
|
||
|
if c = '~' then -1
|
||
|
else if is_digit c then 0
|
||
|
else if c = '\000' then 0
|
||
|
else if is_alpha c then Char.code c
|
||
|
else (Char.code c) + 256
|
||
|
in
|
||
|
|
||
|
let len1 = String.length v1 in
|
||
|
let len2 = String.length v2 in
|
||
|
|
||
|
let p = ref 0 in
|
||
|
|
||
|
(** Compare ascii part *)
|
||
|
let compare_vascii () =
|
||
|
let cmp = ref 0 in
|
||
|
while !cmp = 0 &&
|
||
|
!p < len1 && !p < len2 &&
|
||
|
not (is_digit v1.[!p] && is_digit v2.[!p]) do
|
||
|
cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]);
|
||
|
incr p
|
||
|
done;
|
||
|
if !cmp = 0 && !p < len1 && !p = len2 then
|
||
|
val_ascii v1.[!p]
|
||
|
else if !cmp = 0 && !p = len1 && !p < len2 then
|
||
|
- (val_ascii v2.[!p])
|
||
|
else
|
||
|
!cmp
|
||
|
in
|
||
|
|
||
|
(** Compare digit part *)
|
||
|
let compare_digit () =
|
||
|
let extract_int v p =
|
||
|
let start_p = !p in
|
||
|
while !p < String.length v && is_digit v.[!p] do
|
||
|
incr p
|
||
|
done;
|
||
|
let substr =
|
||
|
String.sub v !p ((String.length v) - !p)
|
||
|
in
|
||
|
let res =
|
||
|
match String.sub v start_p (!p - start_p) with
|
||
|
| "" -> 0
|
||
|
| s -> int_of_string s
|
||
|
in
|
||
|
res, substr
|
||
|
in
|
||
|
let i1, tl1 = extract_int v1 (ref !p) in
|
||
|
let i2, tl2 = extract_int v2 (ref !p) in
|
||
|
i1 - i2, tl1, tl2
|
||
|
in
|
||
|
|
||
|
match compare_vascii () with
|
||
|
| 0 ->
|
||
|
begin
|
||
|
match compare_digit () with
|
||
|
| 0, tl1, tl2 ->
|
||
|
if tl1 <> "" && is_digit tl1.[0] then
|
||
|
1
|
||
|
else if tl2 <> "" && is_digit tl2.[0] then
|
||
|
-1
|
||
|
else
|
||
|
version_compare tl1 tl2
|
||
|
| n, _, _ ->
|
||
|
n
|
||
|
end
|
||
|
| n ->
|
||
|
n
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
0
|
||
|
end
|
||
|
|
||
|
|
||
|
let version_of_string str = str
|
||
|
|
||
|
|
||
|
let string_of_version t = t
|
||
|
|
||
|
|
||
|
let version_compare_string s1 s2 =
|
||
|
version_compare (version_of_string s1) (version_of_string s2)
|
||
|
|
||
|
|
||
|
let chop t =
|
||
|
try
|
||
|
let pos =
|
||
|
String.rindex t '.'
|
||
|
in
|
||
|
String.sub t 0 pos
|
||
|
with Not_found ->
|
||
|
t
|
||
|
|
||
|
|
||
|
let rec comparator_apply v op =
|
||
|
match op with
|
||
|
| VGreater cv ->
|
||
|
(version_compare v cv) > 0
|
||
|
| VGreaterEqual cv ->
|
||
|
(version_compare v cv) >= 0
|
||
|
| VLesser cv ->
|
||
|
(version_compare v cv) < 0
|
||
|
| VLesserEqual cv ->
|
||
|
(version_compare v cv) <= 0
|
||
|
| VEqual cv ->
|
||
|
(version_compare v cv) = 0
|
||
|
| VOr (op1, op2) ->
|
||
|
(comparator_apply v op1) || (comparator_apply v op2)
|
||
|
| VAnd (op1, op2) ->
|
||
|
(comparator_apply v op1) && (comparator_apply v op2)
|
||
|
|
||
|
|
||
|
let rec string_of_comparator =
|
||
|
function
|
||
|
| VGreater v -> "> "^(string_of_version v)
|
||
|
| VEqual v -> "= "^(string_of_version v)
|
||
|
| VLesser v -> "< "^(string_of_version v)
|
||
|
| VGreaterEqual v -> ">= "^(string_of_version v)
|
||
|
| VLesserEqual v -> "<= "^(string_of_version v)
|
||
|
| VOr (c1, c2) ->
|
||
|
(string_of_comparator c1)^" || "^(string_of_comparator c2)
|
||
|
| VAnd (c1, c2) ->
|
||
|
(string_of_comparator c1)^" && "^(string_of_comparator c2)
|
||
|
|
||
|
|
||
|
let rec varname_of_comparator =
|
||
|
let concat p v =
|
||
|
OASISUtils.varname_concat
|
||
|
p
|
||
|
(OASISUtils.varname_of_string
|
||
|
(string_of_version v))
|
||
|
in
|
||
|
function
|
||
|
| VGreater v -> concat "gt" v
|
||
|
| VLesser v -> concat "lt" v
|
||
|
| VEqual v -> concat "eq" v
|
||
|
| VGreaterEqual v -> concat "ge" v
|
||
|
| VLesserEqual v -> concat "le" v
|
||
|
| VOr (c1, c2) ->
|
||
|
(varname_of_comparator c1)^"_or_"^(varname_of_comparator c2)
|
||
|
| VAnd (c1, c2) ->
|
||
|
(varname_of_comparator c1)^"_and_"^(varname_of_comparator c2)
|
||
|
|
||
|
|
||
|
let rec comparator_ge v' =
|
||
|
let cmp v = version_compare v v' >= 0 in
|
||
|
function
|
||
|
| VEqual v
|
||
|
| VGreaterEqual v
|
||
|
| VGreater v -> cmp v
|
||
|
| VLesserEqual _
|
||
|
| VLesser _ -> false
|
||
|
| VOr (c1, c2) -> comparator_ge v' c1 || comparator_ge v' c2
|
||
|
| VAnd (c1, c2) -> comparator_ge v' c1 && comparator_ge v' c2
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISLicense = struct
|
||
|
(* # 22 "src/oasis/OASISLicense.ml" *)
|
||
|
|
||
|
|
||
|
(** License for _oasis fields
|
||
|
@author Sylvain Le Gall
|
||
|
*)
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
type license = string
|
||
|
|
||
|
|
||
|
type license_exception = string
|
||
|
|
||
|
|
||
|
type license_version =
|
||
|
| Version of OASISVersion.t
|
||
|
| VersionOrLater of OASISVersion.t
|
||
|
| NoVersion
|
||
|
|
||
|
|
||
|
|
||
|
type license_dep_5_unit =
|
||
|
{
|
||
|
license: license;
|
||
|
excption: license_exception option;
|
||
|
version: license_version;
|
||
|
}
|
||
|
|
||
|
|
||
|
|
||
|
type license_dep_5 =
|
||
|
| DEP5Unit of license_dep_5_unit
|
||
|
| DEP5Or of license_dep_5 list
|
||
|
| DEP5And of license_dep_5 list
|
||
|
|
||
|
|
||
|
type t =
|
||
|
| DEP5License of license_dep_5
|
||
|
| OtherLicense of string (* URL *)
|
||
|
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISExpr = struct
|
||
|
(* # 22 "src/oasis/OASISExpr.ml" *)
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
open OASISGettext
|
||
|
|
||
|
|
||
|
type test = string
|
||
|
|
||
|
|
||
|
type flag = string
|
||
|
|
||
|
|
||
|
type t =
|
||
|
| EBool of bool
|
||
|
| ENot of t
|
||
|
| EAnd of t * t
|
||
|
| EOr of t * t
|
||
|
| EFlag of flag
|
||
|
| ETest of test * string
|
||
|
|
||
|
|
||
|
|
||
|
type 'a choices = (t * 'a) list
|
||
|
|
||
|
|
||
|
let eval var_get t =
|
||
|
let rec eval' =
|
||
|
function
|
||
|
| EBool b ->
|
||
|
b
|
||
|
|
||
|
| ENot e ->
|
||
|
not (eval' e)
|
||
|
|
||
|
| EAnd (e1, e2) ->
|
||
|
(eval' e1) && (eval' e2)
|
||
|
|
||
|
| EOr (e1, e2) ->
|
||
|
(eval' e1) || (eval' e2)
|
||
|
|
||
|
| EFlag nm ->
|
||
|
let v =
|
||
|
var_get nm
|
||
|
in
|
||
|
assert(v = "true" || v = "false");
|
||
|
(v = "true")
|
||
|
|
||
|
| ETest (nm, vl) ->
|
||
|
let v =
|
||
|
var_get nm
|
||
|
in
|
||
|
(v = vl)
|
||
|
in
|
||
|
eval' t
|
||
|
|
||
|
|
||
|
let choose ?printer ?name var_get lst =
|
||
|
let rec choose_aux =
|
||
|
function
|
||
|
| (cond, vl) :: tl ->
|
||
|
if eval var_get cond then
|
||
|
vl
|
||
|
else
|
||
|
choose_aux tl
|
||
|
| [] ->
|
||
|
let str_lst =
|
||
|
if lst = [] then
|
||
|
s_ "<empty>"
|
||
|
else
|
||
|
String.concat
|
||
|
(s_ ", ")
|
||
|
(List.map
|
||
|
(fun (cond, vl) ->
|
||
|
match printer with
|
||
|
| Some p -> p vl
|
||
|
| None -> s_ "<no printer>")
|
||
|
lst)
|
||
|
in
|
||
|
match name with
|
||
|
| Some nm ->
|
||
|
failwith
|
||
|
(Printf.sprintf
|
||
|
(f_ "No result for the choice list '%s': %s")
|
||
|
nm str_lst)
|
||
|
| None ->
|
||
|
failwith
|
||
|
(Printf.sprintf
|
||
|
(f_ "No result for a choice list: %s")
|
||
|
str_lst)
|
||
|
in
|
||
|
choose_aux (List.rev lst)
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISText = struct
|
||
|
(* # 22 "src/oasis/OASISText.ml" *)
|
||
|
|
||
|
|
||
|
|
||
|
type elt =
|
||
|
| Para of string
|
||
|
| Verbatim of string
|
||
|
| BlankLine
|
||
|
|
||
|
|
||
|
type t = elt list
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISTypes = struct
|
||
|
(* # 22 "src/oasis/OASISTypes.ml" *)
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
type name = string
|
||
|
type package_name = string
|
||
|
type url = string
|
||
|
type unix_dirname = string
|
||
|
type unix_filename = string
|
||
|
type host_dirname = string
|
||
|
type host_filename = string
|
||
|
type prog = string
|
||
|
type arg = string
|
||
|
type args = string list
|
||
|
type command_line = (prog * arg list)
|
||
|
|
||
|
|
||
|
type findlib_name = string
|
||
|
type findlib_full = string
|
||
|
|
||
|
|
||
|
type compiled_object =
|
||
|
| Byte
|
||
|
| Native
|
||
|
| Best
|
||
|
|
||
|
|
||
|
|
||
|
type dependency =
|
||
|
| FindlibPackage of findlib_full * OASISVersion.comparator option
|
||
|
| InternalLibrary of name
|
||
|
|
||
|
|
||
|
|
||
|
type tool =
|
||
|
| ExternalTool of name
|
||
|
| InternalExecutable of name
|
||
|
|
||
|
|
||
|
|
||
|
type vcs =
|
||
|
| Darcs
|
||
|
| Git
|
||
|
| Svn
|
||
|
| Cvs
|
||
|
| Hg
|
||
|
| Bzr
|
||
|
| Arch
|
||
|
| Monotone
|
||
|
| OtherVCS of url
|
||
|
|
||
|
|
||
|
|
||
|
type plugin_kind =
|
||
|
[ `Configure
|
||
|
| `Build
|
||
|
| `Doc
|
||
|
| `Test
|
||
|
| `Install
|
||
|
| `Extra
|
||
|
]
|
||
|
|
||
|
|
||
|
type plugin_data_purpose =
|
||
|
[ `Configure
|
||
|
| `Build
|
||
|
| `Install
|
||
|
| `Clean
|
||
|
| `Distclean
|
||
|
| `Install
|
||
|
| `Uninstall
|
||
|
| `Test
|
||
|
| `Doc
|
||
|
| `Extra
|
||
|
| `Other of string
|
||
|
]
|
||
|
|
||
|
|
||
|
type 'a plugin = 'a * name * OASISVersion.t option
|
||
|
|
||
|
|
||
|
type all_plugin = plugin_kind plugin
|
||
|
|
||
|
|
||
|
type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list
|
||
|
|
||
|
|
||
|
(* # 115 "src/oasis/OASISTypes.ml" *)
|
||
|
|
||
|
|
||
|
type 'a conditional = 'a OASISExpr.choices
|
||
|
|
||
|
|
||
|
type custom =
|
||
|
{
|
||
|
pre_command: (command_line option) conditional;
|
||
|
post_command: (command_line option) conditional;
|
||
|
}
|
||
|
|
||
|
|
||
|
|
||
|
type common_section =
|
||
|
{
|
||
|
cs_name: name;
|
||
|
cs_data: PropList.Data.t;
|
||
|
cs_plugin_data: plugin_data;
|
||
|
}
|
||
|
|
||
|
|
||
|
|
||
|
type build_section =
|
||
|
{
|
||
|
bs_build: bool conditional;
|
||
|
bs_install: bool conditional;
|
||
|
bs_path: unix_dirname;
|
||
|
bs_compiled_object: compiled_object;
|
||
|
bs_build_depends: dependency list;
|
||
|
bs_build_tools: tool list;
|
||
|
bs_c_sources: unix_filename list;
|
||
|
bs_data_files: (unix_filename * unix_filename option) list;
|
||
|
bs_ccopt: args conditional;
|
||
|
bs_cclib: args conditional;
|
||
|
bs_dlllib: args conditional;
|
||
|
bs_dllpath: args conditional;
|
||
|
bs_byteopt: args conditional;
|
||
|
bs_nativeopt: args conditional;
|
||
|
}
|
||
|
|
||
|
|
||
|
|
||
|
type library =
|
||
|
{
|
||
|
lib_modules: string list;
|
||
|
lib_pack: bool;
|
||
|
lib_internal_modules: string list;
|
||
|
lib_findlib_parent: findlib_name option;
|
||
|
lib_findlib_name: findlib_name option;
|
||
|
lib_findlib_containers: findlib_name list;
|
||
|
}
|
||
|
|
||
|
|
||
|
type object_ =
|
||
|
{
|
||
|
obj_modules: string list;
|
||
|
obj_findlib_fullname: findlib_name list option;
|
||
|
}
|
||
|
|
||
|
|
||
|
type executable =
|
||
|
{
|
||
|
exec_custom: bool;
|
||
|
exec_main_is: unix_filename;
|
||
|
}
|
||
|
|
||
|
|
||
|
type flag =
|
||
|
{
|
||
|
flag_description: string option;
|
||
|
flag_default: bool conditional;
|
||
|
}
|
||
|
|
||
|
|
||
|
type source_repository =
|
||
|
{
|
||
|
src_repo_type: vcs;
|
||
|
src_repo_location: url;
|
||
|
src_repo_browser: url option;
|
||
|
src_repo_module: string option;
|
||
|
src_repo_branch: string option;
|
||
|
src_repo_tag: string option;
|
||
|
src_repo_subdir: unix_filename option;
|
||
|
}
|
||
|
|
||
|
|
||
|
type test =
|
||
|
{
|
||
|
test_type: [`Test] plugin;
|
||
|
test_command: command_line conditional;
|
||
|
test_custom: custom;
|
||
|
test_working_directory: unix_filename option;
|
||
|
test_run: bool conditional;
|
||
|
test_tools: tool list;
|
||
|
}
|
||
|
|
||
|
|
||
|
type doc_format =
|
||
|
| HTML of unix_filename
|
||
|
| DocText
|
||
|
| PDF
|
||
|
| PostScript
|
||
|
| Info of unix_filename
|
||
|
| DVI
|
||
|
| OtherDoc
|
||
|
|
||
|
|
||
|
|
||
|
type doc =
|
||
|
{
|
||
|
doc_type: [`Doc] plugin;
|
||
|
doc_custom: custom;
|
||
|
doc_build: bool conditional;
|
||
|
doc_install: bool conditional;
|
||
|
doc_install_dir: unix_filename;
|
||
|
doc_title: string;
|
||
|
doc_authors: string list;
|
||
|
doc_abstract: string option;
|
||
|
doc_format: doc_format;
|
||
|
doc_data_files: (unix_filename * unix_filename option) list;
|
||
|
doc_build_tools: tool list;
|
||
|
}
|
||
|
|
||
|
|
||
|
type section =
|
||
|
| Library of common_section * build_section * library
|
||
|
| Object of common_section * build_section * object_
|
||
|
| Executable of common_section * build_section * executable
|
||
|
| Flag of common_section * flag
|
||
|
| SrcRepo of common_section * source_repository
|
||
|
| Test of common_section * test
|
||
|
| Doc of common_section * doc
|
||
|
|
||
|
|
||
|
|
||
|
type section_kind =
|
||
|
[ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ]
|
||
|
|
||
|
|
||
|
type package =
|
||
|
{
|
||
|
oasis_version: OASISVersion.t;
|
||
|
ocaml_version: OASISVersion.comparator option;
|
||
|
findlib_version: OASISVersion.comparator option;
|
||
|
alpha_features: string list;
|
||
|
beta_features: string list;
|
||
|
name: package_name;
|
||
|
version: OASISVersion.t;
|
||
|
license: OASISLicense.t;
|
||
|
license_file: unix_filename option;
|
||
|
copyrights: string list;
|
||
|
maintainers: string list;
|
||
|
authors: string list;
|
||
|
homepage: url option;
|
||
|
synopsis: string;
|
||
|
description: OASISText.t option;
|
||
|
categories: url list;
|
||
|
|
||
|
conf_type: [`Configure] plugin;
|
||
|
conf_custom: custom;
|
||
|
|
||
|
build_type: [`Build] plugin;
|
||
|
build_custom: custom;
|
||
|
|
||
|
install_type: [`Install] plugin;
|
||
|
install_custom: custom;
|
||
|
uninstall_custom: custom;
|
||
|
|
||
|
clean_custom: custom;
|
||
|
distclean_custom: custom;
|
||
|
|
||
|
files_ab: unix_filename list;
|
||
|
sections: section list;
|
||
|
plugins: [`Extra] plugin list;
|
||
|
disable_oasis_section: unix_filename list;
|
||
|
schema_data: PropList.Data.t;
|
||
|
plugin_data: plugin_data;
|
||
|
}
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISFeatures = struct
|
||
|
(* # 22 "src/oasis/OASISFeatures.ml" *)
|
||
|
|
||
|
open OASISTypes
|
||
|
open OASISUtils
|
||
|
open OASISGettext
|
||
|
open OASISVersion
|
||
|
|
||
|
module MapPlugin =
|
||
|
Map.Make
|
||
|
(struct
|
||
|
type t = plugin_kind * name
|
||
|
let compare = Pervasives.compare
|
||
|
end)
|
||
|
|
||
|
module Data =
|
||
|
struct
|
||
|
type t =
|
||
|
{
|
||
|
oasis_version: OASISVersion.t;
|
||
|
plugin_versions: OASISVersion.t option MapPlugin.t;
|
||
|
alpha_features: string list;
|
||
|
beta_features: string list;
|
||
|
}
|
||
|
|
||
|
let create oasis_version alpha_features beta_features =
|
||
|
{
|
||
|
oasis_version = oasis_version;
|
||
|
plugin_versions = MapPlugin.empty;
|
||
|
alpha_features = alpha_features;
|
||
|
beta_features = beta_features
|
||
|
}
|
||
|
|
||
|
let of_package pkg =
|
||
|
create
|
||
|
pkg.OASISTypes.oasis_version
|
||
|
pkg.OASISTypes.alpha_features
|
||
|
pkg.OASISTypes.beta_features
|
||
|
|
||
|
let add_plugin (plugin_kind, plugin_name, plugin_version) t =
|
||
|
{t with
|
||
|
plugin_versions = MapPlugin.add
|
||
|
(plugin_kind, plugin_name)
|
||
|
plugin_version
|
||
|
t.plugin_versions}
|
||
|
|
||
|
let plugin_version plugin_kind plugin_name t =
|
||
|
MapPlugin.find (plugin_kind, plugin_name) t.plugin_versions
|
||
|
|
||
|
let to_string t =
|
||
|
Printf.sprintf
|
||
|
"oasis_version: %s; alpha_features: %s; beta_features: %s; \
|
||
|
plugins_version: %s"
|
||
|
(OASISVersion.string_of_version t.oasis_version)
|
||
|
(String.concat ", " t.alpha_features)
|
||
|
(String.concat ", " t.beta_features)
|
||
|
(String.concat ", "
|
||
|
(MapPlugin.fold
|
||
|
(fun (_, plg) ver_opt acc ->
|
||
|
(plg^
|
||
|
(match ver_opt with
|
||
|
| Some v ->
|
||
|
" "^(OASISVersion.string_of_version v)
|
||
|
| None -> ""))
|
||
|
:: acc)
|
||
|
t.plugin_versions []))
|
||
|
end
|
||
|
|
||
|
type origin =
|
||
|
| Field of string * string
|
||
|
| Section of string
|
||
|
| NoOrigin
|
||
|
|
||
|
type stage = Alpha | Beta
|
||
|
|
||
|
|
||
|
let string_of_stage =
|
||
|
function
|
||
|
| Alpha -> "alpha"
|
||
|
| Beta -> "beta"
|
||
|
|
||
|
|
||
|
let field_of_stage =
|
||
|
function
|
||
|
| Alpha -> "AlphaFeatures"
|
||
|
| Beta -> "BetaFeatures"
|
||
|
|
||
|
type publication = InDev of stage | SinceVersion of OASISVersion.t
|
||
|
|
||
|
type t =
|
||
|
{
|
||
|
name: string;
|
||
|
plugin: all_plugin option;
|
||
|
publication: publication;
|
||
|
description: unit -> string;
|
||
|
}
|
||
|
|
||
|
(* TODO: mutex protect this. *)
|
||
|
let all_features = Hashtbl.create 13
|
||
|
|
||
|
|
||
|
let since_version ver_str = SinceVersion (version_of_string ver_str)
|
||
|
let alpha = InDev Alpha
|
||
|
let beta = InDev Beta
|
||
|
|
||
|
|
||
|
let to_string t =
|
||
|
Printf.sprintf
|
||
|
"feature: %s; plugin: %s; publication: %s"
|
||
|
t.name
|
||
|
(match t.plugin with
|
||
|
| None -> "<none>"
|
||
|
| Some (_, nm, _) -> nm)
|
||
|
(match t.publication with
|
||
|
| InDev stage -> string_of_stage stage
|
||
|
| SinceVersion ver -> ">= "^(OASISVersion.string_of_version ver))
|
||
|
|
||
|
let data_check t data origin =
|
||
|
let no_message = "no message" in
|
||
|
|
||
|
let check_feature features stage =
|
||
|
let has_feature = List.mem t.name features in
|
||
|
if not has_feature then
|
||
|
match origin with
|
||
|
| Field (fld, where) ->
|
||
|
Some
|
||
|
(Printf.sprintf
|
||
|
(f_ "Field %s in %s is only available when feature %s \
|
||
|
is in field %s.")
|
||
|
fld where t.name (field_of_stage stage))
|
||
|
| Section sct ->
|
||
|
Some
|
||
|
(Printf.sprintf
|
||
|
(f_ "Section %s is only available when features %s \
|
||
|
is in field %s.")
|
||
|
sct t.name (field_of_stage stage))
|
||
|
| NoOrigin ->
|
||
|
Some no_message
|
||
|
else
|
||
|
None
|
||
|
in
|
||
|
|
||
|
let version_is_good ~min_version version fmt =
|
||
|
let version_is_good =
|
||
|
OASISVersion.comparator_apply
|
||
|
version (OASISVersion.VGreaterEqual min_version)
|
||
|
in
|
||
|
Printf.ksprintf
|
||
|
(fun str ->
|
||
|
if version_is_good then
|
||
|
None
|
||
|
else
|
||
|
Some str)
|
||
|
fmt
|
||
|
in
|
||
|
|
||
|
match origin, t.plugin, t.publication with
|
||
|
| _, _, InDev Alpha -> check_feature data.Data.alpha_features Alpha
|
||
|
| _, _, InDev Beta -> check_feature data.Data.beta_features Beta
|
||
|
| Field(fld, where), None, SinceVersion min_version ->
|
||
|
version_is_good ~min_version data.Data.oasis_version
|
||
|
(f_ "Field %s in %s is only valid since OASIS v%s, update \
|
||
|
OASISFormat field from '%s' to '%s' after checking \
|
||
|
OASIS changelog.")
|
||
|
fld where (string_of_version min_version)
|
||
|
(string_of_version data.Data.oasis_version)
|
||
|
(string_of_version min_version)
|
||
|
|
||
|
| Field(fld, where), Some(plugin_knd, plugin_name, _),
|
||
|
SinceVersion min_version ->
|
||
|
begin
|
||
|
try
|
||
|
let plugin_version_current =
|
||
|
try
|
||
|
match Data.plugin_version plugin_knd plugin_name data with
|
||
|
| Some ver -> ver
|
||
|
| None ->
|
||
|
failwithf
|
||
|
(f_ "Field %s in %s is only valid for the OASIS \
|
||
|
plugin %s since v%s, but no plugin version is \
|
||
|
defined in the _oasis file, change '%s' to \
|
||
|
'%s (%s)' in your _oasis file.")
|
||
|
fld where plugin_name (string_of_version min_version)
|
||
|
plugin_name
|
||
|
plugin_name (string_of_version min_version)
|
||
|
with Not_found ->
|
||
|
failwithf
|
||
|
(f_ "Field %s in %s is only valid when the OASIS plugin %s \
|
||
|
is defined.")
|
||
|
fld where plugin_name
|
||
|
in
|
||
|
version_is_good ~min_version plugin_version_current
|
||
|
(f_ "Field %s in %s is only valid for the OASIS plugin %s \
|
||
|
since v%s, update your plugin from '%s (%s)' to \
|
||
|
'%s (%s)' after checking the plugin's changelog.")
|
||
|
fld where plugin_name (string_of_version min_version)
|
||
|
plugin_name (string_of_version plugin_version_current)
|
||
|
plugin_name (string_of_version min_version)
|
||
|
with Failure msg ->
|
||
|
Some msg
|
||
|
end
|
||
|
|
||
|
| Section sct, None, SinceVersion min_version ->
|
||
|
version_is_good ~min_version data.Data.oasis_version
|
||
|
(f_ "Section %s is only valid for since OASIS v%s, update \
|
||
|
OASISFormat field from '%s' to '%s' after checking OASIS \
|
||
|
changelog.")
|
||
|
sct (string_of_version min_version)
|
||
|
(string_of_version data.Data.oasis_version)
|
||
|
(string_of_version min_version)
|
||
|
|
||
|
| Section sct, Some(plugin_knd, plugin_name, _),
|
||
|
SinceVersion min_version ->
|
||
|
begin
|
||
|
try
|
||
|
let plugin_version_current =
|
||
|
try
|
||
|
match Data.plugin_version plugin_knd plugin_name data with
|
||
|
| Some ver -> ver
|
||
|
| None ->
|
||
|
failwithf
|
||
|
(f_ "Section %s is only valid for the OASIS \
|
||
|
plugin %s since v%s, but no plugin version is \
|
||
|
defined in the _oasis file, change '%s' to \
|
||
|
'%s (%s)' in your _oasis file.")
|
||
|
sct plugin_name (string_of_version min_version)
|
||
|
plugin_name
|
||
|
plugin_name (string_of_version min_version)
|
||
|
with Not_found ->
|
||
|
failwithf
|
||
|
(f_ "Section %s is only valid when the OASIS plugin %s \
|
||
|
is defined.")
|
||
|
sct plugin_name
|
||
|
in
|
||
|
version_is_good ~min_version plugin_version_current
|
||
|
(f_ "Section %s is only valid for the OASIS plugin %s \
|
||
|
since v%s, update your plugin from '%s (%s)' to \
|
||
|
'%s (%s)' after checking the plugin's changelog.")
|
||
|
sct plugin_name (string_of_version min_version)
|
||
|
plugin_name (string_of_version plugin_version_current)
|
||
|
plugin_name (string_of_version min_version)
|
||
|
with Failure msg ->
|
||
|
Some msg
|
||
|
end
|
||
|
|
||
|
| NoOrigin, None, SinceVersion min_version ->
|
||
|
version_is_good ~min_version data.Data.oasis_version "%s" no_message
|
||
|
|
||
|
| NoOrigin, Some(plugin_knd, plugin_name, _), SinceVersion min_version ->
|
||
|
begin
|
||
|
try
|
||
|
let plugin_version_current =
|
||
|
match Data.plugin_version plugin_knd plugin_name data with
|
||
|
| Some ver -> ver
|
||
|
| None -> raise Not_found
|
||
|
in
|
||
|
version_is_good ~min_version plugin_version_current
|
||
|
"%s" no_message
|
||
|
with Not_found ->
|
||
|
Some no_message
|
||
|
end
|
||
|
|
||
|
|
||
|
let data_assert t data origin =
|
||
|
match data_check t data origin with
|
||
|
| None -> ()
|
||
|
| Some str -> failwith str
|
||
|
|
||
|
|
||
|
let data_test t data =
|
||
|
match data_check t data NoOrigin with
|
||
|
| None -> true
|
||
|
| Some str -> false
|
||
|
|
||
|
|
||
|
let package_test t pkg =
|
||
|
data_test t (Data.of_package pkg)
|
||
|
|
||
|
|
||
|
let create ?plugin name publication description =
|
||
|
let () =
|
||
|
if Hashtbl.mem all_features name then
|
||
|
failwithf "Feature '%s' is already declared." name
|
||
|
in
|
||
|
let t =
|
||
|
{
|
||
|
name = name;
|
||
|
plugin = plugin;
|
||
|
publication = publication;
|
||
|
description = description;
|
||
|
}
|
||
|
in
|
||
|
Hashtbl.add all_features name t;
|
||
|
t
|
||
|
|
||
|
|
||
|
let get_stage name =
|
||
|
try
|
||
|
(Hashtbl.find all_features name).publication
|
||
|
with Not_found ->
|
||
|
failwithf (f_ "Feature %s doesn't exist.") name
|
||
|
|
||
|
|
||
|
let list () =
|
||
|
Hashtbl.fold (fun _ v acc -> v :: acc) all_features []
|
||
|
|
||
|
(*
|
||
|
* Real flags.
|
||
|
*)
|
||
|
|
||
|
|
||
|
let features =
|
||
|
create "features_fields"
|
||
|
(since_version "0.4")
|
||
|
(fun () ->
|
||
|
s_ "Enable to experiment not yet official features.")
|
||
|
|
||
|
|
||
|
let flag_docs =
|
||
|
create "flag_docs"
|
||
|
(since_version "0.3")
|
||
|
(fun () ->
|
||
|
s_ "Building docs require '-docs' flag at configure.")
|
||
|
|
||
|
|
||
|
let flag_tests =
|
||
|
create "flag_tests"
|
||
|
(since_version "0.3")
|
||
|
(fun () ->
|
||
|
s_ "Running tests require '-tests' flag at configure.")
|
||
|
|
||
|
|
||
|
let pack =
|
||
|
create "pack"
|
||
|
(since_version "0.3")
|
||
|
(fun () ->
|
||
|
s_ "Allow to create packed library.")
|
||
|
|
||
|
|
||
|
let section_object =
|
||
|
create "section_object" beta
|
||
|
(fun () ->
|
||
|
s_ "Implement an object section.")
|
||
|
|
||
|
|
||
|
let dynrun_for_release =
|
||
|
create "dynrun_for_release" alpha
|
||
|
(fun () ->
|
||
|
s_ "Make '-setup-update dynamic' suitable for releasing project.")
|
||
|
|
||
|
|
||
|
let compiled_setup_ml =
|
||
|
create "compiled_setup_ml" alpha
|
||
|
(fun () ->
|
||
|
s_ "It compiles the setup.ml and speed-up actions done with it.")
|
||
|
|
||
|
let disable_oasis_section =
|
||
|
create "disable_oasis_section" alpha
|
||
|
(fun () ->
|
||
|
s_ "Allows the OASIS section comments and digest to be omitted in \
|
||
|
generated files.")
|
||
|
|
||
|
let no_automatic_syntax =
|
||
|
create "no_automatic_syntax" alpha
|
||
|
(fun () ->
|
||
|
s_ "Disable the automatic inclusion of -syntax camlp4o for packages \
|
||
|
that matches the internal heuristic (if a dependency ends with \
|
||
|
a .syntax or is a well known syntax).")
|
||
|
end
|
||
|
|
||
|
module OASISUnixPath = struct
|
||
|
(* # 22 "src/oasis/OASISUnixPath.ml" *)
|
||
|
|
||
|
|
||
|
type unix_filename = string
|
||
|
type unix_dirname = string
|
||
|
|
||
|
|
||
|
type host_filename = string
|
||
|
type host_dirname = string
|
||
|
|
||
|
|
||
|
let current_dir_name = "."
|
||
|
|
||
|
|
||
|
let parent_dir_name = ".."
|
||
|
|
||
|
|
||
|
let is_current_dir fn =
|
||
|
fn = current_dir_name || fn = ""
|
||
|
|
||
|
|
||
|
let concat f1 f2 =
|
||
|
if is_current_dir f1 then
|
||
|
f2
|
||
|
else
|
||
|
let f1' =
|
||
|
try OASISString.strip_ends_with ~what:"/" f1 with Not_found -> f1
|
||
|
in
|
||
|
f1'^"/"^f2
|
||
|
|
||
|
|
||
|
let make =
|
||
|
function
|
||
|
| hd :: tl ->
|
||
|
List.fold_left
|
||
|
(fun f p -> concat f p)
|
||
|
hd
|
||
|
tl
|
||
|
| [] ->
|
||
|
invalid_arg "OASISUnixPath.make"
|
||
|
|
||
|
|
||
|
let dirname f =
|
||
|
try
|
||
|
String.sub f 0 (String.rindex f '/')
|
||
|
with Not_found ->
|
||
|
current_dir_name
|
||
|
|
||
|
|
||
|
let basename f =
|
||
|
try
|
||
|
let pos_start =
|
||
|
(String.rindex f '/') + 1
|
||
|
in
|
||
|
String.sub f pos_start ((String.length f) - pos_start)
|
||
|
with Not_found ->
|
||
|
f
|
||
|
|
||
|
|
||
|
let chop_extension f =
|
||
|
try
|
||
|
let last_dot =
|
||
|
String.rindex f '.'
|
||
|
in
|
||
|
let sub =
|
||
|
String.sub f 0 last_dot
|
||
|
in
|
||
|
try
|
||
|
let last_slash =
|
||
|
String.rindex f '/'
|
||
|
in
|
||
|
if last_slash < last_dot then
|
||
|
sub
|
||
|
else
|
||
|
f
|
||
|
with Not_found ->
|
||
|
sub
|
||
|
|
||
|
with Not_found ->
|
||
|
f
|
||
|
|
||
|
|
||
|
let capitalize_file f =
|
||
|
let dir = dirname f in
|
||
|
let base = basename f in
|
||
|
concat dir (OASISString.capitalize_ascii base)
|
||
|
|
||
|
|
||
|
let uncapitalize_file f =
|
||
|
let dir = dirname f in
|
||
|
let base = basename f in
|
||
|
concat dir (OASISString.uncapitalize_ascii base)
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISHostPath = struct
|
||
|
(* # 22 "src/oasis/OASISHostPath.ml" *)
|
||
|
|
||
|
|
||
|
open Filename
|
||
|
|
||
|
|
||
|
module Unix = OASISUnixPath
|
||
|
|
||
|
|
||
|
let make =
|
||
|
function
|
||
|
| [] ->
|
||
|
invalid_arg "OASISHostPath.make"
|
||
|
| hd :: tl ->
|
||
|
List.fold_left Filename.concat hd tl
|
||
|
|
||
|
|
||
|
let of_unix ufn =
|
||
|
if Sys.os_type = "Unix" then
|
||
|
ufn
|
||
|
else
|
||
|
make
|
||
|
(List.map
|
||
|
(fun p ->
|
||
|
if p = Unix.current_dir_name then
|
||
|
current_dir_name
|
||
|
else if p = Unix.parent_dir_name then
|
||
|
parent_dir_name
|
||
|
else
|
||
|
p)
|
||
|
(OASISString.nsplit ufn '/'))
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISSection = struct
|
||
|
(* # 22 "src/oasis/OASISSection.ml" *)
|
||
|
|
||
|
|
||
|
open OASISTypes
|
||
|
|
||
|
|
||
|
let section_kind_common =
|
||
|
function
|
||
|
| Library (cs, _, _) ->
|
||
|
`Library, cs
|
||
|
| Object (cs, _, _) ->
|
||
|
`Object, cs
|
||
|
| Executable (cs, _, _) ->
|
||
|
`Executable, cs
|
||
|
| Flag (cs, _) ->
|
||
|
`Flag, cs
|
||
|
| SrcRepo (cs, _) ->
|
||
|
`SrcRepo, cs
|
||
|
| Test (cs, _) ->
|
||
|
`Test, cs
|
||
|
| Doc (cs, _) ->
|
||
|
`Doc, cs
|
||
|
|
||
|
|
||
|
let section_common sct =
|
||
|
snd (section_kind_common sct)
|
||
|
|
||
|
|
||
|
let section_common_set cs =
|
||
|
function
|
||
|
| Library (_, bs, lib) -> Library (cs, bs, lib)
|
||
|
| Object (_, bs, obj) -> Object (cs, bs, obj)
|
||
|
| Executable (_, bs, exec) -> Executable (cs, bs, exec)
|
||
|
| Flag (_, flg) -> Flag (cs, flg)
|
||
|
| SrcRepo (_, src_repo) -> SrcRepo (cs, src_repo)
|
||
|
| Test (_, tst) -> Test (cs, tst)
|
||
|
| Doc (_, doc) -> Doc (cs, doc)
|
||
|
|
||
|
|
||
|
(** Key used to identify section
|
||
|
*)
|
||
|
let section_id sct =
|
||
|
let k, cs =
|
||
|
section_kind_common sct
|
||
|
in
|
||
|
k, cs.cs_name
|
||
|
|
||
|
|
||
|
let string_of_section sct =
|
||
|
let k, nm =
|
||
|
section_id sct
|
||
|
in
|
||
|
(match k with
|
||
|
| `Library -> "library"
|
||
|
| `Object -> "object"
|
||
|
| `Executable -> "executable"
|
||
|
| `Flag -> "flag"
|
||
|
| `SrcRepo -> "src repository"
|
||
|
| `Test -> "test"
|
||
|
| `Doc -> "doc")
|
||
|
^" "^nm
|
||
|
|
||
|
|
||
|
let section_find id scts =
|
||
|
List.find
|
||
|
(fun sct -> id = section_id sct)
|
||
|
scts
|
||
|
|
||
|
|
||
|
module CSection =
|
||
|
struct
|
||
|
type t = section
|
||
|
|
||
|
let id = section_id
|
||
|
|
||
|
let compare t1 t2 =
|
||
|
compare (id t1) (id t2)
|
||
|
|
||
|
let equal t1 t2 =
|
||
|
(id t1) = (id t2)
|
||
|
|
||
|
let hash t =
|
||
|
Hashtbl.hash (id t)
|
||
|
end
|
||
|
|
||
|
|
||
|
module MapSection = Map.Make(CSection)
|
||
|
module SetSection = Set.Make(CSection)
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISBuildSection = struct
|
||
|
(* # 22 "src/oasis/OASISBuildSection.ml" *)
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISExecutable = struct
|
||
|
(* # 22 "src/oasis/OASISExecutable.ml" *)
|
||
|
|
||
|
|
||
|
open OASISTypes
|
||
|
|
||
|
|
||
|
let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program =
|
||
|
let dir =
|
||
|
OASISUnixPath.concat
|
||
|
bs.bs_path
|
||
|
(OASISUnixPath.dirname exec.exec_main_is)
|
||
|
in
|
||
|
let is_native_exec =
|
||
|
match bs.bs_compiled_object with
|
||
|
| Native -> true
|
||
|
| Best -> is_native ()
|
||
|
| Byte -> false
|
||
|
in
|
||
|
|
||
|
OASISUnixPath.concat
|
||
|
dir
|
||
|
(cs.cs_name^(suffix_program ())),
|
||
|
|
||
|
if not is_native_exec &&
|
||
|
not exec.exec_custom &&
|
||
|
bs.bs_c_sources <> [] then
|
||
|
Some (dir^"/dll"^cs.cs_name^"_stubs"^(ext_dll ()))
|
||
|
else
|
||
|
None
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISLibrary = struct
|
||
|
(* # 22 "src/oasis/OASISLibrary.ml" *)
|
||
|
|
||
|
|
||
|
open OASISTypes
|
||
|
open OASISUtils
|
||
|
open OASISGettext
|
||
|
open OASISSection
|
||
|
|
||
|
|
||
|
(* Look for a module file, considering capitalization or not. *)
|
||
|
let find_module source_file_exists bs modul =
|
||
|
let possible_base_fn =
|
||
|
List.map
|
||
|
(OASISUnixPath.concat bs.bs_path)
|
||
|
[modul;
|
||
|
OASISUnixPath.uncapitalize_file modul;
|
||
|
OASISUnixPath.capitalize_file modul]
|
||
|
in
|
||
|
(* TODO: we should be able to be able to determine the source for every
|
||
|
* files. Hence we should introduce a Module(source: fn) for the fields
|
||
|
* Modules and InternalModules
|
||
|
*)
|
||
|
List.fold_left
|
||
|
(fun acc base_fn ->
|
||
|
match acc with
|
||
|
| `No_sources _ ->
|
||
|
begin
|
||
|
let file_found =
|
||
|
List.fold_left
|
||
|
(fun acc ext ->
|
||
|
if source_file_exists (base_fn^ext) then
|
||
|
(base_fn^ext) :: acc
|
||
|
else
|
||
|
acc)
|
||
|
[]
|
||
|
[".ml"; ".mli"; ".mll"; ".mly"]
|
||
|
in
|
||
|
match file_found with
|
||
|
| [] ->
|
||
|
acc
|
||
|
| lst ->
|
||
|
`Sources (base_fn, lst)
|
||
|
end
|
||
|
| `Sources _ ->
|
||
|
acc)
|
||
|
(`No_sources possible_base_fn)
|
||
|
possible_base_fn
|
||
|
|
||
|
|
||
|
let source_unix_files ~ctxt (cs, bs, lib) source_file_exists =
|
||
|
List.fold_left
|
||
|
(fun acc modul ->
|
||
|
match find_module source_file_exists bs modul with
|
||
|
| `Sources (base_fn, lst) ->
|
||
|
(base_fn, lst) :: acc
|
||
|
| `No_sources _ ->
|
||
|
OASISMessage.warning
|
||
|
~ctxt
|
||
|
(f_ "Cannot find source file matching \
|
||
|
module '%s' in library %s")
|
||
|
modul cs.cs_name;
|
||
|
acc)
|
||
|
[]
|
||
|
(lib.lib_modules @ lib.lib_internal_modules)
|
||
|
|
||
|
|
||
|
let generated_unix_files
|
||
|
~ctxt
|
||
|
~is_native
|
||
|
~has_native_dynlink
|
||
|
~ext_lib
|
||
|
~ext_dll
|
||
|
~source_file_exists
|
||
|
(cs, bs, lib) =
|
||
|
|
||
|
let find_modules lst ext =
|
||
|
let find_module modul =
|
||
|
match find_module source_file_exists bs modul with
|
||
|
| `Sources (base_fn, [fn]) when ext <> "cmi"
|
||
|
&& Filename.check_suffix fn ".mli" ->
|
||
|
None (* No implementation files for pure interface. *)
|
||
|
| `Sources (base_fn, _) ->
|
||
|
Some [base_fn]
|
||
|
| `No_sources lst ->
|
||
|
OASISMessage.warning
|
||
|
~ctxt
|
||
|
(f_ "Cannot find source file matching \
|
||
|
module '%s' in library %s")
|
||
|
modul cs.cs_name;
|
||
|
Some lst
|
||
|
in
|
||
|
List.fold_left
|
||
|
(fun acc nm ->
|
||
|
match find_module nm with
|
||
|
| None -> acc
|
||
|
| Some base_fns ->
|
||
|
List.map (fun base_fn -> base_fn ^"."^ext) base_fns :: acc)
|
||
|
[]
|
||
|
lst
|
||
|
in
|
||
|
|
||
|
(* The .cmx that be compiled along *)
|
||
|
let cmxs =
|
||
|
let should_be_built =
|
||
|
match bs.bs_compiled_object with
|
||
|
| Native -> true
|
||
|
| Best -> is_native
|
||
|
| Byte -> false
|
||
|
in
|
||
|
if should_be_built then
|
||
|
if lib.lib_pack then
|
||
|
find_modules
|
||
|
[cs.cs_name]
|
||
|
"cmx"
|
||
|
else
|
||
|
find_modules
|
||
|
(lib.lib_modules @ lib.lib_internal_modules)
|
||
|
"cmx"
|
||
|
else
|
||
|
[]
|
||
|
in
|
||
|
|
||
|
let acc_nopath =
|
||
|
[]
|
||
|
in
|
||
|
|
||
|
(* The headers and annot/cmt files that should be compiled along *)
|
||
|
let headers =
|
||
|
let sufx =
|
||
|
if lib.lib_pack
|
||
|
then [".cmti"; ".cmt"; ".annot"]
|
||
|
else [".cmi"; ".cmti"; ".cmt"; ".annot"]
|
||
|
in
|
||
|
List.map
|
||
|
begin
|
||
|
List.fold_left
|
||
|
begin fun accu s ->
|
||
|
let dot = String.rindex s '.' in
|
||
|
let base = String.sub s 0 dot in
|
||
|
List.map ((^) base) sufx @ accu
|
||
|
end
|
||
|
[]
|
||
|
end
|
||
|
(find_modules lib.lib_modules "cmi")
|
||
|
in
|
||
|
|
||
|
(* Compute what libraries should be built *)
|
||
|
let acc_nopath =
|
||
|
(* Add the packed header file if required *)
|
||
|
let add_pack_header acc =
|
||
|
if lib.lib_pack then
|
||
|
[cs.cs_name^".cmi"; cs.cs_name^".cmti"; cs.cs_name^".cmt"] :: acc
|
||
|
else
|
||
|
acc
|
||
|
in
|
||
|
let byte acc =
|
||
|
add_pack_header ([cs.cs_name^".cma"] :: acc)
|
||
|
in
|
||
|
let native acc =
|
||
|
let acc =
|
||
|
add_pack_header
|
||
|
(if has_native_dynlink then
|
||
|
[cs.cs_name^".cmxs"] :: acc
|
||
|
else acc)
|
||
|
in
|
||
|
[cs.cs_name^".cmxa"] :: [cs.cs_name^ext_lib] :: acc
|
||
|
in
|
||
|
match bs.bs_compiled_object with
|
||
|
| Native ->
|
||
|
byte (native acc_nopath)
|
||
|
| Best when is_native ->
|
||
|
byte (native acc_nopath)
|
||
|
| Byte | Best ->
|
||
|
byte acc_nopath
|
||
|
in
|
||
|
|
||
|
(* Add C library to be built *)
|
||
|
let acc_nopath =
|
||
|
if bs.bs_c_sources <> [] then
|
||
|
begin
|
||
|
["lib"^cs.cs_name^"_stubs"^ext_lib]
|
||
|
::
|
||
|
["dll"^cs.cs_name^"_stubs"^ext_dll]
|
||
|
::
|
||
|
acc_nopath
|
||
|
end
|
||
|
else
|
||
|
acc_nopath
|
||
|
in
|
||
|
|
||
|
(* All the files generated *)
|
||
|
List.rev_append
|
||
|
(List.rev_map
|
||
|
(List.rev_map
|
||
|
(OASISUnixPath.concat bs.bs_path))
|
||
|
acc_nopath)
|
||
|
(headers @ cmxs)
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISObject = struct
|
||
|
(* # 22 "src/oasis/OASISObject.ml" *)
|
||
|
|
||
|
|
||
|
open OASISTypes
|
||
|
open OASISGettext
|
||
|
|
||
|
|
||
|
let source_unix_files ~ctxt (cs, bs, obj) source_file_exists =
|
||
|
List.fold_left
|
||
|
(fun acc modul ->
|
||
|
match OASISLibrary.find_module source_file_exists bs modul with
|
||
|
| `Sources (base_fn, lst) ->
|
||
|
(base_fn, lst) :: acc
|
||
|
| `No_sources _ ->
|
||
|
OASISMessage.warning
|
||
|
~ctxt
|
||
|
(f_ "Cannot find source file matching \
|
||
|
module '%s' in object %s")
|
||
|
modul cs.cs_name;
|
||
|
acc)
|
||
|
[]
|
||
|
obj.obj_modules
|
||
|
|
||
|
|
||
|
let generated_unix_files
|
||
|
~ctxt
|
||
|
~is_native
|
||
|
~source_file_exists
|
||
|
(cs, bs, obj) =
|
||
|
|
||
|
let find_module ext modul =
|
||
|
match OASISLibrary.find_module source_file_exists bs modul with
|
||
|
| `Sources (base_fn, _) -> [base_fn ^ ext]
|
||
|
| `No_sources lst ->
|
||
|
OASISMessage.warning
|
||
|
~ctxt
|
||
|
(f_ "Cannot find source file matching \
|
||
|
module '%s' in object %s")
|
||
|
modul cs.cs_name ;
|
||
|
lst
|
||
|
in
|
||
|
|
||
|
let header, byte, native, c_object, f =
|
||
|
match obj.obj_modules with
|
||
|
| [ m ] -> (find_module ".cmi" m,
|
||
|
find_module ".cmo" m,
|
||
|
find_module ".cmx" m,
|
||
|
find_module ".o" m,
|
||
|
fun x -> x)
|
||
|
| _ -> ([cs.cs_name ^ ".cmi"],
|
||
|
[cs.cs_name ^ ".cmo"],
|
||
|
[cs.cs_name ^ ".cmx"],
|
||
|
[cs.cs_name ^ ".o"],
|
||
|
OASISUnixPath.concat bs.bs_path)
|
||
|
in
|
||
|
List.map (List.map f) (
|
||
|
match bs.bs_compiled_object with
|
||
|
| Native ->
|
||
|
native :: c_object :: byte :: header :: []
|
||
|
| Best when is_native ->
|
||
|
native :: c_object :: byte :: header :: []
|
||
|
| Byte | Best ->
|
||
|
byte :: header :: [])
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISFindlib = struct
|
||
|
(* # 22 "src/oasis/OASISFindlib.ml" *)
|
||
|
|
||
|
|
||
|
open OASISTypes
|
||
|
open OASISUtils
|
||
|
open OASISGettext
|
||
|
open OASISSection
|
||
|
|
||
|
|
||
|
type library_name = name
|
||
|
type findlib_part_name = name
|
||
|
type 'a map_of_findlib_part_name = 'a OASISUtils.MapString.t
|
||
|
|
||
|
|
||
|
exception InternalLibraryNotFound of library_name
|
||
|
exception FindlibPackageNotFound of findlib_name
|
||
|
|
||
|
|
||
|
type group_t =
|
||
|
| Container of findlib_name * group_t list
|
||
|
| Package of (findlib_name *
|
||
|
common_section *
|
||
|
build_section *
|
||
|
[`Library of library | `Object of object_] *
|
||
|
group_t list)
|
||
|
|
||
|
|
||
|
type data = common_section *
|
||
|
build_section *
|
||
|
[`Library of library | `Object of object_]
|
||
|
type tree =
|
||
|
| Node of (data option) * (tree MapString.t)
|
||
|
| Leaf of data
|
||
|
|
||
|
|
||
|
let findlib_mapping pkg =
|
||
|
(* Map from library name to either full findlib name or parts + parent. *)
|
||
|
let fndlb_parts_of_lib_name =
|
||
|
let fndlb_parts cs lib =
|
||
|
let name =
|
||
|
match lib.lib_findlib_name with
|
||
|
| Some nm -> nm
|
||
|
| None -> cs.cs_name
|
||
|
in
|
||
|
let name =
|
||
|
String.concat "." (lib.lib_findlib_containers @ [name])
|
||
|
in
|
||
|
name
|
||
|
in
|
||
|
List.fold_left
|
||
|
(fun mp ->
|
||
|
function
|
||
|
| Library (cs, _, lib) ->
|
||
|
begin
|
||
|
let lib_name = cs.cs_name in
|
||
|
let fndlb_parts = fndlb_parts cs lib in
|
||
|
if MapString.mem lib_name mp then
|
||
|
failwithf
|
||
|
(f_ "The library name '%s' is used more than once.")
|
||
|
lib_name;
|
||
|
match lib.lib_findlib_parent with
|
||
|
| Some lib_name_parent ->
|
||
|
MapString.add
|
||
|
lib_name
|
||
|
(`Unsolved (lib_name_parent, fndlb_parts))
|
||
|
mp
|
||
|
| None ->
|
||
|
MapString.add
|
||
|
lib_name
|
||
|
(`Solved fndlb_parts)
|
||
|
mp
|
||
|
end
|
||
|
|
||
|
| Object (cs, _, obj) ->
|
||
|
begin
|
||
|
let obj_name = cs.cs_name in
|
||
|
if MapString.mem obj_name mp then
|
||
|
failwithf
|
||
|
(f_ "The object name '%s' is used more than once.")
|
||
|
obj_name;
|
||
|
let findlib_full_name = match obj.obj_findlib_fullname with
|
||
|
| Some ns -> String.concat "." ns
|
||
|
| None -> obj_name
|
||
|
in
|
||
|
MapString.add
|
||
|
obj_name
|
||
|
(`Solved findlib_full_name)
|
||
|
mp
|
||
|
end
|
||
|
|
||
|
| Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ ->
|
||
|
mp)
|
||
|
MapString.empty
|
||
|
pkg.sections
|
||
|
in
|
||
|
|
||
|
(* Solve the above graph to be only library name to full findlib name. *)
|
||
|
let fndlb_name_of_lib_name =
|
||
|
let rec solve visited mp lib_name lib_name_child =
|
||
|
if SetString.mem lib_name visited then
|
||
|
failwithf
|
||
|
(f_ "Library '%s' is involved in a cycle \
|
||
|
with regard to findlib naming.")
|
||
|
lib_name;
|
||
|
let visited = SetString.add lib_name visited in
|
||
|
try
|
||
|
match MapString.find lib_name mp with
|
||
|
| `Solved fndlb_nm ->
|
||
|
fndlb_nm, mp
|
||
|
| `Unsolved (lib_nm_parent, post_fndlb_nm) ->
|
||
|
let pre_fndlb_nm, mp =
|
||
|
solve visited mp lib_nm_parent lib_name
|
||
|
in
|
||
|
let fndlb_nm = pre_fndlb_nm^"."^post_fndlb_nm in
|
||
|
fndlb_nm, MapString.add lib_name (`Solved fndlb_nm) mp
|
||
|
with Not_found ->
|
||
|
failwithf
|
||
|
(f_ "Library '%s', which is defined as the findlib parent of \
|
||
|
library '%s', doesn't exist.")
|
||
|
lib_name lib_name_child
|
||
|
in
|
||
|
let mp =
|
||
|
MapString.fold
|
||
|
(fun lib_name status mp ->
|
||
|
match status with
|
||
|
| `Solved _ ->
|
||
|
(* Solved initialy, no need to go further *)
|
||
|
mp
|
||
|
| `Unsolved _ ->
|
||
|
let _, mp = solve SetString.empty mp lib_name "<none>" in
|
||
|
mp)
|
||
|
fndlb_parts_of_lib_name
|
||
|
fndlb_parts_of_lib_name
|
||
|
in
|
||
|
MapString.map
|
||
|
(function
|
||
|
| `Solved fndlb_nm -> fndlb_nm
|
||
|
| `Unsolved _ -> assert false)
|
||
|
mp
|
||
|
in
|
||
|
|
||
|
(* Convert an internal library name to a findlib name. *)
|
||
|
let findlib_name_of_library_name lib_nm =
|
||
|
try
|
||
|
MapString.find lib_nm fndlb_name_of_lib_name
|
||
|
with Not_found ->
|
||
|
raise (InternalLibraryNotFound lib_nm)
|
||
|
in
|
||
|
|
||
|
(* Add a library to the tree.
|
||
|
*)
|
||
|
let add sct mp =
|
||
|
let fndlb_fullname =
|
||
|
let cs, _, _ = sct in
|
||
|
let lib_name = cs.cs_name in
|
||
|
findlib_name_of_library_name lib_name
|
||
|
in
|
||
|
let rec add_children nm_lst (children: tree MapString.t) =
|
||
|
match nm_lst with
|
||
|
| (hd :: tl) ->
|
||
|
begin
|
||
|
let node =
|
||
|
try
|
||
|
add_node tl (MapString.find hd children)
|
||
|
with Not_found ->
|
||
|
(* New node *)
|
||
|
new_node tl
|
||
|
in
|
||
|
MapString.add hd node children
|
||
|
end
|
||
|
| [] ->
|
||
|
(* Should not have a nameless library. *)
|
||
|
assert false
|
||
|
and add_node tl node =
|
||
|
if tl = [] then
|
||
|
begin
|
||
|
match node with
|
||
|
| Node (None, children) ->
|
||
|
Node (Some sct, children)
|
||
|
| Leaf (cs', _, _) | Node (Some (cs', _, _), _) ->
|
||
|
(* TODO: allow to merge Package, i.e.
|
||
|
* archive(byte) = "foo.cma foo_init.cmo"
|
||
|
*)
|
||
|
let cs, _, _ = sct in
|
||
|
failwithf
|
||
|
(f_ "Library '%s' and '%s' have the same findlib name '%s'")
|
||
|
cs.cs_name cs'.cs_name fndlb_fullname
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
match node with
|
||
|
| Leaf data ->
|
||
|
Node (Some data, add_children tl MapString.empty)
|
||
|
| Node (data_opt, children) ->
|
||
|
Node (data_opt, add_children tl children)
|
||
|
end
|
||
|
and new_node =
|
||
|
function
|
||
|
| [] ->
|
||
|
Leaf sct
|
||
|
| hd :: tl ->
|
||
|
Node (None, MapString.add hd (new_node tl) MapString.empty)
|
||
|
in
|
||
|
add_children (OASISString.nsplit fndlb_fullname '.') mp
|
||
|
in
|
||
|
|
||
|
let rec group_of_tree mp =
|
||
|
MapString.fold
|
||
|
(fun nm node acc ->
|
||
|
let cur =
|
||
|
match node with
|
||
|
| Node (Some (cs, bs, lib), children) ->
|
||
|
Package (nm, cs, bs, lib, group_of_tree children)
|
||
|
| Node (None, children) ->
|
||
|
Container (nm, group_of_tree children)
|
||
|
| Leaf (cs, bs, lib) ->
|
||
|
Package (nm, cs, bs, lib, [])
|
||
|
in
|
||
|
cur :: acc)
|
||
|
mp []
|
||
|
in
|
||
|
|
||
|
let group_mp =
|
||
|
List.fold_left
|
||
|
(fun mp ->
|
||
|
function
|
||
|
| Library (cs, bs, lib) ->
|
||
|
add (cs, bs, `Library lib) mp
|
||
|
| Object (cs, bs, obj) ->
|
||
|
add (cs, bs, `Object obj) mp
|
||
|
| _ ->
|
||
|
mp)
|
||
|
MapString.empty
|
||
|
pkg.sections
|
||
|
in
|
||
|
|
||
|
let groups =
|
||
|
group_of_tree group_mp
|
||
|
in
|
||
|
|
||
|
let library_name_of_findlib_name =
|
||
|
lazy begin
|
||
|
(* Revert findlib_name_of_library_name. *)
|
||
|
MapString.fold
|
||
|
(fun k v mp -> MapString.add v k mp)
|
||
|
fndlb_name_of_lib_name
|
||
|
MapString.empty
|
||
|
end
|
||
|
in
|
||
|
let library_name_of_findlib_name fndlb_nm =
|
||
|
try
|
||
|
MapString.find fndlb_nm (Lazy.force library_name_of_findlib_name)
|
||
|
with Not_found ->
|
||
|
raise (FindlibPackageNotFound fndlb_nm)
|
||
|
in
|
||
|
|
||
|
groups,
|
||
|
findlib_name_of_library_name,
|
||
|
library_name_of_findlib_name
|
||
|
|
||
|
|
||
|
let findlib_of_group =
|
||
|
function
|
||
|
| Container (fndlb_nm, _)
|
||
|
| Package (fndlb_nm, _, _, _, _) -> fndlb_nm
|
||
|
|
||
|
|
||
|
let root_of_group grp =
|
||
|
let rec root_lib_aux =
|
||
|
(* We do a DFS in the group. *)
|
||
|
function
|
||
|
| Container (_, children) ->
|
||
|
List.fold_left
|
||
|
(fun res grp ->
|
||
|
if res = None then
|
||
|
root_lib_aux grp
|
||
|
else
|
||
|
res)
|
||
|
None
|
||
|
children
|
||
|
| Package (_, cs, bs, lib, _) ->
|
||
|
Some (cs, bs, lib)
|
||
|
in
|
||
|
match root_lib_aux grp with
|
||
|
| Some res ->
|
||
|
res
|
||
|
| None ->
|
||
|
failwithf
|
||
|
(f_ "Unable to determine root library of findlib library '%s'")
|
||
|
(findlib_of_group grp)
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISFlag = struct
|
||
|
(* # 22 "src/oasis/OASISFlag.ml" *)
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISPackage = struct
|
||
|
(* # 22 "src/oasis/OASISPackage.ml" *)
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISSourceRepository = struct
|
||
|
(* # 22 "src/oasis/OASISSourceRepository.ml" *)
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISTest = struct
|
||
|
(* # 22 "src/oasis/OASISTest.ml" *)
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISDocument = struct
|
||
|
(* # 22 "src/oasis/OASISDocument.ml" *)
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OASISExec = struct
|
||
|
(* # 22 "src/oasis/OASISExec.ml" *)
|
||
|
|
||
|
|
||
|
open OASISGettext
|
||
|
open OASISUtils
|
||
|
open OASISMessage
|
||
|
|
||
|
|
||
|
(* TODO: I don't like this quote, it is there because $(rm) foo expands to
|
||
|
* 'rm -f' foo...
|
||
|
*)
|
||
|
let run ~ctxt ?f_exit_code ?(quote=true) cmd args =
|
||
|
let cmd =
|
||
|
if quote then
|
||
|
if Sys.os_type = "Win32" then
|
||
|
if String.contains cmd ' ' then
|
||
|
(* Double the 1st double quote... win32... sigh *)
|
||
|
"\""^(Filename.quote cmd)
|
||
|
else
|
||
|
cmd
|
||
|
else
|
||
|
Filename.quote cmd
|
||
|
else
|
||
|
cmd
|
||
|
in
|
||
|
let cmdline =
|
||
|
String.concat " " (cmd :: args)
|
||
|
in
|
||
|
info ~ctxt (f_ "Running command '%s'") cmdline;
|
||
|
match f_exit_code, Sys.command cmdline with
|
||
|
| None, 0 -> ()
|
||
|
| None, i ->
|
||
|
failwithf
|
||
|
(f_ "Command '%s' terminated with error code %d")
|
||
|
cmdline i
|
||
|
| Some f, i ->
|
||
|
f i
|
||
|
|
||
|
|
||
|
let run_read_output ~ctxt ?f_exit_code cmd args =
|
||
|
let fn =
|
||
|
Filename.temp_file "oasis-" ".txt"
|
||
|
in
|
||
|
try
|
||
|
begin
|
||
|
let () =
|
||
|
run ~ctxt ?f_exit_code cmd (args @ [">"; Filename.quote fn])
|
||
|
in
|
||
|
let chn =
|
||
|
open_in fn
|
||
|
in
|
||
|
let routput =
|
||
|
ref []
|
||
|
in
|
||
|
begin
|
||
|
try
|
||
|
while true do
|
||
|
routput := (input_line chn) :: !routput
|
||
|
done
|
||
|
with End_of_file ->
|
||
|
()
|
||
|
end;
|
||
|
close_in chn;
|
||
|
Sys.remove fn;
|
||
|
List.rev !routput
|
||
|
end
|
||
|
with e ->
|
||
|
(try Sys.remove fn with _ -> ());
|
||
|
raise e
|
||
|
|
||
|
|
||
|
let run_read_one_line ~ctxt ?f_exit_code cmd args =
|
||
|
match run_read_output ~ctxt ?f_exit_code cmd args with
|
||
|
| [fst] ->
|
||
|
fst
|
||
|
| lst ->
|
||
|
failwithf
|
||
|
(f_ "Command return unexpected output %S")
|
||
|
(String.concat "\n" lst)
|
||
|
end
|
||
|
|
||
|
module OASISFileUtil = struct
|
||
|
(* # 22 "src/oasis/OASISFileUtil.ml" *)
|
||
|
|
||
|
|
||
|
open OASISGettext
|
||
|
|
||
|
|
||
|
let file_exists_case fn =
|
||
|
let dirname = Filename.dirname fn in
|
||
|
let basename = Filename.basename fn in
|
||
|
if Sys.file_exists dirname then
|
||
|
if basename = Filename.current_dir_name then
|
||
|
true
|
||
|
else
|
||
|
List.mem
|
||
|
basename
|
||
|
(Array.to_list (Sys.readdir dirname))
|
||
|
else
|
||
|
false
|
||
|
|
||
|
|
||
|
let find_file ?(case_sensitive=true) paths exts =
|
||
|
|
||
|
(* Cardinal product of two list *)
|
||
|
let ( * ) lst1 lst2 =
|
||
|
List.flatten
|
||
|
(List.map
|
||
|
(fun a ->
|
||
|
List.map
|
||
|
(fun b -> a, b)
|
||
|
lst2)
|
||
|
lst1)
|
||
|
in
|
||
|
|
||
|
let rec combined_paths lst =
|
||
|
match lst with
|
||
|
| p1 :: p2 :: tl ->
|
||
|
let acc =
|
||
|
(List.map
|
||
|
(fun (a, b) -> Filename.concat a b)
|
||
|
(p1 * p2))
|
||
|
in
|
||
|
combined_paths (acc :: tl)
|
||
|
| [e] ->
|
||
|
e
|
||
|
| [] ->
|
||
|
[]
|
||
|
in
|
||
|
|
||
|
let alternatives =
|
||
|
List.map
|
||
|
(fun (p, e) ->
|
||
|
if String.length e > 0 && e.[0] <> '.' then
|
||
|
p ^ "." ^ e
|
||
|
else
|
||
|
p ^ e)
|
||
|
((combined_paths paths) * exts)
|
||
|
in
|
||
|
List.find (fun file ->
|
||
|
(if case_sensitive then
|
||
|
file_exists_case file
|
||
|
else
|
||
|
Sys.file_exists file)
|
||
|
&& not (Sys.is_directory file)
|
||
|
) alternatives
|
||
|
|
||
|
|
||
|
let which ~ctxt prg =
|
||
|
let path_sep =
|
||
|
match Sys.os_type with
|
||
|
| "Win32" ->
|
||
|
';'
|
||
|
| _ ->
|
||
|
':'
|
||
|
in
|
||
|
let path_lst = OASISString.nsplit (Sys.getenv "PATH") path_sep in
|
||
|
let exec_ext =
|
||
|
match Sys.os_type with
|
||
|
| "Win32" ->
|
||
|
"" :: (OASISString.nsplit (Sys.getenv "PATHEXT") path_sep)
|
||
|
| _ ->
|
||
|
[""]
|
||
|
in
|
||
|
find_file ~case_sensitive:false [path_lst; [prg]] exec_ext
|
||
|
|
||
|
|
||
|
(**/**)
|
||
|
let rec fix_dir dn =
|
||
|
(* Windows hack because Sys.file_exists "src\\" = false when
|
||
|
* Sys.file_exists "src" = true
|
||
|
*)
|
||
|
let ln =
|
||
|
String.length dn
|
||
|
in
|
||
|
if Sys.os_type = "Win32" && ln > 0 && dn.[ln - 1] = '\\' then
|
||
|
fix_dir (String.sub dn 0 (ln - 1))
|
||
|
else
|
||
|
dn
|
||
|
|
||
|
|
||
|
let q = Filename.quote
|
||
|
(**/**)
|
||
|
|
||
|
|
||
|
let cp ~ctxt ?(recurse=false) src tgt =
|
||
|
if recurse then
|
||
|
match Sys.os_type with
|
||
|
| "Win32" ->
|
||
|
OASISExec.run ~ctxt
|
||
|
"xcopy" [q src; q tgt; "/E"]
|
||
|
| _ ->
|
||
|
OASISExec.run ~ctxt
|
||
|
"cp" ["-r"; q src; q tgt]
|
||
|
else
|
||
|
OASISExec.run ~ctxt
|
||
|
(match Sys.os_type with
|
||
|
| "Win32" -> "copy"
|
||
|
| _ -> "cp")
|
||
|
[q src; q tgt]
|
||
|
|
||
|
|
||
|
let mkdir ~ctxt tgt =
|
||
|
OASISExec.run ~ctxt
|
||
|
(match Sys.os_type with
|
||
|
| "Win32" -> "md"
|
||
|
| _ -> "mkdir")
|
||
|
[q tgt]
|
||
|
|
||
|
|
||
|
let rec mkdir_parent ~ctxt f tgt =
|
||
|
let tgt =
|
||
|
fix_dir tgt
|
||
|
in
|
||
|
if Sys.file_exists tgt then
|
||
|
begin
|
||
|
if not (Sys.is_directory tgt) then
|
||
|
OASISUtils.failwithf
|
||
|
(f_ "Cannot create directory '%s', a file of the same name already \
|
||
|
exists")
|
||
|
tgt
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
mkdir_parent ~ctxt f (Filename.dirname tgt);
|
||
|
if not (Sys.file_exists tgt) then
|
||
|
begin
|
||
|
f tgt;
|
||
|
mkdir ~ctxt tgt
|
||
|
end
|
||
|
end
|
||
|
|
||
|
|
||
|
let rmdir ~ctxt tgt =
|
||
|
if Sys.readdir tgt = [||] then begin
|
||
|
match Sys.os_type with
|
||
|
| "Win32" ->
|
||
|
OASISExec.run ~ctxt "rd" [q tgt]
|
||
|
| _ ->
|
||
|
OASISExec.run ~ctxt "rm" ["-r"; q tgt]
|
||
|
end else begin
|
||
|
OASISMessage.error ~ctxt
|
||
|
(f_ "Cannot remove directory '%s': not empty.")
|
||
|
tgt
|
||
|
end
|
||
|
|
||
|
|
||
|
let glob ~ctxt fn =
|
||
|
let basename =
|
||
|
Filename.basename fn
|
||
|
in
|
||
|
if String.length basename >= 2 &&
|
||
|
basename.[0] = '*' &&
|
||
|
basename.[1] = '.' then
|
||
|
begin
|
||
|
let ext_len =
|
||
|
(String.length basename) - 2
|
||
|
in
|
||
|
let ext =
|
||
|
String.sub basename 2 ext_len
|
||
|
in
|
||
|
let dirname =
|
||
|
Filename.dirname fn
|
||
|
in
|
||
|
Array.fold_left
|
||
|
(fun acc fn ->
|
||
|
try
|
||
|
let fn_ext =
|
||
|
String.sub
|
||
|
fn
|
||
|
((String.length fn) - ext_len)
|
||
|
ext_len
|
||
|
in
|
||
|
if fn_ext = ext then
|
||
|
(Filename.concat dirname fn) :: acc
|
||
|
else
|
||
|
acc
|
||
|
with Invalid_argument _ ->
|
||
|
acc)
|
||
|
[]
|
||
|
(Sys.readdir dirname)
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
if file_exists_case fn then
|
||
|
[fn]
|
||
|
else
|
||
|
[]
|
||
|
end
|
||
|
end
|
||
|
|
||
|
|
||
|
# 2916 "setup.ml"
|
||
|
module BaseEnvLight = struct
|
||
|
(* # 22 "src/base/BaseEnvLight.ml" *)
|
||
|
|
||
|
|
||
|
module MapString = Map.Make(String)
|
||
|
|
||
|
|
||
|
type t = string MapString.t
|
||
|
|
||
|
|
||
|
let default_filename =
|
||
|
Filename.concat
|
||
|
(Sys.getcwd ())
|
||
|
"setup.data"
|
||
|
|
||
|
|
||
|
let load ?(allow_empty=false) ?(filename=default_filename) () =
|
||
|
if Sys.file_exists filename then
|
||
|
begin
|
||
|
let chn =
|
||
|
open_in_bin filename
|
||
|
in
|
||
|
let st =
|
||
|
Stream.of_channel chn
|
||
|
in
|
||
|
let line =
|
||
|
ref 1
|
||
|
in
|
||
|
let st_line =
|
||
|
Stream.from
|
||
|
(fun _ ->
|
||
|
try
|
||
|
match Stream.next st with
|
||
|
| '\n' -> incr line; Some '\n'
|
||
|
| c -> Some c
|
||
|
with Stream.Failure -> None)
|
||
|
in
|
||
|
let lexer =
|
||
|
Genlex.make_lexer ["="] st_line
|
||
|
in
|
||
|
let rec read_file mp =
|
||
|
match Stream.npeek 3 lexer with
|
||
|
| [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
|
||
|
Stream.junk lexer;
|
||
|
Stream.junk lexer;
|
||
|
Stream.junk lexer;
|
||
|
read_file (MapString.add nm value mp)
|
||
|
| [] ->
|
||
|
mp
|
||
|
| _ ->
|
||
|
failwith
|
||
|
(Printf.sprintf
|
||
|
"Malformed data file '%s' line %d"
|
||
|
filename !line)
|
||
|
in
|
||
|
let mp =
|
||
|
read_file MapString.empty
|
||
|
in
|
||
|
close_in chn;
|
||
|
mp
|
||
|
end
|
||
|
else if allow_empty then
|
||
|
begin
|
||
|
MapString.empty
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
failwith
|
||
|
(Printf.sprintf
|
||
|
"Unable to load environment, the file '%s' doesn't exist."
|
||
|
filename)
|
||
|
end
|
||
|
|
||
|
|
||
|
let rec var_expand str env =
|
||
|
let buff =
|
||
|
Buffer.create ((String.length str) * 2)
|
||
|
in
|
||
|
Buffer.add_substitute
|
||
|
buff
|
||
|
(fun var ->
|
||
|
try
|
||
|
var_expand (MapString.find var env) env
|
||
|
with Not_found ->
|
||
|
failwith
|
||
|
(Printf.sprintf
|
||
|
"No variable %s defined when trying to expand %S."
|
||
|
var
|
||
|
str))
|
||
|
str;
|
||
|
Buffer.contents buff
|
||
|
|
||
|
|
||
|
let var_get name env =
|
||
|
var_expand (MapString.find name env) env
|
||
|
|
||
|
|
||
|
let var_choose lst env =
|
||
|
OASISExpr.choose
|
||
|
(fun nm -> var_get nm env)
|
||
|
lst
|
||
|
end
|
||
|
|
||
|
|
||
|
# 3021 "setup.ml"
|
||
|
module BaseContext = struct
|
||
|
(* # 22 "src/base/BaseContext.ml" *)
|
||
|
|
||
|
(* TODO: get rid of this module. *)
|
||
|
open OASISContext
|
||
|
|
||
|
|
||
|
let args () = fst (fspecs ())
|
||
|
|
||
|
|
||
|
let default = default
|
||
|
|
||
|
end
|
||
|
|
||
|
module BaseMessage = struct
|
||
|
(* # 22 "src/base/BaseMessage.ml" *)
|
||
|
|
||
|
|
||
|
(** Message to user, overrid for Base
|
||
|
@author Sylvain Le Gall
|
||
|
*)
|
||
|
open OASISMessage
|
||
|
open BaseContext
|
||
|
|
||
|
|
||
|
let debug fmt = debug ~ctxt:!default fmt
|
||
|
|
||
|
|
||
|
let info fmt = info ~ctxt:!default fmt
|
||
|
|
||
|
|
||
|
let warning fmt = warning ~ctxt:!default fmt
|
||
|
|
||
|
|
||
|
let error fmt = error ~ctxt:!default fmt
|
||
|
|
||
|
end
|
||
|
|
||
|
module BaseEnv = struct
|
||
|
(* # 22 "src/base/BaseEnv.ml" *)
|
||
|
|
||
|
open OASISGettext
|
||
|
open OASISUtils
|
||
|
open PropList
|
||
|
|
||
|
|
||
|
module MapString = BaseEnvLight.MapString
|
||
|
|
||
|
|
||
|
type origin_t =
|
||
|
| ODefault
|
||
|
| OGetEnv
|
||
|
| OFileLoad
|
||
|
| OCommandLine
|
||
|
|
||
|
|
||
|
type cli_handle_t =
|
||
|
| CLINone
|
||
|
| CLIAuto
|
||
|
| CLIWith
|
||
|
| CLIEnable
|
||
|
| CLIUser of (Arg.key * Arg.spec * Arg.doc) list
|
||
|
|
||
|
|
||
|
type definition_t =
|
||
|
{
|
||
|
hide: bool;
|
||
|
dump: bool;
|
||
|
cli: cli_handle_t;
|
||
|
arg_help: string option;
|
||
|
group: string option;
|
||
|
}
|
||
|
|
||
|
|
||
|
let schema =
|
||
|
Schema.create "environment"
|
||
|
|
||
|
|
||
|
(* Environment data *)
|
||
|
let env =
|
||
|
Data.create ()
|
||
|
|
||
|
|
||
|
(* Environment data from file *)
|
||
|
let env_from_file =
|
||
|
ref MapString.empty
|
||
|
|
||
|
|
||
|
(* Lexer for var *)
|
||
|
let var_lxr =
|
||
|
Genlex.make_lexer []
|
||
|
|
||
|
|
||
|
let rec var_expand str =
|
||
|
let buff =
|
||
|
Buffer.create ((String.length str) * 2)
|
||
|
in
|
||
|
Buffer.add_substitute
|
||
|
buff
|
||
|
(fun var ->
|
||
|
try
|
||
|
(* TODO: this is a quick hack to allow calling Test.Command
|
||
|
* without defining executable name really. I.e. if there is
|
||
|
* an exec Executable toto, then $(toto) should be replace
|
||
|
* by its real name. It is however useful to have this function
|
||
|
* for other variable that depend on the host and should be
|
||
|
* written better than that.
|
||
|
*)
|
||
|
let st =
|
||
|
var_lxr (Stream.of_string var)
|
||
|
in
|
||
|
match Stream.npeek 3 st with
|
||
|
| [Genlex.Ident "utoh"; Genlex.Ident nm] ->
|
||
|
OASISHostPath.of_unix (var_get nm)
|
||
|
| [Genlex.Ident "utoh"; Genlex.String s] ->
|
||
|
OASISHostPath.of_unix s
|
||
|
| [Genlex.Ident "ocaml_escaped"; Genlex.Ident nm] ->
|
||
|
String.escaped (var_get nm)
|
||
|
| [Genlex.Ident "ocaml_escaped"; Genlex.String s] ->
|
||
|
String.escaped s
|
||
|
| [Genlex.Ident nm] ->
|
||
|
var_get nm
|
||
|
| _ ->
|
||
|
failwithf
|
||
|
(f_ "Unknown expression '%s' in variable expansion of %s.")
|
||
|
var
|
||
|
str
|
||
|
with
|
||
|
| Unknown_field (_, _) ->
|
||
|
failwithf
|
||
|
(f_ "No variable %s defined when trying to expand %S.")
|
||
|
var
|
||
|
str
|
||
|
| Stream.Error e ->
|
||
|
failwithf
|
||
|
(f_ "Syntax error when parsing '%s' when trying to \
|
||
|
expand %S: %s")
|
||
|
var
|
||
|
str
|
||
|
e)
|
||
|
str;
|
||
|
Buffer.contents buff
|
||
|
|
||
|
|
||
|
and var_get name =
|
||
|
let vl =
|
||
|
try
|
||
|
Schema.get schema env name
|
||
|
with Unknown_field _ as e ->
|
||
|
begin
|
||
|
try
|
||
|
MapString.find name !env_from_file
|
||
|
with Not_found ->
|
||
|
raise e
|
||
|
end
|
||
|
in
|
||
|
var_expand vl
|
||
|
|
||
|
|
||
|
let var_choose ?printer ?name lst =
|
||
|
OASISExpr.choose
|
||
|
?printer
|
||
|
?name
|
||
|
var_get
|
||
|
lst
|
||
|
|
||
|
|
||
|
let var_protect vl =
|
||
|
let buff =
|
||
|
Buffer.create (String.length vl)
|
||
|
in
|
||
|
String.iter
|
||
|
(function
|
||
|
| '$' -> Buffer.add_string buff "\\$"
|
||
|
| c -> Buffer.add_char buff c)
|
||
|
vl;
|
||
|
Buffer.contents buff
|
||
|
|
||
|
|
||
|
let var_define
|
||
|
?(hide=false)
|
||
|
?(dump=true)
|
||
|
?short_desc
|
||
|
?(cli=CLINone)
|
||
|
?arg_help
|
||
|
?group
|
||
|
name (* TODO: type constraint on the fact that name must be a valid OCaml
|
||
|
id *)
|
||
|
dflt =
|
||
|
|
||
|
let default =
|
||
|
[
|
||
|
OFileLoad, (fun () -> MapString.find name !env_from_file);
|
||
|
ODefault, dflt;
|
||
|
OGetEnv, (fun () -> Sys.getenv name);
|
||
|
]
|
||
|
in
|
||
|
|
||
|
let extra =
|
||
|
{
|
||
|
hide = hide;
|
||
|
dump = dump;
|
||
|
cli = cli;
|
||
|
arg_help = arg_help;
|
||
|
group = group;
|
||
|
}
|
||
|
in
|
||
|
|
||
|
(* Try to find a value that can be defined
|
||
|
*)
|
||
|
let var_get_low lst =
|
||
|
let errors, res =
|
||
|
List.fold_left
|
||
|
(fun (errors, res) (o, v) ->
|
||
|
if res = None then
|
||
|
begin
|
||
|
try
|
||
|
errors, Some (v ())
|
||
|
with
|
||
|
| Not_found ->
|
||
|
errors, res
|
||
|
| Failure rsn ->
|
||
|
(rsn :: errors), res
|
||
|
| e ->
|
||
|
(Printexc.to_string e) :: errors, res
|
||
|
end
|
||
|
else
|
||
|
errors, res)
|
||
|
([], None)
|
||
|
(List.sort
|
||
|
(fun (o1, _) (o2, _) ->
|
||
|
Pervasives.compare o2 o1)
|
||
|
lst)
|
||
|
in
|
||
|
match res, errors with
|
||
|
| Some v, _ ->
|
||
|
v
|
||
|
| None, [] ->
|
||
|
raise (Not_set (name, None))
|
||
|
| None, lst ->
|
||
|
raise (Not_set (name, Some (String.concat (s_ ", ") lst)))
|
||
|
in
|
||
|
|
||
|
let help =
|
||
|
match short_desc with
|
||
|
| Some fs -> Some fs
|
||
|
| None -> None
|
||
|
in
|
||
|
|
||
|
let var_get_lst =
|
||
|
FieldRO.create
|
||
|
~schema
|
||
|
~name
|
||
|
~parse:(fun ?(context=ODefault) s -> [context, fun () -> s])
|
||
|
~print:var_get_low
|
||
|
~default
|
||
|
~update:(fun ?context x old_x -> x @ old_x)
|
||
|
?help
|
||
|
extra
|
||
|
in
|
||
|
|
||
|
fun () ->
|
||
|
var_expand (var_get_low (var_get_lst env))
|
||
|
|
||
|
|
||
|
let var_redefine
|
||
|
?hide
|
||
|
?dump
|
||
|
?short_desc
|
||
|
?cli
|
||
|
?arg_help
|
||
|
?group
|
||
|
name
|
||
|
dflt =
|
||
|
if Schema.mem schema name then
|
||
|
begin
|
||
|
(* TODO: look suspsicious, we want to memorize dflt not dflt () *)
|
||
|
Schema.set schema env ~context:ODefault name (dflt ());
|
||
|
fun () -> var_get name
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
var_define
|
||
|
?hide
|
||
|
?dump
|
||
|
?short_desc
|
||
|
?cli
|
||
|
?arg_help
|
||
|
?group
|
||
|
name
|
||
|
dflt
|
||
|
end
|
||
|
|
||
|
|
||
|
let var_ignore (e: unit -> string) = ()
|
||
|
|
||
|
|
||
|
let print_hidden =
|
||
|
var_define
|
||
|
~hide:true
|
||
|
~dump:false
|
||
|
~cli:CLIAuto
|
||
|
~arg_help:"Print even non-printable variable. (debug)"
|
||
|
"print_hidden"
|
||
|
(fun () -> "false")
|
||
|
|
||
|
|
||
|
let var_all () =
|
||
|
List.rev
|
||
|
(Schema.fold
|
||
|
(fun acc nm def _ ->
|
||
|
if not def.hide || bool_of_string (print_hidden ()) then
|
||
|
nm :: acc
|
||
|
else
|
||
|
acc)
|
||
|
[]
|
||
|
schema)
|
||
|
|
||
|
|
||
|
let default_filename =
|
||
|
BaseEnvLight.default_filename
|
||
|
|
||
|
|
||
|
let load ?allow_empty ?filename () =
|
||
|
env_from_file := BaseEnvLight.load ?allow_empty ?filename ()
|
||
|
|
||
|
|
||
|
let unload () =
|
||
|
env_from_file := MapString.empty;
|
||
|
Data.clear env
|
||
|
|
||
|
|
||
|
let dump ?(filename=default_filename) () =
|
||
|
let chn =
|
||
|
open_out_bin filename
|
||
|
in
|
||
|
let output nm value =
|
||
|
Printf.fprintf chn "%s=%S\n" nm value
|
||
|
in
|
||
|
let mp_todo =
|
||
|
(* Dump data from schema *)
|
||
|
Schema.fold
|
||
|
(fun mp_todo nm def _ ->
|
||
|
if def.dump then
|
||
|
begin
|
||
|
try
|
||
|
let value =
|
||
|
Schema.get
|
||
|
schema
|
||
|
env
|
||
|
nm
|
||
|
in
|
||
|
output nm value
|
||
|
with Not_set _ ->
|
||
|
()
|
||
|
end;
|
||
|
MapString.remove nm mp_todo)
|
||
|
!env_from_file
|
||
|
schema
|
||
|
in
|
||
|
(* Dump data defined outside of schema *)
|
||
|
MapString.iter output mp_todo;
|
||
|
|
||
|
(* End of the dump *)
|
||
|
close_out chn
|
||
|
|
||
|
|
||
|
let print () =
|
||
|
let printable_vars =
|
||
|
Schema.fold
|
||
|
(fun acc nm def short_descr_opt ->
|
||
|
if not def.hide || bool_of_string (print_hidden ()) then
|
||
|
begin
|
||
|
try
|
||
|
let value =
|
||
|
Schema.get
|
||
|
schema
|
||
|
env
|
||
|
nm
|
||
|
in
|
||
|
let txt =
|
||
|
match short_descr_opt with
|
||
|
| Some s -> s ()
|
||
|
| None -> nm
|
||
|
in
|
||
|
(txt, value) :: acc
|
||
|
with Not_set _ ->
|
||
|
acc
|
||
|
end
|
||
|
else
|
||
|
acc)
|
||
|
[]
|
||
|
schema
|
||
|
in
|
||
|
let max_length =
|
||
|
List.fold_left max 0
|
||
|
(List.rev_map String.length
|
||
|
(List.rev_map fst printable_vars))
|
||
|
in
|
||
|
let dot_pad str =
|
||
|
String.make ((max_length - (String.length str)) + 3) '.'
|
||
|
in
|
||
|
|
||
|
Printf.printf "\nConfiguration: \n";
|
||
|
List.iter
|
||
|
(fun (name, value) ->
|
||
|
Printf.printf "%s: %s %s\n" name (dot_pad name) value)
|
||
|
(List.rev printable_vars);
|
||
|
Printf.printf "\n%!"
|
||
|
|
||
|
|
||
|
let args () =
|
||
|
let arg_concat =
|
||
|
OASISUtils.varname_concat ~hyphen:'-'
|
||
|
in
|
||
|
[
|
||
|
"--override",
|
||
|
Arg.Tuple
|
||
|
(
|
||
|
let rvr = ref ""
|
||
|
in
|
||
|
let rvl = ref ""
|
||
|
in
|
||
|
[
|
||
|
Arg.Set_string rvr;
|
||
|
Arg.Set_string rvl;
|
||
|
Arg.Unit
|
||
|
(fun () ->
|
||
|
Schema.set
|
||
|
schema
|
||
|
env
|
||
|
~context:OCommandLine
|
||
|
!rvr
|
||
|
!rvl)
|
||
|
]
|
||
|
),
|
||
|
"var+val Override any configuration variable.";
|
||
|
|
||
|
]
|
||
|
@
|
||
|
List.flatten
|
||
|
(Schema.fold
|
||
|
(fun acc name def short_descr_opt ->
|
||
|
let var_set s =
|
||
|
Schema.set
|
||
|
schema
|
||
|
env
|
||
|
~context:OCommandLine
|
||
|
name
|
||
|
s
|
||
|
in
|
||
|
|
||
|
let arg_name =
|
||
|
OASISUtils.varname_of_string ~hyphen:'-' name
|
||
|
in
|
||
|
|
||
|
let hlp =
|
||
|
match short_descr_opt with
|
||
|
| Some txt -> txt ()
|
||
|
| None -> ""
|
||
|
in
|
||
|
|
||
|
let arg_hlp =
|
||
|
match def.arg_help with
|
||
|
| Some s -> s
|
||
|
| None -> "str"
|
||
|
in
|
||
|
|
||
|
let default_value =
|
||
|
try
|
||
|
Printf.sprintf
|
||
|
(f_ " [%s]")
|
||
|
(Schema.get
|
||
|
schema
|
||
|
env
|
||
|
name)
|
||
|
with Not_set _ ->
|
||
|
""
|
||
|
in
|
||
|
|
||
|
let args =
|
||
|
match def.cli with
|
||
|
| CLINone ->
|
||
|
[]
|
||
|
| CLIAuto ->
|
||
|
[
|
||
|
arg_concat "--" arg_name,
|
||
|
Arg.String var_set,
|
||
|
Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value
|
||
|
]
|
||
|
| CLIWith ->
|
||
|
[
|
||
|
arg_concat "--with-" arg_name,
|
||
|
Arg.String var_set,
|
||
|
Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value
|
||
|
]
|
||
|
| CLIEnable ->
|
||
|
let dflt =
|
||
|
if default_value = " [true]" then
|
||
|
s_ " [default: enabled]"
|
||
|
else
|
||
|
s_ " [default: disabled]"
|
||
|
in
|
||
|
[
|
||
|
arg_concat "--enable-" arg_name,
|
||
|
Arg.Unit (fun () -> var_set "true"),
|
||
|
Printf.sprintf (f_ " %s%s") hlp dflt;
|
||
|
|
||
|
arg_concat "--disable-" arg_name,
|
||
|
Arg.Unit (fun () -> var_set "false"),
|
||
|
Printf.sprintf (f_ " %s%s") hlp dflt
|
||
|
]
|
||
|
| CLIUser lst ->
|
||
|
lst
|
||
|
in
|
||
|
args :: acc)
|
||
|
[]
|
||
|
schema)
|
||
|
end
|
||
|
|
||
|
module BaseArgExt = struct
|
||
|
(* # 22 "src/base/BaseArgExt.ml" *)
|
||
|
|
||
|
|
||
|
open OASISUtils
|
||
|
open OASISGettext
|
||
|
|
||
|
|
||
|
let parse argv args =
|
||
|
(* Simulate command line for Arg *)
|
||
|
let current =
|
||
|
ref 0
|
||
|
in
|
||
|
|
||
|
try
|
||
|
Arg.parse_argv
|
||
|
~current:current
|
||
|
(Array.concat [[|"none"|]; argv])
|
||
|
(Arg.align args)
|
||
|
(failwithf (f_ "Don't know what to do with arguments: '%s'"))
|
||
|
(s_ "configure options:")
|
||
|
with
|
||
|
| Arg.Help txt ->
|
||
|
print_endline txt;
|
||
|
exit 0
|
||
|
| Arg.Bad txt ->
|
||
|
prerr_endline txt;
|
||
|
exit 1
|
||
|
end
|
||
|
|
||
|
module BaseCheck = struct
|
||
|
(* # 22 "src/base/BaseCheck.ml" *)
|
||
|
|
||
|
|
||
|
open BaseEnv
|
||
|
open BaseMessage
|
||
|
open OASISUtils
|
||
|
open OASISGettext
|
||
|
|
||
|
|
||
|
let prog_best prg prg_lst =
|
||
|
var_redefine
|
||
|
prg
|
||
|
(fun () ->
|
||
|
let alternate =
|
||
|
List.fold_left
|
||
|
(fun res e ->
|
||
|
match res with
|
||
|
| Some _ ->
|
||
|
res
|
||
|
| None ->
|
||
|
try
|
||
|
Some (OASISFileUtil.which ~ctxt:!BaseContext.default e)
|
||
|
with Not_found ->
|
||
|
None)
|
||
|
None
|
||
|
prg_lst
|
||
|
in
|
||
|
match alternate with
|
||
|
| Some prg -> prg
|
||
|
| None -> raise Not_found)
|
||
|
|
||
|
|
||
|
let prog prg =
|
||
|
prog_best prg [prg]
|
||
|
|
||
|
|
||
|
let prog_opt prg =
|
||
|
prog_best prg [prg^".opt"; prg]
|
||
|
|
||
|
|
||
|
let ocamlfind =
|
||
|
prog "ocamlfind"
|
||
|
|
||
|
|
||
|
let version
|
||
|
var_prefix
|
||
|
cmp
|
||
|
fversion
|
||
|
() =
|
||
|
(* Really compare version provided *)
|
||
|
let var =
|
||
|
var_prefix^"_version_"^(OASISVersion.varname_of_comparator cmp)
|
||
|
in
|
||
|
var_redefine
|
||
|
~hide:true
|
||
|
var
|
||
|
(fun () ->
|
||
|
let version_str =
|
||
|
match fversion () with
|
||
|
| "[Distributed with OCaml]" ->
|
||
|
begin
|
||
|
try
|
||
|
(var_get "ocaml_version")
|
||
|
with Not_found ->
|
||
|
warning
|
||
|
(f_ "Variable ocaml_version not defined, fallback \
|
||
|
to default");
|
||
|
Sys.ocaml_version
|
||
|
end
|
||
|
| res ->
|
||
|
res
|
||
|
in
|
||
|
let version =
|
||
|
OASISVersion.version_of_string version_str
|
||
|
in
|
||
|
if OASISVersion.comparator_apply version cmp then
|
||
|
version_str
|
||
|
else
|
||
|
failwithf
|
||
|
(f_ "Cannot satisfy version constraint on %s: %s (version: %s)")
|
||
|
var_prefix
|
||
|
(OASISVersion.string_of_comparator cmp)
|
||
|
version_str)
|
||
|
()
|
||
|
|
||
|
|
||
|
let package_version pkg =
|
||
|
OASISExec.run_read_one_line ~ctxt:!BaseContext.default
|
||
|
(ocamlfind ())
|
||
|
["query"; "-format"; "%v"; pkg]
|
||
|
|
||
|
|
||
|
let package ?version_comparator pkg () =
|
||
|
let var =
|
||
|
OASISUtils.varname_concat
|
||
|
"pkg_"
|
||
|
(OASISUtils.varname_of_string pkg)
|
||
|
in
|
||
|
let findlib_dir pkg =
|
||
|
let dir =
|
||
|
OASISExec.run_read_one_line ~ctxt:!BaseContext.default
|
||
|
(ocamlfind ())
|
||
|
["query"; "-format"; "%d"; pkg]
|
||
|
in
|
||
|
if Sys.file_exists dir && Sys.is_directory dir then
|
||
|
dir
|
||
|
else
|
||
|
failwithf
|
||
|
(f_ "When looking for findlib package %s, \
|
||
|
directory %s return doesn't exist")
|
||
|
pkg dir
|
||
|
in
|
||
|
let vl =
|
||
|
var_redefine
|
||
|
var
|
||
|
(fun () -> findlib_dir pkg)
|
||
|
()
|
||
|
in
|
||
|
(
|
||
|
match version_comparator with
|
||
|
| Some ver_cmp ->
|
||
|
ignore
|
||
|
(version
|
||
|
var
|
||
|
ver_cmp
|
||
|
(fun _ -> package_version pkg)
|
||
|
())
|
||
|
| None ->
|
||
|
()
|
||
|
);
|
||
|
vl
|
||
|
end
|
||
|
|
||
|
module BaseOCamlcConfig = struct
|
||
|
(* # 22 "src/base/BaseOCamlcConfig.ml" *)
|
||
|
|
||
|
|
||
|
open BaseEnv
|
||
|
open OASISUtils
|
||
|
open OASISGettext
|
||
|
|
||
|
|
||
|
module SMap = Map.Make(String)
|
||
|
|
||
|
|
||
|
let ocamlc =
|
||
|
BaseCheck.prog_opt "ocamlc"
|
||
|
|
||
|
|
||
|
let ocamlc_config_map =
|
||
|
(* Map name to value for ocamlc -config output
|
||
|
(name ^": "^value)
|
||
|
*)
|
||
|
let rec split_field mp lst =
|
||
|
match lst with
|
||
|
| line :: tl ->
|
||
|
let mp =
|
||
|
try
|
||
|
let pos_semicolon =
|
||
|
String.index line ':'
|
||
|
in
|
||
|
if pos_semicolon > 1 then
|
||
|
(
|
||
|
let name =
|
||
|
String.sub line 0 pos_semicolon
|
||
|
in
|
||
|
let linelen =
|
||
|
String.length line
|
||
|
in
|
||
|
let value =
|
||
|
if linelen > pos_semicolon + 2 then
|
||
|
String.sub
|
||
|
line
|
||
|
(pos_semicolon + 2)
|
||
|
(linelen - pos_semicolon - 2)
|
||
|
else
|
||
|
""
|
||
|
in
|
||
|
SMap.add name value mp
|
||
|
)
|
||
|
else
|
||
|
(
|
||
|
mp
|
||
|
)
|
||
|
with Not_found ->
|
||
|
(
|
||
|
mp
|
||
|
)
|
||
|
in
|
||
|
split_field mp tl
|
||
|
| [] ->
|
||
|
mp
|
||
|
in
|
||
|
|
||
|
let cache =
|
||
|
lazy
|
||
|
(var_protect
|
||
|
(Marshal.to_string
|
||
|
(split_field
|
||
|
SMap.empty
|
||
|
(OASISExec.run_read_output
|
||
|
~ctxt:!BaseContext.default
|
||
|
(ocamlc ()) ["-config"]))
|
||
|
[]))
|
||
|
in
|
||
|
var_redefine
|
||
|
"ocamlc_config_map"
|
||
|
~hide:true
|
||
|
~dump:false
|
||
|
(fun () ->
|
||
|
(* TODO: update if ocamlc change !!! *)
|
||
|
Lazy.force cache)
|
||
|
|
||
|
|
||
|
let var_define nm =
|
||
|
(* Extract data from ocamlc -config *)
|
||
|
let avlbl_config_get () =
|
||
|
Marshal.from_string
|
||
|
(ocamlc_config_map ())
|
||
|
0
|
||
|
in
|
||
|
let chop_version_suffix s =
|
||
|
try
|
||
|
String.sub s 0 (String.index s '+')
|
||
|
with _ ->
|
||
|
s
|
||
|
in
|
||
|
|
||
|
let nm_config, value_config =
|
||
|
match nm with
|
||
|
| "ocaml_version" ->
|
||
|
"version", chop_version_suffix
|
||
|
| _ -> nm, (fun x -> x)
|
||
|
in
|
||
|
var_redefine
|
||
|
nm
|
||
|
(fun () ->
|
||
|
try
|
||
|
let map =
|
||
|
avlbl_config_get ()
|
||
|
in
|
||
|
let value =
|
||
|
SMap.find nm_config map
|
||
|
in
|
||
|
value_config value
|
||
|
with Not_found ->
|
||
|
failwithf
|
||
|
(f_ "Cannot find field '%s' in '%s -config' output")
|
||
|
nm
|
||
|
(ocamlc ()))
|
||
|
|
||
|
end
|
||
|
|
||
|
module BaseStandardVar = struct
|
||
|
(* # 22 "src/base/BaseStandardVar.ml" *)
|
||
|
|
||
|
|
||
|
open OASISGettext
|
||
|
open OASISTypes
|
||
|
open OASISExpr
|
||
|
open BaseCheck
|
||
|
open BaseEnv
|
||
|
|
||
|
|
||
|
let ocamlfind = BaseCheck.ocamlfind
|
||
|
let ocamlc = BaseOCamlcConfig.ocamlc
|
||
|
let ocamlopt = prog_opt "ocamlopt"
|
||
|
let ocamlbuild = prog "ocamlbuild"
|
||
|
|
||
|
|
||
|
(**/**)
|
||
|
let rpkg =
|
||
|
ref None
|
||
|
|
||
|
|
||
|
let pkg_get () =
|
||
|
match !rpkg with
|
||
|
| Some pkg -> pkg
|
||
|
| None -> failwith (s_ "OASIS Package is not set")
|
||
|
|
||
|
|
||
|
let var_cond = ref []
|
||
|
|
||
|
|
||
|
let var_define_cond ~since_version f dflt =
|
||
|
let holder = ref (fun () -> dflt) in
|
||
|
let since_version =
|
||
|
OASISVersion.VGreaterEqual (OASISVersion.version_of_string since_version)
|
||
|
in
|
||
|
var_cond :=
|
||
|
(fun ver ->
|
||
|
if OASISVersion.comparator_apply ver since_version then
|
||
|
holder := f ()) :: !var_cond;
|
||
|
fun () -> !holder ()
|
||
|
|
||
|
|
||
|
(**/**)
|
||
|
|
||
|
|
||
|
let pkg_name =
|
||
|
var_define
|
||
|
~short_desc:(fun () -> s_ "Package name")
|
||
|
"pkg_name"
|
||
|
(fun () -> (pkg_get ()).name)
|
||
|
|
||
|
|
||
|
let pkg_version =
|
||
|
var_define
|
||
|
~short_desc:(fun () -> s_ "Package version")
|
||
|
"pkg_version"
|
||
|
(fun () ->
|
||
|
(OASISVersion.string_of_version (pkg_get ()).version))
|
||
|
|
||
|
|
||
|
let c = BaseOCamlcConfig.var_define
|
||
|
|
||
|
|
||
|
let os_type = c "os_type"
|
||
|
let system = c "system"
|
||
|
let architecture = c "architecture"
|
||
|
let ccomp_type = c "ccomp_type"
|
||
|
let ocaml_version = c "ocaml_version"
|
||
|
|
||
|
|
||
|
(* TODO: Check standard variable presence at runtime *)
|
||
|
|
||
|
|
||
|
let standard_library_default = c "standard_library_default"
|
||
|
let standard_library = c "standard_library"
|
||
|
let standard_runtime = c "standard_runtime"
|
||
|
let bytecomp_c_compiler = c "bytecomp_c_compiler"
|
||
|
let native_c_compiler = c "native_c_compiler"
|
||
|
let model = c "model"
|
||
|
let ext_obj = c "ext_obj"
|
||
|
let ext_asm = c "ext_asm"
|
||
|
let ext_lib = c "ext_lib"
|
||
|
let ext_dll = c "ext_dll"
|
||
|
let default_executable_name = c "default_executable_name"
|
||
|
let systhread_supported = c "systhread_supported"
|
||
|
|
||
|
|
||
|
let flexlink =
|
||
|
BaseCheck.prog "flexlink"
|
||
|
|
||
|
|
||
|
let flexdll_version =
|
||
|
var_define
|
||
|
~short_desc:(fun () -> "FlexDLL version (Win32)")
|
||
|
"flexdll_version"
|
||
|
(fun () ->
|
||
|
let lst =
|
||
|
OASISExec.run_read_output ~ctxt:!BaseContext.default
|
||
|
(flexlink ()) ["-help"]
|
||
|
in
|
||
|
match lst with
|
||
|
| line :: _ ->
|
||
|
Scanf.sscanf line "FlexDLL version %s" (fun ver -> ver)
|
||
|
| [] ->
|
||
|
raise Not_found)
|
||
|
|
||
|
|
||
|
(**/**)
|
||
|
let p name hlp dflt =
|
||
|
var_define
|
||
|
~short_desc:hlp
|
||
|
~cli:CLIAuto
|
||
|
~arg_help:"dir"
|
||
|
name
|
||
|
dflt
|
||
|
|
||
|
|
||
|
let (/) a b =
|
||
|
if os_type () = Sys.os_type then
|
||
|
Filename.concat a b
|
||
|
else if os_type () = "Unix" then
|
||
|
OASISUnixPath.concat a b
|
||
|
else
|
||
|
OASISUtils.failwithf (f_ "Cannot handle os_type %s filename concat")
|
||
|
(os_type ())
|
||
|
(**/**)
|
||
|
|
||
|
|
||
|
let prefix =
|
||
|
p "prefix"
|
||
|
(fun () -> s_ "Install architecture-independent files dir")
|
||
|
(fun () ->
|
||
|
match os_type () with
|
||
|
| "Win32" ->
|
||
|
let program_files =
|
||
|
Sys.getenv "PROGRAMFILES"
|
||
|
in
|
||
|
program_files/(pkg_name ())
|
||
|
| _ ->
|
||
|
"/usr/local")
|
||
|
|
||
|
|
||
|
let exec_prefix =
|
||
|
p "exec_prefix"
|
||
|
(fun () -> s_ "Install architecture-dependent files in dir")
|
||
|
(fun () -> "$prefix")
|
||
|
|
||
|
|
||
|
let bindir =
|
||
|
p "bindir"
|
||
|
(fun () -> s_ "User executables")
|
||
|
(fun () -> "$exec_prefix"/"bin")
|
||
|
|
||
|
|
||
|
let sbindir =
|
||
|
p "sbindir"
|
||
|
(fun () -> s_ "System admin executables")
|
||
|
(fun () -> "$exec_prefix"/"sbin")
|
||
|
|
||
|
|
||
|
let libexecdir =
|
||
|
p "libexecdir"
|
||
|
(fun () -> s_ "Program executables")
|
||
|
(fun () -> "$exec_prefix"/"libexec")
|
||
|
|
||
|
|
||
|
let sysconfdir =
|
||
|
p "sysconfdir"
|
||
|
(fun () -> s_ "Read-only single-machine data")
|
||
|
(fun () -> "$prefix"/"etc")
|
||
|
|
||
|
|
||
|
let sharedstatedir =
|
||
|
p "sharedstatedir"
|
||
|
(fun () -> s_ "Modifiable architecture-independent data")
|
||
|
(fun () -> "$prefix"/"com")
|
||
|
|
||
|
|
||
|
let localstatedir =
|
||
|
p "localstatedir"
|
||
|
(fun () -> s_ "Modifiable single-machine data")
|
||
|
(fun () -> "$prefix"/"var")
|
||
|
|
||
|
|
||
|
let libdir =
|
||
|
p "libdir"
|
||
|
(fun () -> s_ "Object code libraries")
|
||
|
(fun () -> "$exec_prefix"/"lib")
|
||
|
|
||
|
|
||
|
let datarootdir =
|
||
|
p "datarootdir"
|
||
|
(fun () -> s_ "Read-only arch-independent data root")
|
||
|
(fun () -> "$prefix"/"share")
|
||
|
|
||
|
|
||
|
let datadir =
|
||
|
p "datadir"
|
||
|
(fun () -> s_ "Read-only architecture-independent data")
|
||
|
(fun () -> "$datarootdir")
|
||
|
|
||
|
|
||
|
let infodir =
|
||
|
p "infodir"
|
||
|
(fun () -> s_ "Info documentation")
|
||
|
(fun () -> "$datarootdir"/"info")
|
||
|
|
||
|
|
||
|
let localedir =
|
||
|
p "localedir"
|
||
|
(fun () -> s_ "Locale-dependent data")
|
||
|
(fun () -> "$datarootdir"/"locale")
|
||
|
|
||
|
|
||
|
let mandir =
|
||
|
p "mandir"
|
||
|
(fun () -> s_ "Man documentation")
|
||
|
(fun () -> "$datarootdir"/"man")
|
||
|
|
||
|
|
||
|
let docdir =
|
||
|
p "docdir"
|
||
|
(fun () -> s_ "Documentation root")
|
||
|
(fun () -> "$datarootdir"/"doc"/"$pkg_name")
|
||
|
|
||
|
|
||
|
let htmldir =
|
||
|
p "htmldir"
|
||
|
(fun () -> s_ "HTML documentation")
|
||
|
(fun () -> "$docdir")
|
||
|
|
||
|
|
||
|
let dvidir =
|
||
|
p "dvidir"
|
||
|
(fun () -> s_ "DVI documentation")
|
||
|
(fun () -> "$docdir")
|
||
|
|
||
|
|
||
|
let pdfdir =
|
||
|
p "pdfdir"
|
||
|
(fun () -> s_ "PDF documentation")
|
||
|
(fun () -> "$docdir")
|
||
|
|
||
|
|
||
|
let psdir =
|
||
|
p "psdir"
|
||
|
(fun () -> s_ "PS documentation")
|
||
|
(fun () -> "$docdir")
|
||
|
|
||
|
|
||
|
let destdir =
|
||
|
p "destdir"
|
||
|
(fun () -> s_ "Prepend a path when installing package")
|
||
|
(fun () ->
|
||
|
raise
|
||
|
(PropList.Not_set
|
||
|
("destdir",
|
||
|
Some (s_ "undefined by construct"))))
|
||
|
|
||
|
|
||
|
let findlib_version =
|
||
|
var_define
|
||
|
"findlib_version"
|
||
|
(fun () ->
|
||
|
BaseCheck.package_version "findlib")
|
||
|
|
||
|
|
||
|
let is_native =
|
||
|
var_define
|
||
|
"is_native"
|
||
|
(fun () ->
|
||
|
try
|
||
|
let _s: string =
|
||
|
ocamlopt ()
|
||
|
in
|
||
|
"true"
|
||
|
with PropList.Not_set _ ->
|
||
|
let _s: string =
|
||
|
ocamlc ()
|
||
|
in
|
||
|
"false")
|
||
|
|
||
|
|
||
|
let ext_program =
|
||
|
var_define
|
||
|
"suffix_program"
|
||
|
(fun () ->
|
||
|
match os_type () with
|
||
|
| "Win32" | "Cygwin" -> ".exe"
|
||
|
| _ -> "")
|
||
|
|
||
|
|
||
|
let rm =
|
||
|
var_define
|
||
|
~short_desc:(fun () -> s_ "Remove a file.")
|
||
|
"rm"
|
||
|
(fun () ->
|
||
|
match os_type () with
|
||
|
| "Win32" -> "del"
|
||
|
| _ -> "rm -f")
|
||
|
|
||
|
|
||
|
let rmdir =
|
||
|
var_define
|
||
|
~short_desc:(fun () -> s_ "Remove a directory.")
|
||
|
"rmdir"
|
||
|
(fun () ->
|
||
|
match os_type () with
|
||
|
| "Win32" -> "rd"
|
||
|
| _ -> "rm -rf")
|
||
|
|
||
|
|
||
|
let debug =
|
||
|
var_define
|
||
|
~short_desc:(fun () -> s_ "Turn ocaml debug flag on")
|
||
|
~cli:CLIEnable
|
||
|
"debug"
|
||
|
(fun () -> "true")
|
||
|
|
||
|
|
||
|
let profile =
|
||
|
var_define
|
||
|
~short_desc:(fun () -> s_ "Turn ocaml profile flag on")
|
||
|
~cli:CLIEnable
|
||
|
"profile"
|
||
|
(fun () -> "false")
|
||
|
|
||
|
|
||
|
let tests =
|
||
|
var_define_cond ~since_version:"0.3"
|
||
|
(fun () ->
|
||
|
var_define
|
||
|
~short_desc:(fun () ->
|
||
|
s_ "Compile tests executable and library and run them")
|
||
|
~cli:CLIEnable
|
||
|
"tests"
|
||
|
(fun () -> "false"))
|
||
|
"true"
|
||
|
|
||
|
|
||
|
let docs =
|
||
|
var_define_cond ~since_version:"0.3"
|
||
|
(fun () ->
|
||
|
var_define
|
||
|
~short_desc:(fun () -> s_ "Create documentations")
|
||
|
~cli:CLIEnable
|
||
|
"docs"
|
||
|
(fun () -> "true"))
|
||
|
"true"
|
||
|
|
||
|
|
||
|
let native_dynlink =
|
||
|
var_define
|
||
|
~short_desc:(fun () -> s_ "Compiler support generation of .cmxs.")
|
||
|
~cli:CLINone
|
||
|
"native_dynlink"
|
||
|
(fun () ->
|
||
|
let res =
|
||
|
let ocaml_lt_312 () =
|
||
|
OASISVersion.comparator_apply
|
||
|
(OASISVersion.version_of_string (ocaml_version ()))
|
||
|
(OASISVersion.VLesser
|
||
|
(OASISVersion.version_of_string "3.12.0"))
|
||
|
in
|
||
|
let flexdll_lt_030 () =
|
||
|
OASISVersion.comparator_apply
|
||
|
(OASISVersion.version_of_string (flexdll_version ()))
|
||
|
(OASISVersion.VLesser
|
||
|
(OASISVersion.version_of_string "0.30"))
|
||
|
in
|
||
|
let has_native_dynlink =
|
||
|
let ocamlfind = ocamlfind () in
|
||
|
try
|
||
|
let fn =
|
||
|
OASISExec.run_read_one_line
|
||
|
~ctxt:!BaseContext.default
|
||
|
ocamlfind
|
||
|
["query"; "-predicates"; "native"; "dynlink";
|
||
|
"-format"; "%d/%a"]
|
||
|
in
|
||
|
Sys.file_exists fn
|
||
|
with _ ->
|
||
|
false
|
||
|
in
|
||
|
if not has_native_dynlink then
|
||
|
false
|
||
|
else if ocaml_lt_312 () then
|
||
|
false
|
||
|
else if (os_type () = "Win32" || os_type () = "Cygwin")
|
||
|
&& flexdll_lt_030 () then
|
||
|
begin
|
||
|
BaseMessage.warning
|
||
|
(f_ ".cmxs generation disabled because FlexDLL needs to be \
|
||
|
at least 0.30. Please upgrade FlexDLL from %s to 0.30.")
|
||
|
(flexdll_version ());
|
||
|
false
|
||
|
end
|
||
|
else
|
||
|
true
|
||
|
in
|
||
|
string_of_bool res)
|
||
|
|
||
|
|
||
|
let init pkg =
|
||
|
rpkg := Some pkg;
|
||
|
List.iter (fun f -> f pkg.oasis_version) !var_cond
|
||
|
|
||
|
end
|
||
|
|
||
|
module BaseFileAB = struct
|
||
|
(* # 22 "src/base/BaseFileAB.ml" *)
|
||
|
|
||
|
|
||
|
open BaseEnv
|
||
|
open OASISGettext
|
||
|
open BaseMessage
|
||
|
|
||
|
|
||
|
let to_filename fn =
|
||
|
let fn =
|
||
|
OASISHostPath.of_unix fn
|
||
|
in
|
||
|
if not (Filename.check_suffix fn ".ab") then
|
||
|
warning
|
||
|
(f_ "File '%s' doesn't have '.ab' extension")
|
||
|
fn;
|
||
|
Filename.chop_extension fn
|
||
|
|
||
|
|
||
|
let replace fn_lst =
|
||
|
let buff =
|
||
|
Buffer.create 13
|
||
|
in
|
||
|
List.iter
|
||
|
(fun fn ->
|
||
|
let fn =
|
||
|
OASISHostPath.of_unix fn
|
||
|
in
|
||
|
let chn_in =
|
||
|
open_in fn
|
||
|
in
|
||
|
let chn_out =
|
||
|
open_out (to_filename fn)
|
||
|
in
|
||
|
(
|
||
|
try
|
||
|
while true do
|
||
|
Buffer.add_string buff (var_expand (input_line chn_in));
|
||
|
Buffer.add_char buff '\n'
|
||
|
done
|
||
|
with End_of_file ->
|
||
|
()
|
||
|
);
|
||
|
Buffer.output_buffer chn_out buff;
|
||
|
Buffer.clear buff;
|
||
|
close_in chn_in;
|
||
|
close_out chn_out)
|
||
|
fn_lst
|
||
|
end
|
||
|
|
||
|
module BaseLog = struct
|
||
|
(* # 22 "src/base/BaseLog.ml" *)
|
||
|
|
||
|
|
||
|
open OASISUtils
|
||
|
|
||
|
|
||
|
let default_filename =
|
||
|
Filename.concat
|
||
|
(Filename.dirname BaseEnv.default_filename)
|
||
|
"setup.log"
|
||
|
|
||
|
|
||
|
module SetTupleString =
|
||
|
Set.Make
|
||
|
(struct
|
||
|
type t = string * string
|
||
|
let compare (s11, s12) (s21, s22) =
|
||
|
match String.compare s11 s21 with
|
||
|
| 0 -> String.compare s12 s22
|
||
|
| n -> n
|
||
|
end)
|
||
|
|
||
|
|
||
|
let load () =
|
||
|
if Sys.file_exists default_filename then
|
||
|
begin
|
||
|
let chn =
|
||
|
open_in default_filename
|
||
|
in
|
||
|
let scbuf =
|
||
|
Scanf.Scanning.from_file default_filename
|
||
|
in
|
||
|
let rec read_aux (st, lst) =
|
||
|
if not (Scanf.Scanning.end_of_input scbuf) then
|
||
|
begin
|
||
|
let acc =
|
||
|
try
|
||
|
Scanf.bscanf scbuf "%S %S\n"
|
||
|
(fun e d ->
|
||
|
let t =
|
||
|
e, d
|
||
|
in
|
||
|
if SetTupleString.mem t st then
|
||
|
st, lst
|
||
|
else
|
||
|
SetTupleString.add t st,
|
||
|
t :: lst)
|
||
|
with Scanf.Scan_failure _ ->
|
||
|
failwith
|
||
|
(Scanf.bscanf scbuf
|
||
|
"%l"
|
||
|
(fun line ->
|
||
|
Printf.sprintf
|
||
|
"Malformed log file '%s' at line %d"
|
||
|
default_filename
|
||
|
line))
|
||
|
in
|
||
|
read_aux acc
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
close_in chn;
|
||
|
List.rev lst
|
||
|
end
|
||
|
in
|
||
|
read_aux (SetTupleString.empty, [])
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
[]
|
||
|
end
|
||
|
|
||
|
|
||
|
let register event data =
|
||
|
let chn_out =
|
||
|
open_out_gen [Open_append; Open_creat; Open_text] 0o644 default_filename
|
||
|
in
|
||
|
Printf.fprintf chn_out "%S %S\n" event data;
|
||
|
close_out chn_out
|
||
|
|
||
|
|
||
|
let unregister event data =
|
||
|
if Sys.file_exists default_filename then
|
||
|
begin
|
||
|
let lst =
|
||
|
load ()
|
||
|
in
|
||
|
let chn_out =
|
||
|
open_out default_filename
|
||
|
in
|
||
|
let write_something =
|
||
|
ref false
|
||
|
in
|
||
|
List.iter
|
||
|
(fun (e, d) ->
|
||
|
if e <> event || d <> data then
|
||
|
begin
|
||
|
write_something := true;
|
||
|
Printf.fprintf chn_out "%S %S\n" e d
|
||
|
end)
|
||
|
lst;
|
||
|
close_out chn_out;
|
||
|
if not !write_something then
|
||
|
Sys.remove default_filename
|
||
|
end
|
||
|
|
||
|
|
||
|
let filter events =
|
||
|
let st_events =
|
||
|
List.fold_left
|
||
|
(fun st e ->
|
||
|
SetString.add e st)
|
||
|
SetString.empty
|
||
|
events
|
||
|
in
|
||
|
List.filter
|
||
|
(fun (e, _) -> SetString.mem e st_events)
|
||
|
(load ())
|
||
|
|
||
|
|
||
|
let exists event data =
|
||
|
List.exists
|
||
|
(fun v -> (event, data) = v)
|
||
|
(load ())
|
||
|
end
|
||
|
|
||
|
module BaseBuilt = struct
|
||
|
(* # 22 "src/base/BaseBuilt.ml" *)
|
||
|
|
||
|
|
||
|
open OASISTypes
|
||
|
open OASISGettext
|
||
|
open BaseStandardVar
|
||
|
open BaseMessage
|
||
|
|
||
|
|
||
|
type t =
|
||
|
| BExec (* Executable *)
|
||
|
| BExecLib (* Library coming with executable *)
|
||
|
| BLib (* Library *)
|
||
|
| BObj (* Library *)
|
||
|
| BDoc (* Document *)
|
||
|
|
||
|
|
||
|
let to_log_event_file t nm =
|
||
|
"built_"^
|
||
|
(match t with
|
||
|
| BExec -> "exec"
|
||
|
| BExecLib -> "exec_lib"
|
||
|
| BLib -> "lib"
|
||
|
| BObj -> "obj"
|
||
|
| BDoc -> "doc")^
|
||
|
"_"^nm
|
||
|
|
||
|
|
||
|
let to_log_event_done t nm =
|
||
|
"is_"^(to_log_event_file t nm)
|
||
|
|
||
|
|
||
|
let register t nm lst =
|
||
|
BaseLog.register
|
||
|
(to_log_event_done t nm)
|
||
|
"true";
|
||
|
List.iter
|
||
|
(fun alt ->
|
||
|
let registered =
|
||
|
List.fold_left
|
||
|
(fun registered fn ->
|
||
|
if OASISFileUtil.file_exists_case fn then
|
||
|
begin
|
||
|
BaseLog.register
|
||
|
(to_log_event_file t nm)
|
||
|
(if Filename.is_relative fn then
|
||
|
Filename.concat (Sys.getcwd ()) fn
|
||
|
else
|
||
|
fn);
|
||
|
true
|
||
|
end
|
||
|
else
|
||
|
registered)
|
||
|
false
|
||
|
alt
|
||
|
in
|
||
|
if not registered then
|
||
|
warning
|
||
|
(f_ "Cannot find an existing alternative files among: %s")
|
||
|
(String.concat (s_ ", ") alt))
|
||
|
lst
|
||
|
|
||
|
|
||
|
let unregister t nm =
|
||
|
List.iter
|
||
|
(fun (e, d) ->
|
||
|
BaseLog.unregister e d)
|
||
|
(BaseLog.filter
|
||
|
[to_log_event_file t nm;
|
||
|
to_log_event_done t nm])
|
||
|
|
||
|
|
||
|
let fold t nm f acc =
|
||
|
List.fold_left
|
||
|
(fun acc (_, fn) ->
|
||
|
if OASISFileUtil.file_exists_case fn then
|
||
|
begin
|
||
|
f acc fn
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
warning
|
||
|
(f_ "File '%s' has been marked as built \
|
||
|
for %s but doesn't exist")
|
||
|
fn
|
||
|
(Printf.sprintf
|
||
|
(match t with
|
||
|
| BExec | BExecLib ->
|
||
|
(f_ "executable %s")
|
||
|
| BLib ->
|
||
|
(f_ "library %s")
|
||
|
| BObj ->
|
||
|
(f_ "object %s")
|
||
|
| BDoc ->
|
||
|
(f_ "documentation %s"))
|
||
|
nm);
|
||
|
acc
|
||
|
end)
|
||
|
acc
|
||
|
(BaseLog.filter
|
||
|
[to_log_event_file t nm])
|
||
|
|
||
|
|
||
|
let is_built t nm =
|
||
|
List.fold_left
|
||
|
(fun is_built (_, d) ->
|
||
|
(try
|
||
|
bool_of_string d
|
||
|
with _ ->
|
||
|
false))
|
||
|
false
|
||
|
(BaseLog.filter
|
||
|
[to_log_event_done t nm])
|
||
|
|
||
|
|
||
|
let of_executable ffn (cs, bs, exec) =
|
||
|
let unix_exec_is, unix_dll_opt =
|
||
|
OASISExecutable.unix_exec_is
|
||
|
(cs, bs, exec)
|
||
|
(fun () ->
|
||
|
bool_of_string
|
||
|
(is_native ()))
|
||
|
ext_dll
|
||
|
ext_program
|
||
|
in
|
||
|
let evs =
|
||
|
(BExec, cs.cs_name, [[ffn unix_exec_is]])
|
||
|
::
|
||
|
(match unix_dll_opt with
|
||
|
| Some fn ->
|
||
|
[BExecLib, cs.cs_name, [[ffn fn]]]
|
||
|
| None ->
|
||
|
[])
|
||
|
in
|
||
|
evs,
|
||
|
unix_exec_is,
|
||
|
unix_dll_opt
|
||
|
|
||
|
|
||
|
let of_library ffn (cs, bs, lib) =
|
||
|
let unix_lst =
|
||
|
OASISLibrary.generated_unix_files
|
||
|
~ctxt:!BaseContext.default
|
||
|
~source_file_exists:(fun fn ->
|
||
|
OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
|
||
|
~is_native:(bool_of_string (is_native ()))
|
||
|
~has_native_dynlink:(bool_of_string (native_dynlink ()))
|
||
|
~ext_lib:(ext_lib ())
|
||
|
~ext_dll:(ext_dll ())
|
||
|
(cs, bs, lib)
|
||
|
in
|
||
|
let evs =
|
||
|
[BLib,
|
||
|
cs.cs_name,
|
||
|
List.map (List.map ffn) unix_lst]
|
||
|
in
|
||
|
evs, unix_lst
|
||
|
|
||
|
|
||
|
let of_object ffn (cs, bs, obj) =
|
||
|
let unix_lst =
|
||
|
OASISObject.generated_unix_files
|
||
|
~ctxt:!BaseContext.default
|
||
|
~source_file_exists:(fun fn ->
|
||
|
OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
|
||
|
~is_native:(bool_of_string (is_native ()))
|
||
|
(cs, bs, obj)
|
||
|
in
|
||
|
let evs =
|
||
|
[BObj,
|
||
|
cs.cs_name,
|
||
|
List.map (List.map ffn) unix_lst]
|
||
|
in
|
||
|
evs, unix_lst
|
||
|
|
||
|
end
|
||
|
|
||
|
module BaseCustom = struct
|
||
|
(* # 22 "src/base/BaseCustom.ml" *)
|
||
|
|
||
|
|
||
|
open BaseEnv
|
||
|
open BaseMessage
|
||
|
open OASISTypes
|
||
|
open OASISGettext
|
||
|
|
||
|
|
||
|
let run cmd args extra_args =
|
||
|
OASISExec.run ~ctxt:!BaseContext.default ~quote:false
|
||
|
(var_expand cmd)
|
||
|
(List.map
|
||
|
var_expand
|
||
|
(args @ (Array.to_list extra_args)))
|
||
|
|
||
|
|
||
|
let hook ?(failsafe=false) cstm f e =
|
||
|
let optional_command lst =
|
||
|
let printer =
|
||
|
function
|
||
|
| Some (cmd, args) -> String.concat " " (cmd :: args)
|
||
|
| None -> s_ "No command"
|
||
|
in
|
||
|
match
|
||
|
var_choose
|
||
|
~name:(s_ "Pre/Post Command")
|
||
|
~printer
|
||
|
lst with
|
||
|
| Some (cmd, args) ->
|
||
|
begin
|
||
|
try
|
||
|
run cmd args [||]
|
||
|
with e when failsafe ->
|
||
|
warning
|
||
|
(f_ "Command '%s' fail with error: %s")
|
||
|
(String.concat " " (cmd :: args))
|
||
|
(match e with
|
||
|
| Failure msg -> msg
|
||
|
| e -> Printexc.to_string e)
|
||
|
end
|
||
|
| None ->
|
||
|
()
|
||
|
in
|
||
|
let res =
|
||
|
optional_command cstm.pre_command;
|
||
|
f e
|
||
|
in
|
||
|
optional_command cstm.post_command;
|
||
|
res
|
||
|
end
|
||
|
|
||
|
module BaseDynVar = struct
|
||
|
(* # 22 "src/base/BaseDynVar.ml" *)
|
||
|
|
||
|
|
||
|
open OASISTypes
|
||
|
open OASISGettext
|
||
|
open BaseEnv
|
||
|
open BaseBuilt
|
||
|
|
||
|
|
||
|
let init pkg =
|
||
|
(* TODO: disambiguate exec vs other variable by adding exec_VARNAME. *)
|
||
|
(* TODO: provide compile option for library libary_byte_args_VARNAME... *)
|
||
|
List.iter
|
||
|
(function
|
||
|
| Executable (cs, bs, exec) ->
|
||
|
if var_choose bs.bs_build then
|
||
|
var_ignore
|
||
|
(var_redefine
|
||
|
(* We don't save this variable *)
|
||
|
~dump:false
|
||
|
~short_desc:(fun () ->
|
||
|
Printf.sprintf
|
||
|
(f_ "Filename of executable '%s'")
|
||
|
cs.cs_name)
|
||
|
(OASISUtils.varname_of_string cs.cs_name)
|
||
|
(fun () ->
|
||
|
let fn_opt =
|
||
|
fold
|
||
|
BExec cs.cs_name
|
||
|
(fun _ fn -> Some fn)
|
||
|
None
|
||
|
in
|
||
|
match fn_opt with
|
||
|
| Some fn -> fn
|
||
|
| None ->
|
||
|
raise
|
||
|
(PropList.Not_set
|
||
|
(cs.cs_name,
|
||
|
Some (Printf.sprintf
|
||
|
(f_ "Executable '%s' not yet built.")
|
||
|
cs.cs_name)))))
|
||
|
|
||
|
| Library _ | Object _ | Flag _ | Test _ | SrcRepo _ | Doc _ ->
|
||
|
())
|
||
|
pkg.sections
|
||
|
end
|
||
|
|
||
|
module BaseTest = struct
|
||
|
(* # 22 "src/base/BaseTest.ml" *)
|
||
|
|
||
|
|
||
|
open BaseEnv
|
||
|
open BaseMessage
|
||
|
open OASISTypes
|
||
|
open OASISExpr
|
||
|
open OASISGettext
|
||
|
|
||
|
|
||
|
let test lst pkg extra_args =
|
||
|
|
||
|
let one_test (failure, n) (test_plugin, cs, test) =
|
||
|
if var_choose
|
||
|
~name:(Printf.sprintf
|
||
|
(f_ "test %s run")
|
||
|
cs.cs_name)
|
||
|
~printer:string_of_bool
|
||
|
test.test_run then
|
||
|
begin
|
||
|
let () =
|
||
|
info (f_ "Running test '%s'") cs.cs_name
|
||
|
in
|
||
|
let back_cwd =
|
||
|
match test.test_working_directory with
|
||
|
| Some dir ->
|
||
|
let cwd =
|
||
|
Sys.getcwd ()
|
||
|
in
|
||
|
let chdir d =
|
||
|
info (f_ "Changing directory to '%s'") d;
|
||
|
Sys.chdir d
|
||
|
in
|
||
|
chdir dir;
|
||
|
fun () -> chdir cwd
|
||
|
|
||
|
| None ->
|
||
|
fun () -> ()
|
||
|
in
|
||
|
try
|
||
|
let failure_percent =
|
||
|
BaseCustom.hook
|
||
|
test.test_custom
|
||
|
(test_plugin pkg (cs, test))
|
||
|
extra_args
|
||
|
in
|
||
|
back_cwd ();
|
||
|
(failure_percent +. failure, n + 1)
|
||
|
with e ->
|
||
|
begin
|
||
|
back_cwd ();
|
||
|
raise e
|
||
|
end
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
info (f_ "Skipping test '%s'") cs.cs_name;
|
||
|
(failure, n)
|
||
|
end
|
||
|
in
|
||
|
let failed, n =
|
||
|
List.fold_left
|
||
|
one_test
|
||
|
(0.0, 0)
|
||
|
lst
|
||
|
in
|
||
|
let failure_percent =
|
||
|
if n = 0 then
|
||
|
0.0
|
||
|
else
|
||
|
failed /. (float_of_int n)
|
||
|
in
|
||
|
let msg =
|
||
|
Printf.sprintf
|
||
|
(f_ "Tests had a %.2f%% failure rate")
|
||
|
(100. *. failure_percent)
|
||
|
in
|
||
|
if failure_percent > 0.0 then
|
||
|
failwith msg
|
||
|
else
|
||
|
info "%s" msg;
|
||
|
|
||
|
(* Possible explanation why the tests where not run. *)
|
||
|
if OASISFeatures.package_test OASISFeatures.flag_tests pkg &&
|
||
|
not (bool_of_string (BaseStandardVar.tests ())) &&
|
||
|
lst <> [] then
|
||
|
BaseMessage.warning
|
||
|
"Tests are turned off, consider enabling with \
|
||
|
'ocaml setup.ml -configure --enable-tests'"
|
||
|
end
|
||
|
|
||
|
module BaseDoc = struct
|
||
|
(* # 22 "src/base/BaseDoc.ml" *)
|
||
|
|
||
|
|
||
|
open BaseEnv
|
||
|
open BaseMessage
|
||
|
open OASISTypes
|
||
|
open OASISGettext
|
||
|
|
||
|
|
||
|
let doc lst pkg extra_args =
|
||
|
|
||
|
let one_doc (doc_plugin, cs, doc) =
|
||
|
if var_choose
|
||
|
~name:(Printf.sprintf
|
||
|
(f_ "documentation %s build")
|
||
|
cs.cs_name)
|
||
|
~printer:string_of_bool
|
||
|
doc.doc_build then
|
||
|
begin
|
||
|
info (f_ "Building documentation '%s'") cs.cs_name;
|
||
|
BaseCustom.hook
|
||
|
doc.doc_custom
|
||
|
(doc_plugin pkg (cs, doc))
|
||
|
extra_args
|
||
|
end
|
||
|
in
|
||
|
List.iter one_doc lst;
|
||
|
|
||
|
if OASISFeatures.package_test OASISFeatures.flag_docs pkg &&
|
||
|
not (bool_of_string (BaseStandardVar.docs ())) &&
|
||
|
lst <> [] then
|
||
|
BaseMessage.warning
|
||
|
"Docs are turned off, consider enabling with \
|
||
|
'ocaml setup.ml -configure --enable-docs'"
|
||
|
end
|
||
|
|
||
|
module BaseSetup = struct
|
||
|
(* # 22 "src/base/BaseSetup.ml" *)
|
||
|
|
||
|
open BaseEnv
|
||
|
open BaseMessage
|
||
|
open OASISTypes
|
||
|
open OASISSection
|
||
|
open OASISGettext
|
||
|
open OASISUtils
|
||
|
|
||
|
|
||
|
type std_args_fun =
|
||
|
package -> string array -> unit
|
||
|
|
||
|
|
||
|
type ('a, 'b) section_args_fun =
|
||
|
name * (package -> (common_section * 'a) -> string array -> 'b)
|
||
|
|
||
|
|
||
|
type t =
|
||
|
{
|
||
|
configure: std_args_fun;
|
||
|
build: std_args_fun;
|
||
|
doc: ((doc, unit) section_args_fun) list;
|
||
|
test: ((test, float) section_args_fun) list;
|
||
|
install: std_args_fun;
|
||
|
uninstall: std_args_fun;
|
||
|
clean: std_args_fun list;
|
||
|
clean_doc: (doc, unit) section_args_fun list;
|
||
|
clean_test: (test, unit) section_args_fun list;
|
||
|
distclean: std_args_fun list;
|
||
|
distclean_doc: (doc, unit) section_args_fun list;
|
||
|
distclean_test: (test, unit) section_args_fun list;
|
||
|
package: package;
|
||
|
oasis_fn: string option;
|
||
|
oasis_version: string;
|
||
|
oasis_digest: Digest.t option;
|
||
|
oasis_exec: string option;
|
||
|
oasis_setup_args: string list;
|
||
|
setup_update: bool;
|
||
|
}
|
||
|
|
||
|
|
||
|
(* Associate a plugin function with data from package *)
|
||
|
let join_plugin_sections filter_map lst =
|
||
|
List.rev
|
||
|
(List.fold_left
|
||
|
(fun acc sct ->
|
||
|
match filter_map sct with
|
||
|
| Some e ->
|
||
|
e :: acc
|
||
|
| None ->
|
||
|
acc)
|
||
|
[]
|
||
|
lst)
|
||
|
|
||
|
|
||
|
(* Search for plugin data associated with a section name *)
|
||
|
let lookup_plugin_section plugin action nm lst =
|
||
|
try
|
||
|
List.assoc nm lst
|
||
|
with Not_found ->
|
||
|
failwithf
|
||
|
(f_ "Cannot find plugin %s matching section %s for %s action")
|
||
|
plugin
|
||
|
nm
|
||
|
action
|
||
|
|
||
|
|
||
|
let configure t args =
|
||
|
(* Run configure *)
|
||
|
BaseCustom.hook
|
||
|
t.package.conf_custom
|
||
|
(fun () ->
|
||
|
(* Reload if preconf has changed it *)
|
||
|
begin
|
||
|
try
|
||
|
unload ();
|
||
|
load ();
|
||
|
with _ ->
|
||
|
()
|
||
|
end;
|
||
|
|
||
|
(* Run plugin's configure *)
|
||
|
t.configure t.package args;
|
||
|
|
||
|
(* Dump to allow postconf to change it *)
|
||
|
dump ())
|
||
|
();
|
||
|
|
||
|
(* Reload environment *)
|
||
|
unload ();
|
||
|
load ();
|
||
|
|
||
|
(* Save environment *)
|
||
|
print ();
|
||
|
|
||
|
(* Replace data in file *)
|
||
|
BaseFileAB.replace t.package.files_ab
|
||
|
|
||
|
|
||
|
let build t args =
|
||
|
BaseCustom.hook
|
||
|
t.package.build_custom
|
||
|
(t.build t.package)
|
||
|
args
|
||
|
|
||
|
|
||
|
let doc t args =
|
||
|
BaseDoc.doc
|
||
|
(join_plugin_sections
|
||
|
(function
|
||
|
| Doc (cs, e) ->
|
||
|
Some
|
||
|
(lookup_plugin_section
|
||
|
"documentation"
|
||
|
(s_ "build")
|
||
|
cs.cs_name
|
||
|
t.doc,
|
||
|
cs,
|
||
|
e)
|
||
|
| _ ->
|
||
|
None)
|
||
|
t.package.sections)
|
||
|
t.package
|
||
|
args
|
||
|
|
||
|
|
||
|
let test t args =
|
||
|
BaseTest.test
|
||
|
(join_plugin_sections
|
||
|
(function
|
||
|
| Test (cs, e) ->
|
||
|
Some
|
||
|
(lookup_plugin_section
|
||
|
"test"
|
||
|
(s_ "run")
|
||
|
cs.cs_name
|
||
|
t.test,
|
||
|
cs,
|
||
|
e)
|
||
|
| _ ->
|
||
|
None)
|
||
|
t.package.sections)
|
||
|
t.package
|
||
|
args
|
||
|
|
||
|
|
||
|
let all t args =
|
||
|
let rno_doc =
|
||
|
ref false
|
||
|
in
|
||
|
let rno_test =
|
||
|
ref false
|
||
|
in
|
||
|
let arg_rest =
|
||
|
ref []
|
||
|
in
|
||
|
Arg.parse_argv
|
||
|
~current:(ref 0)
|
||
|
(Array.of_list
|
||
|
((Sys.executable_name^" all") ::
|
||
|
(Array.to_list args)))
|
||
|
[
|
||
|
"-no-doc",
|
||
|
Arg.Set rno_doc,
|
||
|
s_ "Don't run doc target";
|
||
|
|
||
|
"-no-test",
|
||
|
Arg.Set rno_test,
|
||
|
s_ "Don't run test target";
|
||
|
|
||
|
"--",
|
||
|
Arg.Rest (fun arg -> arg_rest := arg :: !arg_rest),
|
||
|
s_ "All arguments for configure.";
|
||
|
]
|
||
|
(failwithf (f_ "Don't know what to do with '%s'"))
|
||
|
"";
|
||
|
|
||
|
info "Running configure step";
|
||
|
configure t (Array.of_list (List.rev !arg_rest));
|
||
|
|
||
|
info "Running build step";
|
||
|
build t [||];
|
||
|
|
||
|
(* Load setup.log dynamic variables *)
|
||
|
BaseDynVar.init t.package;
|
||
|
|
||
|
if not !rno_doc then
|
||
|
begin
|
||
|
info "Running doc step";
|
||
|
doc t [||];
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
info "Skipping doc step"
|
||
|
end;
|
||
|
|
||
|
if not !rno_test then
|
||
|
begin
|
||
|
info "Running test step";
|
||
|
test t [||]
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
info "Skipping test step"
|
||
|
end
|
||
|
|
||
|
|
||
|
let install t args =
|
||
|
BaseCustom.hook
|
||
|
t.package.install_custom
|
||
|
(t.install t.package)
|
||
|
args
|
||
|
|
||
|
|
||
|
let uninstall t args =
|
||
|
BaseCustom.hook
|
||
|
t.package.uninstall_custom
|
||
|
(t.uninstall t.package)
|
||
|
args
|
||
|
|
||
|
|
||
|
let reinstall t args =
|
||
|
uninstall t args;
|
||
|
install t args
|
||
|
|
||
|
|
||
|
let clean, distclean =
|
||
|
let failsafe f a =
|
||
|
try
|
||
|
f a
|
||
|
with e ->
|
||
|
warning
|
||
|
(f_ "Action fail with error: %s")
|
||
|
(match e with
|
||
|
| Failure msg -> msg
|
||
|
| e -> Printexc.to_string e)
|
||
|
in
|
||
|
|
||
|
let generic_clean t cstm mains docs tests args =
|
||
|
BaseCustom.hook
|
||
|
~failsafe:true
|
||
|
cstm
|
||
|
(fun () ->
|
||
|
(* Clean section *)
|
||
|
List.iter
|
||
|
(function
|
||
|
| Test (cs, test) ->
|
||
|
let f =
|
||
|
try
|
||
|
List.assoc cs.cs_name tests
|
||
|
with Not_found ->
|
||
|
fun _ _ _ -> ()
|
||
|
in
|
||
|
failsafe
|
||
|
(f t.package (cs, test))
|
||
|
args
|
||
|
| Doc (cs, doc) ->
|
||
|
let f =
|
||
|
try
|
||
|
List.assoc cs.cs_name docs
|
||
|
with Not_found ->
|
||
|
fun _ _ _ -> ()
|
||
|
in
|
||
|
failsafe
|
||
|
(f t.package (cs, doc))
|
||
|
args
|
||
|
| Library _
|
||
|
| Object _
|
||
|
| Executable _
|
||
|
| Flag _
|
||
|
| SrcRepo _ ->
|
||
|
())
|
||
|
t.package.sections;
|
||
|
(* Clean whole package *)
|
||
|
List.iter
|
||
|
(fun f ->
|
||
|
failsafe
|
||
|
(f t.package)
|
||
|
args)
|
||
|
mains)
|
||
|
()
|
||
|
in
|
||
|
|
||
|
let clean t args =
|
||
|
generic_clean
|
||
|
t
|
||
|
t.package.clean_custom
|
||
|
t.clean
|
||
|
t.clean_doc
|
||
|
t.clean_test
|
||
|
args
|
||
|
in
|
||
|
|
||
|
let distclean t args =
|
||
|
(* Call clean *)
|
||
|
clean t args;
|
||
|
|
||
|
(* Call distclean code *)
|
||
|
generic_clean
|
||
|
t
|
||
|
t.package.distclean_custom
|
||
|
t.distclean
|
||
|
t.distclean_doc
|
||
|
t.distclean_test
|
||
|
args;
|
||
|
|
||
|
(* Remove generated file *)
|
||
|
List.iter
|
||
|
(fun fn ->
|
||
|
if Sys.file_exists fn then
|
||
|
begin
|
||
|
info (f_ "Remove '%s'") fn;
|
||
|
Sys.remove fn
|
||
|
end)
|
||
|
(BaseEnv.default_filename
|
||
|
::
|
||
|
BaseLog.default_filename
|
||
|
::
|
||
|
(List.rev_map BaseFileAB.to_filename t.package.files_ab))
|
||
|
in
|
||
|
|
||
|
clean, distclean
|
||
|
|
||
|
|
||
|
let version t _ =
|
||
|
print_endline t.oasis_version
|
||
|
|
||
|
|
||
|
let update_setup_ml, no_update_setup_ml_cli =
|
||
|
let b = ref true in
|
||
|
b,
|
||
|
("-no-update-setup-ml",
|
||
|
Arg.Clear b,
|
||
|
s_ " Don't try to update setup.ml, even if _oasis has changed.")
|
||
|
|
||
|
|
||
|
let default_oasis_fn = "_oasis"
|
||
|
|
||
|
|
||
|
let update_setup_ml t =
|
||
|
let oasis_fn =
|
||
|
match t.oasis_fn with
|
||
|
| Some fn -> fn
|
||
|
| None -> default_oasis_fn
|
||
|
in
|
||
|
let oasis_exec =
|
||
|
match t.oasis_exec with
|
||
|
| Some fn -> fn
|
||
|
| None -> "oasis"
|
||
|
in
|
||
|
let ocaml =
|
||
|
Sys.executable_name
|
||
|
in
|
||
|
let setup_ml, args =
|
||
|
match Array.to_list Sys.argv with
|
||
|
| setup_ml :: args ->
|
||
|
setup_ml, args
|
||
|
| [] ->
|
||
|
failwith
|
||
|
(s_ "Expecting non-empty command line arguments.")
|
||
|
in
|
||
|
let ocaml, setup_ml =
|
||
|
if Sys.executable_name = Sys.argv.(0) then
|
||
|
(* We are not running in standard mode, probably the script
|
||
|
* is precompiled.
|
||
|
*)
|
||
|
"ocaml", "setup.ml"
|
||
|
else
|
||
|
ocaml, setup_ml
|
||
|
in
|
||
|
let no_update_setup_ml_cli, _, _ = no_update_setup_ml_cli in
|
||
|
let do_update () =
|
||
|
let oasis_exec_version =
|
||
|
OASISExec.run_read_one_line
|
||
|
~ctxt:!BaseContext.default
|
||
|
~f_exit_code:
|
||
|
(function
|
||
|
| 0 ->
|
||
|
()
|
||
|
| 1 ->
|
||
|
failwithf
|
||
|
(f_ "Executable '%s' is probably an old version \
|
||
|
of oasis (< 0.3.0), please update to version \
|
||
|
v%s.")
|
||
|
oasis_exec t.oasis_version
|
||
|
| 127 ->
|
||
|
failwithf
|
||
|
(f_ "Cannot find executable '%s', please install \
|
||
|
oasis v%s.")
|
||
|
oasis_exec t.oasis_version
|
||
|
| n ->
|
||
|
failwithf
|
||
|
(f_ "Command '%s version' exited with code %d.")
|
||
|
oasis_exec n)
|
||
|
oasis_exec ["version"]
|
||
|
in
|
||
|
if OASISVersion.comparator_apply
|
||
|
(OASISVersion.version_of_string oasis_exec_version)
|
||
|
(OASISVersion.VGreaterEqual
|
||
|
(OASISVersion.version_of_string t.oasis_version)) then
|
||
|
begin
|
||
|
(* We have a version >= for the executable oasis, proceed with
|
||
|
* update.
|
||
|
*)
|
||
|
(* TODO: delegate this check to 'oasis setup'. *)
|
||
|
if Sys.os_type = "Win32" then
|
||
|
failwithf
|
||
|
(f_ "It is not possible to update the running script \
|
||
|
setup.ml on Windows. Please update setup.ml by \
|
||
|
running '%s'.")
|
||
|
(String.concat " " (oasis_exec :: "setup" :: t.oasis_setup_args))
|
||
|
else
|
||
|
begin
|
||
|
OASISExec.run
|
||
|
~ctxt:!BaseContext.default
|
||
|
~f_exit_code:
|
||
|
(function
|
||
|
| 0 ->
|
||
|
()
|
||
|
| n ->
|
||
|
failwithf
|
||
|
(f_ "Unable to update setup.ml using '%s', \
|
||
|
please fix the problem and retry.")
|
||
|
oasis_exec)
|
||
|
oasis_exec ("setup" :: t.oasis_setup_args);
|
||
|
OASISExec.run ~ctxt:!BaseContext.default ocaml (setup_ml :: args)
|
||
|
end
|
||
|
end
|
||
|
else
|
||
|
failwithf
|
||
|
(f_ "The version of '%s' (v%s) doesn't match the version of \
|
||
|
oasis used to generate the %s file. Please install at \
|
||
|
least oasis v%s.")
|
||
|
oasis_exec oasis_exec_version setup_ml t.oasis_version
|
||
|
in
|
||
|
|
||
|
if !update_setup_ml then
|
||
|
begin
|
||
|
try
|
||
|
match t.oasis_digest with
|
||
|
| Some dgst ->
|
||
|
if Sys.file_exists oasis_fn &&
|
||
|
dgst <> Digest.file default_oasis_fn then
|
||
|
begin
|
||
|
do_update ();
|
||
|
true
|
||
|
end
|
||
|
else
|
||
|
false
|
||
|
| None ->
|
||
|
false
|
||
|
with e ->
|
||
|
error
|
||
|
(f_ "Error when updating setup.ml. If you want to avoid this error, \
|
||
|
you can bypass the update of %s by running '%s %s %s %s'")
|
||
|
setup_ml ocaml setup_ml no_update_setup_ml_cli
|
||
|
(String.concat " " args);
|
||
|
raise e
|
||
|
end
|
||
|
else
|
||
|
false
|
||
|
|
||
|
|
||
|
let setup t =
|
||
|
let catch_exn =
|
||
|
ref true
|
||
|
in
|
||
|
try
|
||
|
let act_ref =
|
||
|
ref (fun _ ->
|
||
|
failwithf
|
||
|
(f_ "No action defined, run '%s %s -help'")
|
||
|
Sys.executable_name
|
||
|
Sys.argv.(0))
|
||
|
|
||
|
in
|
||
|
let extra_args_ref =
|
||
|
ref []
|
||
|
in
|
||
|
let allow_empty_env_ref =
|
||
|
ref false
|
||
|
in
|
||
|
let arg_handle ?(allow_empty_env=false) act =
|
||
|
Arg.Tuple
|
||
|
[
|
||
|
Arg.Rest (fun str -> extra_args_ref := str :: !extra_args_ref);
|
||
|
|
||
|
Arg.Unit
|
||
|
(fun () ->
|
||
|
allow_empty_env_ref := allow_empty_env;
|
||
|
act_ref := act);
|
||
|
]
|
||
|
in
|
||
|
|
||
|
Arg.parse
|
||
|
(Arg.align
|
||
|
([
|
||
|
"-configure",
|
||
|
arg_handle ~allow_empty_env:true configure,
|
||
|
s_ "[options*] Configure the whole build process.";
|
||
|
|
||
|
"-build",
|
||
|
arg_handle build,
|
||
|
s_ "[options*] Build executables and libraries.";
|
||
|
|
||
|
"-doc",
|
||
|
arg_handle doc,
|
||
|
s_ "[options*] Build documents.";
|
||
|
|
||
|
"-test",
|
||
|
arg_handle test,
|
||
|
s_ "[options*] Run tests.";
|
||
|
|
||
|
"-all",
|
||
|
arg_handle ~allow_empty_env:true all,
|
||
|
s_ "[options*] Run configure, build, doc and test targets.";
|
||
|
|
||
|
"-install",
|
||
|
arg_handle install,
|
||
|
s_ "[options*] Install libraries, data, executables \
|
||
|
and documents.";
|
||
|
|
||
|
"-uninstall",
|
||
|
arg_handle uninstall,
|
||
|
s_ "[options*] Uninstall libraries, data, executables \
|
||
|
and documents.";
|
||
|
|
||
|
"-reinstall",
|
||
|
arg_handle reinstall,
|
||
|
s_ "[options*] Uninstall and install libraries, data, \
|
||
|
executables and documents.";
|
||
|
|
||
|
"-clean",
|
||
|
arg_handle ~allow_empty_env:true clean,
|
||
|
s_ "[options*] Clean files generated by a build.";
|
||
|
|
||
|
"-distclean",
|
||
|
arg_handle ~allow_empty_env:true distclean,
|
||
|
s_ "[options*] Clean files generated by a build and configure.";
|
||
|
|
||
|
"-version",
|
||
|
arg_handle ~allow_empty_env:true version,
|
||
|
s_ " Display version of OASIS used to generate this setup.ml.";
|
||
|
|
||
|
"-no-catch-exn",
|
||
|
Arg.Clear catch_exn,
|
||
|
s_ " Don't catch exception, useful for debugging.";
|
||
|
]
|
||
|
@
|
||
|
(if t.setup_update then
|
||
|
[no_update_setup_ml_cli]
|
||
|
else
|
||
|
[])
|
||
|
@ (BaseContext.args ())))
|
||
|
(failwithf (f_ "Don't know what to do with '%s'"))
|
||
|
(s_ "Setup and run build process current package\n");
|
||
|
|
||
|
(* Build initial environment *)
|
||
|
load ~allow_empty:!allow_empty_env_ref ();
|
||
|
|
||
|
(** Initialize flags *)
|
||
|
List.iter
|
||
|
(function
|
||
|
| Flag (cs, {flag_description = hlp;
|
||
|
flag_default = choices}) ->
|
||
|
begin
|
||
|
let apply ?short_desc () =
|
||
|
var_ignore
|
||
|
(var_define
|
||
|
~cli:CLIEnable
|
||
|
?short_desc
|
||
|
(OASISUtils.varname_of_string cs.cs_name)
|
||
|
(fun () ->
|
||
|
string_of_bool
|
||
|
(var_choose
|
||
|
~name:(Printf.sprintf
|
||
|
(f_ "default value of flag %s")
|
||
|
cs.cs_name)
|
||
|
~printer:string_of_bool
|
||
|
choices)))
|
||
|
in
|
||
|
match hlp with
|
||
|
| Some hlp ->
|
||
|
apply ~short_desc:(fun () -> hlp) ()
|
||
|
| None ->
|
||
|
apply ()
|
||
|
end
|
||
|
| _ ->
|
||
|
())
|
||
|
t.package.sections;
|
||
|
|
||
|
BaseStandardVar.init t.package;
|
||
|
|
||
|
BaseDynVar.init t.package;
|
||
|
|
||
|
if t.setup_update && update_setup_ml t then
|
||
|
()
|
||
|
else
|
||
|
!act_ref t (Array.of_list (List.rev !extra_args_ref))
|
||
|
|
||
|
with e when !catch_exn ->
|
||
|
error "%s" (Printexc.to_string e);
|
||
|
exit 1
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
|
||
|
# 5432 "setup.ml"
|
||
|
module InternalConfigurePlugin = struct
|
||
|
(* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *)
|
||
|
|
||
|
|
||
|
(** Configure using internal scheme
|
||
|
@author Sylvain Le Gall
|
||
|
*)
|
||
|
|
||
|
|
||
|
open BaseEnv
|
||
|
open OASISTypes
|
||
|
open OASISUtils
|
||
|
open OASISGettext
|
||
|
open BaseMessage
|
||
|
|
||
|
|
||
|
(** Configure build using provided series of check to be done
|
||
|
* and then output corresponding file.
|
||
|
*)
|
||
|
let configure pkg argv =
|
||
|
let var_ignore_eval var = let _s: string = var () in () in
|
||
|
let errors = ref SetString.empty in
|
||
|
let buff = Buffer.create 13 in
|
||
|
|
||
|
let add_errors fmt =
|
||
|
Printf.kbprintf
|
||
|
(fun b ->
|
||
|
errors := SetString.add (Buffer.contents b) !errors;
|
||
|
Buffer.clear b)
|
||
|
buff
|
||
|
fmt
|
||
|
in
|
||
|
|
||
|
let warn_exception e =
|
||
|
warning "%s" (Printexc.to_string e)
|
||
|
in
|
||
|
|
||
|
(* Check tools *)
|
||
|
let check_tools lst =
|
||
|
List.iter
|
||
|
(function
|
||
|
| ExternalTool tool ->
|
||
|
begin
|
||
|
try
|
||
|
var_ignore_eval (BaseCheck.prog tool)
|
||
|
with e ->
|
||
|
warn_exception e;
|
||
|
add_errors (f_ "Cannot find external tool '%s'") tool
|
||
|
end
|
||
|
| InternalExecutable nm1 ->
|
||
|
(* Check that matching tool is built *)
|
||
|
List.iter
|
||
|
(function
|
||
|
| Executable ({cs_name = nm2},
|
||
|
{bs_build = build},
|
||
|
_) when nm1 = nm2 ->
|
||
|
if not (var_choose build) then
|
||
|
add_errors
|
||
|
(f_ "Cannot find buildable internal executable \
|
||
|
'%s' when checking build depends")
|
||
|
nm1
|
||
|
| _ ->
|
||
|
())
|
||
|
pkg.sections)
|
||
|
lst
|
||
|
in
|
||
|
|
||
|
let build_checks sct bs =
|
||
|
if var_choose bs.bs_build then
|
||
|
begin
|
||
|
if bs.bs_compiled_object = Native then
|
||
|
begin
|
||
|
try
|
||
|
var_ignore_eval BaseStandardVar.ocamlopt
|
||
|
with e ->
|
||
|
warn_exception e;
|
||
|
add_errors
|
||
|
(f_ "Section %s requires native compilation")
|
||
|
(OASISSection.string_of_section sct)
|
||
|
end;
|
||
|
|
||
|
(* Check tools *)
|
||
|
check_tools bs.bs_build_tools;
|
||
|
|
||
|
(* Check depends *)
|
||
|
List.iter
|
||
|
(function
|
||
|
| FindlibPackage (findlib_pkg, version_comparator) ->
|
||
|
begin
|
||
|
try
|
||
|
var_ignore_eval
|
||
|
(BaseCheck.package ?version_comparator findlib_pkg)
|
||
|
with e ->
|
||
|
warn_exception e;
|
||
|
match version_comparator with
|
||
|
| None ->
|
||
|
add_errors
|
||
|
(f_ "Cannot find findlib package %s")
|
||
|
findlib_pkg
|
||
|
| Some ver_cmp ->
|
||
|
add_errors
|
||
|
(f_ "Cannot find findlib package %s (%s)")
|
||
|
findlib_pkg
|
||
|
(OASISVersion.string_of_comparator ver_cmp)
|
||
|
end
|
||
|
| InternalLibrary nm1 ->
|
||
|
(* Check that matching library is built *)
|
||
|
List.iter
|
||
|
(function
|
||
|
| Library ({cs_name = nm2},
|
||
|
{bs_build = build},
|
||
|
_) when nm1 = nm2 ->
|
||
|
if not (var_choose build) then
|
||
|
add_errors
|
||
|
(f_ "Cannot find buildable internal library \
|
||
|
'%s' when checking build depends")
|
||
|
nm1
|
||
|
| _ ->
|
||
|
())
|
||
|
pkg.sections)
|
||
|
bs.bs_build_depends
|
||
|
end
|
||
|
in
|
||
|
|
||
|
(* Parse command line *)
|
||
|
BaseArgExt.parse argv (BaseEnv.args ());
|
||
|
|
||
|
(* OCaml version *)
|
||
|
begin
|
||
|
match pkg.ocaml_version with
|
||
|
| Some ver_cmp ->
|
||
|
begin
|
||
|
try
|
||
|
var_ignore_eval
|
||
|
(BaseCheck.version
|
||
|
"ocaml"
|
||
|
ver_cmp
|
||
|
BaseStandardVar.ocaml_version)
|
||
|
with e ->
|
||
|
warn_exception e;
|
||
|
add_errors
|
||
|
(f_ "OCaml version %s doesn't match version constraint %s")
|
||
|
(BaseStandardVar.ocaml_version ())
|
||
|
(OASISVersion.string_of_comparator ver_cmp)
|
||
|
end
|
||
|
| None ->
|
||
|
()
|
||
|
end;
|
||
|
|
||
|
(* Findlib version *)
|
||
|
begin
|
||
|
match pkg.findlib_version with
|
||
|
| Some ver_cmp ->
|
||
|
begin
|
||
|
try
|
||
|
var_ignore_eval
|
||
|
(BaseCheck.version
|
||
|
"findlib"
|
||
|
ver_cmp
|
||
|
BaseStandardVar.findlib_version)
|
||
|
with e ->
|
||
|
warn_exception e;
|
||
|
add_errors
|
||
|
(f_ "Findlib version %s doesn't match version constraint %s")
|
||
|
(BaseStandardVar.findlib_version ())
|
||
|
(OASISVersion.string_of_comparator ver_cmp)
|
||
|
end
|
||
|
| None ->
|
||
|
()
|
||
|
end;
|
||
|
(* Make sure the findlib version is fine for the OCaml compiler. *)
|
||
|
begin
|
||
|
let ocaml_ge4 =
|
||
|
OASISVersion.version_compare
|
||
|
(OASISVersion.version_of_string (BaseStandardVar.ocaml_version()))
|
||
|
(OASISVersion.version_of_string "4.0.0") >= 0 in
|
||
|
if ocaml_ge4 then
|
||
|
let findlib_lt132 =
|
||
|
OASISVersion.version_compare
|
||
|
(OASISVersion.version_of_string (BaseStandardVar.findlib_version()))
|
||
|
(OASISVersion.version_of_string "1.3.2") < 0 in
|
||
|
if findlib_lt132 then
|
||
|
add_errors "OCaml >= 4.0.0 requires Findlib version >= 1.3.2"
|
||
|
end;
|
||
|
|
||
|
(* FlexDLL *)
|
||
|
if BaseStandardVar.os_type () = "Win32" ||
|
||
|
BaseStandardVar.os_type () = "Cygwin" then
|
||
|
begin
|
||
|
try
|
||
|
var_ignore_eval BaseStandardVar.flexlink
|
||
|
with e ->
|
||
|
warn_exception e;
|
||
|
add_errors (f_ "Cannot find 'flexlink'")
|
||
|
end;
|
||
|
|
||
|
(* Check build depends *)
|
||
|
List.iter
|
||
|
(function
|
||
|
| Executable (_, bs, _)
|
||
|
| Library (_, bs, _) as sct ->
|
||
|
build_checks sct bs
|
||
|
| Doc (_, doc) ->
|
||
|
if var_choose doc.doc_build then
|
||
|
check_tools doc.doc_build_tools
|
||
|
| Test (_, test) ->
|
||
|
if var_choose test.test_run then
|
||
|
check_tools test.test_tools
|
||
|
| _ ->
|
||
|
())
|
||
|
pkg.sections;
|
||
|
|
||
|
(* Check if we need native dynlink (presence of libraries that compile to
|
||
|
* native)
|
||
|
*)
|
||
|
begin
|
||
|
let has_cmxa =
|
||
|
List.exists
|
||
|
(function
|
||
|
| Library (_, bs, _) ->
|
||
|
var_choose bs.bs_build &&
|
||
|
(bs.bs_compiled_object = Native ||
|
||
|
(bs.bs_compiled_object = Best &&
|
||
|
bool_of_string (BaseStandardVar.is_native ())))
|
||
|
| _ ->
|
||
|
false)
|
||
|
pkg.sections
|
||
|
in
|
||
|
if has_cmxa then
|
||
|
var_ignore_eval BaseStandardVar.native_dynlink
|
||
|
end;
|
||
|
|
||
|
(* Check errors *)
|
||
|
if SetString.empty != !errors then
|
||
|
begin
|
||
|
List.iter
|
||
|
(fun e -> error "%s" e)
|
||
|
(SetString.elements !errors);
|
||
|
failwithf
|
||
|
(fn_
|
||
|
"%d configuration error"
|
||
|
"%d configuration errors"
|
||
|
(SetString.cardinal !errors))
|
||
|
(SetString.cardinal !errors)
|
||
|
end
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module InternalInstallPlugin = struct
|
||
|
(* # 22 "src/plugins/internal/InternalInstallPlugin.ml" *)
|
||
|
|
||
|
|
||
|
(** Install using internal scheme
|
||
|
@author Sylvain Le Gall
|
||
|
*)
|
||
|
|
||
|
|
||
|
open BaseEnv
|
||
|
open BaseStandardVar
|
||
|
open BaseMessage
|
||
|
open OASISTypes
|
||
|
open OASISFindlib
|
||
|
open OASISGettext
|
||
|
open OASISUtils
|
||
|
|
||
|
|
||
|
let exec_hook =
|
||
|
ref (fun (cs, bs, exec) -> cs, bs, exec)
|
||
|
|
||
|
|
||
|
let lib_hook =
|
||
|
ref (fun (cs, bs, lib) -> cs, bs, lib, [])
|
||
|
|
||
|
|
||
|
let obj_hook =
|
||
|
ref (fun (cs, bs, obj) -> cs, bs, obj, [])
|
||
|
|
||
|
|
||
|
let doc_hook =
|
||
|
ref (fun (cs, doc) -> cs, doc)
|
||
|
|
||
|
|
||
|
let install_file_ev =
|
||
|
"install-file"
|
||
|
|
||
|
|
||
|
let install_dir_ev =
|
||
|
"install-dir"
|
||
|
|
||
|
|
||
|
let install_findlib_ev =
|
||
|
"install-findlib"
|
||
|
|
||
|
|
||
|
let win32_max_command_line_length = 8000
|
||
|
|
||
|
|
||
|
let split_install_command ocamlfind findlib_name meta files =
|
||
|
if Sys.os_type = "Win32" then
|
||
|
(* Arguments for the first command: *)
|
||
|
let first_args = ["install"; findlib_name; meta] in
|
||
|
(* Arguments for remaining commands: *)
|
||
|
let other_args = ["install"; findlib_name; "-add"] in
|
||
|
(* Extract as much files as possible from [files], [len] is
|
||
|
the current command line length: *)
|
||
|
let rec get_files len acc files =
|
||
|
match files with
|
||
|
| [] ->
|
||
|
(List.rev acc, [])
|
||
|
| file :: rest ->
|
||
|
let len = len + 1 + String.length file in
|
||
|
if len > win32_max_command_line_length then
|
||
|
(List.rev acc, files)
|
||
|
else
|
||
|
get_files len (file :: acc) rest
|
||
|
in
|
||
|
(* Split the command into several commands. *)
|
||
|
let rec split args files =
|
||
|
match files with
|
||
|
| [] ->
|
||
|
[]
|
||
|
| _ ->
|
||
|
(* Length of "ocamlfind install <lib> [META|-add]" *)
|
||
|
let len =
|
||
|
List.fold_left
|
||
|
(fun len arg ->
|
||
|
len + 1 (* for the space *) + String.length arg)
|
||
|
(String.length ocamlfind)
|
||
|
args
|
||
|
in
|
||
|
match get_files len [] files with
|
||
|
| ([], _) ->
|
||
|
failwith (s_ "Command line too long.")
|
||
|
| (firsts, others) ->
|
||
|
let cmd = args @ firsts in
|
||
|
(* Use -add for remaining commands: *)
|
||
|
let () =
|
||
|
let findlib_ge_132 =
|
||
|
OASISVersion.comparator_apply
|
||
|
(OASISVersion.version_of_string
|
||
|
(BaseStandardVar.findlib_version ()))
|
||
|
(OASISVersion.VGreaterEqual
|
||
|
(OASISVersion.version_of_string "1.3.2"))
|
||
|
in
|
||
|
if not findlib_ge_132 then
|
||
|
failwithf
|
||
|
(f_ "Installing the library %s require to use the \
|
||
|
flag '-add' of ocamlfind because the command \
|
||
|
line is too long. This flag is only available \
|
||
|
for findlib 1.3.2. Please upgrade findlib from \
|
||
|
%s to 1.3.2")
|
||
|
findlib_name (BaseStandardVar.findlib_version ())
|
||
|
in
|
||
|
let cmds = split other_args others in
|
||
|
cmd :: cmds
|
||
|
in
|
||
|
(* The first command does not use -add: *)
|
||
|
split first_args files
|
||
|
else
|
||
|
["install" :: findlib_name :: meta :: files]
|
||
|
|
||
|
|
||
|
let install pkg argv =
|
||
|
|
||
|
let in_destdir =
|
||
|
try
|
||
|
let destdir =
|
||
|
destdir ()
|
||
|
in
|
||
|
(* Practically speaking destdir is prepended
|
||
|
* at the beginning of the target filename
|
||
|
*)
|
||
|
fun fn -> destdir^fn
|
||
|
with PropList.Not_set _ ->
|
||
|
fun fn -> fn
|
||
|
in
|
||
|
|
||
|
let install_file ?tgt_fn src_file envdir =
|
||
|
let tgt_dir =
|
||
|
in_destdir (envdir ())
|
||
|
in
|
||
|
let tgt_file =
|
||
|
Filename.concat
|
||
|
tgt_dir
|
||
|
(match tgt_fn with
|
||
|
| Some fn ->
|
||
|
fn
|
||
|
| None ->
|
||
|
Filename.basename src_file)
|
||
|
in
|
||
|
(* Create target directory if needed *)
|
||
|
OASISFileUtil.mkdir_parent
|
||
|
~ctxt:!BaseContext.default
|
||
|
(fun dn ->
|
||
|
info (f_ "Creating directory '%s'") dn;
|
||
|
BaseLog.register install_dir_ev dn)
|
||
|
tgt_dir;
|
||
|
|
||
|
(* Really install files *)
|
||
|
info (f_ "Copying file '%s' to '%s'") src_file tgt_file;
|
||
|
OASISFileUtil.cp ~ctxt:!BaseContext.default src_file tgt_file;
|
||
|
BaseLog.register install_file_ev tgt_file
|
||
|
in
|
||
|
|
||
|
(* Install data into defined directory *)
|
||
|
let install_data srcdir lst tgtdir =
|
||
|
let tgtdir =
|
||
|
OASISHostPath.of_unix (var_expand tgtdir)
|
||
|
in
|
||
|
List.iter
|
||
|
(fun (src, tgt_opt) ->
|
||
|
let real_srcs =
|
||
|
OASISFileUtil.glob
|
||
|
~ctxt:!BaseContext.default
|
||
|
(Filename.concat srcdir src)
|
||
|
in
|
||
|
if real_srcs = [] then
|
||
|
failwithf
|
||
|
(f_ "Wildcard '%s' doesn't match any files")
|
||
|
src;
|
||
|
List.iter
|
||
|
(fun fn ->
|
||
|
install_file
|
||
|
fn
|
||
|
(fun () ->
|
||
|
match tgt_opt with
|
||
|
| Some s ->
|
||
|
OASISHostPath.of_unix (var_expand s)
|
||
|
| None ->
|
||
|
tgtdir))
|
||
|
real_srcs)
|
||
|
lst
|
||
|
in
|
||
|
|
||
|
let make_fnames modul sufx =
|
||
|
List.fold_right
|
||
|
begin fun sufx accu ->
|
||
|
(OASISString.capitalize_ascii modul ^ sufx) ::
|
||
|
(OASISString.uncapitalize_ascii modul ^ sufx) ::
|
||
|
accu
|
||
|
end
|
||
|
sufx
|
||
|
[]
|
||
|
in
|
||
|
|
||
|
(** Install all libraries *)
|
||
|
let install_libs pkg =
|
||
|
|
||
|
let files_of_library (f_data, acc) data_lib =
|
||
|
let cs, bs, lib, lib_extra =
|
||
|
!lib_hook data_lib
|
||
|
in
|
||
|
if var_choose bs.bs_install &&
|
||
|
BaseBuilt.is_built BaseBuilt.BLib cs.cs_name then
|
||
|
begin
|
||
|
let acc =
|
||
|
(* Start with acc + lib_extra *)
|
||
|
List.rev_append lib_extra acc
|
||
|
in
|
||
|
let acc =
|
||
|
(* Add uncompiled header from the source tree *)
|
||
|
let path =
|
||
|
OASISHostPath.of_unix bs.bs_path
|
||
|
in
|
||
|
List.fold_left
|
||
|
begin fun acc modul ->
|
||
|
begin
|
||
|
try
|
||
|
[List.find
|
||
|
OASISFileUtil.file_exists_case
|
||
|
(List.map
|
||
|
(Filename.concat path)
|
||
|
(make_fnames modul [".mli"; ".ml"]))]
|
||
|
with Not_found ->
|
||
|
warning
|
||
|
(f_ "Cannot find source header for module %s \
|
||
|
in library %s")
|
||
|
modul cs.cs_name;
|
||
|
[]
|
||
|
end
|
||
|
@
|
||
|
List.filter
|
||
|
OASISFileUtil.file_exists_case
|
||
|
(List.map
|
||
|
(Filename.concat path)
|
||
|
(make_fnames modul [".annot";".cmti";".cmt"]))
|
||
|
@ acc
|
||
|
end
|
||
|
acc
|
||
|
lib.lib_modules
|
||
|
in
|
||
|
|
||
|
let acc =
|
||
|
(* Get generated files *)
|
||
|
BaseBuilt.fold
|
||
|
BaseBuilt.BLib
|
||
|
cs.cs_name
|
||
|
(fun acc fn -> fn :: acc)
|
||
|
acc
|
||
|
in
|
||
|
|
||
|
let f_data () =
|
||
|
(* Install data associated with the library *)
|
||
|
install_data
|
||
|
bs.bs_path
|
||
|
bs.bs_data_files
|
||
|
(Filename.concat
|
||
|
(datarootdir ())
|
||
|
pkg.name);
|
||
|
f_data ()
|
||
|
in
|
||
|
|
||
|
(f_data, acc)
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
(f_data, acc)
|
||
|
end
|
||
|
and files_of_object (f_data, acc) data_obj =
|
||
|
let cs, bs, obj, obj_extra =
|
||
|
!obj_hook data_obj
|
||
|
in
|
||
|
if var_choose bs.bs_install &&
|
||
|
BaseBuilt.is_built BaseBuilt.BObj cs.cs_name then
|
||
|
begin
|
||
|
let acc =
|
||
|
(* Start with acc + obj_extra *)
|
||
|
List.rev_append obj_extra acc
|
||
|
in
|
||
|
let acc =
|
||
|
(* Add uncompiled header from the source tree *)
|
||
|
let path =
|
||
|
OASISHostPath.of_unix bs.bs_path
|
||
|
in
|
||
|
List.fold_left
|
||
|
begin fun acc modul ->
|
||
|
begin
|
||
|
try
|
||
|
[List.find
|
||
|
OASISFileUtil.file_exists_case
|
||
|
(List.map
|
||
|
(Filename.concat path)
|
||
|
(make_fnames modul [".mli"; ".ml"]))]
|
||
|
with Not_found ->
|
||
|
warning
|
||
|
(f_ "Cannot find source header for module %s \
|
||
|
in object %s")
|
||
|
modul cs.cs_name;
|
||
|
[]
|
||
|
end
|
||
|
@
|
||
|
List.filter
|
||
|
OASISFileUtil.file_exists_case
|
||
|
(List.map
|
||
|
(Filename.concat path)
|
||
|
(make_fnames modul [".annot";".cmti";".cmt"]))
|
||
|
@ acc
|
||
|
end
|
||
|
acc
|
||
|
obj.obj_modules
|
||
|
in
|
||
|
|
||
|
let acc =
|
||
|
(* Get generated files *)
|
||
|
BaseBuilt.fold
|
||
|
BaseBuilt.BObj
|
||
|
cs.cs_name
|
||
|
(fun acc fn -> fn :: acc)
|
||
|
acc
|
||
|
in
|
||
|
|
||
|
let f_data () =
|
||
|
(* Install data associated with the object *)
|
||
|
install_data
|
||
|
bs.bs_path
|
||
|
bs.bs_data_files
|
||
|
(Filename.concat
|
||
|
(datarootdir ())
|
||
|
pkg.name);
|
||
|
f_data ()
|
||
|
in
|
||
|
|
||
|
(f_data, acc)
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
(f_data, acc)
|
||
|
end
|
||
|
|
||
|
in
|
||
|
|
||
|
(* Install one group of library *)
|
||
|
let install_group_lib grp =
|
||
|
(* Iterate through all group nodes *)
|
||
|
let rec install_group_lib_aux data_and_files grp =
|
||
|
let data_and_files, children =
|
||
|
match grp with
|
||
|
| Container (_, children) ->
|
||
|
data_and_files, children
|
||
|
| Package (_, cs, bs, `Library lib, children) ->
|
||
|
files_of_library data_and_files (cs, bs, lib), children
|
||
|
| Package (_, cs, bs, `Object obj, children) ->
|
||
|
files_of_object data_and_files (cs, bs, obj), children
|
||
|
in
|
||
|
List.fold_left
|
||
|
install_group_lib_aux
|
||
|
data_and_files
|
||
|
children
|
||
|
in
|
||
|
|
||
|
(* Findlib name of the root library *)
|
||
|
let findlib_name =
|
||
|
findlib_of_group grp
|
||
|
in
|
||
|
|
||
|
(* Determine root library *)
|
||
|
let root_lib =
|
||
|
root_of_group grp
|
||
|
in
|
||
|
|
||
|
(* All files to install for this library *)
|
||
|
let f_data, files =
|
||
|
install_group_lib_aux (ignore, []) grp
|
||
|
in
|
||
|
|
||
|
(* Really install, if there is something to install *)
|
||
|
if files = [] then
|
||
|
begin
|
||
|
warning
|
||
|
(f_ "Nothing to install for findlib library '%s'")
|
||
|
findlib_name
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
let meta =
|
||
|
(* Search META file *)
|
||
|
let _, bs, _ =
|
||
|
root_lib
|
||
|
in
|
||
|
let res =
|
||
|
Filename.concat bs.bs_path "META"
|
||
|
in
|
||
|
if not (OASISFileUtil.file_exists_case res) then
|
||
|
failwithf
|
||
|
(f_ "Cannot find file '%s' for findlib library %s")
|
||
|
res
|
||
|
findlib_name;
|
||
|
res
|
||
|
in
|
||
|
let files =
|
||
|
(* Make filename shorter to avoid hitting command max line length
|
||
|
* too early, esp. on Windows.
|
||
|
*)
|
||
|
let remove_prefix p n =
|
||
|
let plen = String.length p in
|
||
|
let nlen = String.length n in
|
||
|
if plen <= nlen && String.sub n 0 plen = p then
|
||
|
begin
|
||
|
let fn_sep =
|
||
|
if Sys.os_type = "Win32" then
|
||
|
'\\'
|
||
|
else
|
||
|
'/'
|
||
|
in
|
||
|
let cutpoint = plen +
|
||
|
(if plen < nlen && n.[plen] = fn_sep then
|
||
|
1
|
||
|
else
|
||
|
0)
|
||
|
in
|
||
|
String.sub n cutpoint (nlen - cutpoint)
|
||
|
end
|
||
|
else
|
||
|
n
|
||
|
in
|
||
|
List.map (remove_prefix (Sys.getcwd ())) files
|
||
|
in
|
||
|
info
|
||
|
(f_ "Installing findlib library '%s'")
|
||
|
findlib_name;
|
||
|
let ocamlfind = ocamlfind () in
|
||
|
let commands =
|
||
|
split_install_command
|
||
|
ocamlfind
|
||
|
findlib_name
|
||
|
meta
|
||
|
files
|
||
|
in
|
||
|
List.iter
|
||
|
(OASISExec.run ~ctxt:!BaseContext.default ocamlfind)
|
||
|
commands;
|
||
|
BaseLog.register install_findlib_ev findlib_name
|
||
|
end;
|
||
|
|
||
|
(* Install data files *)
|
||
|
f_data ();
|
||
|
|
||
|
in
|
||
|
|
||
|
let group_libs, _, _ =
|
||
|
findlib_mapping pkg
|
||
|
in
|
||
|
|
||
|
(* We install libraries in groups *)
|
||
|
List.iter install_group_lib group_libs
|
||
|
in
|
||
|
|
||
|
let install_execs pkg =
|
||
|
let install_exec data_exec =
|
||
|
let cs, bs, exec =
|
||
|
!exec_hook data_exec
|
||
|
in
|
||
|
if var_choose bs.bs_install &&
|
||
|
BaseBuilt.is_built BaseBuilt.BExec cs.cs_name then
|
||
|
begin
|
||
|
let exec_libdir () =
|
||
|
Filename.concat
|
||
|
(libdir ())
|
||
|
pkg.name
|
||
|
in
|
||
|
BaseBuilt.fold
|
||
|
BaseBuilt.BExec
|
||
|
cs.cs_name
|
||
|
(fun () fn ->
|
||
|
install_file
|
||
|
~tgt_fn:(cs.cs_name ^ ext_program ())
|
||
|
fn
|
||
|
bindir)
|
||
|
();
|
||
|
BaseBuilt.fold
|
||
|
BaseBuilt.BExecLib
|
||
|
cs.cs_name
|
||
|
(fun () fn ->
|
||
|
install_file
|
||
|
fn
|
||
|
exec_libdir)
|
||
|
();
|
||
|
install_data
|
||
|
bs.bs_path
|
||
|
bs.bs_data_files
|
||
|
(Filename.concat
|
||
|
(datarootdir ())
|
||
|
pkg.name)
|
||
|
end
|
||
|
in
|
||
|
List.iter
|
||
|
(function
|
||
|
| Executable (cs, bs, exec)->
|
||
|
install_exec (cs, bs, exec)
|
||
|
| _ ->
|
||
|
())
|
||
|
pkg.sections
|
||
|
in
|
||
|
|
||
|
let install_docs pkg =
|
||
|
let install_doc data =
|
||
|
let cs, doc =
|
||
|
!doc_hook data
|
||
|
in
|
||
|
if var_choose doc.doc_install &&
|
||
|
BaseBuilt.is_built BaseBuilt.BDoc cs.cs_name then
|
||
|
begin
|
||
|
let tgt_dir =
|
||
|
OASISHostPath.of_unix (var_expand doc.doc_install_dir)
|
||
|
in
|
||
|
BaseBuilt.fold
|
||
|
BaseBuilt.BDoc
|
||
|
cs.cs_name
|
||
|
(fun () fn ->
|
||
|
install_file
|
||
|
fn
|
||
|
(fun () -> tgt_dir))
|
||
|
();
|
||
|
install_data
|
||
|
Filename.current_dir_name
|
||
|
doc.doc_data_files
|
||
|
doc.doc_install_dir
|
||
|
end
|
||
|
in
|
||
|
List.iter
|
||
|
(function
|
||
|
| Doc (cs, doc) ->
|
||
|
install_doc (cs, doc)
|
||
|
| _ ->
|
||
|
())
|
||
|
pkg.sections
|
||
|
in
|
||
|
|
||
|
install_libs pkg;
|
||
|
install_execs pkg;
|
||
|
install_docs pkg
|
||
|
|
||
|
|
||
|
(* Uninstall already installed data *)
|
||
|
let uninstall _ argv =
|
||
|
List.iter
|
||
|
(fun (ev, data) ->
|
||
|
if ev = install_file_ev then
|
||
|
begin
|
||
|
if OASISFileUtil.file_exists_case data then
|
||
|
begin
|
||
|
info
|
||
|
(f_ "Removing file '%s'")
|
||
|
data;
|
||
|
Sys.remove data
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
warning
|
||
|
(f_ "File '%s' doesn't exist anymore")
|
||
|
data
|
||
|
end
|
||
|
end
|
||
|
else if ev = install_dir_ev then
|
||
|
begin
|
||
|
if Sys.file_exists data && Sys.is_directory data then
|
||
|
begin
|
||
|
if Sys.readdir data = [||] then
|
||
|
begin
|
||
|
info
|
||
|
(f_ "Removing directory '%s'")
|
||
|
data;
|
||
|
OASISFileUtil.rmdir ~ctxt:!BaseContext.default data
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
warning
|
||
|
(f_ "Directory '%s' is not empty (%s)")
|
||
|
data
|
||
|
(String.concat
|
||
|
", "
|
||
|
(Array.to_list
|
||
|
(Sys.readdir data)))
|
||
|
end
|
||
|
end
|
||
|
else
|
||
|
begin
|
||
|
warning
|
||
|
(f_ "Directory '%s' doesn't exist anymore")
|
||
|
data
|
||
|
end
|
||
|
end
|
||
|
else if ev = install_findlib_ev then
|
||
|
begin
|
||
|
info (f_ "Removing findlib library '%s'") data;
|
||
|
OASISExec.run ~ctxt:!BaseContext.default
|
||
|
(ocamlfind ()) ["remove"; data]
|
||
|
end
|
||
|
else
|
||
|
failwithf (f_ "Unknown log event '%s'") ev;
|
||
|
BaseLog.unregister ev data)
|
||
|
(* We process event in reverse order *)
|
||
|
(List.rev
|
||
|
(BaseLog.filter
|
||
|
[install_file_ev;
|
||
|
install_dir_ev;
|
||
|
install_findlib_ev]))
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
|
||
|
# 6296 "setup.ml"
|
||
|
module OCamlbuildCommon = struct
|
||
|
(* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *)
|
||
|
|
||
|
|
||
|
(** Functions common to OCamlbuild build and doc plugin
|
||
|
*)
|
||
|
|
||
|
|
||
|
open OASISGettext
|
||
|
open BaseEnv
|
||
|
open BaseStandardVar
|
||
|
open OASISTypes
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
type extra_args = string list
|
||
|
|
||
|
|
||
|
let ocamlbuild_clean_ev = "ocamlbuild-clean"
|
||
|
|
||
|
|
||
|
let ocamlbuildflags =
|
||
|
var_define
|
||
|
~short_desc:(fun () -> "OCamlbuild additional flags")
|
||
|
"ocamlbuildflags"
|
||
|
(fun () -> "")
|
||
|
|
||
|
|
||
|
(** Fix special arguments depending on environment *)
|
||
|
let fix_args args extra_argv =
|
||
|
List.flatten
|
||
|
[
|
||
|
if (os_type ()) = "Win32" then
|
||
|
[
|
||
|
"-classic-display";
|
||
|
"-no-log";
|
||
|
"-no-links";
|
||
|
"-install-lib-dir";
|
||
|
(Filename.concat (standard_library ()) "ocamlbuild")
|
||
|
]
|
||
|
else
|
||
|
[];
|
||
|
|
||
|
if not (bool_of_string (is_native ())) || (os_type ()) = "Win32" then
|
||
|
[
|
||
|
"-byte-plugin"
|
||
|
]
|
||
|
else
|
||
|
[];
|
||
|
args;
|
||
|
|
||
|
if bool_of_string (debug ()) then
|
||
|
["-tag"; "debug"]
|
||
|
else
|
||
|
[];
|
||
|
|
||
|
if bool_of_string (tests ()) then
|
||
|
["-tag"; "tests"]
|
||
|
else
|
||
|
[];
|
||
|
|
||
|
if bool_of_string (profile ()) then
|
||
|
["-tag"; "profile"]
|
||
|
else
|
||
|
[];
|
||
|
|
||
|
OASISString.nsplit (ocamlbuildflags ()) ' ';
|
||
|
|
||
|
Array.to_list extra_argv;
|
||
|
]
|
||
|
|
||
|
|
||
|
(** Run 'ocamlbuild -clean' if not already done *)
|
||
|
let run_clean extra_argv =
|
||
|
let extra_cli =
|
||
|
String.concat " " (Array.to_list extra_argv)
|
||
|
in
|
||
|
(* Run if never called with these args *)
|
||
|
if not (BaseLog.exists ocamlbuild_clean_ev extra_cli) then
|
||
|
begin
|
||
|
OASISExec.run ~ctxt:!BaseContext.default
|
||
|
(ocamlbuild ()) (fix_args ["-clean"] extra_argv);
|
||
|
BaseLog.register ocamlbuild_clean_ev extra_cli;
|
||
|
at_exit
|
||
|
(fun () ->
|
||
|
try
|
||
|
BaseLog.unregister ocamlbuild_clean_ev extra_cli
|
||
|
with _ ->
|
||
|
())
|
||
|
end
|
||
|
|
||
|
|
||
|
(** Run ocamlbuild, unregister all clean events *)
|
||
|
let run_ocamlbuild args extra_argv =
|
||
|
(* TODO: enforce that target in args must be UNIX encoded i.e. toto/index.html
|
||
|
*)
|
||
|
OASISExec.run ~ctxt:!BaseContext.default
|
||
|
(ocamlbuild ()) (fix_args args extra_argv);
|
||
|
(* Remove any clean event, we must run it again *)
|
||
|
List.iter
|
||
|
(fun (e, d) -> BaseLog.unregister e d)
|
||
|
(BaseLog.filter [ocamlbuild_clean_ev])
|
||
|
|
||
|
|
||
|
(** Determine real build directory *)
|
||
|
let build_dir extra_argv =
|
||
|
let rec search_args dir =
|
||
|
function
|
||
|
| "-build-dir" :: dir :: tl ->
|
||
|
search_args dir tl
|
||
|
| _ :: tl ->
|
||
|
search_args dir tl
|
||
|
| [] ->
|
||
|
dir
|
||
|
in
|
||
|
search_args "_build" (fix_args [] extra_argv)
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OCamlbuildPlugin = struct
|
||
|
(* # 22 "src/plugins/ocamlbuild/OCamlbuildPlugin.ml" *)
|
||
|
|
||
|
|
||
|
(** Build using ocamlbuild
|
||
|
@author Sylvain Le Gall
|
||
|
*)
|
||
|
|
||
|
|
||
|
open OASISTypes
|
||
|
open OASISGettext
|
||
|
open OASISUtils
|
||
|
open OASISString
|
||
|
open BaseEnv
|
||
|
open OCamlbuildCommon
|
||
|
open BaseStandardVar
|
||
|
open BaseMessage
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
let cond_targets_hook =
|
||
|
ref (fun lst -> lst)
|
||
|
|
||
|
|
||
|
let build extra_args pkg argv =
|
||
|
(* Return the filename in build directory *)
|
||
|
let in_build_dir fn =
|
||
|
Filename.concat
|
||
|
(build_dir argv)
|
||
|
fn
|
||
|
in
|
||
|
|
||
|
(* Return the unix filename in host build directory *)
|
||
|
let in_build_dir_of_unix fn =
|
||
|
in_build_dir (OASISHostPath.of_unix fn)
|
||
|
in
|
||
|
|
||
|
let cond_targets =
|
||
|
List.fold_left
|
||
|
(fun acc ->
|
||
|
function
|
||
|
| Library (cs, bs, lib) when var_choose bs.bs_build ->
|
||
|
begin
|
||
|
let evs, unix_files =
|
||
|
BaseBuilt.of_library
|
||
|
in_build_dir_of_unix
|
||
|
(cs, bs, lib)
|
||
|
in
|
||
|
|
||
|
let tgts =
|
||
|
List.flatten
|
||
|
(List.filter
|
||
|
(fun l -> l <> [])
|
||
|
(List.map
|
||
|
(List.filter
|
||
|
(fun fn ->
|
||
|
ends_with ~what:".cma" fn
|
||
|
|| ends_with ~what:".cmxs" fn
|
||
|
|| ends_with ~what:".cmxa" fn
|
||
|
|| ends_with ~what:(ext_lib ()) fn
|
||
|
|| ends_with ~what:(ext_dll ()) fn))
|
||
|
unix_files))
|
||
|
in
|
||
|
|
||
|
match tgts with
|
||
|
| _ :: _ ->
|
||
|
(evs, tgts) :: acc
|
||
|
| [] ->
|
||
|
failwithf
|
||
|
(f_ "No possible ocamlbuild targets for library %s")
|
||
|
cs.cs_name
|
||
|
end
|
||
|
|
||
|
| Object (cs, bs, obj) when var_choose bs.bs_build ->
|
||
|
begin
|
||
|
let evs, unix_files =
|
||
|
BaseBuilt.of_object
|
||
|
in_build_dir_of_unix
|
||
|
(cs, bs, obj)
|
||
|
in
|
||
|
|
||
|
let tgts =
|
||
|
List.flatten
|
||
|
(List.filter
|
||
|
(fun l -> l <> [])
|
||
|
(List.map
|
||
|
(List.filter
|
||
|
(fun fn ->
|
||
|
ends_with ".cmo" fn
|
||
|
|| ends_with ".cmx" fn))
|
||
|
unix_files))
|
||
|
in
|
||
|
|
||
|
match tgts with
|
||
|
| _ :: _ ->
|
||
|
(evs, tgts) :: acc
|
||
|
| [] ->
|
||
|
failwithf
|
||
|
(f_ "No possible ocamlbuild targets for object %s")
|
||
|
cs.cs_name
|
||
|
end
|
||
|
|
||
|
| Executable (cs, bs, exec) when var_choose bs.bs_build ->
|
||
|
begin
|
||
|
let evs, unix_exec_is, unix_dll_opt =
|
||
|
BaseBuilt.of_executable
|
||
|
in_build_dir_of_unix
|
||
|
(cs, bs, exec)
|
||
|
in
|
||
|
|
||
|
let target ext =
|
||
|
let unix_tgt =
|
||
|
(OASISUnixPath.concat
|
||
|
bs.bs_path
|
||
|
(OASISUnixPath.chop_extension
|
||
|
exec.exec_main_is))^ext
|
||
|
in
|
||
|
let evs =
|
||
|
(* Fix evs, we want to use the unix_tgt, without copying *)
|
||
|
List.map
|
||
|
(function
|
||
|
| BaseBuilt.BExec, nm, lst when nm = cs.cs_name ->
|
||
|
BaseBuilt.BExec, nm,
|
||
|
[[in_build_dir_of_unix unix_tgt]]
|
||
|
| ev ->
|
||
|
ev)
|
||
|
evs
|
||
|
in
|
||
|
evs, [unix_tgt]
|
||
|
in
|
||
|
|
||
|
(* Add executable *)
|
||
|
let acc =
|
||
|
match bs.bs_compiled_object with
|
||
|
| Native ->
|
||
|
(target ".native") :: acc
|
||
|
| Best when bool_of_string (is_native ()) ->
|
||
|
(target ".native") :: acc
|
||
|
| Byte
|
||
|
| Best ->
|
||
|
(target ".byte") :: acc
|
||
|
in
|
||
|
acc
|
||
|
end
|
||
|
|
||
|
| Library _ | Object _ | Executable _ | Test _
|
||
|
| SrcRepo _ | Flag _ | Doc _ ->
|
||
|
acc)
|
||
|
[]
|
||
|
(* Keep the pkg.sections ordered *)
|
||
|
(List.rev pkg.sections);
|
||
|
in
|
||
|
|
||
|
(* Check and register built files *)
|
||
|
let check_and_register (bt, bnm, lst) =
|
||
|
List.iter
|
||
|
(fun fns ->
|
||
|
if not (List.exists OASISFileUtil.file_exists_case fns) then
|
||
|
failwithf
|
||
|
(fn_
|
||
|
"Expected built file %s doesn't exist."
|
||
|
"None of expected built files %s exists."
|
||
|
(List.length fns))
|
||
|
(String.concat (s_ " or ") (List.map (Printf.sprintf "'%s'") fns)))
|
||
|
lst;
|
||
|
(BaseBuilt.register bt bnm lst)
|
||
|
in
|
||
|
|
||
|
(* Run the hook *)
|
||
|
let cond_targets = !cond_targets_hook cond_targets in
|
||
|
|
||
|
(* Run a list of target... *)
|
||
|
run_ocamlbuild (List.flatten (List.map snd cond_targets) @ extra_args) argv;
|
||
|
(* ... and register events *)
|
||
|
List.iter check_and_register (List.flatten (List.map fst cond_targets))
|
||
|
|
||
|
|
||
|
let clean pkg extra_args =
|
||
|
run_clean extra_args;
|
||
|
List.iter
|
||
|
(function
|
||
|
| Library (cs, _, _) ->
|
||
|
BaseBuilt.unregister BaseBuilt.BLib cs.cs_name
|
||
|
| Executable (cs, _, _) ->
|
||
|
BaseBuilt.unregister BaseBuilt.BExec cs.cs_name;
|
||
|
BaseBuilt.unregister BaseBuilt.BExecLib cs.cs_name
|
||
|
| _ ->
|
||
|
())
|
||
|
pkg.sections
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
module OCamlbuildDocPlugin = struct
|
||
|
(* # 22 "src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml" *)
|
||
|
|
||
|
|
||
|
(* Create documentation using ocamlbuild .odocl files
|
||
|
@author Sylvain Le Gall
|
||
|
*)
|
||
|
|
||
|
|
||
|
open OASISTypes
|
||
|
open OASISGettext
|
||
|
open OASISMessage
|
||
|
open OCamlbuildCommon
|
||
|
open BaseStandardVar
|
||
|
|
||
|
|
||
|
|
||
|
|
||
|
type run_t =
|
||
|
{
|
||
|
extra_args: string list;
|
||
|
run_path: unix_filename;
|
||
|
}
|
||
|
|
||
|
|
||
|
let doc_build run pkg (cs, doc) argv =
|
||
|
let index_html =
|
||
|
OASISUnixPath.make
|
||
|
[
|
||
|
run.run_path;
|
||
|
cs.cs_name^".docdir";
|
||
|
"index.html";
|
||
|
]
|
||
|
in
|
||
|
let tgt_dir =
|
||
|
OASISHostPath.make
|
||
|
[
|
||
|
build_dir argv;
|
||
|
OASISHostPath.of_unix run.run_path;
|
||
|
cs.cs_name^".docdir";
|
||
|
]
|
||
|
in
|
||
|
run_ocamlbuild (index_html :: run.extra_args) argv;
|
||
|
List.iter
|
||
|
(fun glb ->
|
||
|
BaseBuilt.register
|
||
|
BaseBuilt.BDoc
|
||
|
cs.cs_name
|
||
|
[OASISFileUtil.glob ~ctxt:!BaseContext.default
|
||
|
(Filename.concat tgt_dir glb)])
|
||
|
["*.html"; "*.css"]
|
||
|
|
||
|
|
||
|
let doc_clean run pkg (cs, doc) argv =
|
||
|
run_clean argv;
|
||
|
BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name
|
||
|
|
||
|
|
||
|
end
|
||
|
|
||
|
|
||
|
# 6674 "setup.ml"
|
||
|
open OASISTypes;;
|
||
|
|
||
|
let setup_t =
|
||
|
{
|
||
|
BaseSetup.configure = InternalConfigurePlugin.configure;
|
||
|
build = OCamlbuildPlugin.build ["-use-ocamlfind"];
|
||
|
test = [];
|
||
|
doc =
|
||
|
[
|
||
|
("keystone",
|
||
|
OCamlbuildDocPlugin.doc_build
|
||
|
{
|
||
|
OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
|
||
|
run_path = "."
|
||
|
})
|
||
|
];
|
||
|
install = InternalInstallPlugin.install;
|
||
|
uninstall = InternalInstallPlugin.uninstall;
|
||
|
clean = [OCamlbuildPlugin.clean];
|
||
|
clean_test = [];
|
||
|
clean_doc =
|
||
|
[
|
||
|
("keystone",
|
||
|
OCamlbuildDocPlugin.doc_clean
|
||
|
{
|
||
|
OCamlbuildDocPlugin.extra_args = ["-use-ocamlfind"];
|
||
|
run_path = "."
|
||
|
})
|
||
|
];
|
||
|
distclean = [];
|
||
|
distclean_test = [];
|
||
|
distclean_doc = [];
|
||
|
package =
|
||
|
{
|
||
|
oasis_version = "0.4";
|
||
|
ocaml_version = Some (OASISVersion.VGreaterEqual "4.01");
|
||
|
findlib_version = None;
|
||
|
alpha_features = [];
|
||
|
beta_features = [];
|
||
|
name = "keystone";
|
||
|
version = "0.1";
|
||
|
license =
|
||
|
OASISLicense.DEP5License
|
||
|
(OASISLicense.DEP5Unit
|
||
|
{
|
||
|
OASISLicense.license = "LGPL";
|
||
|
excption = Some "OCaml linking";
|
||
|
version = OASISLicense.Version "2.1"
|
||
|
});
|
||
|
license_file = None;
|
||
|
copyrights = [];
|
||
|
maintainers = [];
|
||
|
authors = ["Aziem Chawdhary"];
|
||
|
homepage = None;
|
||
|
synopsis = "Ctypes bindings to Keystone assembler for OCaml";
|
||
|
description = None;
|
||
|
categories = [];
|
||
|
conf_type = (`Configure, "internal", Some "0.4");
|
||
|
conf_custom =
|
||
|
{
|
||
|
pre_command = [(OASISExpr.EBool true, None)];
|
||
|
post_command = [(OASISExpr.EBool true, None)]
|
||
|
};
|
||
|
build_type = (`Build, "ocamlbuild", Some "0.4");
|
||
|
build_custom =
|
||
|
{
|
||
|
pre_command = [(OASISExpr.EBool true, None)];
|
||
|
post_command = [(OASISExpr.EBool true, None)]
|
||
|
};
|
||
|
install_type = (`Install, "internal", Some "0.4");
|
||
|
install_custom =
|
||
|
{
|
||
|
pre_command = [(OASISExpr.EBool true, None)];
|
||
|
post_command = [(OASISExpr.EBool true, None)]
|
||
|
};
|
||
|
uninstall_custom =
|
||
|
{
|
||
|
pre_command = [(OASISExpr.EBool true, None)];
|
||
|
post_command = [(OASISExpr.EBool true, None)]
|
||
|
};
|
||
|
clean_custom =
|
||
|
{
|
||
|
pre_command = [(OASISExpr.EBool true, None)];
|
||
|
post_command = [(OASISExpr.EBool true, None)]
|
||
|
};
|
||
|
distclean_custom =
|
||
|
{
|
||
|
pre_command = [(OASISExpr.EBool true, None)];
|
||
|
post_command = [(OASISExpr.EBool true, None)]
|
||
|
};
|
||
|
files_ab = [];
|
||
|
sections =
|
||
|
[
|
||
|
Library
|
||
|
({
|
||
|
cs_name = "keystone";
|
||
|
cs_data = PropList.Data.create ();
|
||
|
cs_plugin_data = []
|
||
|
},
|
||
|
{
|
||
|
bs_build = [(OASISExpr.EBool true, true)];
|
||
|
bs_install = [(OASISExpr.EBool true, true)];
|
||
|
bs_path = ".";
|
||
|
bs_compiled_object = Native;
|
||
|
bs_build_depends =
|
||
|
[
|
||
|
FindlibPackage ("ctypes", None);
|
||
|
FindlibPackage ("uchar", None);
|
||
|
FindlibPackage ("ctypes.stubs", None);
|
||
|
FindlibPackage ("ctypes.foreign", None);
|
||
|
FindlibPackage ("result", None)
|
||
|
];
|
||
|
bs_build_tools = [ExternalTool "ocamlbuild"];
|
||
|
bs_c_sources = ["ffi_generated_stubs.c"];
|
||
|
bs_data_files = [];
|
||
|
bs_ccopt =
|
||
|
[
|
||
|
(OASISExpr.EBool true,
|
||
|
["-I"; "${pkg_ctypes_stubs}"])
|
||
|
];
|
||
|
bs_cclib = [(OASISExpr.EBool true, ["-lkeystone"])];
|
||
|
bs_dlllib = [(OASISExpr.EBool true, [])];
|
||
|
bs_dllpath = [(OASISExpr.EBool true, [])];
|
||
|
bs_byteopt = [(OASISExpr.EBool true, [])];
|
||
|
bs_nativeopt = [(OASISExpr.EBool true, [])]
|
||
|
},
|
||
|
{
|
||
|
lib_modules =
|
||
|
[
|
||
|
"Keystone";
|
||
|
"Ffi_generated";
|
||
|
"Ffi_types";
|
||
|
"Ffi_bindings";
|
||
|
"Ffi_generated_types"
|
||
|
];
|
||
|
lib_pack = false;
|
||
|
lib_internal_modules = [];
|
||
|
lib_findlib_parent = None;
|
||
|
lib_findlib_name = Some "keystone";
|
||
|
lib_findlib_containers = []
|
||
|
});
|
||
|
Doc
|
||
|
({
|
||
|
cs_name = "keystone";
|
||
|
cs_data = PropList.Data.create ();
|
||
|
cs_plugin_data = []
|
||
|
},
|
||
|
{
|
||
|
doc_type = (`Doc, "ocamlbuild", Some "0.4");
|
||
|
doc_custom =
|
||
|
{
|
||
|
pre_command = [(OASISExpr.EBool true, None)];
|
||
|
post_command = [(OASISExpr.EBool true, None)]
|
||
|
};
|
||
|
doc_build =
|
||
|
[
|
||
|
(OASISExpr.ENot (OASISExpr.EFlag "docs"), false);
|
||
|
(OASISExpr.EFlag "docs", true)
|
||
|
];
|
||
|
doc_install = [(OASISExpr.EBool true, true)];
|
||
|
doc_install_dir = "$docdir";
|
||
|
doc_title = "API reference for Keystone";
|
||
|
doc_authors = [];
|
||
|
doc_abstract = None;
|
||
|
doc_format = OtherDoc;
|
||
|
doc_data_files = [];
|
||
|
doc_build_tools =
|
||
|
[ExternalTool "ocamlbuild"; ExternalTool "ocamldoc"]
|
||
|
});
|
||
|
Executable
|
||
|
({
|
||
|
cs_name = "ffi_types_stubgen";
|
||
|
cs_data = PropList.Data.create ();
|
||
|
cs_plugin_data = []
|
||
|
},
|
||
|
{
|
||
|
bs_build = [(OASISExpr.EBool true, true)];
|
||
|
bs_install = [(OASISExpr.EBool true, false)];
|
||
|
bs_path = ".";
|
||
|
bs_compiled_object = Native;
|
||
|
bs_build_depends =
|
||
|
[FindlibPackage ("ctypes.stubs", None)];
|
||
|
bs_build_tools = [ExternalTool "ocamlbuild"];
|
||
|
bs_c_sources = [];
|
||
|
bs_data_files = [];
|
||
|
bs_ccopt = [(OASISExpr.EBool true, [])];
|
||
|
bs_cclib = [(OASISExpr.EBool true, [])];
|
||
|
bs_dlllib = [(OASISExpr.EBool true, [])];
|
||
|
bs_dllpath = [(OASISExpr.EBool true, [])];
|
||
|
bs_byteopt = [(OASISExpr.EBool true, [])];
|
||
|
bs_nativeopt = [(OASISExpr.EBool true, [])]
|
||
|
},
|
||
|
{
|
||
|
exec_custom = false;
|
||
|
exec_main_is = "ffi_types_stubgen.ml"
|
||
|
});
|
||
|
Executable
|
||
|
({
|
||
|
cs_name = "ffi_stubgen";
|
||
|
cs_data = PropList.Data.create ();
|
||
|
cs_plugin_data = []
|
||
|
},
|
||
|
{
|
||
|
bs_build = [(OASISExpr.EBool true, true)];
|
||
|
bs_install = [(OASISExpr.EBool true, false)];
|
||
|
bs_path = ".";
|
||
|
bs_compiled_object = Native;
|
||
|
bs_build_depends =
|
||
|
[
|
||
|
FindlibPackage ("ctypes.stubs", None);
|
||
|
FindlibPackage ("ctypes.foreign", None)
|
||
|
];
|
||
|
bs_build_tools = [ExternalTool "ocamlbuild"];
|
||
|
bs_c_sources = [];
|
||
|
bs_data_files = [];
|
||
|
bs_ccopt = [(OASISExpr.EBool true, [])];
|
||
|
bs_cclib = [(OASISExpr.EBool true, [])];
|
||
|
bs_dlllib = [(OASISExpr.EBool true, [])];
|
||
|
bs_dllpath = [(OASISExpr.EBool true, [])];
|
||
|
bs_byteopt = [(OASISExpr.EBool true, [])];
|
||
|
bs_nativeopt = [(OASISExpr.EBool true, [])]
|
||
|
},
|
||
|
{exec_custom = false; exec_main_is = "ffi_stubgen.ml"});
|
||
|
Executable
|
||
|
({
|
||
|
cs_name = "test_bindings";
|
||
|
cs_data = PropList.Data.create ();
|
||
|
cs_plugin_data = []
|
||
|
},
|
||
|
{
|
||
|
bs_build = [(OASISExpr.EBool true, true)];
|
||
|
bs_install = [(OASISExpr.EBool true, false)];
|
||
|
bs_path = ".";
|
||
|
bs_compiled_object = Native;
|
||
|
bs_build_depends = [InternalLibrary "keystone"];
|
||
|
bs_build_tools = [ExternalTool "ocamlbuild"];
|
||
|
bs_c_sources = [];
|
||
|
bs_data_files = [];
|
||
|
bs_ccopt = [(OASISExpr.EBool true, [])];
|
||
|
bs_cclib = [(OASISExpr.EBool true, ["-lkeystone"])];
|
||
|
bs_dlllib = [(OASISExpr.EBool true, [])];
|
||
|
bs_dllpath = [(OASISExpr.EBool true, [])];
|
||
|
bs_byteopt = [(OASISExpr.EBool true, [])];
|
||
|
bs_nativeopt = [(OASISExpr.EBool true, [])]
|
||
|
},
|
||
|
{exec_custom = false; exec_main_is = "test_bindings.ml"})
|
||
|
];
|
||
|
plugins =
|
||
|
[(`Extra, "DevFiles", Some "0.4"); (`Extra, "META", Some "0.4")];
|
||
|
disable_oasis_section = [];
|
||
|
schema_data = PropList.Data.create ();
|
||
|
plugin_data = []
|
||
|
};
|
||
|
oasis_fn = Some "_oasis";
|
||
|
oasis_version = "0.4.6";
|
||
|
oasis_digest = Some "\0174\176\255\171N\142\235\136\215R8\140\185^\250";
|
||
|
oasis_exec = None;
|
||
|
oasis_setup_args = [];
|
||
|
setup_update = false
|
||
|
};;
|
||
|
|
||
|
let setup () = BaseSetup.setup setup_t;;
|
||
|
|
||
|
# 6939 "setup.ml"
|
||
|
(* OASIS_STOP *)
|
||
|
let () = setup ();;
|