Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

6761 lines (6077 sloc) 197.293 kb
(* setup.ml generated for the first time by OASIS v0.3.0 *)
(* OASIS_START *)
(* DO NOT EDIT (digest: dff705cab44fa9f01fac3250fbd724fd) *)
(*
Regenerated by OASIS v0.3.0
Visit http://oasis.forge.ocamlcore.org for more information and
documentation about functions used in this file.
*)
module OASISGettext = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/src/oasis/OASISContext.ml"
open OASISGettext
type level =
[ `Debug
| `Info
| `Warning
| `Error]
type t =
{
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 args () =
["-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")]
end
module OASISString = struct
# 1 "/Users/avsm/.opam/system/build/oasis.0.3.0/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 = String.make (String.length s) 'X' in
for i = 0 to String.length s - 1 do
buf.[i] <- f s.[i]
done;
buf
end
module OASISUtils = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/src/oasis/OASISUtils.ml"
open OASISGettext
module MapString = Map.Make(String)
let map_string_of_assoc assoc =
List.fold_left
(fun acc (k, v) -> MapString.add k v acc)
MapString.empty
assoc
module SetString = Set.Make(String)
let set_string_add_list st lst =
List.fold_left
(fun acc e -> SetString.add e acc)
st
lst
let set_string_of_list =
set_string_add_list
SetString.empty
let compare_csl s1 s2 =
String.compare (String.lowercase s1) (String.lowercase s2)
module HashStringCsl =
Hashtbl.Make
(struct
type t = string
let equal s1 s2 =
(String.lowercase s1) = (String.lowercase s2)
let hash s =
Hashtbl.hash (String.lowercase s)
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
String.lowercase 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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
# 71 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
String.lowercase
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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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 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 version_0_3_or_after t =
comparator_apply t (VGreaterEqual (string_of_version "0.3"))
end
module OASISLicense = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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 OASISTypes = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
# 102 "/Users/avsm/.opam/system/build/oasis.0.3.0/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 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
| 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 | `Executable | `Flag | `SrcRepo | `Test | `Doc ]
type package =
{
oasis_version: OASISVersion.t;
ocaml_version: OASISVersion.comparator option;
findlib_version: OASISVersion.comparator option;
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: string 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;
schema_data: PropList.Data.t;
plugin_data: plugin_data;
}
end
module OASISUnixPath = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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 (String.capitalize base)
let uncapitalize_file f =
let dir = dirname f in
let base = basename f in
concat dir (String.uncapitalize base)
end
module OASISHostPath = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/src/oasis/OASISSection.ml"
open OASISTypes
let section_kind_common =
function
| Library (cs, _, _) ->
`Library, 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)
| 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"
| `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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/src/oasis/OASISBuildSection.ml"
end
module OASISExecutable = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/src/oasis/OASISLibrary.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 *
group_t list)
(* Look for a module file, considering capitalization or not. *)
let find_module source_file_exists (cs, bs, lib) 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 (cs, bs, lib) 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 (cs, bs, lib) modul with
| `Sources (base_fn, _) ->
[base_fn]
| `No_sources lst ->
OASISMessage.warning
~ctxt
(f_ "Cannot find source file matching \
module '%s' in library %s")
modul cs.cs_name;
lst
in
List.map
(fun nm ->
List.map
(fun base_fn -> base_fn ^"."^ext)
(find_module nm))
lst
in
(* The headers that should be compiled along *)
let headers =
if lib.lib_pack then
[]
else
find_modules
lib.lib_modules
"cmi"
in
(* The .cmx that be compiled along *)
let cmxs =
let should_be_built =
(not lib.lib_pack) && (* Do not install .cmx packed submodules *)
match bs.bs_compiled_object with
| Native -> true
| Best -> is_native
| Byte -> false
in
if should_be_built then
find_modules
(lib.lib_modules @ lib.lib_internal_modules)
"cmx"
else
[]
in
let acc_nopath =
[]
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"] :: 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)
type data = common_section * build_section * library
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
| 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, lib) mp
| _ ->
mp)
MapString.empty
pkg.sections
in
let groups =
group_of_tree group_mp
in
let library_name_of_findlib_name =
Lazy.lazy_from_fun
(fun () ->
(* Revert findlib_name_of_library_name. *)
MapString.fold
(fun k v mp -> MapString.add v k mp)
fndlb_name_of_lib_name
MapString.empty)
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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/src/oasis/OASISFlag.ml"
end
module OASISPackage = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/src/oasis/OASISPackage.ml"
end
module OASISSourceRepository = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/src/oasis/OASISSourceRepository.ml"
end
module OASISTest = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/src/oasis/OASISTest.ml"
end
module OASISDocument = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/src/oasis/OASISDocument.ml"
end
module OASISExec = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
(if case_sensitive then
file_exists_case
else
Sys.file_exists)
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
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
# 2142 "setup.ml"
module BaseEnvLight = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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 var_get name env =
let rec var_expand str =
let buff =
Buffer.create ((String.length str) * 2)
in
Buffer.add_substitute
buff
(fun var ->
try
var_expand (MapString.find var env)
with Not_found ->
failwith
(Printf.sprintf
"No variable %s defined when trying to expand %S."
var
str))
str;
Buffer.contents buff
in
var_expand (MapString.find name env)
let var_choose lst env =
OASISExpr.choose
(fun nm -> var_get nm env)
lst
end
# 2240 "setup.ml"
module BaseContext = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/src/base/BaseContext.ml"
open OASISContext
let args = args
let default = default
end
module BaseMessage = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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" -> ".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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/src/base/BaseBuilt.ml"
open OASISTypes
open OASISGettext
open BaseStandardVar
open BaseMessage
type t =
| BExec (* Executable *)
| BExecLib (* Library coming with executable *)
| BLib (* Library *)
| BDoc (* Document *)
let to_log_event_file t nm =
"built_"^
(match t with
| BExec -> "exec"
| BExecLib -> "exec_lib"
| BLib -> "lib"
| 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")
| 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
end
module BaseCustom = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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 _ | Flag _ | Test _ | SrcRepo _ | Doc _ ->
())
pkg.sections
end
module BaseTest = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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 OASISVersion.version_0_3_or_after pkg.oasis_version &&
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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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 OASISVersion.version_0_3_or_after pkg.oasis_version &&
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
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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
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";
]
(failwithf (f_ "Don't know what to do with '%s'"))
"";
info "Running configure step";
configure t [||];
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 _
| 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 update_setup_ml t =
let oasis_fn =
match t.oasis_fn with
| Some fn -> fn
| None -> "_oasis"
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 "_oasis" 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
# 4480 "setup.ml"
module InternalConfigurePlugin = struct
# 21 "/Users/avsm/.opam/system/build/oasis.0.3.0/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")