diff options
author | jaapb <jaapb@pkgsrc.org> | 2018-01-10 16:17:05 +0000 |
---|---|---|
committer | jaapb <jaapb@pkgsrc.org> | 2018-01-10 16:17:05 +0000 |
commit | 7120384101cd808bb22744b0ff8ef9d30e3968a8 (patch) | |
tree | adfd436bb8333427297180def8d0146899c48cf9 | |
parent | 5c4f9f5f6536a0f369c2ee6b6a6f0137d6b20668 (diff) | |
download | pkgsrc-7120384101cd808bb22744b0ff8ef9d30e3968a8.tar.gz |
Revision bump for package devel/ocamlify.
No upstream changes, but the OASIS setup.ml file had to be regenerated
due to it no longer working with OCaml 4.06.
-rw-r--r-- | devel/ocamlify/Makefile | 4 | ||||
-rw-r--r-- | devel/ocamlify/buildlink3.mk | 6 | ||||
-rw-r--r-- | devel/ocamlify/distinfo | 5 | ||||
-rw-r--r-- | devel/ocamlify/patches/patch-__tags | 18 | ||||
-rw-r--r-- | devel/ocamlify/patches/patch-myocamlbuild.ml | 1067 | ||||
-rw-r--r-- | devel/ocamlify/patches/patch-setup.ml | 9551 |
6 files changed, 10645 insertions, 6 deletions
diff --git a/devel/ocamlify/Makefile b/devel/ocamlify/Makefile index c1b8a100111..c150a4e515a 100644 --- a/devel/ocamlify/Makefile +++ b/devel/ocamlify/Makefile @@ -1,7 +1,7 @@ -# $NetBSD: Makefile,v 1.8 2017/09/08 09:51:23 jaapb Exp $ +# $NetBSD: Makefile,v 1.9 2018/01/10 16:17:05 jaapb Exp $ DISTNAME= ocamlify-0.0.2 -PKGREVISION= 6 +PKGREVISION= 7 CATEGORIES= devel MASTER_SITES= http://forge.ocamlcore.org/frs/download.php/1209/ diff --git a/devel/ocamlify/buildlink3.mk b/devel/ocamlify/buildlink3.mk index df1105859f9..bb4ab89eb51 100644 --- a/devel/ocamlify/buildlink3.mk +++ b/devel/ocamlify/buildlink3.mk @@ -1,4 +1,4 @@ -# $NetBSD: buildlink3.mk,v 1.4 2018/01/07 13:04:09 rillig Exp $ +# $NetBSD: buildlink3.mk,v 1.5 2018/01/10 16:17:05 jaapb Exp $ BUILDLINK_TREE+= ocamlify @@ -6,8 +6,8 @@ BUILDLINK_TREE+= ocamlify OCAMLIFY_BUILDLINK3_MK:= BUILDLINK_API_DEPENDS.ocamlify+= ocamlify>=0.0.2nb1 -BUILDLINK_ABI_DEPENDS.ocamlify+= ocamlify>=0.0.2nb5 -BUILDLINK_PKGSRCDIR.ocamlify?= ../../devel/ocamlify +BUILDLINK_ABI_DEPENDS.ocamlify+= ocamlify>=0.0.2nb7 +BUILDLINK_PKGSRCDIR.ocamlify?= ../../devel/ocamlify .endif # OCAMLIFY_BUILDLINK3_MK BUILDLINK_TREE+= -ocamlify diff --git a/devel/ocamlify/distinfo b/devel/ocamlify/distinfo index db70eafd060..ad99920d7f9 100644 --- a/devel/ocamlify/distinfo +++ b/devel/ocamlify/distinfo @@ -1,6 +1,9 @@ -$NetBSD: distinfo,v 1.2 2015/11/03 03:27:53 agc Exp $ +$NetBSD: distinfo,v 1.3 2018/01/10 16:17:05 jaapb Exp $ SHA1 (ocamlify-0.0.2.tar.gz) = 9c52cd2ce6ee9a48b5f0e5ee8cc8576b733f7e46 RMD160 (ocamlify-0.0.2.tar.gz) = 3462a5682975198096ca1f2b2ca88671db0172d0 SHA512 (ocamlify-0.0.2.tar.gz) = e36dd09de6163be1e4d1a54944bb66871a5d461b3ead9ee8393d91a624cf6f7d038be8d8b9db36b04786adff67eb830d9aa3e81475e774dc0dee73adb985079e Size (ocamlify-0.0.2.tar.gz) = 53184 bytes +SHA1 (patch-__tags) = 2283a7fbb030eb127e4267c15600414c7ae310f5 +SHA1 (patch-myocamlbuild.ml) = 97417a3e22d93581b880d810f68960fa786559f2 +SHA1 (patch-setup.ml) = 0baa0b5b05af6b5448017ed9fa6ab96470b52b46 diff --git a/devel/ocamlify/patches/patch-__tags b/devel/ocamlify/patches/patch-__tags new file mode 100644 index 00000000000..792f22cbf49 --- /dev/null +++ b/devel/ocamlify/patches/patch-__tags @@ -0,0 +1,18 @@ +$NetBSD: patch-__tags,v 1.1 2018/01/10 16:17:05 jaapb Exp $ + +Regenerated Oasis files (don't compile with 4.06) +--- _tags.orig 2013-06-25 22:08:31.000000000 +0000 ++++ _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/devel/ocamlify/patches/patch-myocamlbuild.ml b/devel/ocamlify/patches/patch-myocamlbuild.ml new file mode 100644 index 00000000000..7d12c8e613f --- /dev/null +++ b/devel/ocamlify/patches/patch-myocamlbuild.ml @@ -0,0 +1,1067 @@ +$NetBSD: patch-myocamlbuild.ml,v 1.1 2018/01/10 16:17:05 jaapb Exp $ + +Regenerated Oasis files (don't compile with 4.06) +--- myocamlbuild.ml.orig 2013-06-25 22:08:31.000000000 +0000 ++++ 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 ++ ++ ++ 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 test = string ++ type flag = 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 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_choose lst env = +- OASISExpr.choose +- (fun nm -> var_get nm env) +- lst ++ ++ 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/devel/ocamlify/patches/patch-setup.ml b/devel/ocamlify/patches/patch-setup.ml new file mode 100644 index 00000000000..eba7c4a775a --- /dev/null +++ b/devel/ocamlify/patches/patch-setup.ml @@ -0,0 +1,9551 @@ +$NetBSD: patch-setup.ml,v 1.1 2018/01/10 16:17:05 jaapb Exp $ + +Regenerated Oasis files (don't compile with 4.06) +--- setup.ml.orig 2013-06-25 22:08:31.000000000 +0000 ++++ setup.ml +@@ -20,23 +20,20 @@ + (********************************************************************************) + + (* OASIS_START *) +-(* DO NOT EDIT (digest: e1b35f4beac5c9c844c0c1c02d73290d) *) ++(* DO NOT EDIT (digest: d1578d1ccd9abb72f2c38bc94fe75e59) *) + (* +- Regenerated by OASIS v0.3.1 ++ Regenerated by OASIS v0.4.10 + 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) + +- module SetString = Set.Make(String) ++ 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) + +- let set_string_add_list st lst = +- List.fold_left +- (fun acc e -> SetString.add e acc) +- st +- lst + +- let set_string_of_list = +- set_string_add_list +- SetString.empty ++ 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) ++ function ++ | VGreater v -> concat "gt" v ++ | VLesser v -> concat "lt" v ++ | VEqual v -> concat "eq" v ++ | VGreaterEqual v -> concat "ge" v ++ | VLesserEqual v -> concat "le" v ++ | VOr (c1, c2) -> ++ (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2) ++ | VAnd (c1, c2) -> ++ (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2) + +- let version_0_3_or_after t = +- comparator_apply t (VGreaterEqual (string_of_version "0.3")) + + end + + module OASISLicense = struct +-# 21 "/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; ++ } ++ ++ ++ type common_section = ++ { ++ cs_name: name; ++ cs_data: PropList.Data.t; ++ cs_plugin_data: plugin_data; ++ } ++ ++ ++ type build_section = ++ { ++ bs_build: bool conditional; ++ bs_install: bool conditional; ++ bs_path: unix_dirname; ++ bs_compiled_object: compiled_object; ++ bs_build_depends: dependency list; ++ bs_build_tools: tool list; ++ bs_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 = + { +- pre_command: (command_line option) conditional; +- post_command: (command_line option) conditional; ++ oasis_version: OASISVersion.t; ++ plugin_versions: OASISVersion.t option MapPlugin.t; ++ alpha_features: string list; ++ beta_features: string list; + } +- + +- type common_section = +- { +- cs_name: name; +- cs_data: PropList.Data.t; +- cs_plugin_data: plugin_data; +- } +- ++ let create oasis_version alpha_features beta_features = ++ { ++ oasis_version = oasis_version; ++ plugin_versions = MapPlugin.empty; ++ alpha_features = alpha_features; ++ beta_features = beta_features ++ } ++ ++ let of_package pkg = ++ create ++ pkg.OASISTypes.oasis_version ++ pkg.OASISTypes.alpha_features ++ pkg.OASISTypes.beta_features ++ ++ let add_plugin (plugin_kind, plugin_name, plugin_version) t = ++ {t with ++ plugin_versions = MapPlugin.add ++ (plugin_kind, plugin_name) ++ plugin_version ++ t.plugin_versions} ++ ++ let plugin_version plugin_kind plugin_name t = ++ MapPlugin.find (plugin_kind, plugin_name) t.plugin_versions ++ ++ let to_string t = ++ Printf.sprintf ++ "oasis_version: %s; alpha_features: %s; beta_features: %s; \ ++ plugins_version: %s" ++ (OASISVersion.string_of_version (t: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) + +- type build_section = +- { +- bs_build: bool conditional; +- bs_install: bool conditional; +- bs_path: unix_dirname; +- bs_compiled_object: compiled_object; +- bs_build_depends: dependency list; +- bs_build_tools: tool list; +- bs_c_sources: unix_filename list; +- bs_data_files: (unix_filename * unix_filename option) list; +- bs_ccopt: args conditional; +- bs_cclib: args conditional; +- bs_dlllib: args conditional; +- bs_dllpath: args conditional; +- bs_byteopt: args conditional; +- bs_nativeopt: args conditional; +- } +- ++ | 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 + +- type library = +- { +- lib_modules: string list; +- lib_pack: bool; +- lib_internal_modules: string list; +- lib_findlib_parent: findlib_name option; +- lib_findlib_name: findlib_name option; +- lib_findlib_containers: findlib_name list; +- } ++ | 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) = ++ ~ctxt ++ ~is_native ++ ~has_native_dynlink ++ ~ext_lib ++ ~ext_dll ++ ~source_file_exists ++ (cs, bs, lib) = + +- let find_modules lst ext = ++ 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 +- 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 ++ 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.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 +- obj_name +- (`Solved findlib_full_name) ++ lib_name ++ (`Unsolved (lib_name_parent, fndlb_parts)) + mp +- end ++ | None -> ++ MapString.add ++ lib_name ++ (`Solved fndlb_parts) ++ mp ++ 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. *) +@@ -1782,40 +2651,40 @@ module OASISFindlib = struct + 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 ++ 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) +- 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) ++ List.fold_left ++ (fun res grp -> ++ if res = None then ++ root_lib_aux grp ++ else ++ res) ++ None ++ children ++ | Package (_, cs, bs, lib, _, _) -> ++ Some (cs, bs, lib) ++ in ++ match root_lib_aux grp with ++ | Some res -> ++ res ++ | None -> ++ failwithf ++ (f_ "Unable to determine root library of findlib library '%s'") ++ (findlib_of_group grp) ++ + + end + + module OASISFlag = struct +-# 21 "/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 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_choose lst env = +- OASISExpr.choose +- (fun nm -> var_get nm env) +- lst ++ ++ 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 ++ ++ 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 ++ 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 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 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 +- begin +- [] +- end ++ ctxt.srcfs#remove default_filename + +- let register event data = +- let chn_out = +- open_out_gen [Open_append; Open_creat; Open_text] 0o644 default_filename +- in +- Printf.fprintf chn_out "%S %S\n" event data; +- close_out chn_out + +- let unregister event data = +- if Sys.file_exists default_filename then +- begin +- let lst = +- load () +- in +- let chn_out = +- open_out default_filename +- in +- let write_something = +- ref false +- in +- List.iter +- (fun (e, d) -> +- if e <> event || d <> data then +- begin +- write_something := true; +- Printf.fprintf chn_out "%S %S\n" e d +- end) +- lst; +- close_out chn_out; +- if not !write_something then +- Sys.remove default_filename +- end ++ let filter ~ctxt events = ++ let st_events = SetString.of_list events in ++ List.filter ++ (fun (e, _) -> SetString.mem e st_events) ++ (load ~ctxt ()) + +- let filter events = +- let st_events = +- List.fold_left +- (fun st e -> +- SetString.add e st) +- SetString.empty +- events +- in +- List.filter +- (fun (e, _) -> SetString.mem e st_events) +- (load ()) + +- let exists event data = ++ 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 \ ++ (fun acc (_, fn) -> ++ if OASISFileUtil.file_exists_case fn then begin ++ f acc fn ++ end else begin ++ warning ++ (f_ "File '%s' has been marked as built \ + for %s but doesn't exist") +- fn +- (Printf.sprintf +- (match t with +- | BExec | BExecLib -> +- (f_ "executable %s") +- | BLib -> +- (f_ "library %s") +- | BObj -> +- (f_ "object %s") +- | BDoc -> +- (f_ "documentation %s")) +- nm); +- acc +- end) ++ 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 -> +- []) +- in +- evs, +- unix_exec_is, +- unix_dll_opt ++ (match unix_dll_opt with ++ | Some fn -> ++ [BExecLib, cs.cs_name, [[ffn fn]]] ++ | None -> ++ []) ++ in ++ evs, ++ unix_exec_is, ++ unix_dll_opt ++ + + let of_library ffn (cs, bs, lib) = + let unix_lst = + OASISLibrary.generated_unix_files + ~ctxt:!BaseContext.default + ~source_file_exists:(fun fn -> +- OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn)) ++ 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,6 +4775,7 @@ module BaseCustom = struct + var_expand + (args @ (Array.to_list extra_args))) + ++ + let hook ?(failsafe=false) cstm f e = + let optional_command lst = + let printer = +@@ -3847,36 +4783,36 @@ module BaseCustom = struct + | 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 -> +- () ++ 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))))) ++ | 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 _ -> +- ()) ++ | 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; ++ 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'" ++ (* 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; ++ 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'" ++ 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-test", +- Arg.Set rno_test, +- s_ "Don't run test target"; +- ] +- (failwithf (f_ "Don't know what to do with '%s'")) +- ""; ++ [ ++ "-no-doc", ++ Arg.Set rno_doc, ++ s_ "Don't run doc target"; ++ ++ "-no-test", ++ Arg.Set rno_test, ++ s_ "Don't run test target"; ++ ++ "--", ++ Arg.Rest (fun arg -> arg_rest := arg :: !arg_rest), ++ s_ "All arguments for configure."; ++ ] ++ (failwithf (f_ "Don't know what to do with '%s'")) ++ ""; + +- info "Running configure step"; +- configure t [||]; ++ info "Running configure step"; ++ configure ~ctxt t (Array.of_list (List.rev !arg_rest)); + +- info "Running build step"; +- build t [||]; ++ info "Running build step"; ++ build ~ctxt t [||]; + +- (* Load setup.log dynamic variables *) +- BaseDynVar.init t.package; ++ (* Load setup.log dynamic variables *) ++ BaseDynVar.init ~ctxt t.package; ++ ++ 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 + +- if not !rno_doc then +- begin +- info "Running doc step"; +- doc t [||]; +- end +- else +- begin +- info "Skipping doc step" +- end; + +- if not !rno_test then +- begin +- info "Running test step"; +- test t [||] +- end +- else +- begin +- info "Skipping test step" +- end ++ let install ~ctxt t args = ++ BaseCustom.hook t.package.install_custom (t.install ~ctxt t.package) args + +- 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 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 (); ++ ++ (** Initialize flags *) ++ List.iter ++ (function ++ | Flag (cs, {flag_description = hlp; ++ flag_default = choices}) -> ++ begin ++ let apply ?short_desc () = ++ var_ignore ++ (var_define ++ ~cli:CLIEnable ++ ?short_desc ++ (OASISUtils.varname_of_string cs.cs_name) ++ (fun () -> ++ string_of_bool ++ (var_choose ++ ~name:(Printf.sprintf ++ (f_ "default value of flag %s") ++ cs.cs_name) ++ ~printer:string_of_bool ++ choices))) ++ in ++ match hlp with ++ | Some hlp -> apply ~short_desc:(fun () -> hlp) () ++ | None -> apply () ++ end ++ | _ -> ++ ()) ++ t.package.sections; + +- BaseStandardVar.init t.package; ++ BaseStandardVar.init t.package; + +- BaseDynVar.init t.package; ++ BaseDynVar.init ~ctxt t.package; + +- if t.setup_update && update_setup_ml t then +- () +- else +- !act_ref t (Array.of_list (List.rev !extra_args_ref)) ++ 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 ++ 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 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_file_ev = +- "install-file" ++ let install_file_ev = "install-file" ++ let install_dir_ev = "install-dir" ++ let install_findlib_ev = "install-findlib" + +- let install_dir_ev = +- "install-dir" +- +- 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 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 acc = +- (* Get generated files *) +- BaseBuilt.fold +- BaseBuilt.BObj +- cs.cs_name +- (fun acc fn -> fn :: acc) +- acc +- 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 object *) +- install_data +- bs.bs_path +- bs.bs_data_files +- (Filename.concat +- (datarootdir ()) +- pkg.name); +- f_data () +- 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,209 @@ 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 extra_args = string list ++ ++ ++ let ocamlbuild_clean_ev = "ocamlbuild-clean" + +- let ocamlbuild_clean_ev = +- "ocamlbuild-clean" + + let ocamlbuildflags = + var_define +@@ -5488,6 +6508,7 @@ module OCamlbuildCommon = struct + "ocamlbuildflags" + (fun () -> "") + ++ + (** Fix special arguments depending on environment *) + let fix_args args extra_argv = + List.flatten +@@ -5497,6 +6518,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") + ] +@@ -5516,6 +6545,11 @@ module OCamlbuildCommon = struct + else + []; + ++ if bool_of_string (tests ()) then ++ ["-tag"; "tests"] ++ else ++ []; ++ + if bool_of_string (profile ()) then + ["-tag"; "profile"] + else +@@ -5526,71 +6560,74 @@ 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 ["-clean"] 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_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 extra_args pkg argv = + (* Return the filename in build directory *) + let in_build_dir fn = + Filename.concat +@@ -5603,19 +6640,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 +6659,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 +6691,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 +6707,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 +6718,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 +6760,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 ++ (List.flatten (List.map snd cond_targets) @ extra_args) ++ argv; ++ (* ... and register events *) ++ List.iter check_and_register (List.flatten (List.map fst cond_targets)) + + +- let clean pkg extra_args = +- run_clean extra_args; ++ let clean ~ctxt pkg extra_args = ++ run_clean ~ctxt extra_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 = ++ { ++ extra_args: string list; ++ 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 +6831,35 @@ 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"] ++ run_ocamlbuild ~ctxt (index_html :: run.extra_args) 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 + +- let doc_clean t pkg (cs, doc) argv = +- run_clean argv; +- BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name + + end + + +-# 5807 "setup.ml" ++# 6837 "setup.ml" + open OASISTypes;; + + let setup_t = + { + BaseSetup.configure = InternalConfigurePlugin.configure; +- build = OCamlbuildPlugin.build; ++ build = OCamlbuildPlugin.build []; + test = []; + doc = []; + install = InternalInstallPlugin.install; +@@ -5844,8 +6874,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 +6881,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,8 +6904,8 @@ 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)]; +@@ -5912,35 +6913,182 @@ let setup_t = + bs_compiled_object = Byte; + 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_version = "0.4.10"; + oasis_digest = Some "n>\223\251\160\250J\198\167_\r\200\174\0231\220"; + oasis_exec = None; + oasis_setup_args = []; +- setup_update = false; +- };; ++ setup_update = false ++ };; + + let setup () = BaseSetup.setup setup_t;; + +-# 5926 "setup.ml" ++# 7072 "setup.ml" ++let setup_t = BaseCompat.Compat_0_3.adapt_setup_t setup_t ++open BaseCompat.Compat_0_3 + (* OASIS_STOP *) + let () = setup ();; |