diff --git a/AUTHORS.txt b/AUTHORS.txt
index 6abb041..acd16db 100644
--- a/AUTHORS.txt
+++ b/AUTHORS.txt
@@ -1,5 +1,8 @@
(* OASIS_START *)
-(* DO NOT EDIT (digest: d1a132a4ab095df48f3d2d499d6c5000) *)
-Authors of ocamlify
-Sylvain Le Gall
+(* DO NOT EDIT (digest: 91079c4be5aa27b6a082f4de77fd51fe) *)
+
+Authors of ocamlify:
+
+* Sylvain Le Gall
+
(* OASIS_STOP *)
diff --git a/INSTALL.txt b/INSTALL.txt
index 667d1b3..8da6e65 100644
--- a/INSTALL.txt
+++ b/INSTALL.txt
@@ -1,16 +1,17 @@
(* OASIS_START *)
-(* DO NOT EDIT (digest: ff14f9ae83ff16013a48d7bd3b76fa73) *)
+(* DO NOT EDIT (digest: 322ab0a9779a65bd67816455cc8076ab) *)
+
This is the INSTALL file for the ocamlify distribution.
This package uses OASIS to generate its build system. See section OASIS for
-full information.
+full information.
Dependencies
============
In order to compile this package, you will need:
-* ocaml
-* findlib
+ * ocaml
+ * findlib
Installing
==========
@@ -23,7 +24,7 @@ Installing
Uninstalling
============
-1. Go to the root of the package
+1. Go to the root of the package
2. Run 'ocaml setup.ml -uninstall'
OASIS
diff --git a/Makefile b/Makefile
index ccbf9cf..a9411ed 100644
--- a/Makefile
+++ b/Makefile
@@ -20,7 +20,7 @@
################################################################################
# OASIS_START
-# DO NOT EDIT (digest: bc1e05bfc8b39b664f29dae8dbd3ebbb)
+# DO NOT EDIT (digest: a3c674b4239234cbbe53afe090018954)
SETUP = ocaml setup.ml
@@ -33,7 +33,7 @@ doc: setup.data build
test: setup.data build
$(SETUP) -test $(TESTFLAGS)
-all:
+all:
$(SETUP) -all $(ALLFLAGS)
install: setup.data
@@ -45,15 +45,18 @@ uninstall: setup.data
reinstall: setup.data
$(SETUP) -reinstall $(REINSTALLFLAGS)
-clean:
+clean:
$(SETUP) -clean $(CLEANFLAGS)
-distclean:
+distclean:
$(SETUP) -distclean $(DISTCLEANFLAGS)
setup.data:
$(SETUP) -configure $(CONFIGUREFLAGS)
+configure:
+ $(SETUP) -configure $(CONFIGUREFLAGS)
+
.PHONY: build doc test all install uninstall reinstall clean distclean configure
# OASIS_STOP
diff --git a/README.txt b/README.txt
index c8d0c50..82e15a2 100644
--- a/README.txt
+++ b/README.txt
@@ -1,11 +1,18 @@
(* OASIS_START *)
-(* DO NOT EDIT (digest: 6b14e9f8e3ce93d7b61df6632978b14b) *)
-This is the README file for the ocamlify distribution.
+(* DO NOT EDIT (digest: e5345f3fe2acd3045d4e251cfbf369a6) *)
-include files in OCaml code
+ocamlify - include files in OCaml code
+======================================
-See the files INSTALL.txt for building and installation instructions. See the
-file COPYING.txt for copying conditions.
+See the file [INSTALL.txt](INSTALL.txt) for building and installation
+instructions.
+Copyright and license
+---------------------
+
+ocamlify is distributed under the terms of the GNU Lesser General Public
+License version 2.1 with OCaml linking exception.
+
+See [COPYING.txt](COPYING.txt) for more information.
(* OASIS_STOP *)
diff --git a/_oasis b/_oasis
index 4915f09..658a9a3 100644
--- a/_oasis
+++ b/_oasis
@@ -11,5 +11,5 @@ BuildTools: ocamlbuild
Executable ocamlify
Path: src
- CompiledObject: byte
+ CompiledObject: best
MainIs: ocamlify.ml
diff --git a/_tags b/_tags
index 30cf144..7fe9fed 100644
--- a/_tags
+++ b/_tags
@@ -1,8 +1,9 @@
# OASIS_START
-# DO NOT EDIT (digest: d0ff94eb3e82a4875dd557595bea8eb3)
-# Ignore VCS directories, you can use the same kind of rule outside
-# OASIS_START/STOP if you want to exclude directories that contains
+# DO NOT EDIT (digest: b0a95a3908a35f1eadb2bb5d7f18ff09)
+# Ignore VCS directories, you can use the same kind of rule outside
+# OASIS_START/STOP if you want to exclude directories that contains
# useless stuff for the build process
+true: annot, bin_annot
<**/.svn>: -traverse
<**/.svn>: not_hygienic
".bzr": -traverse
diff --git a/configure b/configure
index 97ed012..6acfaeb 100755
--- a/configure
+++ b/configure
@@ -1,11 +1,11 @@
#!/bin/sh
# OASIS_START
-# DO NOT EDIT (digest: 425187ed8bfdbdd207fd76392dd243a7)
+# DO NOT EDIT (digest: dc86c2ad450f91ca10c931b6045d0499)
set -e
FST=true
-for i in "$@"; do
+for i in "$@"; do
if $FST; then
set --
FST=false
diff --git a/myocamlbuild.ml b/myocamlbuild.ml
index 805eb5d..5924578 100644
--- a/myocamlbuild.ml
+++ b/myocamlbuild.ml
@@ -1,16 +1,13 @@
(* OASIS_START *)
-(* DO NOT EDIT (digest: c731f09030552f20f1d702a3c5473c9c) *)
+(* DO NOT EDIT (digest: 9bd78b75e5e0b109a1abb54bf043b292) *)
module OASISGettext = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISGettext.ml"
+(* # 22 "src/oasis/OASISGettext.ml" *)
- let ns_ str =
- str
- let s_ str =
- str
+ let ns_ str = str
+ let s_ str = str
+ let f_ (str: ('a, 'b, 'c, 'd) format4) = str
- let f_ (str : ('a, 'b, 'c, 'd) format4) =
- str
let fn_ fmt1 fmt2 n =
if n = 1 then
@@ -18,21 +15,341 @@ module OASISGettext = struct
else
fmt2^^""
- let init =
- []
+ let init = []
end
-module OASISExpr = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISExpr.ml"
+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;
+ !what_idx = String.length what
+
+
+ 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;
+ !what_idx = -1
+
+
+ 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
- type test = string
- type flag = string
+ 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
+
+
+ let rec file_location ?pos1 ?pos2 ?lexbuf () =
+ match pos1, pos2, lexbuf with
+ | Some p, None, _ | None, Some p, _ ->
+ file_location ~pos1:p ~pos2:p ?lexbuf ()
+ | Some p1, Some p2, _ ->
+ let open Lexing in
+ let fn, lineno = p1.pos_fname, p1.pos_lnum in
+ let c1 = p1.pos_cnum - p1.pos_bol in
+ let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in
+ Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2
+ | _, _, Some lexbuf ->
+ file_location
+ ~pos1:(Lexing.lexeme_start_p lexbuf)
+ ~pos2:(Lexing.lexeme_end_p lexbuf)
+ ()
+ | None, None, None ->
+ s_ "<position undefined>"
+
+
+ let failwithpf ?pos1 ?pos2 ?lexbuf fmt =
+ let loc = file_location ?pos1 ?pos2 ?lexbuf () in
+ Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt
+
+
+end
+
+module OASISExpr = struct
+(* # 22 "src/oasis/OASISExpr.ml" *)
+
+
+ open OASISGettext
+ open OASISUtils
+
+
+ type test = string
+ type flag = string
+
type t =
| EBool of bool
@@ -41,9 +358,10 @@ module OASISExpr = struct
| EOr of t * t
| EFlag of flag
| ETest of test * string
-
- type 'a choices = (t * 'a) list
+
+ type 'a choices = (t * 'a) list
+
let eval var_get t =
let rec eval' =
@@ -75,6 +393,7 @@ module OASISExpr = struct
in
eval' t
+
let choose ?printer ?name var_get lst =
let rec choose_aux =
function
@@ -111,282 +430,337 @@ module OASISExpr = struct
in
choose_aux (List.rev lst)
+
end
-# 117 "myocamlbuild.ml"
+# 437 "myocamlbuild.ml"
module BaseEnvLight = struct
-# 21 "/home/gildor/programmation/oasis/src/base/BaseEnvLight.ml"
+(* # 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
+ let default_filename = Filename.concat (Sys.getcwd ()) "setup.data"
+
+
+ let load ?(allow_empty=false) ?(filename=default_filename) ?stream () =
+ let line = ref 1 in
+ let lexer st =
+ 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
+ Genlex.make_lexer ["="] st_line
+ in
+ let rec read_file lxr mp =
+ match Stream.npeek 3 lxr with
+ | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
+ Stream.junk lxr; Stream.junk lxr; Stream.junk lxr;
+ read_file lxr (MapString.add nm value mp)
+ | [] -> mp
+ | _ ->
+ failwith
+ (Printf.sprintf "Malformed data file '%s' line %d" filename !line)
+ in
+ match stream with
+ | Some st -> read_file (lexer st) MapString.empty
+ | None ->
+ if Sys.file_exists filename then begin
+ let chn = open_in_bin filename in
+ let st = Stream.of_channel chn in
+ try
+ let mp = read_file (lexer st) MapString.empty in
+ close_in chn; mp
+ with e ->
+ close_in chn; raise e
+ end else if allow_empty then begin
MapString.empty
- end
- else
- begin
+ 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
+ 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
-# 215 "myocamlbuild.ml"
+# 517 "myocamlbuild.ml"
module MyOCamlbuildFindlib = struct
-# 21 "/home/gildor/programmation/oasis/src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml"
+(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
+
- (** OCamlbuild extension, copied from
- * http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild
+ (** OCamlbuild extension, copied from
+ * https://ocaml.org/learn/tutorials/ocamlbuild/Using_ocamlfind_with_ocamlbuild.html
* by N. Pouillard and others
*
- * Updated on 2009/02/28
+ * Updated on 2016-06-02
*
- * Modified by Sylvain Le Gall
- *)
+ * Modified by Sylvain Le Gall
+ *)
open Ocamlbuild_plugin
- (* these functions are not really officially exported *)
- let run_and_read =
- Ocamlbuild_pack.My_unix.run_and_read
- let blank_sep_strings =
- Ocamlbuild_pack.Lexers.blank_sep_strings
+ type conf = {no_automatic_syntax: bool}
+
+
+ let run_and_read = Ocamlbuild_pack.My_unix.run_and_read
+
+
+ let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings
+
+
+ let exec_from_conf exec =
+ let exec =
+ let env = BaseEnvLight.load ~allow_empty:true () in
+ try
+ BaseEnvLight.var_get exec env
+ with Not_found ->
+ Printf.eprintf "W: Cannot get variable %s\n" exec;
+ exec
+ in
+ let fix_win32 str =
+ if Sys.os_type = "Win32" then begin
+ let buff = Buffer.create (String.length str) in
+ (* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'.
+ *)
+ String.iter
+ (fun c -> Buffer.add_char buff (if c = '\\' then '/' else c))
+ str;
+ Buffer.contents buff
+ end else begin
+ str
+ end
+ in
+ fix_win32 exec
+
let split s ch =
let buf = Buffer.create 13 in
let x = ref [] in
- let flush () =
+ let flush () =
x := (Buffer.contents buf) :: !x;
Buffer.clear buf
in
- String.iter
- (fun c ->
- if c = ch then
- flush ()
- else
- Buffer.add_char buf c)
- s;
- flush ();
- List.rev !x
+ String.iter
+ (fun c ->
+ if c = ch then
+ flush ()
+ else
+ Buffer.add_char buf c)
+ s;
+ flush ();
+ List.rev !x
+
let split_nl s = split s '\n'
+
let before_space s =
try
String.before s (String.index s ' ')
with Not_found -> s
- (* this lists all supported packages *)
+ (* ocamlfind command *)
+ let ocamlfind x = S[Sh (exec_from_conf "ocamlfind"); x]
+
+ (* This lists all supported packages. *)
let find_packages () =
- List.map before_space (split_nl & run_and_read "ocamlfind list")
+ List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list"))
- (* this is supposed to list available syntaxes, but I don't know how to do it. *)
+
+ (* Mock to list available syntaxes. *)
let find_syntaxes () = ["camlp4o"; "camlp4r"]
- (* ocamlfind command *)
- let ocamlfind x = S[A"ocamlfind"; x]
- let dispatch =
+ let well_known_syntax = [
+ "camlp4.quotations.o";
+ "camlp4.quotations.r";
+ "camlp4.exceptiontracer";
+ "camlp4.extend";
+ "camlp4.foldgenerator";
+ "camlp4.listcomprehension";
+ "camlp4.locationstripper";
+ "camlp4.macro";
+ "camlp4.mapgenerator";
+ "camlp4.metagenerator";
+ "camlp4.profiler";
+ "camlp4.tracer"
+ ]
+
+
+ let dispatch conf =
function
- | Before_options ->
- (* by using Before_options one let command line options have an higher priority *)
- (* on the contrary using After_options will guarantee to have the higher priority *)
- (* override default commands by ocamlfind ones *)
- Options.ocamlc := ocamlfind & A"ocamlc";
- Options.ocamlopt := ocamlfind & A"ocamlopt";
- Options.ocamldep := ocamlfind & A"ocamldep";
- Options.ocamldoc := ocamlfind & A"ocamldoc";
- Options.ocamlmktop := ocamlfind & A"ocamlmktop"
-
+ | After_options ->
+ (* By using Before_options one let command line options have an higher
+ * priority on the contrary using After_options will guarantee to have
+ * the higher priority override default commands by ocamlfind ones *)
+ Options.ocamlc := ocamlfind & A"ocamlc";
+ Options.ocamlopt := ocamlfind & A"ocamlopt";
+ Options.ocamldep := ocamlfind & A"ocamldep";
+ Options.ocamldoc := ocamlfind & A"ocamldoc";
+ Options.ocamlmktop := ocamlfind & A"ocamlmktop";
+ Options.ocamlmklib := ocamlfind & A"ocamlmklib"
+
| After_rules ->
-
- (* When one link an OCaml library/binary/package, one should use -linkpkg *)
- flag ["ocaml"; "link"; "program"] & A"-linkpkg";
-
- (* For each ocamlfind package one inject the -package option when
- * compiling, computing dependencies, generating documentation and
- * linking. *)
- List.iter
- begin fun pkg ->
- let base_args = [A"-package"; A pkg] in
- let syn_args = [A"-syntax"; A "camlp4o"] in
- let args =
- (* heuristic to identify syntax extensions:
- whether they end in ".syntax"; some might not *)
- if Filename.check_suffix pkg "syntax"
- then syn_args @ base_args
- else base_args
- in
- flag ["ocaml"; "compile"; "pkg_"^pkg] & S args;
- flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
- flag ["ocaml"; "doc"; "pkg_"^pkg] & S args;
- flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args;
- flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
- end
- (find_packages ());
-
- (* Like -package but for extensions syntax. Morover -syntax is useless
- * when linking. *)
- List.iter begin fun syntax ->
+
+ (* Avoid warnings for unused tag *)
+ flag ["tests"] N;
+
+ (* When one link an OCaml library/binary/package, one should use
+ * -linkpkg *)
+ flag ["ocaml"; "link"; "program"] & A"-linkpkg";
+
+ (* For each ocamlfind package one inject the -package option when
+ * compiling, computing dependencies, generating documentation and
+ * linking. *)
+ List.iter
+ begin fun pkg ->
+ let base_args = [A"-package"; A pkg] in
+ (* TODO: consider how to really choose camlp4o or camlp4r. *)
+ let syn_args = [A"-syntax"; A "camlp4o"] in
+ let (args, pargs) =
+ (* Heuristic to identify syntax extensions: whether they end in
+ ".syntax"; some might not.
+ *)
+ if not (conf.no_automatic_syntax) &&
+ (Filename.check_suffix pkg "syntax" ||
+ List.mem pkg well_known_syntax) then
+ (syn_args @ base_args, syn_args)
+ else
+ (base_args, [])
+ in
+ flag ["ocaml"; "compile"; "pkg_"^pkg] & S args;
+ flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S args;
+ flag ["ocaml"; "doc"; "pkg_"^pkg] & S args;
+ flag ["ocaml"; "link"; "pkg_"^pkg] & S base_args;
+ flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S args;
+
+ (* TODO: Check if this is allowed for OCaml < 3.12.1 *)
+ flag ["ocaml"; "compile"; "package("^pkg^")"] & S pargs;
+ flag ["ocaml"; "ocamldep"; "package("^pkg^")"] & S pargs;
+ flag ["ocaml"; "doc"; "package("^pkg^")"] & S pargs;
+ flag ["ocaml"; "infer_interface"; "package("^pkg^")"] & S pargs;
+ end
+ (find_packages ());
+
+ (* Like -package but for extensions syntax. Morover -syntax is useless
+ * when linking. *)
+ List.iter begin fun syntax ->
flag ["ocaml"; "compile"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "ocamldep"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
- flag ["ocaml"; "infer_interface"; "syntax_"^syntax] & S[A"-syntax"; A syntax];
- end (find_syntaxes ());
-
- (* The default "thread" tag is not compatible with ocamlfind.
- * Indeed, the default rules add the "threads.cma" or "threads.cmxa"
- * options when using this tag. When using the "-linkpkg" option with
- * ocamlfind, this module will then be added twice on the command line.
- *
- * To solve this, one approach is to add the "-thread" option when using
- * the "threads" package using the previous plugin.
- *)
- flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
- flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]);
- flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]);
- flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"])
-
- | _ ->
- ()
-
+ flag ["ocaml"; "infer_interface"; "syntax_"^syntax] &
+ S[A"-syntax"; A syntax];
+ end (find_syntaxes ());
+
+ (* The default "thread" tag is not compatible with ocamlfind.
+ * Indeed, the default rules add the "threads.cma" or "threads.cmxa"
+ * options when using this tag. When using the "-linkpkg" option with
+ * ocamlfind, this module will then be added twice on the command line.
+ *
+ * To solve this, one approach is to add the "-thread" option when using
+ * the "threads" package using the previous plugin.
+ *)
+ flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
+ flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]);
+ flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]);
+ flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]);
+ flag ["c"; "pkg_threads"; "compile"] (S[A "-thread"]);
+ flag ["ocaml"; "package(threads)"; "compile"] (S[A "-thread"]);
+ flag ["ocaml"; "package(threads)"; "doc"] (S[A "-I"; A "+threads"]);
+ flag ["ocaml"; "package(threads)"; "link"] (S[A "-thread"]);
+ flag ["ocaml"; "package(threads)"; "infer_interface"] (S[A "-thread"]);
+ flag ["c"; "package(threads)"; "compile"] (S[A "-thread"]);
+
+ | _ ->
+ ()
end
module MyOCamlbuildBase = struct
-# 21 "/home/gildor/programmation/oasis/src/plugins/ocamlbuild/MyOCamlbuildBase.ml"
+(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
+
(** Base functions for writing myocamlbuild.ml
@author Sylvain Le Gall
*)
-
open Ocamlbuild_plugin
module OC = Ocamlbuild_pack.Ocaml_compiler
- type dir = string
- type file = string
- type name = string
- type tag = string
-# 56 "/home/gildor/programmation/oasis/src/plugins/ocamlbuild/MyOCamlbuildBase.ml"
+ type dir = string
+ type file = string
+ type name = string
+ type tag = string
+
type t =
{
- lib_ocaml: (name * dir list) list;
- lib_c: (name * dir * file list) list;
+ lib_ocaml: (name * dir list * string list) list;
+ lib_c: (name * dir * file list) list;
flags: (tag list * (spec OASISExpr.choices)) list;
(* Replace the 'dir: include' from _tags by a precise interdepends in
* directory.
*)
- includes: (dir * dir list) list;
- }
+ includes: (dir * dir list) list;
+ }
+
+
+(* # 110 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
+
+
+ let env_filename = Pathname.basename BaseEnvLight.default_filename
- let env_filename =
- Pathname.basename
- BaseEnvLight.default_filename
let dispatch_combine lst =
fun e ->
- List.iter
+ List.iter
(fun dispatch -> dispatch e)
- lst
+ lst
+
let tag_libstubs nm =
"use_lib"^nm^"_stubs"
+
let nm_libstubs nm =
nm^"_stubs"
- let dispatch t e =
- let env =
- BaseEnvLight.load
- ~filename:env_filename
- ~allow_empty:true
- ()
- in
- match e with
+
+ let dispatch t e =
+ let env = BaseEnvLight.load ~allow_empty:true () in
+ match e with
| Before_options ->
let no_trailing_dot s =
if String.length s >= 1 && s.[0] = '.' then
@@ -396,35 +770,44 @@ module MyOCamlbuildBase = struct
in
List.iter
(fun (opt, var) ->
- try
+ try
opt := no_trailing_dot (BaseEnvLight.var_get var env)
with Not_found ->
- Printf.eprintf "W: Cannot get variable %s" var)
+ Printf.eprintf "W: Cannot get variable %s\n" var)
[
Options.ext_obj, "ext_obj";
Options.ext_lib, "ext_lib";
Options.ext_dll, "ext_dll";
]
- | After_rules ->
+ | After_rules ->
(* Declare OCaml libraries *)
- List.iter
+ List.iter
(function
- | nm, [] ->
- ocaml_lib nm
- | nm, dir :: tl ->
+ | nm, [], intf_modules ->
+ ocaml_lib nm;
+ let cmis =
+ List.map (fun m -> (OASISString.uncapitalize_ascii m) ^ ".cmi")
+ intf_modules in
+ dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis
+ | nm, dir :: tl, intf_modules ->
ocaml_lib ~dir:dir (dir^"/"^nm);
- List.iter
- (fun dir ->
+ List.iter
+ (fun dir ->
List.iter
(fun str ->
flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir]))
["compile"; "infer_interface"; "doc"])
- tl)
+ tl;
+ let cmis =
+ List.map (fun m -> dir^"/"^(OASISString.uncapitalize_ascii m)^".cmi")
+ intf_modules in
+ dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"]
+ cmis)
t.lib_ocaml;
(* Declare directories dependencies, replace "include" in _tags. *)
- List.iter
+ List.iter
(fun (dir, include_dirs) ->
Pathname.define_context dir include_dirs)
t.includes;
@@ -439,26 +822,28 @@ module MyOCamlbuildBase = struct
flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib]
(S[A"-cclib"; A("-l"^(nm_libstubs lib))]);
-
- flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib]
- (S[A"-dllib"; A("dll"^(nm_libstubs lib))]);
+
+ if bool_of_string (BaseEnvLight.var_get "native_dynlink" env) then
+ flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib]
+ (S[A"-dllib"; A("dll"^(nm_libstubs lib))]);
(* When ocaml link something that use the C library, then one
need that file to be up to date.
+ This holds both for programs and for libraries.
*)
- dep ["link"; "ocaml"; "program"; tag_libstubs lib]
+ dep ["link"; "ocaml"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
- dep ["compile"; "ocaml"; "program"; tag_libstubs lib]
+ dep ["compile"; "ocaml"; tag_libstubs lib]
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
(* TODO: be more specific about what depends on headers *)
(* Depends on .h files *)
- dep ["compile"; "c"]
+ dep ["compile"; "c"]
headers;
(* Setup search path for lib *)
- flag ["link"; "ocaml"; "use_"^lib]
+ flag ["link"; "ocaml"; "use_"^lib]
(S[A"-I"; P(dir)]);
)
t.lib_c;
@@ -466,32 +851,40 @@ module MyOCamlbuildBase = struct
(* Add flags *)
List.iter
(fun (tags, cond_specs) ->
- let spec =
- BaseEnvLight.var_choose cond_specs env
+ let spec = BaseEnvLight.var_choose cond_specs env in
+ let rec eval_specs =
+ function
+ | S lst -> S (List.map eval_specs lst)
+ | A str -> A (BaseEnvLight.var_expand str env)
+ | spec -> spec
in
- flag tags & spec)
+ flag tags & (eval_specs spec))
t.flags
- | _ ->
+ | _ ->
()
- let dispatch_default t =
- dispatch_combine
+
+ let dispatch_default conf t =
+ dispatch_combine
[
dispatch t;
- MyOCamlbuildFindlib.dispatch;
+ MyOCamlbuildFindlib.dispatch conf;
]
+
end
-# 487 "myocamlbuild.ml"
+# 878 "myocamlbuild.ml"
open Ocamlbuild_plugin;;
let package_default =
- {MyOCamlbuildBase.lib_ocaml = []; lib_c = []; flags = []; includes = []; }
+ {MyOCamlbuildBase.lib_ocaml = []; lib_c = []; flags = []; includes = []}
;;
-let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;;
+let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false}
+
+let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;;
-# 496 "myocamlbuild.ml"
+# 889 "myocamlbuild.ml"
(* OASIS_STOP *)
Ocamlbuild_plugin.dispatch dispatch_default;;
diff --git a/setup.ml b/setup.ml
index 7b53edb..87518ce 100644
--- a/setup.ml
+++ b/setup.ml
@@ -20,23 +20,20 @@
(********************************************************************************)
(* OASIS_START *)
-(* DO NOT EDIT (digest: e1b35f4beac5c9c844c0c1c02d73290d) *)
+(* DO NOT EDIT (digest: 34f91ad0e2768568009a7877006a665e) *)
(*
- Regenerated by OASIS v0.3.1
+ Regenerated by OASIS v0.4.11
Visit http://oasis.forge.ocamlcore.org for more information and
documentation about functions used in this file.
*)
module OASISGettext = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISGettext.ml"
+(* # 22 "src/oasis/OASISGettext.ml" *)
- let ns_ str =
- str
- let s_ str =
- str
+ let ns_ str = str
+ let s_ str = str
+ let f_ (str: ('a, 'b, 'c, 'd) format4) = str
- let f_ (str : ('a, 'b, 'c, 'd) format4) =
- str
let fn_ fmt1 fmt2 n =
if n = 1 then
@@ -44,83 +41,21 @@ module OASISGettext = struct
else
fmt2^^""
- let init =
- []
-end
-
-module OASISContext = struct
-# 21 "/home/gildor/programmation/oasis/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")]
+ let init = []
end
module OASISString = struct
-# 1 "/home/gildor/programmation/oasis/src/oasis/OASISString.ml"
-
+(* # 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
@@ -133,44 +68,48 @@ module OASISString = struct
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
+ 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 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 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
@@ -178,23 +117,22 @@ module OASISString = struct
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
+ 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;
+ !what_idx = String.length what
+
let strip_starts_with ~what str =
if starts_with ~what str then
@@ -202,23 +140,22 @@ module OASISString = struct
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
+ 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;
+ !what_idx = -1
+
let strip_ends_with ~what str =
if ends_with ~what str then
@@ -226,56 +163,127 @@ module OASISString = struct
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
+ 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
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISUtils.ml"
+(* # 22 "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 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
- module SetString = Set.Make(String)
+ let of_list lst = add_list empty lst
- let set_string_add_list st lst =
- List.fold_left
- (fun acc e -> SetString.add e acc)
- st
- lst
+ let to_list t = fold (fun k v acc -> (k, v) :: acc) t []
+ end
+ end
+
+
+ module MapString = MapExt.Make(String)
- let set_string_of_list =
- set_string_add_list
- SetString.empty
+
+ 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 (String.lowercase s1) (String.lowercase 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)
- let equal s1 s2 =
- (String.lowercase s1) = (String.lowercase s2)
-
- let hash s =
- Hashtbl.hash (String.lowercase s)
+ 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
@@ -303,9 +311,10 @@ module OASISUtils = struct
else
buf
in
- String.lowercase buf
+ OASISString.lowercase_ascii buf
end
+
let varname_concat ?(hyphen='_') p s =
let what = String.make 1 hyphen in
let p =
@@ -326,44 +335,443 @@ module OASISUtils = struct
let is_varname str =
str = varname_of_string str
+
let failwithf fmt = Printf.ksprintf failwith fmt
+
+ let rec file_location ?pos1 ?pos2 ?lexbuf () =
+ match pos1, pos2, lexbuf with
+ | Some p, None, _ | None, Some p, _ ->
+ file_location ~pos1:p ~pos2:p ?lexbuf ()
+ | Some p1, Some p2, _ ->
+ let open Lexing in
+ let fn, lineno = p1.pos_fname, p1.pos_lnum in
+ let c1 = p1.pos_cnum - p1.pos_bol in
+ let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in
+ Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2
+ | _, _, Some lexbuf ->
+ file_location
+ ~pos1:(Lexing.lexeme_start_p lexbuf)
+ ~pos2:(Lexing.lexeme_end_p lexbuf)
+ ()
+ | None, None, None ->
+ s_ "<position undefined>"
+
+
+ let failwithpf ?pos1 ?pos2 ?lexbuf fmt =
+ let loc = file_location ?pos1 ?pos2 ?lexbuf () in
+ Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt
+
+
+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
+ open OASISGettext
+
+
+ module Unix = OASISUnixPath
+
+
+ let make =
+ function
+ | [] ->
+ invalid_arg "OASISHostPath.make"
+ | hd :: tl ->
+ List.fold_left Filename.concat hd tl
+
+
+ let of_unix ufn =
+ match Sys.os_type with
+ | "Unix" | "Cygwin" -> ufn
+ | "Win32" ->
+ 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 '/'))
+ | os_type ->
+ OASISUtils.failwithf
+ (f_ "Don't know the path format of os_type %S when translating unix \
+ filename. %S")
+ os_type ufn
+
+
+end
+
+module OASISFileSystem = struct
+(* # 22 "src/oasis/OASISFileSystem.ml" *)
+
+ (** File System functions
+
+ @author Sylvain Le Gall
+ *)
+
+ type 'a filename = string
+
+ class type closer =
+ object
+ method close: unit
+ end
+
+ class type reader =
+ object
+ inherit closer
+ method input: Buffer.t -> int -> unit
+ end
+
+ class type writer =
+ object
+ inherit closer
+ method output: Buffer.t -> unit
+ end
+
+ class type ['a] fs =
+ object
+ method string_of_filename: 'a filename -> string
+ method open_out: ?mode:(open_flag list) -> ?perm:int -> 'a filename -> writer
+ method open_in: ?mode:(open_flag list) -> ?perm:int -> 'a filename -> reader
+ method file_exists: 'a filename -> bool
+ method remove: 'a filename -> unit
+ end
+
+
+ module Mode =
+ struct
+ let default_in = [Open_rdonly]
+ let default_out = [Open_wronly; Open_creat; Open_trunc]
+
+ let text_in = Open_text :: default_in
+ let text_out = Open_text :: default_out
+
+ let binary_in = Open_binary :: default_in
+ let binary_out = Open_binary :: default_out
+ end
+
+ let std_length = 4096 (* Standard buffer/read length. *)
+ let binary_out = Mode.binary_out
+ let binary_in = Mode.binary_in
+
+ let of_unix_filename ufn = (ufn: 'a filename)
+ let to_unix_filename fn = (fn: string)
+
+
+ let defer_close o f =
+ try
+ let r = f o in o#close; r
+ with e ->
+ o#close; raise e
+
+
+ let stream_of_reader rdr =
+ let buf = Buffer.create std_length in
+ let pos = ref 0 in
+ let eof = ref false in
+ let rec next idx =
+ let bpos = idx - !pos in
+ if !eof then begin
+ None
+ end else if bpos < Buffer.length buf then begin
+ Some (Buffer.nth buf bpos)
+ end else begin
+ pos := !pos + Buffer.length buf;
+ Buffer.clear buf;
+ begin
+ try
+ rdr#input buf std_length;
+ with End_of_file ->
+ if Buffer.length buf = 0 then
+ eof := true
+ end;
+ next idx
+ end
+ in
+ Stream.from next
+
+
+ let read_all buf rdr =
+ try
+ while true do
+ rdr#input buf std_length
+ done
+ with End_of_file ->
+ ()
+
+ class ['a] host_fs rootdir : ['a] fs =
+ object (self)
+ method private host_filename fn = Filename.concat rootdir fn
+ method string_of_filename = self#host_filename
+
+ method open_out ?(mode=Mode.text_out) ?(perm=0o666) fn =
+ let chn = open_out_gen mode perm (self#host_filename fn) in
+ object
+ method close = close_out chn
+ method output buf = Buffer.output_buffer chn buf
+ end
+
+ method open_in ?(mode=Mode.text_in) ?(perm=0o666) fn =
+ (* TODO: use Buffer.add_channel when minimal version of OCaml will
+ * be >= 4.03.0 (previous version was discarding last chars).
+ *)
+ let chn = open_in_gen mode perm (self#host_filename fn) in
+ let strm = Stream.of_channel chn in
+ object
+ method close = close_in chn
+ method input buf len =
+ let read = ref 0 in
+ try
+ for _i = 0 to len do
+ Buffer.add_char buf (Stream.next strm);
+ incr read
+ done
+ with Stream.Failure ->
+ if !read = 0 then
+ raise End_of_file
+ end
+
+ method file_exists fn = Sys.file_exists (self#host_filename fn)
+ method remove fn = Sys.remove (self#host_filename fn)
+ end
+
+end
+
+module OASISContext = struct
+(* # 22 "src/oasis/OASISContext.ml" *)
+
+
+ open OASISGettext
+
+
+ type level =
+ [ `Debug
+ | `Info
+ | `Warning
+ | `Error]
+
+
+ type source
+ type source_filename = source OASISFileSystem.filename
+
+
+ let in_srcdir ufn = OASISFileSystem.of_unix_filename ufn
+
+
+ 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;
+ srcfs: source OASISFileSystem.fs;
+ load_oasis_plugin: string -> bool;
+ }
+
+
+ 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;
+ srcfs = new OASISFileSystem.host_fs(Sys.getcwd ());
+ load_oasis_plugin = (fun _ -> false);
+ }
+
+
+ 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",
+ Arg.String
+ (fun str ->
+ Sys.chdir str;
+ default := {!default with srcfs = new OASISFileSystem.host_fs str}),
+ s_ "dir Change directory before running (affects setup.{data,log})."],
+ fun () -> {!default with ignore_plugins = !ignore_plugins}
end
module PropList = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/PropList.ml"
+(* # 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)
+ | 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
+ (name, unit -> unit) Hashtbl.t
let create () =
Hashtbl.create 13
@@ -371,27 +779,28 @@ module PropList = struct
let clear t =
Hashtbl.clear t
-# 71 "/home/gildor/programmation/oasis/src/oasis/PropList.ml"
+
+(* # 77 "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;
- }
+ {
+ 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;
- }
+ {
+ name: name;
+ fields: (name, ('ctxt, 'extra) value) Hashtbl.t;
+ order: name Queue.t;
+ name_norm: string -> string;
+ }
let create ?(case_insensitive=false) nm =
{
@@ -400,7 +809,7 @@ module PropList = struct
order = Queue.create ();
name_norm =
(if case_insensitive then
- String.lowercase
+ OASISString.lowercase_ascii
else
fun s -> s);
}
@@ -410,21 +819,21 @@ module PropList = struct
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
+ 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
@@ -450,7 +859,7 @@ module PropList = struct
let v =
find t k
in
- f acc k v.extra v.help)
+ f acc k v.extra v.help)
acc
t.order
@@ -464,24 +873,24 @@ module PropList = struct
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;
- }
+ {
+ 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
+ fun () -> incr last_id; !last_id
let create ?schema ?name ?parse ?print ?default ?update ?help extra =
(* Default value container *)
@@ -520,33 +929,33 @@ module PropList = struct
let x =
match update with
| Some f ->
- begin
- try
- f ?context (get data) x
- with Not_set _ ->
- x
- end
+ begin
+ try
+ f ?context (get data) x
+ with Not_set _ ->
+ x
+ end
| None ->
- x
+ x
in
- Hashtbl.replace
- data
- nm
- (fun () -> v := Some x)
+ Hashtbl.replace
+ data
+ nm
+ (fun () -> v := Some x)
in
(* Parse string value, if possible *)
let parse =
match parse with
| Some f ->
- f
+ f
| None ->
- fun ?context s ->
- failwith
- (Printf.sprintf
- (f_ "Cannot parse field '%s' when setting value %S")
- nm
- s)
+ fun ?context s ->
+ failwith
+ (Printf.sprintf
+ (f_ "Cannot parse field '%s' when setting value %S")
+ nm
+ s)
in
(* Set data, from string *)
@@ -558,9 +967,9 @@ module PropList = struct
let print =
match print with
| Some f ->
- f
+ f
| None ->
- fun _ -> raise (No_printer nm)
+ fun _ -> raise (No_printer nm)
in
(* Get data, as a string *)
@@ -568,22 +977,22 @@ module PropList = struct
print (get data)
in
- begin
- match schema with
- | Some t ->
- Schema.add t nm sets gets extra help
- | None ->
- ()
- end;
+ 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;
- }
+ {
+ set = set;
+ get = get;
+ sets = sets;
+ gets = gets;
+ help = help;
+ extra = extra;
+ }
let fset data t ?context x =
t.set data ?context x
@@ -596,28 +1005,27 @@ module PropList = struct
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
-
+ fun data -> Field.fget data fld
end
end
module OASISMessage = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISMessage.ml"
+(* # 22 "src/oasis/OASISMessage.ml" *)
open OASISGettext
open OASISContext
+
let generic_message ~ctxt lvl fmt =
let cond =
if ctxt.quiet then
@@ -628,38 +1036,41 @@ module OASISMessage = struct
| `Info -> ctxt.info
| _ -> true
in
- Printf.ksprintf
- (fun str ->
- if cond then
- begin
- ctxt.printf lvl str
- end)
- fmt
+ 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 "/home/gildor/programmation/oasis/src/oasis/OASISVersion.ml"
+(* # 22 "src/oasis/OASISVersion.ml" *)
- open OASISGettext
+ open OASISGettext
- type s = string
+ type t = string
- type t = string
type comparator =
| VGreater of t
@@ -669,26 +1080,20 @@ module OASISVersion = struct
| 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')
+ (* 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 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
@@ -723,76 +1128,79 @@ module OASISVersion = struct
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
+ 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
+ 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
+ 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
+ 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
+ (version_compare v cv) > 0
| VGreaterEqual cv ->
- (version_compare v cv) >= 0
+ (version_compare v cv) >= 0
| VLesser cv ->
- (version_compare v cv) < 0
+ (version_compare v cv) < 0
| VLesserEqual cv ->
- (version_compare v cv) <= 0
+ (version_compare v cv) <= 0
| VEqual cv ->
- (version_compare v cv) = 0
+ (version_compare v cv) = 0
| VOr (op1, op2) ->
- (comparator_apply v op1) || (comparator_apply v op2)
+ (comparator_apply v op1) || (comparator_apply v op2)
| VAnd (op1, op2) ->
- (comparator_apply v op1) && (comparator_apply v op2)
+ (comparator_apply v op1) && (comparator_apply v op2)
+
let rec string_of_comparator =
function
@@ -802,9 +1210,10 @@ module OASISVersion = struct
| VGreaterEqual v -> ">= "^(string_of_version v)
| VLesserEqual v -> "<= "^(string_of_version v)
| VOr (c1, c2) ->
- (string_of_comparator c1)^" || "^(string_of_comparator c2)
+ (string_of_comparator c1)^" || "^(string_of_comparator c2)
| VAnd (c1, c2) ->
- (string_of_comparator c1)^" && "^(string_of_comparator c2)
+ (string_of_comparator c1)^" && "^(string_of_comparator c2)
+
let rec varname_of_comparator =
let concat p v =
@@ -813,40 +1222,38 @@ module OASISVersion = struct
(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"))
+ 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)
+
end
module OASISLicense = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISLicense.ml"
+(* # 22 "src/oasis/OASISLicense.ml" *)
+
(** License for _oasis fields
@author Sylvain Le Gall
- *)
+ *)
+ type license = string
+ type license_exception = string
- type license = string
-
- type license_exception = string
type license_version =
| Version of OASISVersion.t
| VersionOrLater of OASISVersion.t
| NoVersion
-
+
type license_dep_5_unit =
{
@@ -854,31 +1261,32 @@ module OASISLicense = struct
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 "/home/gildor/programmation/oasis/src/oasis/OASISExpr.ml"
-
+(* # 22 "src/oasis/OASISExpr.ml" *)
open OASISGettext
+ open OASISUtils
+
- type test = string
+ type test = string
+ type flag = string
- type flag = string
type t =
| EBool of bool
@@ -887,9 +1295,10 @@ module OASISExpr = struct
| EOr of t * t
| EFlag of flag
| ETest of test * string
-
- type 'a choices = (t * 'a) list
+
+ type 'a choices = (t * 'a) list
+
let eval var_get t =
let rec eval' =
@@ -921,6 +1330,7 @@ module OASISExpr = struct
in
eval' t
+
let choose ?printer ?name var_get lst =
let rec choose_aux =
function
@@ -957,44 +1367,188 @@ module OASISExpr = struct
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 OASISSourcePatterns = struct
+(* # 22 "src/oasis/OASISSourcePatterns.ml" *)
+
+ open OASISUtils
+ open OASISGettext
+
+ module Templater =
+ struct
+ (* TODO: use this module in BaseEnv.var_expand and BaseFileAB, at least. *)
+ type t =
+ {
+ atoms: atom list;
+ origin: string
+ }
+ and atom =
+ | Text of string
+ | Expr of expr
+ and expr =
+ | Ident of string
+ | String of string
+ | Call of string * expr
+
+
+ type env =
+ {
+ variables: string MapString.t;
+ functions: (string -> string) MapString.t;
+ }
+
+
+ let eval env t =
+ let rec eval_expr env =
+ function
+ | String str -> str
+ | Ident nm ->
+ begin
+ try
+ MapString.find nm env.variables
+ with Not_found ->
+ (* TODO: add error location within the string. *)
+ failwithf
+ (f_ "Unable to find variable %S in source pattern %S")
+ nm t.origin
+ end
+
+ | Call (fn, expr) ->
+ begin
+ try
+ (MapString.find fn env.functions) (eval_expr env expr)
+ with Not_found ->
+ (* TODO: add error location within the string. *)
+ failwithf
+ (f_ "Unable to find function %S in source pattern %S")
+ fn t.origin
+ end
+ in
+ String.concat ""
+ (List.map
+ (function
+ | Text str -> str
+ | Expr expr -> eval_expr env expr)
+ t.atoms)
+
+
+ let parse env s =
+ let lxr = Genlex.make_lexer [] in
+ let parse_expr s =
+ let st = lxr (Stream.of_string s) in
+ match Stream.npeek 3 st with
+ | [Genlex.Ident fn; Genlex.Ident nm] -> Call(fn, Ident nm)
+ | [Genlex.Ident fn; Genlex.String str] -> Call(fn, String str)
+ | [Genlex.String str] -> String str
+ | [Genlex.Ident nm] -> Ident nm
+ (* TODO: add error location within the string. *)
+ | _ -> failwithf (f_ "Unable to parse expression %S") s
+ in
+ let parse s =
+ let lst_exprs = ref [] in
+ let ss =
+ let buff = Buffer.create (String.length s) in
+ Buffer.add_substitute
+ buff
+ (fun s -> lst_exprs := (parse_expr s) :: !lst_exprs; "\000")
+ s;
+ Buffer.contents buff
+ in
+ let rec join =
+ function
+ | hd1 :: tl1, hd2 :: tl2 -> Text hd1 :: Expr hd2 :: join (tl1, tl2)
+ | [], tl -> List.map (fun e -> Expr e) tl
+ | tl, [] -> List.map (fun e -> Text e) tl
+ in
+ join (OASISString.nsplit ss '\000', List.rev (!lst_exprs))
+ in
+ let t = {atoms = parse s; origin = s} in
+ (* We rely on a simple evaluation for checking variables/functions.
+ It works because there is no if/loop statement.
+ *)
+ let _s : string = eval env t in
+ t
+
+(* # 144 "src/oasis/OASISSourcePatterns.ml" *)
+ end
+
+
+ type t = Templater.t
+
+
+ let env ~modul () =
+ {
+ Templater.
+ variables = MapString.of_list ["module", modul];
+ functions = MapString.of_list
+ [
+ "capitalize_file", OASISUnixPath.capitalize_file;
+ "uncapitalize_file", OASISUnixPath.uncapitalize_file;
+ ];
+ }
+
+ let all_possible_files lst ~path ~modul =
+ let eval = Templater.eval (env ~modul ()) in
+ List.fold_left
+ (fun acc pat -> OASISUnixPath.concat path (eval pat) :: acc)
+ [] lst
+
+
+ let to_string t = t.Templater.origin
+
+
end
module OASISTypes = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISTypes.ml"
+(* # 22 "src/oasis/OASISTypes.ml" *)
+ type name = string
+ type package_name = string
+ type url = string
+ type unix_dirname = string
+ type unix_filename = string (* TODO: replace everywhere. *)
+ type host_dirname = string (* TODO: replace everywhere. *)
+ type host_filename = string (* TODO: replace everywhere. *)
+ type prog = string
+ type arg = string
+ type args = string list
+ type command_line = (prog * arg list)
- 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 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
@@ -1006,344 +1560,636 @@ module OASISTypes = struct
| Arch
| Monotone
| OtherVCS of url
-
+
type plugin_kind =
- [ `Configure
- | `Build
- | `Doc
- | `Test
- | `Install
- | `Extra
- ]
+ [ `Configure
+ | `Build
+ | `Doc
+ | `Test
+ | `Install
+ | `Extra
+ ]
+
type plugin_data_purpose =
- [ `Configure
- | `Build
- | `Install
- | `Clean
- | `Distclean
- | `Install
- | `Uninstall
- | `Test
- | `Doc
- | `Extra
- | `Other of string
- ]
+ [ `Configure
+ | `Build
+ | `Install
+ | `Clean
+ | `Distclean
+ | `Install
+ | `Uninstall
+ | `Test
+ | `Doc
+ | `Extra
+ | `Other of string
+ ]
+
+
+ type 'a plugin = 'a * name * OASISVersion.t option
- 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 "/home/gildor/programmation/oasis/src/oasis/OASISTypes.ml"
- type 'a conditional = 'a OASISExpr.choices
+ type 'a conditional = 'a OASISExpr.choices
+
type custom =
- {
- pre_command: (command_line option) conditional;
- post_command: (command_line option) conditional;
- }
-
+ {
+ 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;
- }
-
+ {
+ 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_interface_patterns: OASISSourcePatterns.t list;
+ bs_implementation_patterns: OASISSourcePatterns.t list;
+ bs_c_sources: unix_filename list;
+ bs_data_files: (unix_filename * unix_filename option) list;
+ bs_findlib_extra_files: unix_filename 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_directory: unix_dirname option;
+ lib_findlib_containers: findlib_name list;
+ }
+
+
+ type object_ =
+ {
+ obj_modules: string list;
+ obj_findlib_fullname: findlib_name list option;
+ obj_findlib_directory: unix_dirname 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 (* TODO: source filename. *)
+ | DocText
+ | PDF
+ | PostScript
+ | Info of unix_filename (* TODO: source 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; (* TODO: dest filename ?. *)
+ doc_title: string;
+ doc_authors: string list;
+ doc_abstract: string option;
+ doc_format: doc_format;
+ (* TODO: src filename. *)
+ 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; (* TODO: source filename. *)
+ copyrights: string list;
+ maintainers: string list;
+ authors: string list;
+ homepage: url option;
+ bugreports: url option;
+ synopsis: string;
+ description: OASISText.t option;
+ tags: string list;
+ 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; (* TODO: source filename. *)
+ sections: section list;
+ plugins: [`Extra] plugin list;
+ disable_oasis_section: unix_filename list; (* TODO: source filename. *)
+ 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 =
{
- 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;
+ oasis_version: OASISVersion.t;
+ plugin_versions: OASISVersion.t option MapPlugin.t;
+ alpha_features: string list;
+ beta_features: string list;
}
-
- type library =
+ let create oasis_version alpha_features beta_features =
{
- 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;
- }
+ 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: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: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:t).name features in
+ if not has_feature then
+ match (origin: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
- type object_ =
- {
- obj_modules: string list;
- obj_findlib_fullname: findlib_name list option;
- }
+ | NoOrigin, None, SinceVersion min_version ->
+ version_is_good ~min_version data.Data.oasis_version "%s" no_message
- type executable =
- {
- exec_custom: bool;
- exec_main_is: unix_filename;
- }
+ | 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
- 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;
- }
+ let data_assert t data origin =
+ match data_check t data origin with
+ | None -> ()
+ | Some str -> failwith str
- 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
-
+ let data_test t data =
+ match data_check t data NoOrigin with
+ | None -> true
+ | Some _ -> false
- 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
-
+ let package_test t pkg =
+ data_test t (Data.of_package pkg)
- type section_kind =
- [ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ]
- type package =
+ let create ?plugin name publication description =
+ let () =
+ if Hashtbl.mem all_features name then
+ failwithf "Feature '%s' is already declared." name
+ in
+ let t =
{
- 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;
- }
+ name = name;
+ plugin = plugin;
+ publication = publication;
+ description = description;
+ }
+ in
+ Hashtbl.add all_features name t;
+ t
-end
-module OASISUnixPath = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISUnixPath.ml"
+ let get_stage name =
+ try
+ (Hashtbl.find all_features name).publication
+ with Not_found ->
+ failwithf (f_ "Feature %s doesn't exist.") name
- type unix_filename = string
- type unix_dirname = string
- type host_filename = string
- type host_dirname = string
+ let list () =
+ Hashtbl.fold (fun _ v acc -> v :: acc) all_features []
- let current_dir_name = "."
+ (*
+ * Real flags.
+ *)
- let parent_dir_name = ".."
- let is_current_dir fn =
- fn = current_dir_name || fn = ""
+ let features =
+ create "features_fields"
+ (since_version "0.4")
+ (fun () ->
+ s_ "Enable to experiment not yet official features.")
- 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 flag_docs =
+ create "flag_docs"
+ (since_version "0.3")
+ (fun () ->
+ s_ "Make building docs require '-docs' flag at configure.")
- 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 flag_tests =
+ create "flag_tests"
+ (since_version "0.3")
+ (fun () ->
+ s_ "Make running tests require '-tests' flag at configure.")
- 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 pack =
+ create "pack"
+ (since_version "0.3")
+ (fun () ->
+ s_ "Allow to create packed library.")
- 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)
+ let section_object =
+ create "section_object" beta
+ (fun () ->
+ s_ "Implement an object section.")
-end
-module OASISHostPath = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISHostPath.ml"
+ let dynrun_for_release =
+ create "dynrun_for_release" alpha
+ (fun () ->
+ s_ "Make '-setup-update dynamic' suitable for releasing project.")
- open Filename
+ let compiled_setup_ml =
+ create "compiled_setup_ml" alpha
+ (fun () ->
+ s_ "Compile the setup.ml and speed-up actions done with it.")
- module Unix = OASISUnixPath
+ let disable_oasis_section =
+ create "disable_oasis_section" alpha
+ (fun () ->
+ s_ "Allow the OASIS section comments and digests to be omitted in \
+ generated files.")
- let make =
- function
- | [] ->
- invalid_arg "OASISHostPath.make"
- | hd :: tl ->
- List.fold_left Filename.concat hd tl
+ 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).")
- 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 '/'))
+ let findlib_directory =
+ create "findlib_directory" beta
+ (fun () ->
+ s_ "Allow to install findlib libraries in sub-directories of the target \
+ findlib directory.")
+ let findlib_extra_files =
+ create "findlib_extra_files" beta
+ (fun () ->
+ s_ "Allow to install extra files for findlib libraries.")
+ let source_patterns =
+ create "source_patterns" alpha
+ (fun () ->
+ s_ "Customize mapping between module name and source file.")
end
module OASISSection = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISSection.ml"
+(* # 22 "src/oasis/OASISSection.ml" *)
+
open OASISTypes
- let section_kind_common =
+
+ let section_kind_common =
function
- | Library (cs, _, _) ->
- `Library, cs
+ | Library (cs, _, _) ->
+ `Library, cs
| Object (cs, _, _) ->
- `Object, cs
+ `Object, cs
| Executable (cs, _, _) ->
- `Executable, cs
+ `Executable, cs
| Flag (cs, _) ->
- `Flag, cs
+ `Flag, cs
| SrcRepo (cs, _) ->
- `SrcRepo, cs
+ `SrcRepo, cs
| Test (cs, _) ->
- `Test, cs
+ `Test, cs
| Doc (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)
@@ -1354,42 +2200,47 @@ module OASISSection = struct
| Test (_, tst) -> Test (cs, tst)
| Doc (_, doc) -> Doc (cs, doc)
+
(** Key used to identify section
- *)
- let section_id sct =
- let k, cs =
+ *)
+ let section_id sct =
+ let k, cs =
section_kind_common sct
in
- k, cs.cs_name
+ k, cs.cs_name
+
+
+ let string_of_section_kind =
+ function
+ | `Library -> "library"
+ | `Object -> "object"
+ | `Executable -> "executable"
+ | `Flag -> "flag"
+ | `SrcRepo -> "src repository"
+ | `Test -> "test"
+ | `Doc -> "doc"
+
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 k, nm = section_id sct in
+ (string_of_section_kind k)^" "^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 =
+ let compare t1 t2 =
compare (id t1) (id t2)
-
+
let equal t1 t2 =
(id t1) = (id t2)
@@ -1397,177 +2248,187 @@ module OASISSection = struct
Hashtbl.hash (id t)
end
+
module MapSection = Map.Make(CSection)
module SetSection = Set.Make(CSection)
+
end
module OASISBuildSection = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISBuildSection.ml"
+(* # 22 "src/oasis/OASISBuildSection.ml" *)
+
+ open OASISTypes
+
+ (* Look for a module file, considering capitalization or not. *)
+ let find_module source_file_exists bs modul =
+ let possible_lst =
+ OASISSourcePatterns.all_possible_files
+ (bs.bs_interface_patterns @ bs.bs_implementation_patterns)
+ ~path:bs.bs_path
+ ~modul
+ in
+ match List.filter source_file_exists possible_lst with
+ | (fn :: _) as fn_lst -> `Sources (OASISUnixPath.chop_extension fn, fn_lst)
+ | [] ->
+ let open OASISUtils in
+ let _, rev_lst =
+ List.fold_left
+ (fun (set, acc) fn ->
+ let base_fn = OASISUnixPath.chop_extension fn in
+ if SetString.mem base_fn set then
+ set, acc
+ else
+ SetString.add base_fn set, base_fn :: acc)
+ (SetString.empty, []) possible_lst
+ in
+ `No_sources (List.rev rev_lst)
+
end
module OASISExecutable = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISExecutable.ml"
+(* # 22 "src/oasis/OASISExecutable.ml" *)
+
open OASISTypes
- let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program =
- let dir =
+
+ 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 =
+ 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 ())),
+ 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
- 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 "/home/gildor/programmation/oasis/src/oasis/OASISLibrary.ml"
+(* # 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 find_module ~ctxt source_file_exists cs bs modul =
+ match OASISBuildSection.find_module source_file_exists bs modul with
+ | `Sources _ as res -> res
+ | `No_sources _ as res ->
+ OASISMessage.warning
+ ~ctxt
+ (f_ "Cannot find source file matching module '%s' in library %s.")
+ modul cs.cs_name;
+ OASISMessage.warning
+ ~ctxt
+ (f_ "Use InterfacePatterns or ImplementationPatterns to define \
+ this file with feature %S.")
+ (OASISFeatures.source_patterns.OASISFeatures.name);
+ res
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)
+ match find_module ~ctxt source_file_exists cs bs modul with
+ | `Sources (base_fn, lst) -> (base_fn, lst) :: acc
+ | `No_sources _ -> 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 =
+ ~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, _) ->
- [base_fn]
- | `No_sources lst ->
- OASISMessage.warning
- ~ctxt
- (f_ "Cannot find source file matching \
- module '%s' in library %s")
- modul cs.cs_name;
- lst
+ match find_module ~ctxt source_file_exists cs bs modul with
+ | `Sources (_, [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 -> Some 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
+ 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)
[]
- else
- find_modules
- lib.lib_modules
- "cmi"
+ lst
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
+ | Native -> true
+ | Best -> is_native
+ | Byte -> false
in
- if should_be_built then
+ if should_be_built then
+ if lib.lib_pack then
find_modules
- (lib.lib_modules @ lib.lib_internal_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
+ (List.fold_left
+ (fun accu s ->
+ let dot = String.rindex s '.' in
+ let base = String.sub s 0 dot in
+ List.map ((^) base) sufx @ accu)
+ [])
+ (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"] :: acc
+ [cs.cs_name^".cmi"; cs.cs_name^".cmti"; cs.cs_name^".cmt"] :: acc
else
acc
in
@@ -1575,143 +2436,151 @@ module OASISLibrary = struct
add_pack_header ([cs.cs_name^".cma"] :: acc)
in
let native acc =
- let 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
+ [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
+ 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]
- ::
+ if bs.bs_c_sources <> [] then begin
+ ["lib"^cs.cs_name^"_stubs"^ext_lib]
+ ::
+ if has_native_dynlink then
+ ["dll"^cs.cs_name^"_stubs"^ext_dll] :: acc_nopath
+ else
acc_nopath
- end
- else
+ end else begin
acc_nopath
+ end
in
- (* All the files generated *)
- List.rev_append
- (List.rev_map
- (List.rev_map
- (OASISUnixPath.concat bs.bs_path))
- acc_nopath)
- (headers @ cmxs)
+ (* 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
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISObject.ml"
+(* # 22 "src/oasis/OASISObject.ml" *)
+
open OASISTypes
open OASISGettext
+
+ let find_module ~ctxt source_file_exists cs bs modul =
+ match OASISBuildSection.find_module source_file_exists bs modul with
+ | `Sources _ as res -> res
+ | `No_sources _ as res ->
+ OASISMessage.warning
+ ~ctxt
+ (f_ "Cannot find source file matching module '%s' in object %s.")
+ modul cs.cs_name;
+ OASISMessage.warning
+ ~ctxt
+ (f_ "Use InterfacePatterns or ImplementationPatterns to define \
+ this file with feature %S.")
+ (OASISFeatures.source_patterns.OASISFeatures.name);
+ res
+
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)
+ match find_module ~ctxt source_file_exists cs bs modul with
+ | `Sources (base_fn, lst) -> (base_fn, lst) :: acc
+ | `No_sources _ -> acc)
[]
obj.obj_modules
let generated_unix_files
- ~ctxt
- ~is_native
- ~source_file_exists
- (cs, bs, obj) =
+ ~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
+ match find_module ~ctxt source_file_exists cs bs modul with
+ | `Sources (base_fn, _) -> [base_fn ^ ext]
+ | `No_sources lst -> 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)
+ 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)
+ [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 :: [])
+ 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
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISFindlib.ml"
+(* # 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_] *
+ unix_dirname option *
group_t list)
+
type data = common_section *
- build_section *
- [`Library of library | `Object of object_]
+ 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 =
@@ -1724,53 +2593,53 @@ module OASISFindlib = struct
let name =
String.concat "." (lib.lib_findlib_containers @ [name])
in
- name
+ 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
+ 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
- obj_name
- (`Solved findlib_full_name)
+ lib_name
+ (`Solved fndlb_parts)
mp
- end
+ end
- | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ ->
- mp)
- MapString.empty
- pkg.sections
+ | 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. *)
@@ -1780,42 +2649,42 @@ module OASISFindlib = struct
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
+ 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
+ (* Solved initialy, no need to go further *)
+ mp
| `Unsolved _ ->
- let _, mp = solve SetString.empty mp lib_name "<none>" in
- mp)
+ 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
+ MapString.map
+ (function
+ | `Solved fndlb_nm -> fndlb_nm
+ | `Unsolved _ -> assert false)
+ mp
in
(* Convert an internal library name to a findlib name. *)
@@ -1827,75 +2696,89 @@ module OASISFindlib = struct
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
+ findlib_name_of_library_name lib_name
in
- let rec add_children nm_lst (children : tree MapString.t) =
+ 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
+ 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
+ (* 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)
+ 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
+ (* 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 (Some data, add_children tl MapString.empty)
| Node (data_opt, children) ->
- Node (data_opt, add_children tl children)
+ Node (data_opt, add_children tl children)
end
and new_node =
function
| [] ->
- Leaf sct
+ Leaf sct
| hd :: tl ->
- Node (None, MapString.add hd (new_node tl) MapString.empty)
+ Node (None, MapString.add hd (new_node tl) MapString.empty)
+ in
+ add_children (OASISString.nsplit fndlb_fullname '.') mp
+ in
+
+ let unix_directory dn lib =
+ let directory =
+ match lib with
+ | `Library lib -> lib.lib_findlib_directory
+ | `Object obj -> obj.obj_findlib_directory
in
- add_children (OASISString.nsplit fndlb_fullname '.') mp
+ match dn, directory with
+ | None, None -> None
+ | None, Some dn | Some dn, None -> Some dn
+ | Some dn1, Some dn2 -> Some (OASISUnixPath.concat dn1 dn2)
in
- let rec group_of_tree mp =
+ let rec group_of_tree dn 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, [])
+ | Node (Some (cs, bs, lib), children) ->
+ let current_dn = unix_directory dn lib in
+ Package (nm, cs, bs, lib, current_dn, group_of_tree current_dn children)
+ | Node (None, children) ->
+ Container (nm, group_of_tree dn children)
+ | Leaf (cs, bs, lib) ->
+ let current_dn = unix_directory dn lib in
+ Package (nm, cs, bs, lib, current_dn, [])
in
- cur :: acc)
+ cur :: acc)
mp []
in
@@ -1904,27 +2787,25 @@ module OASISFindlib = struct
(fun mp ->
function
| Library (cs, bs, lib) ->
- add (cs, bs, `Library lib) mp
+ add (cs, bs, `Library lib) mp
| Object (cs, bs, obj) ->
- add (cs, bs, `Object obj) mp
+ add (cs, bs, `Object obj) mp
| _ ->
- mp)
+ mp)
MapString.empty
pkg.sections
in
- let groups =
- group_of_tree group_mp
- in
+ let groups = group_of_tree None 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)
+ 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
@@ -1933,76 +2814,86 @@ module OASISFindlib = struct
raise (FindlibPackageNotFound fndlb_nm)
in
- groups,
- findlib_name_of_library_name,
- library_name_of_findlib_name
+ groups,
+ findlib_name_of_library_name,
+ library_name_of_findlib_name
+
let findlib_of_group =
function
| Container (fndlb_nm, _)
- | Package (fndlb_nm, _, _, _, _) -> 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)
+ 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)
+ 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 "/home/gildor/programmation/oasis/src/oasis/OASISFlag.ml"
+(* # 22 "src/oasis/OASISFlag.ml" *)
+
end
module OASISPackage = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISPackage.ml"
+(* # 22 "src/oasis/OASISPackage.ml" *)
+
end
module OASISSourceRepository = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISSourceRepository.ml"
+(* # 22 "src/oasis/OASISSourceRepository.ml" *)
+
end
module OASISTest = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISTest.ml"
+(* # 22 "src/oasis/OASISTest.ml" *)
+
end
module OASISDocument = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISDocument.ml"
+(* # 22 "src/oasis/OASISDocument.ml" *)
+
end
module OASISExec = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISExec.ml"
+(* # 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
@@ -2020,74 +2911,79 @@ module OASISExec = struct
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
+ 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
+ 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
- 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
+ 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
+ fst
| lst ->
- failwithf
- (f_ "Command return unexpected output %S")
- (String.concat "\n" lst)
+ failwithf
+ (f_ "Command return unexpected output %S")
+ (String.concat "\n" lst)
end
module OASISFileUtil = struct
-# 21 "/home/gildor/programmation/oasis/src/oasis/OASISFileUtil.ml"
+(* # 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))
+ if Sys.file_exists dirname then
+ if basename = Filename.current_dir_name then
+ true
else
- false
+ List.mem
+ basename
+ (Array.to_list (Sys.readdir dirname))
+ else
+ false
+
let find_file ?(case_sensitive=true) paths exts =
@@ -2097,7 +2993,7 @@ module OASISFileUtil = struct
(List.map
(fun a ->
List.map
- (fun b -> a,b)
+ (fun b -> a, b)
lst2)
lst1)
in
@@ -2105,312 +3001,318 @@ module OASISFileUtil = struct
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)
+ let acc =
+ (List.map
+ (fun (a, b) -> Filename.concat a b)
+ (p1 * p2))
+ in
+ combined_paths (acc :: tl)
| [e] ->
- e
+ e
| [] ->
- []
+ []
in
let alternatives =
List.map
- (fun (p,e) ->
+ (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
+ 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)
+ "" :: (OASISString.nsplit (Sys.getenv "PATHEXT") path_sep)
| _ ->
- [""]
+ [""]
in
- find_file ~case_sensitive:false [path_lst; [prg]] exec_ext
+ 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
+ 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
+ "xcopy" [q src; q tgt; "/E"]
| _ ->
- OASISExec.run ~ctxt
- "cp" ["-r"; q src; q tgt]
+ OASISExec.run ~ctxt
+ "cp" ["-r"; q src; q tgt]
else
OASISExec.run ~ctxt
(match Sys.os_type with
- | "Win32" -> "copy"
- | _ -> "cp")
+ | "Win32" -> "copy"
+ | _ -> "cp")
[q src; q tgt]
+
let mkdir ~ctxt tgt =
OASISExec.run ~ctxt
(match Sys.os_type with
- | "Win32" -> "md"
- | _ -> "mkdir")
+ | "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
+ if Sys.file_exists tgt then
begin
- match Sys.os_type with
- | "Win32" ->
- OASISExec.run ~ctxt "rd" [q tgt]
- | _ ->
- OASISExec.run ~ctxt "rm" ["-r"; q tgt]
+ 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
+ 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
-# 2251 "setup.ml"
+# 3159 "setup.ml"
module BaseEnvLight = struct
-# 21 "/home/gildor/programmation/oasis/src/base/BaseEnvLight.ml"
+(* # 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
+ let default_filename = Filename.concat (Sys.getcwd ()) "setup.data"
+
+
+ let load ?(allow_empty=false) ?(filename=default_filename) ?stream () =
+ let line = ref 1 in
+ let lexer st =
+ 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
+ Genlex.make_lexer ["="] st_line
+ in
+ let rec read_file lxr mp =
+ match Stream.npeek 3 lxr with
+ | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
+ Stream.junk lxr; Stream.junk lxr; Stream.junk lxr;
+ read_file lxr (MapString.add nm value mp)
+ | [] -> mp
+ | _ ->
+ failwith
+ (Printf.sprintf "Malformed data file '%s' line %d" filename !line)
+ in
+ match stream with
+ | Some st -> read_file (lexer st) MapString.empty
+ | None ->
+ if Sys.file_exists filename then begin
+ let chn = open_in_bin filename in
+ let st = Stream.of_channel chn in
+ try
+ let mp = read_file (lexer st) MapString.empty in
+ close_in chn; mp
+ with e ->
+ close_in chn; raise e
+ end else if allow_empty then begin
MapString.empty
- end
- else
- begin
+ 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
+ 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
-# 2349 "setup.ml"
+# 3239 "setup.ml"
module BaseContext = struct
-# 21 "/home/gildor/programmation/oasis/src/base/BaseContext.ml"
+(* # 22 "src/base/BaseContext.ml" *)
+ (* TODO: get rid of this module. *)
open OASISContext
- let args = args
+
+ let args () = fst (fspecs ())
+
let default = default
end
module BaseMessage = struct
-# 21 "/home/gildor/programmation/oasis/src/base/BaseMessage.ml"
+(* # 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
-# 21 "/home/gildor/programmation/oasis/src/base/BaseEnv.ml"
+(* # 22 "src/base/BaseEnv.ml" *)
open OASISGettext
open OASISUtils
+ open OASISContext
open PropList
+
module MapString = BaseEnvLight.MapString
+
type origin_t =
| ODefault
| OGetEnv
| OFileLoad
| OCommandLine
+
type cli_handle_t =
| CLINone
| CLIAuto
@@ -2418,79 +3320,82 @@ module BaseEnv = struct
| 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;
- }
+ {
+ hide: bool;
+ dump: bool;
+ cli: cli_handle_t;
+ arg_help: string option;
+ group: string option;
+ }
+
+
+ let schema = Schema.create "environment"
- let schema =
- Schema.create "environment"
(* Environment data *)
- let env =
- Data.create ()
+ let env = Data.create ()
+
(* Environment data from file *)
- let env_from_file =
- ref MapString.empty
+ let env_from_file = ref MapString.empty
+
(* Lexer for var *)
- let var_lxr =
- Genlex.make_lexer []
+ 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
+ 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 =
@@ -2504,7 +3409,8 @@ module BaseEnv = struct
raise e
end
in
- var_expand vl
+ var_expand vl
+
let var_choose ?printer ?name lst =
OASISExpr.choose
@@ -2513,27 +3419,29 @@ module BaseEnv = struct
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
+ 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 =
+ ?(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 =
[
@@ -2554,22 +3462,22 @@ module BaseEnv = struct
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) ->
+ (fun (errors, res) (_, v) ->
if res = None then
begin
try
errors, Some (v ())
with
| Not_found ->
- errors, res
+ errors, res
| Failure rsn ->
- (rsn :: errors), res
+ (rsn :: errors), res
| e ->
- (Printexc.to_string e) :: errors, res
+ (Printexc.to_string e) :: errors, res
end
else
errors, res)
@@ -2579,13 +3487,13 @@ module BaseEnv = struct
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)))
+ 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 =
@@ -2601,23 +3509,24 @@ module BaseEnv = struct
~parse:(fun ?(context=ODefault) s -> [context, fun () -> s])
~print:var_get_low
~default
- ~update:(fun ?context x old_x -> x @ old_x)
+ ~update:(fun ?context:_ x old_x -> x @ old_x)
?help
extra
in
- fun () ->
- var_expand (var_get_low (var_get_lst env))
+ fun () ->
+ var_expand (var_get_low (var_get_lst env))
+
let var_redefine
- ?hide
- ?dump
- ?short_desc
- ?cli
- ?arg_help
- ?group
- name
- dflt =
+ ?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 () *)
@@ -2637,8 +3546,9 @@ module BaseEnv = struct
dflt
end
- let var_ignore (e : unit -> string) =
- ()
+
+ let var_ignore (_: unit -> string) = ()
+
let print_hidden =
var_define
@@ -2649,6 +3559,7 @@ module BaseEnv = struct
"print_hidden"
(fun () -> "false")
+
let var_all () =
List.rev
(Schema.fold
@@ -2660,49 +3571,68 @@ module BaseEnv = struct
[]
schema)
- let default_filename =
- BaseEnvLight.default_filename
- let load ?allow_empty ?filename () =
- env_from_file := BaseEnvLight.load ?allow_empty ?filename ()
+ let default_filename = in_srcdir "setup.data"
+
+
+ let load ~ctxt ?(allow_empty=false) ?(filename=default_filename) () =
+ let open OASISFileSystem in
+ env_from_file :=
+ let repr_filename = ctxt.srcfs#string_of_filename filename in
+ if ctxt.srcfs#file_exists filename then begin
+ let buf = Buffer.create 13 in
+ defer_close
+ (ctxt.srcfs#open_in ~mode:binary_in filename)
+ (read_all buf);
+ defer_close
+ (ctxt.srcfs#open_in ~mode:binary_in filename)
+ (fun rdr ->
+ OASISMessage.info ~ctxt "Loading environment from %S." repr_filename;
+ BaseEnvLight.load ~allow_empty
+ ~filename:(repr_filename)
+ ~stream:(stream_of_reader rdr)
+ ())
+ end else if allow_empty then begin
+ BaseEnvLight.MapString.empty
+ end else begin
+ failwith
+ (Printf.sprintf
+ (f_ "Unable to load environment, the file '%s' doesn't exist.")
+ repr_filename)
+ end
+
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 dump ~ctxt ?(filename=default_filename) () =
+ let open OASISFileSystem in
+ defer_close
+ (ctxt.OASISContext.srcfs#open_out ~mode:binary_out filename)
+ (fun wrtr ->
+ let buf = Buffer.create 63 in
+ let output nm value =
+ Buffer.add_string buf (Printf.sprintf "%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
+ output nm (Schema.get schema env nm)
+ 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;
+ wrtr#output buf)
let print () =
let printable_vars =
@@ -2711,20 +3641,15 @@ module BaseEnv = struct
if not def.hide || bool_of_string (print_hidden ()) then
begin
try
- let value =
- Schema.get
- schema
- env
- nm
- in
+ let value = Schema.get schema env nm in
let txt =
match short_descr_opt with
| Some s -> s ()
| None -> nm
in
- (txt, value) :: acc
+ (txt, value) :: acc
with Not_set _ ->
- acc
+ acc
end
else
acc)
@@ -2736,162 +3661,166 @@ module BaseEnv = struct
(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";
+ 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)
+ (fun (name, value) ->
+ Printf.printf "%s: %s" name (dot_pad name);
+ if value = "" then
+ Printf.printf "\n"
+ else
+ Printf.printf " %s\n" 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.";
+ 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
+ (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 arg_name =
+ OASISUtils.varname_of_string ~hyphen:'-' name
+ in
- let hlp =
- match short_descr_opt with
- | Some txt -> txt ()
- | None -> ""
- 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 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 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)
+ 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 "/home/gildor/programmation/oasis/src/base/BaseArgExt.ml"
+(* # 22 "src/base/BaseArgExt.ml" *)
+
open OASISUtils
open OASISGettext
+
let parse argv args =
- (* Simulate command line for Arg *)
- let current =
- ref 0
- in
+ (* 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
+ 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 "/home/gildor/programmation/oasis/src/base/BaseCheck.ml"
+(* # 22 "src/base/BaseCheck.ml" *)
+
open BaseEnv
open BaseMessage
open OASISUtils
open OASISGettext
+
let prog_best prg prg_lst =
var_redefine
prg
@@ -2901,74 +3830,80 @@ module BaseCheck = struct
(fun res e ->
match res with
| Some _ ->
- res
+ res
| None ->
- try
- Some (OASISFileUtil.which ~ctxt:!BaseContext.default e)
- with Not_found ->
- 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)
+ 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
- () =
+ 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)
- ()
+ 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
@@ -2981,13 +3916,13 @@ module BaseCheck = struct
(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
+ 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
@@ -2995,80 +3930,83 @@ module BaseCheck = struct
(fun () -> findlib_dir pkg)
()
in
- (
- match version_comparator with
- | Some ver_cmp ->
- ignore
- (version
- var
- ver_cmp
- (fun _ -> package_version pkg)
- ())
- | None ->
- ()
- );
- vl
+ (
+ match version_comparator with
+ | Some ver_cmp ->
+ ignore
+ (version
+ var
+ ver_cmp
+ (fun _ -> package_version pkg)
+ ())
+ | None ->
+ ()
+ );
+ vl
end
module BaseOCamlcConfig = struct
-# 21 "/home/gildor/programmation/oasis/src/base/BaseOCamlcConfig.ml"
+(* # 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 ->
+ 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
)
- in
- split_field mp tl
+ with Not_found ->
+ (
+ mp
+ )
+ in
+ split_field mp tl
| [] ->
- mp
+ mp
in
- let cache =
+ let cache =
lazy
(var_protect
(Marshal.to_string
@@ -3079,13 +4017,14 @@ module BaseOCamlcConfig = struct
(ocamlc ()) ["-config"]))
[]))
in
- var_redefine
- "ocamlc_config_map"
- ~hide:true
- ~dump:false
- (fun () ->
- (* TODO: update if ocamlc change !!! *)
- Lazy.force cache)
+ 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 *)
@@ -3095,47 +4034,47 @@ module BaseOCamlcConfig = struct
0
in
let chop_version_suffix s =
- try
+ try
String.sub s 0 (String.index s '+')
- with _ ->
+ with _ ->
s
- in
+ in
let nm_config, value_config =
match nm with
- | "ocaml_version" ->
- "version", chop_version_suffix
+ | "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 ()))
+ 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 "/home/gildor/programmation/oasis/src/base/BaseStandardVar.ml"
+(* # 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"
@@ -3146,32 +4085,38 @@ module BaseStandardVar = struct
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 :=
+ var_cond :=
(fun ver ->
if OASISVersion.comparator_apply ver since_version then
holder := f ()) :: !var_cond;
- fun () -> !holder ()
+ 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")
@@ -3179,16 +4124,20 @@ module BaseStandardVar = struct
(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"
@@ -3202,23 +4151,26 @@ module BaseStandardVar = struct
let default_executable_name = c "default_executable_name"
let systhread_supported = c "systhread_supported"
- let flexlink =
+
+ let flexlink =
BaseCheck.prog "flexlink"
+
let flexdll_version =
var_define
~short_desc:(fun () -> "FlexDLL version (Win32)")
"flexdll_version"
(fun () ->
- let lst =
+ 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)
+ match lst with
+ | line :: _ ->
+ Scanf.sscanf line "FlexDLL version %s" (fun ver -> ver)
+ | [] ->
+ raise Not_found)
+
(**/**)
let p name hlp dflt =
@@ -3229,119 +4181,140 @@ module BaseStandardVar = struct
name
dflt
+
let (/) a b =
if os_type () = Sys.os_type then
Filename.concat a b
- else if os_type () = "Unix" then
+ else if os_type () = "Unix" || os_type () = "Cygwin" 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 ())
+ let program_files =
+ Sys.getenv "PROGRAMFILES"
+ in
+ program_files/(pkg_name ())
| _ ->
- "/usr/local")
+ "/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")
@@ -3351,35 +4324,39 @@ module BaseStandardVar = struct
("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 =
+ let _s: string =
ocamlopt ()
in
- "true"
+ "true"
with PropList.Not_set _ ->
- let _s : string =
+ let _s: string =
ocamlc ()
in
- "false")
+ "false")
+
let ext_program =
var_define
"suffix_program"
(fun () ->
match os_type () with
- | "Win32" -> ".exe"
+ | "Win32" | "Cygwin" -> ".exe"
| _ -> "")
+
let rm =
var_define
~short_desc:(fun () -> s_ "Remove a file.")
@@ -3389,6 +4366,7 @@ module BaseStandardVar = struct
| "Win32" -> "del"
| _ -> "rm -f")
+
let rmdir =
var_define
~short_desc:(fun () -> s_ "Remove a directory.")
@@ -3398,6 +4376,7 @@ module BaseStandardVar = struct
| "Win32" -> "rd"
| _ -> "rm -rf")
+
let debug =
var_define
~short_desc:(fun () -> s_ "Turn ocaml debug flag on")
@@ -3405,6 +4384,7 @@ module BaseStandardVar = struct
"debug"
(fun () -> "true")
+
let profile =
var_define
~short_desc:(fun () -> s_ "Turn ocaml profile flag on")
@@ -3412,17 +4392,19 @@ module BaseStandardVar = struct
"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")
+ 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 () ->
@@ -3433,6 +4415,7 @@ module BaseStandardVar = struct
(fun () -> "true"))
"true"
+
let native_dynlink =
var_define
~short_desc:(fun () -> s_ "Compiler support generation of .cmxs.")
@@ -3440,7 +4423,7 @@ module BaseStandardVar = struct
"native_dynlink"
(fun () ->
let res =
- let ocaml_lt_312 () =
+ let ocaml_lt_312 () =
OASISVersion.comparator_apply
(OASISVersion.version_of_string (ocaml_version ()))
(OASISVersion.VLesser
@@ -3452,37 +4435,38 @@ module BaseStandardVar = struct
(OASISVersion.VLesser
(OASISVersion.version_of_string "0.30"))
in
- let has_native_dynlink =
+ 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
+ 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
- else if ocaml_lt_312 () then
+ 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
- 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
+ end
+ else
+ true
in
- string_of_bool res)
+ string_of_bool res)
+
let init pkg =
rpkg := Some pkg;
@@ -3491,180 +4475,140 @@ module BaseStandardVar = struct
end
module BaseFileAB = struct
-# 21 "/home/gildor/programmation/oasis/src/base/BaseFileAB.ml"
+(* # 22 "src/base/BaseFileAB.ml" *)
+
open BaseEnv
open OASISGettext
open BaseMessage
+ open OASISContext
+
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
+ if not (Filename.check_suffix fn ".ab") then
+ warning (f_ "File '%s' doesn't have '.ab' extension") fn;
+ OASISFileSystem.of_unix_filename (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
+
+ let replace ~ctxt fn_lst =
+ let open OASISFileSystem in
+ let ibuf, obuf = Buffer.create 13, Buffer.create 13 in
+ List.iter
+ (fun fn ->
+ Buffer.clear ibuf; Buffer.clear obuf;
+ defer_close
+ (ctxt.srcfs#open_in (of_unix_filename fn))
+ (read_all ibuf);
+ Buffer.add_string obuf (var_expand (Buffer.contents ibuf));
+ defer_close
+ (ctxt.srcfs#open_out (to_filename fn))
+ (fun wrtr -> wrtr#output obuf))
+ fn_lst
end
module BaseLog = struct
-# 21 "/home/gildor/programmation/oasis/src/base/BaseLog.ml"
+(* # 22 "src/base/BaseLog.ml" *)
+
open OASISUtils
+ open OASISContext
+ open OASISGettext
+ open OASISFileSystem
- 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 default_filename = in_srcdir "setup.log"
- 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
+ let load ~ctxt () =
+ let 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)
in
- Printf.fprintf chn_out "%S %S\n" event data;
- close_out chn_out
+ if ctxt.srcfs#file_exists default_filename then begin
+ defer_close
+ (ctxt.srcfs#open_in default_filename)
+ (fun rdr ->
+ let line = ref 1 in
+ let lxr = Genlex.make_lexer [] (stream_of_reader rdr) in
+ let rec read_aux (st, lst) =
+ match Stream.npeek 2 lxr with
+ | [Genlex.String e; Genlex.String d] ->
+ let t = e, d in
+ Stream.junk lxr; Stream.junk lxr;
+ if SetTupleString.mem t st then
+ read_aux (st, lst)
+ else
+ read_aux (SetTupleString.add t st, t :: lst)
+ | [] -> List.rev lst
+ | _ ->
+ failwithf
+ (f_ "Malformed log file '%s' at line %d")
+ (ctxt.srcfs#string_of_filename default_filename)
+ !line
+ in
+ read_aux (SetTupleString.empty, []))
+ end else begin
+ []
+ end
- 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 register ~ctxt event data =
+ defer_close
+ (ctxt.srcfs#open_out
+ ~mode:[Open_append; Open_creat; Open_text]
+ ~perm:0o644
+ default_filename)
+ (fun wrtr ->
+ let buf = Buffer.create 13 in
+ Printf.bprintf buf "%S %S\n" event data;
+ wrtr#output buf)
+
- let exists event data =
+ let unregister ~ctxt event data =
+ let lst = load ~ctxt () in
+ let buf = Buffer.create 13 in
+ List.iter
+ (fun (e, d) ->
+ if e <> event || d <> data then
+ Printf.bprintf buf "%S %S\n" e d)
+ lst;
+ if Buffer.length buf > 0 then
+ defer_close
+ (ctxt.srcfs#open_out default_filename)
+ (fun wrtr -> wrtr#output buf)
+ else
+ ctxt.srcfs#remove default_filename
+
+
+ let filter ~ctxt events =
+ let st_events = SetString.of_list events in
+ List.filter
+ (fun (e, _) -> SetString.mem e st_events)
+ (load ~ctxt ())
+
+
+ let exists ~ctxt event data =
List.exists
(fun v -> (event, data) = v)
- (load ())
+ (load ~ctxt ())
end
module BaseBuilt = struct
-# 21 "/home/gildor/programmation/oasis/src/base/BaseBuilt.ml"
+(* # 22 "src/base/BaseBuilt.ml" *)
+
open OASISTypes
open OASISGettext
open BaseStandardVar
open BaseMessage
+
type t =
| BExec (* Executable *)
| BExecLib (* Library coming with executable *)
@@ -3672,97 +4616,85 @@ module BaseBuilt = struct
| 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
+ (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";
+
+ let register ~ctxt t nm lst =
+ BaseLog.register ~ctxt (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)
+ if OASISFileUtil.file_exists_case fn then begin
+ BaseLog.register ~ctxt
+ (to_log_event_file t nm)
+ (if Filename.is_relative fn then
+ Filename.concat (Sys.getcwd ()) fn
+ else
+ fn);
+ true
+ end else begin
+ registered
+ end)
false
alt
in
- if not registered then
- warning
- (f_ "Cannot find an existing alternative files among: %s")
- (String.concat (s_ ", ") alt))
+ if not registered then
+ warning
+ (f_ "Cannot find an existing alternative files among: %s")
+ (String.concat (s_ ", ") alt))
lst
- let unregister t nm =
+
+ let unregister ~ctxt 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])
+ (fun (e, d) -> BaseLog.unregister ~ctxt e d)
+ (BaseLog.filter ~ctxt [to_log_event_file t nm; to_log_event_done t nm])
+
- let fold t nm f acc =
+ let fold ~ctxt 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 \
+ 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)
+ 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])
+ (BaseLog.filter ~ctxt [to_log_event_file t nm])
- let is_built t nm =
+
+ let is_built ~ctxt t nm =
List.fold_left
- (fun is_built (_, d) ->
- (try
- bool_of_string d
- with _ ->
- false))
+ (fun _ (_, d) -> try bool_of_string d with _ -> false)
false
- (BaseLog.filter
- [to_log_event_done t nm])
+ (BaseLog.filter ~ctxt [to_log_event_done t nm])
+
let of_executable ffn (cs, bs, exec) =
let unix_exec_is, unix_dll_opt =
@@ -3777,22 +4709,23 @@ module BaseBuilt = struct
let evs =
(BExec, cs.cs_name, [[ffn unix_exec_is]])
::
- (match unix_dll_opt with
- | Some fn ->
- [BExecLib, cs.cs_name, [[ffn fn]]]
- | None ->
- [])
+ (match unix_dll_opt with
+ | Some fn ->
+ [BExecLib, cs.cs_name, [[ffn fn]]]
+ | None ->
+ [])
in
- evs,
- unix_exec_is,
- unix_dll_opt
+ 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))
+ 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 ())
@@ -3804,7 +4737,7 @@ module BaseBuilt = struct
cs.cs_name,
List.map (List.map ffn) unix_lst]
in
- evs, unix_lst
+ evs, unix_lst
let of_object ffn (cs, bs, obj) =
@@ -3812,7 +4745,7 @@ module BaseBuilt = struct
OASISObject.generated_unix_files
~ctxt:!BaseContext.default
~source_file_exists:(fun fn ->
- OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
+ OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
~is_native:(bool_of_string (is_native ()))
(cs, bs, obj)
in
@@ -3821,18 +4754,20 @@ module BaseBuilt = struct
cs.cs_name,
List.map (List.map ffn) unix_lst]
in
- evs, unix_lst
+ evs, unix_lst
end
module BaseCustom = struct
-# 21 "/home/gildor/programmation/oasis/src/base/BaseCustom.ml"
+(* # 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)
@@ -3840,43 +4775,44 @@ module BaseCustom = struct
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
+ 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
+ optional_command cstm.post_command;
+ res
end
module BaseDynVar = struct
-# 21 "/home/gildor/programmation/oasis/src/base/BaseDynVar.ml"
+(* # 22 "src/base/BaseDynVar.ml" *)
open OASISTypes
@@ -3884,96 +4820,91 @@ module BaseDynVar = struct
open BaseEnv
open BaseBuilt
- let init pkg =
+
+ let init ~ctxt 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 _ ->
- ())
+ | Executable (cs, bs, _) ->
+ 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 ~ctxt 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
-# 21 "/home/gildor/programmation/oasis/src/base/BaseTest.ml"
+(* # 22 "src/base/BaseTest.ml" *)
+
open BaseEnv
open BaseMessage
open OASISTypes
- open OASISExpr
open OASISGettext
- let test lst pkg extra_args =
+
+ let test ~ctxt 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
+ ~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 () = 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
+ 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 () -> ()
+ 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
+ try
+ let failure_percent =
+ BaseCustom.hook
+ test.test_custom
+ (test_plugin ~ctxt pkg (cs, test))
+ extra_args
+ in
+ back_cwd ();
+ (failure_percent +. failure, n + 1)
+ with e ->
+ begin
+ back_cwd ();
+ raise e
+ end
end
else
begin
@@ -3981,110 +4912,111 @@ module BaseTest = struct
(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 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'"
+ 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
-# 21 "/home/gildor/programmation/oasis/src/base/BaseDoc.ml"
+(* # 22 "src/base/BaseDoc.ml" *)
+
open BaseEnv
open BaseMessage
open OASISTypes
open OASISGettext
- let doc lst pkg extra_args =
+
+ let doc ~ctxt 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
+ ~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))
+ (doc_plugin ~ctxt 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'"
+ 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
-# 21 "/home/gildor/programmation/oasis/src/base/BaseSetup.ml"
+(* # 22 "src/base/BaseSetup.ml" *)
+ open OASISContext
open BaseEnv
open BaseMessage
open OASISTypes
- open OASISSection
open OASISGettext
open OASISUtils
+
type std_args_fun =
- package -> string array -> unit
+ ctxt:OASISContext.t -> package -> string array -> unit
+
type ('a, 'b) section_args_fun =
- name * (package -> (common_section * 'a) -> string array -> 'b)
+ name *
+ (ctxt:OASISContext.t ->
+ 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;
- }
+ {
+ 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 =
@@ -4093,12 +5025,13 @@ module BaseSetup = struct
(fun acc sct ->
match filter_map sct with
| Some e ->
- e :: acc
+ e :: acc
| None ->
- acc)
+ acc)
[]
lst)
+
(* Search for plugin data associated with a section name *)
let lookup_plugin_section plugin action nm lst =
try
@@ -4110,149 +5043,148 @@ module BaseSetup = struct
nm
action
- let configure t args =
+
+ let configure ~ctxt t args =
(* Run configure *)
BaseCustom.hook
t.package.conf_custom
- (fun () ->
+ (fun () ->
(* Reload if preconf has changed it *)
begin
try
unload ();
- load ();
+ load ~ctxt ();
with _ ->
()
end;
(* Run plugin's configure *)
- t.configure t.package args;
+ t.configure ~ctxt t.package args;
(* Dump to allow postconf to change it *)
- dump ())
+ dump ~ctxt ())
();
(* Reload environment *)
unload ();
- load ();
+ load ~ctxt ();
(* Save environment *)
print ();
(* Replace data in file *)
- BaseFileAB.replace t.package.files_ab
+ BaseFileAB.replace ~ctxt t.package.files_ab
+
- let build t args =
+ let build ~ctxt t args =
BaseCustom.hook
t.package.build_custom
- (t.build t.package)
+ (t.build ~ctxt t.package)
args
- let doc t args =
+
+ let doc ~ctxt t args =
BaseDoc.doc
+ ~ctxt
(join_plugin_sections
(function
- | Doc (cs, e) ->
- Some
- (lookup_plugin_section
- "documentation"
- (s_ "build")
- cs.cs_name
- t.doc,
- cs,
- e)
- | _ ->
- None)
+ | 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 =
+
+ let test ~ctxt t args =
BaseTest.test
+ ~ctxt
(join_plugin_sections
(function
- | Test (cs, e) ->
- Some
- (lookup_plugin_section
- "test"
- (s_ "run")
- cs.cs_name
- t.test,
- cs,
- e)
- | _ ->
- None)
+ | 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") ::
+
+ let all ~ctxt 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-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'"))
- "";
+ "-no-test",
+ Arg.Set rno_test,
+ s_ "Don't run test target";
- info "Running configure step";
- configure t [||];
+ "--",
+ 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 build step";
- build t [||];
+ info "Running configure step";
+ configure ~ctxt t (Array.of_list (List.rev !arg_rest));
- (* Load setup.log dynamic variables *)
- BaseDynVar.init t.package;
+ info "Running build step";
+ build ~ctxt t [||];
- if not !rno_doc then
- begin
- info "Running doc step";
- doc t [||];
- end
- else
- begin
- info "Skipping doc step"
- end;
+ (* Load setup.log dynamic variables *)
+ BaseDynVar.init ~ctxt t.package;
- if not !rno_test then
- begin
- info "Running test step";
- test t [||]
- end
- else
- begin
- info "Skipping test step"
- end
+ if not !rno_doc then begin
+ info "Running doc step";
+ doc ~ctxt t [||]
+ end else begin
+ info "Skipping doc step"
+ end;
+ if not !rno_test then begin
+ info "Running test step";
+ test ~ctxt 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 install ~ctxt t args =
+ BaseCustom.hook t.package.install_custom (t.install ~ctxt t.package) args
+
+
+ let uninstall ~ctxt t args =
+ BaseCustom.hook t.package.uninstall_custom (t.uninstall ~ctxt t.package) args
+
+
+ let reinstall ~ctxt t args =
+ uninstall ~ctxt t args;
+ install ~ctxt t args
- let reinstall t args =
- uninstall t args;
- install t args
let clean, distclean =
let failsafe f a =
@@ -4262,11 +5194,11 @@ module BaseSetup = struct
warning
(f_ "Action fail with error: %s")
(match e with
- | Failure msg -> msg
- | e -> Printexc.to_string e)
+ | Failure msg -> msg
+ | e -> Printexc.to_string e)
in
- let generic_clean t cstm mains docs tests args =
+ let generic_clean ~ctxt t cstm mains docs tests args =
BaseCustom.hook
~failsafe:true
cstm
@@ -4274,45 +5206,32 @@ module BaseSetup = struct
(* 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 _ ->
- ())
+ | Test (cs, test) ->
+ let f =
+ try
+ List.assoc cs.cs_name tests
+ with Not_found ->
+ fun ~ctxt:_ _ _ _ -> ()
+ in
+ failsafe (f ~ctxt t.package (cs, test)) args
+ | Doc (cs, doc) ->
+ let f =
+ try
+ List.assoc cs.cs_name docs
+ with Not_found ->
+ fun ~ctxt:_ _ _ _ -> ()
+ in
+ failsafe (f ~ctxt 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)
+ List.iter (fun f -> failsafe (f ~ctxt t.package) args) mains)
()
in
- let clean t args =
+ let clean ~ctxt t args =
generic_clean
+ ~ctxt
t
t.package.clean_custom
t.clean
@@ -4321,12 +5240,13 @@ module BaseSetup = struct
args
in
- let distclean t args =
+ let distclean ~ctxt t args =
(* Call clean *)
- clean t args;
+ clean ~ctxt t args;
(* Call distclean code *)
generic_clean
+ ~ctxt
t
t.package.distclean_custom
t.distclean
@@ -4334,38 +5254,39 @@ module BaseSetup = struct
t.distclean_test
args;
- (* Remove generated file *)
+ (* Remove generated source files. *)
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))
+ if ctxt.srcfs#file_exists fn then begin
+ info (f_ "Remove '%s'") (ctxt.srcfs#string_of_filename fn);
+ ctxt.srcfs#remove fn
+ end)
+ ([BaseEnv.default_filename; BaseLog.default_filename]
+ @ (List.rev_map BaseFileAB.to_filename t.package.files_ab))
in
- clean, distclean
+ clean, distclean
+
+
+ let version ~ctxt:_ (t: t) _ = print_endline t.oasis_version
- 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.")
+ b,
+ ("-no-update-setup-ml",
+ Arg.Clear b,
+ s_ " Don't try to update setup.ml, even if _oasis has changed.")
+
+ (* TODO: srcfs *)
+ let default_oasis_fn = "_oasis"
+
let update_setup_ml t =
let oasis_fn =
match t.oasis_fn with
| Some fn -> fn
- | None -> "_oasis"
+ | None -> default_oasis_fn
in
let oasis_exec =
match t.oasis_exec with
@@ -4378,16 +5299,16 @@ module BaseSetup = struct
let setup_ml, args =
match Array.to_list Sys.argv with
| setup_ml :: args ->
- setup_ml, args
+ setup_ml, args
| [] ->
- failwith
- (s_ "Expecting non-empty command line arguments.")
+ 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
@@ -4398,64 +5319,62 @@ module BaseSetup = struct
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)
+ (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
+ 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:
+ (fun n ->
+ if n <> 0 then
+ 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
@@ -4463,7 +5382,8 @@ module BaseSetup = struct
try
match t.oasis_digest with
| Some dgst ->
- if Sys.file_exists oasis_fn && dgst <> Digest.file "_oasis" then
+ if Sys.file_exists oasis_fn &&
+ dgst <> Digest.file default_oasis_fn then
begin
do_update ();
true
@@ -4471,7 +5391,7 @@ module BaseSetup = struct
else
false
| None ->
- false
+ false
with e ->
error
(f_ "Error when updating setup.ml. If you want to avoid this error, \
@@ -4483,157 +5403,290 @@ module BaseSetup = struct
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
+ let setup t =
+ let catch_exn = ref true in
+ let act_ref =
+ ref (fun ~ctxt:_ _ ->
+ failwithf
+ (f_ "No action defined, run '%s %s -help'")
+ Sys.executable_name
+ Sys.argv.(0))
- 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.";
- ]
- @
+ 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
+ try
+ let () =
+ 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");
+ @ (BaseContext.args ())))
+ (failwithf (f_ "Don't know what to do with '%s'"))
+ (s_ "Setup and run build process current package\n")
+ in
- (* Build initial environment *)
- load ~allow_empty:!allow_empty_env_ref ();
+ (* Instantiate the context. *)
+ let ctxt = !BaseContext.default in
- (** 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;
+ (* Build initial environment *)
+ load ~ctxt ~allow_empty:!allow_empty_env_ref ();
- BaseStandardVar.init t.package;
+ (** 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;
- BaseDynVar.init t.package;
+ BaseStandardVar.init t.package;
- if t.setup_update && update_setup_ml t then
- ()
- else
- !act_ref t (Array.of_list (List.rev !extra_args_ref))
+ BaseDynVar.init ~ctxt t.package;
- with e when !catch_exn ->
- error "%s" (Printexc.to_string e);
- exit 1
+ if not (t.setup_update && update_setup_ml t) then
+ !act_ref ~ctxt t (Array.of_list (List.rev !extra_args_ref))
+
+ with e when !catch_exn ->
+ error "%s" (Printexc.to_string e);
+ exit 1
+
+
+end
+
+module BaseCompat = struct
+(* # 22 "src/base/BaseCompat.ml" *)
+
+ (** Compatibility layer to provide a stable API inside setup.ml.
+ This layer allows OASIS to change in between minor versions
+ (e.g. 0.4.6 -> 0.4.7) but still provides a stable API inside setup.ml. This
+ enables to write functions that manipulate setup_t inside setup.ml. See
+ deps.ml for an example.
+
+ The module opened by default will depend on the version of the _oasis. E.g.
+ if we have "OASISFormat: 0.3", the module Compat_0_3 will be opened and
+ the function Compat_0_3 will be called. If setup.ml is generated with the
+ -nocompat, no module will be opened.
+
+ @author Sylvain Le Gall
+ *)
+
+ module Compat_0_4 =
+ struct
+ let rctxt = ref !BaseContext.default
+
+ module BaseSetup =
+ struct
+ module Original = BaseSetup
+
+ open OASISTypes
+
+ 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;
+ }
+
+ let setup t =
+ let mk_std_args_fun f =
+ fun ~ctxt pkg args -> rctxt := ctxt; f pkg args
+ in
+ let mk_section_args_fun l =
+ List.map
+ (fun (nm, f) ->
+ nm,
+ (fun ~ctxt pkg sct args ->
+ rctxt := ctxt;
+ f pkg sct args))
+ l
+ in
+ let t' =
+ {
+ Original.
+ configure = mk_std_args_fun t.configure;
+ build = mk_std_args_fun t.build;
+ doc = mk_section_args_fun t.doc;
+ test = mk_section_args_fun t.test;
+ install = mk_std_args_fun t.install;
+ uninstall = mk_std_args_fun t.uninstall;
+ clean = List.map mk_std_args_fun t.clean;
+ clean_doc = mk_section_args_fun t.clean_doc;
+ clean_test = mk_section_args_fun t.clean_test;
+ distclean = List.map mk_std_args_fun t.distclean;
+ distclean_doc = mk_section_args_fun t.distclean_doc;
+ distclean_test = mk_section_args_fun t.distclean_test;
+
+ package = t.package;
+ oasis_fn = t.oasis_fn;
+ oasis_version = t.oasis_version;
+ oasis_digest = t.oasis_digest;
+ oasis_exec = t.oasis_exec;
+ oasis_setup_args = t.oasis_setup_args;
+ setup_update = t.setup_update;
+ }
+ in
+ Original.setup t'
+
+ end
+
+ let adapt_setup_t setup_t =
+ let module O = BaseSetup.Original in
+ let mk_std_args_fun f = fun pkg args -> f ~ctxt:!rctxt pkg args in
+ let mk_section_args_fun l =
+ List.map
+ (fun (nm, f) -> nm, (fun pkg sct args -> f ~ctxt:!rctxt pkg sct args))
+ l
+ in
+ {
+ BaseSetup.
+ configure = mk_std_args_fun setup_t.O.configure;
+ build = mk_std_args_fun setup_t.O.build;
+ doc = mk_section_args_fun setup_t.O.doc;
+ test = mk_section_args_fun setup_t.O.test;
+ install = mk_std_args_fun setup_t.O.install;
+ uninstall = mk_std_args_fun setup_t.O.uninstall;
+ clean = List.map mk_std_args_fun setup_t.O.clean;
+ clean_doc = mk_section_args_fun setup_t.O.clean_doc;
+ clean_test = mk_section_args_fun setup_t.O.clean_test;
+ distclean = List.map mk_std_args_fun setup_t.O.distclean;
+ distclean_doc = mk_section_args_fun setup_t.O.distclean_doc;
+ distclean_test = mk_section_args_fun setup_t.O.distclean_test;
+
+ package = setup_t.O.package;
+ oasis_fn = setup_t.O.oasis_fn;
+ oasis_version = setup_t.O.oasis_version;
+ oasis_digest = setup_t.O.oasis_digest;
+ oasis_exec = setup_t.O.oasis_exec;
+ oasis_setup_args = setup_t.O.oasis_setup_args;
+ setup_update = setup_t.O.setup_update;
+ }
+ end
+
+
+ module Compat_0_3 =
+ struct
+ include Compat_0_4
+ end
end
-# 4611 "setup.ml"
+# 5662 "setup.ml"
module InternalConfigurePlugin = struct
-# 21 "/home/gildor/programmation/oasis/src/plugins/internal/InternalConfigurePlugin.ml"
+(* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *)
+
(** Configure using internal scheme
@author Sylvain Le Gall
- *)
+ *)
+
open BaseEnv
open OASISTypes
@@ -4641,24 +5694,14 @@ module InternalConfigurePlugin = struct
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
+ (** Configure build using provided series of check to be done
+ and then output corresponding file.
+ *)
+ let configure ~ctxt:_ 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
@@ -4677,29 +5720,29 @@ module InternalConfigurePlugin = struct
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)
+ | 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
@@ -4723,39 +5766,39 @@ module InternalConfigurePlugin = struct
(* 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)
+ | 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
@@ -4767,50 +5810,50 @@ module InternalConfigurePlugin = struct
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
+ 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
+ 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 (BaseStandardVar.ocaml_version ()))
(OASISVersion.version_of_string "4.0.0") >= 0 in
if ocaml_ge4 then
let findlib_lt132 =
@@ -4835,37 +5878,37 @@ module InternalConfigurePlugin = struct
(* 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
- | _ ->
- ())
+ | 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)
- *)
+ 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)
+ | 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
+ if has_cmxa then
+ var_ignore_eval BaseStandardVar.native_dynlink
end;
(* Check errors *)
@@ -4882,15 +5925,20 @@ module InternalConfigurePlugin = struct
(SetString.cardinal !errors)
end
+
end
module InternalInstallPlugin = struct
-# 21 "/home/gildor/programmation/oasis/src/plugins/internal/InternalInstallPlugin.ml"
+(* # 22 "src/plugins/internal/InternalInstallPlugin.ml" *)
+
(** Install using internal scheme
@author Sylvain Le Gall
*)
+
+ (* TODO: rewrite this module with OASISFileSystem. *)
+
open BaseEnv
open BaseStandardVar
open BaseMessage
@@ -4899,29 +5947,21 @@ module InternalInstallPlugin = struct
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 exec_hook = ref (fun (cs, bs, exec) -> cs, bs, exec)
+ let lib_hook = ref (fun (cs, bs, dn, lib) -> cs, bs, dn, lib, [])
+ let obj_hook = ref (fun (cs, bs, dn, obj) -> cs, bs, dn, obj, [])
+ let doc_hook = ref (fun (cs, doc) -> cs, doc)
- let install_dir_ev =
- "install-dir"
+ let install_file_ev = "install-file"
+ let install_dir_ev = "install-dir"
+ let install_findlib_ev = "install-findlib"
- let install_findlib_ev =
- "install-findlib"
+ (* TODO: this can be more generic and used elsewhere. *)
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: *)
@@ -4961,20 +6001,21 @@ module InternalInstallPlugin = struct
| (firsts, others) ->
let cmd = args @ firsts in
(* Use -add for remaining commands: *)
- let () =
+ let () =
let findlib_ge_132 =
OASISVersion.comparator_apply
- (OASISVersion.version_of_string
+ (OASISVersion.version_of_string
(BaseStandardVar.findlib_version ()))
- (OASISVersion.VGreaterEqual
+ (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")
+ (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
@@ -4985,24 +6026,22 @@ module InternalInstallPlugin = struct
else
["install" :: findlib_name :: meta :: files]
- let install pkg argv =
- let in_destdir =
+ let install =
+
+ let in_destdir fn =
try
- let destdir =
- destdir ()
- in
- (* Practically speaking destdir is prepended
- * at the beginning of the target filename
- *)
- fun fn -> destdir^fn
+ (* Practically speaking destdir is prepended at the beginning of the
+ target filename
+ *)
+ (destdir ())^fn
with PropList.Not_set _ ->
- fun fn -> fn
+ fn
in
- let install_file ?tgt_fn src_file envdir =
+ let install_file ~ctxt ?(prepend_destdir=true) ?tgt_fn src_file envdir =
let tgt_dir =
- in_destdir (envdir ())
+ if prepend_destdir then in_destdir (envdir ()) else envdir ()
in
let tgt_file =
Filename.concat
@@ -5015,20 +6054,48 @@ module InternalInstallPlugin = struct
in
(* Create target directory if needed *)
OASISFileUtil.mkdir_parent
- ~ctxt:!BaseContext.default
+ ~ctxt
(fun dn ->
info (f_ "Creating directory '%s'") dn;
- BaseLog.register install_dir_ev dn)
- tgt_dir;
+ BaseLog.register ~ctxt install_dir_ev dn)
+ (Filename.dirname tgt_file);
(* 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
+ OASISFileUtil.cp ~ctxt src_file tgt_file;
+ BaseLog.register ~ctxt install_file_ev tgt_file
+ in
+
+ (* Install the files for a library. *)
+
+ let install_lib_files ~ctxt findlib_name files =
+ let findlib_dir =
+ let dn =
+ let findlib_destdir =
+ OASISExec.run_read_one_line ~ctxt (ocamlfind ())
+ ["printconf" ; "destdir"]
+ in
+ Filename.concat findlib_destdir findlib_name
+ in
+ fun () -> dn
+ in
+ let () =
+ if not (OASISFileUtil.file_exists_case (findlib_dir ())) then
+ failwithf
+ (f_ "Directory '%s' doesn't exist for findlib library %s")
+ (findlib_dir ()) findlib_name
+ in
+ let f dir file =
+ let basename = Filename.basename file in
+ let tgt_fn = Filename.concat dir basename in
+ (* Destdir is already include in printconf. *)
+ install_file ~ctxt ~prepend_destdir:false ~tgt_fn file findlib_dir
+ in
+ List.iter (fun (dir, files) -> List.iter (f dir) files) files ;
in
(* Install data into defined directory *)
- let install_data srcdir lst tgtdir =
+ let install_data ~ctxt srcdir lst tgtdir =
let tgtdir =
OASISHostPath.of_unix (var_expand tgtdir)
in
@@ -5045,7 +6112,7 @@ module InternalInstallPlugin = struct
src;
List.iter
(fun fn ->
- install_file
+ install_file ~ctxt
fn
(fun () ->
match tgt_opt with
@@ -5057,146 +6124,158 @@ module InternalInstallPlugin = struct
lst
in
- (** Install all libraries *)
- let install_libs pkg =
+ 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
- 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
- (fun acc modul ->
- try
- List.find
- OASISFileUtil.file_exists_case
- (List.map
- (Filename.concat path)
- [modul^".mli";
- modul^".ml";
- String.uncapitalize modul^".mli";
- String.capitalize modul^".mli";
- String.uncapitalize modul^".ml";
- String.capitalize modul^".ml"])
- :: acc
- with Not_found ->
- begin
- warning
- (f_ "Cannot find source header for module %s \
- in library %s")
- modul cs.cs_name;
- acc
- end)
- acc
- lib.lib_modules
- in
+ (** Install all libraries *)
+ let install_libs ~ctxt pkg =
- let acc =
- (* Get generated files *)
- BaseBuilt.fold
- BaseBuilt.BLib
- cs.cs_name
- (fun acc fn -> fn :: acc)
- acc
- in
+ let find_first_existing_files_in_path bs lst =
+ let path = OASISHostPath.of_unix bs.bs_path in
+ List.find
+ OASISFileUtil.file_exists_case
+ (List.map (Filename.concat path) lst)
+ 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
+ let files_of_modules new_files typ cs bs modules =
+ List.fold_left
+ (fun acc modul ->
+ begin
+ try
+ (* Add uncompiled header from the source tree *)
+ [find_first_existing_files_in_path
+ bs (make_fnames modul [".mli"; ".ml"])]
+ with Not_found ->
+ warning
+ (f_ "Cannot find source header for module %s \
+ in %s %s")
+ typ modul cs.cs_name;
+ []
+ end
+ @
+ List.fold_left
+ (fun acc fn ->
+ try
+ find_first_existing_files_in_path bs [fn] :: acc
+ with Not_found ->
+ acc)
+ acc (make_fnames modul [".annot";".cmti";".cmt"]))
+ new_files
+ modules
+ 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
+ let files_of_build_section (f_data, new_files) typ cs bs =
+ let extra_files =
+ List.map
+ (fun fn ->
+ try
+ find_first_existing_files_in_path bs [fn]
+ with Not_found ->
+ failwithf
+ (f_ "Cannot find extra findlib file %S in %s %s ")
+ fn
+ typ
+ cs.cs_name)
+ bs.bs_findlib_extra_files
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
- (fun acc modul ->
- try
- List.find
- OASISFileUtil.file_exists_case
- (List.map
- (Filename.concat path)
- [modul^".mli";
- modul^".ml";
- String.uncapitalize modul^".mli";
- String.capitalize modul^".mli";
- String.uncapitalize modul^".ml";
- String.capitalize modul^".ml"])
- :: acc
- with Not_found ->
- begin
- warning
- (f_ "Cannot find source header for module %s \
- in object %s")
- modul cs.cs_name;
- 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 library *)
+ install_data
+ ~ctxt
+ bs.bs_path
+ bs.bs_data_files
+ (Filename.concat
+ (datarootdir ())
+ pkg.name);
+ f_data ()
+ in
+ f_data, new_files @ extra_files
+ 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
+ let files_of_library (f_data, acc) data_lib =
+ let cs, bs, lib, dn, lib_extra = !lib_hook data_lib in
+ if var_choose bs.bs_install &&
+ BaseBuilt.is_built ~ctxt BaseBuilt.BLib cs.cs_name then begin
+ (* Start with lib_extra *)
+ let new_files = lib_extra in
+ let new_files =
+ files_of_modules new_files "library" cs bs lib.lib_modules
+ in
+ let f_data, new_files =
+ files_of_build_section (f_data, new_files) "library" cs bs
+ in
+ let new_files =
+ (* Get generated files *)
+ BaseBuilt.fold
+ ~ctxt
+ BaseBuilt.BLib
+ cs.cs_name
+ (fun acc fn -> fn :: acc)
+ new_files
+ in
+ let acc = (dn, new_files) :: acc in
+
+ let f_data () =
+ (* Install data associated with the library *)
+ install_data
+ ~ctxt
+ 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
+ (f_data, acc)
+ end else begin
+ (f_data, acc)
+ end
+ and files_of_object (f_data, acc) data_obj =
+ let cs, bs, obj, dn, obj_extra = !obj_hook data_obj in
+ if var_choose bs.bs_install &&
+ BaseBuilt.is_built ~ctxt BaseBuilt.BObj cs.cs_name then begin
+ (* Start with obj_extra *)
+ let new_files = obj_extra in
+ let new_files =
+ files_of_modules new_files "object" cs bs obj.obj_modules
+ in
+ let f_data, new_files =
+ files_of_build_section (f_data, new_files) "object" cs bs
+ in
+ let new_files =
+ (* Get generated files *)
+ BaseBuilt.fold
+ ~ctxt
+ BaseBuilt.BObj
+ cs.cs_name
+ (fun acc fn -> fn :: acc)
+ new_files
+ in
+ let acc = (dn, new_files) :: acc in
+
+ let f_data () =
+ (* Install data associated with the object *)
+ install_data
+ ~ctxt
+ 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 *)
@@ -5207,10 +6286,10 @@ module InternalInstallPlugin = struct
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
+ | Package (_, cs, bs, `Library lib, dn, children) ->
+ files_of_library data_and_files (cs, bs, lib, dn), children
+ | Package (_, cs, bs, `Object obj, dn, children) ->
+ files_of_object data_and_files (cs, bs, obj, dn), children
in
List.fold_left
install_group_lib_aux
@@ -5219,268 +6298,213 @@ module InternalInstallPlugin = struct
in
(* Findlib name of the root library *)
- let findlib_name =
- findlib_of_group grp
- in
+ let findlib_name = findlib_of_group grp in
(* Determine root library *)
- let root_lib =
- root_of_group grp
- in
+ 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
+ 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
+ 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.
+ *)
+ (* TODO: move to OASISHostPath as make_relative. *)
+ 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
- List.iter
- (OASISExec.run ~ctxt:!BaseContext.default ocamlfind)
- commands;
- BaseLog.register install_findlib_ev findlib_name
- end;
-
- (* Install data files *)
- f_data ();
+ String.sub n cutpoint (nlen - cutpoint)
+ end else begin
+ n
+ end
+ in
+ List.map
+ (fun (dir, fn) ->
+ (dir, List.map (remove_prefix (Sys.getcwd ())) fn))
+ files
+ in
+ let ocamlfind = ocamlfind () in
+ let nodir_files, dir_files =
+ List.fold_left
+ (fun (nodir, dir) (dn, lst) ->
+ match dn with
+ | Some dn -> nodir, (dn, lst) :: dir
+ | None -> lst @ nodir, dir)
+ ([], [])
+ (List.rev files)
+ in
+ info (f_ "Installing findlib library '%s'") findlib_name;
+ List.iter
+ (OASISExec.run ~ctxt ocamlfind)
+ (split_install_command ocamlfind findlib_name meta nodir_files);
+ install_lib_files ~ctxt findlib_name dir_files;
+ BaseLog.register ~ctxt install_findlib_ev findlib_name
+ end;
+ (* Install data files *)
+ f_data ();
in
- let group_libs, _, _ =
- findlib_mapping pkg
- 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_execs ~ctxt 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
+ let cs, bs, _ = !exec_hook data_exec in
+ if var_choose bs.bs_install &&
+ BaseBuilt.is_built ~ctxt BaseBuilt.BExec cs.cs_name then begin
+ let exec_libdir () = Filename.concat (libdir ()) pkg.name in
+ BaseBuilt.fold
+ ~ctxt
+ BaseBuilt.BExec
+ cs.cs_name
+ (fun () fn ->
+ install_file ~ctxt
+ ~tgt_fn:(cs.cs_name ^ ext_program ())
+ fn
+ bindir)
+ ();
+ BaseBuilt.fold
+ ~ctxt
+ BaseBuilt.BExecLib
+ cs.cs_name
+ (fun () fn -> install_file ~ctxt fn exec_libdir)
+ ();
+ install_data ~ctxt
+ 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)
- | _ ->
- ())
+ List.iter
+ (function
+ | Executable (cs, bs, exec)-> install_exec (cs, bs, exec)
+ | _ -> ())
pkg.sections
in
- let install_docs pkg =
+ let install_docs ~ctxt 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
+ let cs, doc = !doc_hook data in
+ if var_choose doc.doc_install &&
+ BaseBuilt.is_built ~ctxt BaseBuilt.BDoc cs.cs_name then begin
+ let tgt_dir = OASISHostPath.of_unix (var_expand doc.doc_install_dir) in
+ BaseBuilt.fold
+ ~ctxt
+ BaseBuilt.BDoc
+ cs.cs_name
+ (fun () fn -> install_file ~ctxt fn (fun () -> tgt_dir))
+ ();
+ install_data ~ctxt
+ 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
+ List.iter
+ (function
+ | Doc (cs, doc) -> install_doc (cs, doc)
+ | _ -> ())
+ pkg.sections
in
+ fun ~ctxt pkg _ ->
+ install_libs ~ctxt pkg;
+ install_execs ~ctxt pkg;
+ install_docs ~ctxt pkg
- 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 *)
+ let uninstall ~ctxt _ _ =
+ let uninstall_aux (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 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 (ocamlfind ()) ["remove"; data]
+ end else begin
+ failwithf (f_ "Unknown log event '%s'") ev;
+ end;
+ BaseLog.unregister ~ctxt ev data
+ in
+ (* We process event in reverse order *)
+ List.iter uninstall_aux
(List.rev
- (BaseLog.filter
- [install_file_ev;
- install_dir_ev;
- install_findlib_ev;]))
+ (BaseLog.filter ~ctxt [install_file_ev; install_dir_ev]));
+ List.iter uninstall_aux
+ (List.rev (BaseLog.filter ~ctxt [install_findlib_ev]))
end
-# 5452 "setup.ml"
+# 6465 "setup.ml"
module OCamlbuildCommon = struct
-# 21 "/home/gildor/programmation/oasis/src/plugins/ocamlbuild/OCamlbuildCommon.ml"
+(* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *)
+
(** Functions common to OCamlbuild build and doc plugin
- *)
+ *)
+
open OASISGettext
open BaseEnv
open BaseStandardVar
+ open OASISTypes
+
+
+ type args =
+ {
+ plugin_tags: string option;
+ extra: string list;
+ }
+
+
+ let ocamlbuild_clean_ev = "ocamlbuild-clean"
- let ocamlbuild_clean_ev =
- "ocamlbuild-clean"
let ocamlbuildflags =
var_define
@@ -5488,6 +6512,7 @@ module OCamlbuildCommon = struct
"ocamlbuildflags"
(fun () -> "")
+
(** Fix special arguments depending on environment *)
let fix_args args extra_argv =
List.flatten
@@ -5497,6 +6522,14 @@ module OCamlbuildCommon = struct
"-classic-display";
"-no-log";
"-no-links";
+ ]
+ else
+ [];
+
+ if OASISVersion.comparator_apply
+ (OASISVersion.version_of_string (ocaml_version ()))
+ (OASISVersion.VLesser (OASISVersion.version_of_string "3.11.1")) then
+ [
"-install-lib-dir";
(Filename.concat (standard_library ()) "ocamlbuild")
]
@@ -5509,13 +6542,25 @@ module OCamlbuildCommon = struct
]
else
[];
- args;
+
+ args.extra;
+
+ begin
+ match args.plugin_tags with
+ | Some t -> ["-plugin-tag"; Filename.quote t]
+ | None -> []
+ end;
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
@@ -5526,71 +6571,76 @@ module OCamlbuildCommon = struct
Array.to_list extra_argv;
]
+
(** Run 'ocamlbuild -clean' if not already done *)
- let run_clean extra_argv =
+ let run_clean ~ctxt 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 if never called with these args *)
+ if not (BaseLog.exists ~ctxt ocamlbuild_clean_ev extra_cli) then
+ begin
+ OASISExec.run
+ ~ctxt (ocamlbuild ())
+ (fix_args {extra = ["-clean"]; plugin_tags = None} extra_argv);
+ BaseLog.register ~ctxt ocamlbuild_clean_ev extra_cli;
+ at_exit
+ (fun () ->
+ try
+ BaseLog.unregister ~ctxt ocamlbuild_clean_ev extra_cli
+ with _ -> ())
+ end
+
(** Run ocamlbuild, unregister all clean events *)
- let run_ocamlbuild args extra_argv =
+ let run_ocamlbuild ~ctxt 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);
+ *)
+ OASISExec.run ~ctxt (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])
+ (fun (e, d) -> BaseLog.unregister ~ctxt e d)
+ (BaseLog.filter ~ctxt [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
+ search_args dir tl
| _ :: tl ->
- search_args dir tl
+ search_args dir tl
| [] ->
- dir
+ dir
in
- search_args "_build" (fix_args [] extra_argv)
+ search_args "_build" (fix_args {extra = []; plugin_tags = None} extra_argv)
+
end
module OCamlbuildPlugin = struct
-# 21 "/home/gildor/programmation/oasis/src/plugins/ocamlbuild/OCamlbuildPlugin.ml"
+(* # 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 pkg argv =
+ let cond_targets_hook = ref (fun lst -> lst)
+
+ let build ~ctxt args pkg argv =
(* Return the filename in build directory *)
let in_build_dir fn =
Filename.concat
@@ -5603,19 +6653,6 @@ module OCamlbuildPlugin = struct
in_build_dir (OASISHostPath.of_unix fn)
in
- (* Checks if the string [fn] ends with [nd] *)
- let ends_with nd fn =
- let nd_len =
- String.length nd
- in
- (String.length fn >= nd_len)
- &&
- (String.sub
- fn
- (String.length fn - nd_len)
- nd_len) = nd
- in
-
let cond_targets =
List.fold_left
(fun acc ->
@@ -5635,11 +6672,11 @@ module OCamlbuildPlugin = struct
(List.map
(List.filter
(fun fn ->
- ends_with ".cma" fn
- || ends_with ".cmxs" fn
- || ends_with ".cmxa" fn
- || ends_with (ext_lib ()) fn
- || ends_with (ext_dll ()) 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
@@ -5667,8 +6704,8 @@ module OCamlbuildPlugin = struct
(List.map
(List.filter
(fun fn ->
- ends_with ".cmo" fn
- || ends_with ".cmx" fn))
+ ends_with ~what:".cmo" fn
+ || ends_with ~what:".cmx" fn))
unix_files))
in
@@ -5683,10 +6720,8 @@ module OCamlbuildPlugin = struct
| 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)
+ let evs, _, _ =
+ BaseBuilt.of_executable in_build_dir_of_unix (cs, bs, exec)
in
let target ext =
@@ -5696,12 +6731,13 @@ module OCamlbuildPlugin = struct
(OASISUnixPath.chop_extension
exec.exec_main_is))^ext
in
- let evs =
+ 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]]
+ | BaseBuilt.BExec, nm, _ when nm = cs.cs_name ->
+ BaseBuilt.BExec, nm,
+ [[in_build_dir_of_unix unix_tgt]]
| ev ->
ev)
evs
@@ -5737,63 +6773,69 @@ module OCamlbuildPlugin = struct
(fun fns ->
if not (List.exists OASISFileUtil.file_exists_case fns) then
failwithf
- (f_ "No one of expected built files %s exists")
- (String.concat (s_ ", ") (List.map (Printf.sprintf "'%s'") fns)))
+ (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)
+ (BaseBuilt.register ~ctxt bt bnm lst)
in
- let cond_targets =
- (* Run the hook *)
- !cond_targets_hook cond_targets
- 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))
- argv;
- (* ... and register events *)
- List.iter
- check_and_register
- (List.flatten (List.map fst cond_targets))
+ (* Run a list of target... *)
+ run_ocamlbuild
+ ~ctxt
+ {args with extra = List.flatten (List.map snd cond_targets) @ args.extra}
+ 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;
+ let clean ~ctxt pkg args =
+ run_clean ~ctxt args;
List.iter
(function
| Library (cs, _, _) ->
- BaseBuilt.unregister BaseBuilt.BLib cs.cs_name
+ BaseBuilt.unregister ~ctxt BaseBuilt.BLib cs.cs_name
| Executable (cs, _, _) ->
- BaseBuilt.unregister BaseBuilt.BExec cs.cs_name;
- BaseBuilt.unregister BaseBuilt.BExecLib cs.cs_name
+ BaseBuilt.unregister ~ctxt BaseBuilt.BExec cs.cs_name;
+ BaseBuilt.unregister ~ctxt BaseBuilt.BExecLib cs.cs_name
| _ ->
())
pkg.sections
+
end
module OCamlbuildDocPlugin = struct
-# 21 "/home/gildor/programmation/oasis/src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml"
+(* # 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 =
+ {
+ args: args;
+ run_path: unix_filename;
+ }
- let doc_build path pkg (cs, doc) argv =
+
+ let doc_build ~ctxt run _ (cs, _) argv =
let index_html =
OASISUnixPath.make
[
- path;
+ run.run_path;
cs.cs_name^".docdir";
"index.html";
]
@@ -5802,34 +6844,38 @@ module OCamlbuildDocPlugin = struct
OASISHostPath.make
[
build_dir argv;
- OASISHostPath.of_unix path;
+ OASISHostPath.of_unix run.run_path;
cs.cs_name^".docdir";
]
in
- run_ocamlbuild [index_html] 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 t pkg (cs, doc) argv =
- run_clean argv;
- BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name
+ run_ocamlbuild ~ctxt
+ {run.args with extra = index_html :: run.args.extra} argv;
+ List.iter
+ (fun glb ->
+ match OASISFileUtil.glob ~ctxt (Filename.concat tgt_dir glb) with
+ | (_ :: _) as filenames ->
+ BaseBuilt.register ~ctxt BaseBuilt.BDoc cs.cs_name [filenames]
+ | [] -> ())
+ ["*.html"; "*.css"]
+
+
+ let doc_clean ~ctxt _ _ (cs, _) argv =
+ run_clean ~ctxt argv;
+ BaseBuilt.unregister ~ctxt BaseBuilt.BDoc cs.cs_name
+
end
-# 5807 "setup.ml"
+# 6851 "setup.ml"
open OASISTypes;;
let setup_t =
{
BaseSetup.configure = InternalConfigurePlugin.configure;
- build = OCamlbuildPlugin.build;
+ build =
+ OCamlbuildPlugin.build
+ {OCamlbuildCommon.plugin_tags = None; extra = []};
test = [];
doc = [];
install = InternalInstallPlugin.install;
@@ -5844,8 +6890,6 @@ let setup_t =
{
oasis_version = "0.3";
ocaml_version = None;
- findlib_version = None;
- name = "ocamlify";
version = "0.0.2";
license =
OASISLicense.DEP5License
@@ -5853,49 +6897,22 @@ let setup_t =
{
OASISLicense.license = "LGPL";
excption = Some "OCaml linking";
- version = OASISLicense.Version "2.1";
- });
+ version = OASISLicense.Version "2.1"
+ });
+ findlib_version = None;
+ alpha_features = [];
+ beta_features = [];
+ name = "ocamlify";
license_file = Some "COPYING.txt";
copyrights = [];
maintainers = [];
authors = ["Sylvain Le Gall"];
homepage = None;
+ bugreports = None;
synopsis = "include files in OCaml code";
description = None;
+ tags = [];
categories = [];
- conf_type = (`Configure, "internal", Some "0.3");
- conf_custom =
- {
- pre_command = [(OASISExpr.EBool true, None)];
- post_command = [(OASISExpr.EBool true, None)];
- };
- build_type = (`Build, "ocamlbuild", Some "0.3");
- build_custom =
- {
- pre_command = [(OASISExpr.EBool true, None)];
- post_command = [(OASISExpr.EBool true, None)];
- };
- install_type = (`Install, "internal", Some "0.3");
- 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 = ["src/OCamlifyConfig.ml.ab"];
sections =
[
@@ -5903,44 +6920,192 @@ let setup_t =
({
cs_name = "ocamlify";
cs_data = PropList.Data.create ();
- cs_plugin_data = [];
- },
+ cs_plugin_data = []
+ },
{
bs_build = [(OASISExpr.EBool true, true)];
bs_install = [(OASISExpr.EBool true, true)];
bs_path = "src";
- bs_compiled_object = Byte;
+ bs_compiled_object = Best;
bs_build_depends = [];
bs_build_tools = [ExternalTool "ocamlbuild"];
+ bs_interface_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${capitalize_file module}.mli"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mli"
+ ];
+ origin = "${uncapitalize_file module}.mli"
+ }
+ ];
+ bs_implementation_patterns =
+ [
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${capitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".ml"
+ ];
+ origin = "${uncapitalize_file module}.ml"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${capitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mll"
+ ];
+ origin = "${uncapitalize_file module}.mll"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("capitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${capitalize_file module}.mly"
+ };
+ {
+ OASISSourcePatterns.Templater.atoms =
+ [
+ OASISSourcePatterns.Templater.Text "";
+ OASISSourcePatterns.Templater.Expr
+ (OASISSourcePatterns.Templater.Call
+ ("uncapitalize_file",
+ OASISSourcePatterns.Templater.Ident
+ "module"));
+ OASISSourcePatterns.Templater.Text ".mly"
+ ];
+ origin = "${uncapitalize_file module}.mly"
+ }
+ ];
bs_c_sources = [];
bs_data_files = [];
+ bs_findlib_extra_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 = "ocamlify.ml"; })
+ bs_nativeopt = [(OASISExpr.EBool true, [])]
+ },
+ {exec_custom = false; exec_main_is = "ocamlify.ml"})
];
+ disable_oasis_section = [];
+ 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)]
+ };
plugins =
[
(`Extra, "StdFiles", Some "0.1.0");
(`Extra, "DevFiles", Some "0.1.0")
];
schema_data = PropList.Data.create ();
- plugin_data = [];
- };
+ plugin_data = []
+ };
oasis_fn = Some "_oasis";
- oasis_version = "0.3.1";
- oasis_digest = Some "n>\223\251\160\250J\198\167_\r\200\174\0231\220";
+ oasis_version = "0.4.11";
+ oasis_digest =
+ Some "\142\220\214\196\163\254=\249\151\231PH\n\160\r\200";
oasis_exec = None;
oasis_setup_args = [];
- setup_update = false;
- };;
+ setup_update = false
+ };;
let setup () = BaseSetup.setup setup_t;;
-# 5926 "setup.ml"
+# 7089 "setup.ml"
+let setup_t = BaseCompat.Compat_0_3.adapt_setup_t setup_t
+open BaseCompat.Compat_0_3
(* OASIS_STOP *)
let () = setup ();;