From 0c9424812cf0f0b0ed4f6c7c0a1564896addecb5 Mon Sep 17 00:00:00 2001 From: Rudi Grinberg Date: Tue, 20 Dec 2016 09:40:49 -0500 Subject: [PATCH] oasis noise --- _tags | 6 +- myocamlbuild.ml | 720 +++-- setup.ml | 7039 ++++++++++++++++++++++++++--------------------- 3 files changed, 4349 insertions(+), 3416 deletions(-) diff --git a/_tags b/_tags index 4e7b6c5..bb296ad 100644 --- a/_tags +++ b/_tags @@ -1,5 +1,5 @@ # OASIS_START -# DO NOT EDIT (digest: 80d2f60b71104e8b9926cade6c27edbe) +# DO NOT EDIT (digest: ad8bf5a98b4812d6b2ba0f62e2cecdce) # 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 @@ -21,6 +21,10 @@ true: annot, bin_annot : use_mustache : pkg_oUnit : custom +# Executable mustache_example +: use_mustache +: use_mustache +: custom # Executable mustache_cli : pkg_ezjsonm : use_mustache diff --git a/myocamlbuild.ml b/myocamlbuild.ml index f6cc611..c4793c7 100644 --- a/myocamlbuild.ml +++ b/myocamlbuild.ml @@ -1,19 +1,12 @@ (* OASIS_START *) -(* DO NOT EDIT (digest: 669a67677812aefd988752313856201d) *) +(* DO NOT EDIT (digest: c808ec097981a8a832424fc326d222b3) *) module OASISGettext = struct (* # 22 "src/oasis/OASISGettext.ml" *) - let ns_ str = - str - - - let s_ str = - str - - - let f_ (str: ('a, 'b, 'c, 'd) format4) = - str + let ns_ str = str + let s_ str = str + let f_ (str: ('a, 'b, 'c, 'd) format4) = str let fn_ fmt1 fmt2 n = @@ -23,25 +16,344 @@ module OASISGettext = struct fmt2^^"" - let init = - [] + let init = [] +end +module OASISString = struct +(* # 22 "src/oasis/OASISString.ml" *) -end -module OASISExpr = struct -(* # 22 "src/oasis/OASISExpr.ml" *) + (** Various string utilities. + + Mostly inspired by extlib and batteries ExtString and BatString libraries. + @author Sylvain Le Gall + *) + + + let nsplitf str f = + if str = "" then + [] + else + let buf = Buffer.create 13 in + let lst = ref [] in + let push () = + lst := Buffer.contents buf :: !lst; + Buffer.clear buf + in + let str_len = String.length str in + for i = 0 to str_len - 1 do + if f str.[i] then + push () + else + Buffer.add_char buf str.[i] + done; + push (); + List.rev !lst + + + (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the + separator. + *) + let nsplit str c = + nsplitf str ((=) c) + + + let find ~what ?(offset=0) str = + let what_idx = ref 0 in + let str_idx = ref offset in + while !str_idx < String.length str && + !what_idx < String.length what do + if str.[!str_idx] = what.[!what_idx] then + incr what_idx + else + what_idx := 0; + incr str_idx + done; + if !what_idx <> String.length what then + raise Not_found + else + !str_idx - !what_idx + + + let sub_start str len = + let str_len = String.length str in + if len >= str_len then + "" + else + String.sub str len (str_len - len) + + + let sub_end ?(offset=0) str len = + let str_len = String.length str in + if len >= str_len then + "" + else + String.sub str 0 (str_len - len) + + + let starts_with ~what ?(offset=0) str = + let what_idx = ref 0 in + let str_idx = ref offset in + let ok = ref true in + while !ok && + !str_idx < String.length str && + !what_idx < String.length what do + if str.[!str_idx] = what.[!what_idx] then + incr what_idx + else + ok := false; + incr str_idx + done; + if !what_idx = String.length what then + true + else + false + + + let strip_starts_with ~what str = + if starts_with ~what str then + sub_start str (String.length what) + else + raise Not_found + + + let ends_with ~what ?(offset=0) str = + let what_idx = ref ((String.length what) - 1) in + let str_idx = ref ((String.length str) - 1) in + let ok = ref true in + while !ok && + offset <= !str_idx && + 0 <= !what_idx do + if str.[!str_idx] = what.[!what_idx] then + decr what_idx + else + ok := false; + decr str_idx + done; + if !what_idx = -1 then + true + else + false + + + let strip_ends_with ~what str = + if ends_with ~what str then + sub_end str (String.length what) + else + raise Not_found + + + let replace_chars f s = + let buf = Buffer.create (String.length s) in + String.iter (fun c -> Buffer.add_char buf (f c)) s; + Buffer.contents buf + + let lowercase_ascii = + replace_chars + (fun c -> + if (c >= 'A' && c <= 'Z') then + Char.chr (Char.code c + 32) + else + c) + + let uncapitalize_ascii s = + if s <> "" then + (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) + else + s + + let uppercase_ascii = + replace_chars + (fun c -> + if (c >= 'a' && c <= 'z') then + Char.chr (Char.code c - 32) + else + c) + + let capitalize_ascii s = + if s <> "" then + (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) + else + s +end +module OASISUtils = struct +(* # 22 "src/oasis/OASISUtils.ml" *) open OASISGettext - type test = string + module MapExt = + struct + module type S = + sig + include Map.S + val add_list: 'a t -> (key * 'a) list -> 'a t + val of_list: (key * 'a) list -> 'a t + val to_list: 'a t -> (key * 'a) list + end + + module Make (Ord: Map.OrderedType) = + struct + include Map.Make(Ord) + + let rec add_list t = + function + | (k, v) :: tl -> add_list (add k v t) tl + | [] -> t + + let of_list lst = add_list empty lst + + let to_list t = fold (fun k v acc -> (k, v) :: acc) t [] + end + end + + + module MapString = MapExt.Make(String) + + + module SetExt = + struct + module type S = + sig + include Set.S + val add_list: t -> elt list -> t + val of_list: elt list -> t + val to_list: t -> elt list + end + + module Make (Ord: Set.OrderedType) = + struct + include Set.Make(Ord) + + let rec add_list t = + function + | e :: tl -> add_list (add e t) tl + | [] -> t + + let of_list lst = add_list empty lst + + let to_list = elements + end + end + + + module SetString = SetExt.Make(String) + + + let compare_csl s1 s2 = + String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2) + + + module HashStringCsl = + Hashtbl.Make + (struct + type t = string + let equal s1 s2 = (compare_csl s1 s2) = 0 + let hash s = Hashtbl.hash (OASISString.lowercase_ascii s) + end) + + module SetStringCsl = + SetExt.Make + (struct + type t = string + let compare = compare_csl + end) + + + let varname_of_string ?(hyphen='_') s = + if String.length s = 0 then + begin + invalid_arg "varname_of_string" + end + else + begin + let buf = + OASISString.replace_chars + (fun c -> + if ('a' <= c && c <= 'z') + || + ('A' <= c && c <= 'Z') + || + ('0' <= c && c <= '9') then + c + else + hyphen) + s; + in + let buf = + (* Start with a _ if digit *) + if '0' <= s.[0] && s.[0] <= '9' then + "_"^buf + else + buf + in + OASISString.lowercase_ascii buf + end + + + let varname_concat ?(hyphen='_') p s = + let what = String.make 1 hyphen in + let p = + try + OASISString.strip_ends_with ~what p + with Not_found -> + p + in + let s = + try + OASISString.strip_starts_with ~what s + with Not_found -> + s + in + p^what^s + + + let is_varname str = + str = varname_of_string str + + let failwithf fmt = Printf.ksprintf failwith fmt + + + let rec file_location ?pos1 ?pos2 ?lexbuf () = + match pos1, pos2, lexbuf with + | Some p, None, _ | None, Some p, _ -> + file_location ~pos1:p ~pos2:p ?lexbuf () + | Some p1, Some p2, _ -> + let open Lexing in + let fn, lineno = p1.pos_fname, p1.pos_lnum in + let c1 = p1.pos_cnum - p1.pos_bol in + let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in + Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2 + | _, _, Some lexbuf -> + file_location + ~pos1:(Lexing.lexeme_start_p lexbuf) + ~pos2:(Lexing.lexeme_end_p lexbuf) + () + | None, None, None -> + s_ "" + + + let failwithpf ?pos1 ?pos2 ?lexbuf fmt = + let loc = file_location ?pos1 ?pos2 ?lexbuf () in + Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt + + +end +module OASISExpr = struct +(* # 22 "src/oasis/OASISExpr.ml" *) + + + open OASISGettext + open OASISUtils + + + type test = string type flag = string @@ -54,7 +366,6 @@ module OASISExpr = struct | ETest of test * string - type 'a choices = (t * 'a) list @@ -129,7 +440,7 @@ module OASISExpr = struct end -# 132 "myocamlbuild.ml" +# 443 "myocamlbuild.ml" module BaseEnvLight = struct (* # 22 "src/base/BaseEnvLight.ml" *) @@ -140,132 +451,103 @@ module BaseEnvLight = struct type t = string MapString.t - let default_filename = - Filename.concat - (Sys.getcwd ()) - "setup.data" + 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 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 rec var_expand str env = - let buff = - Buffer.create ((String.length str) * 2) - in - Buffer.add_substitute - buff - (fun var -> - try - var_expand (MapString.find var env) env - with Not_found -> - failwith - (Printf.sprintf - "No variable %s defined when trying to expand %S." - var - str)) - str; - Buffer.contents buff - - - let var_get name env = - var_expand (MapString.find name env) env - - - let var_choose lst env = - OASISExpr.choose - (fun nm -> var_get nm env) - lst + let buff = Buffer.create ((String.length str) * 2) in + Buffer.add_substitute + buff + (fun var -> + try + var_expand (MapString.find var env) env + with Not_found -> + failwith + (Printf.sprintf + "No variable %s defined when trying to expand %S." + var + str)) + str; + Buffer.contents buff + + + let var_get name env = var_expand (MapString.find name env) env + let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst end -# 237 "myocamlbuild.ml" +# 523 "myocamlbuild.ml" module MyOCamlbuildFindlib = struct (* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *) (** OCamlbuild extension, copied from - * http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild + * 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 - *) + *) open Ocamlbuild_plugin - type conf = - { no_automatic_syntax: bool; - } - (* these functions are not really officially exported *) - let run_and_read = - Ocamlbuild_pack.My_unix.run_and_read + 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 blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings let exec_from_conf exec = let exec = - let env_filename = Pathname.basename BaseEnvLight.default_filename in - let env = BaseEnvLight.load ~filename:env_filename ~allow_empty:true () in + let env = BaseEnvLight.load ~allow_empty:true () in try BaseEnvLight.var_get exec env with Not_found -> @@ -276,7 +558,7 @@ module MyOCamlbuildFindlib = struct 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; @@ -285,7 +567,8 @@ module MyOCamlbuildFindlib = struct str end in - fix_win32 exec + fix_win32 exec + let split s ch = let buf = Buffer.create 13 in @@ -294,15 +577,15 @@ module MyOCamlbuildFindlib = struct 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' @@ -344,85 +627,89 @@ module MyOCamlbuildFindlib = struct let dispatch conf = function | 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" + (* 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"; - - if not (conf.no_automatic_syntax) then begin - (* 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 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 ()); - end; - - (* 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"; "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"]); + 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 @@ -434,9 +721,6 @@ module MyOCamlbuildBase = struct *) - - - open Ocamlbuild_plugin module OC = Ocamlbuild_pack.Ocaml_compiler @@ -447,9 +731,6 @@ module MyOCamlbuildBase = struct type tag = string -(* # 62 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) - - type t = { lib_ocaml: (name * dir list * string list) list; @@ -462,9 +743,10 @@ module MyOCamlbuildBase = struct } - let env_filename = - Pathname.basename - BaseEnvLight.default_filename +(* # 110 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) + + + let env_filename = Pathname.basename BaseEnvLight.default_filename let dispatch_combine lst = @@ -483,12 +765,7 @@ module MyOCamlbuildBase = struct let dispatch t e = - let env = - BaseEnvLight.load - ~filename:env_filename - ~allow_empty:true - () - in + let env = BaseEnvLight.load ~allow_empty:true () in match e with | Before_options -> let no_trailing_dot s = @@ -516,7 +793,7 @@ module MyOCamlbuildBase = struct | nm, [], intf_modules -> ocaml_lib nm; let cmis = - List.map (fun m -> (String.uncapitalize m) ^ ".cmi") + 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 -> @@ -529,7 +806,7 @@ module MyOCamlbuildBase = struct ["compile"; "infer_interface"; "doc"]) tl; let cmis = - List.map (fun m -> dir^"/"^(String.uncapitalize m)^".cmi") + List.map (fun m -> dir^"/"^(OASISString.uncapitalize_ascii m)^".cmi") intf_modules in dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"] cmis) @@ -552,18 +829,19 @@ 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"; tag_libstubs lib] - [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; + dep ["link"; "ocaml"; tag_libstubs lib] + [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; - dep ["compile"; "ocaml"; tag_libstubs lib] - [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_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 *) @@ -603,14 +881,14 @@ module MyOCamlbuildBase = struct end -# 606 "myocamlbuild.ml" +# 884 "myocamlbuild.ml" open Ocamlbuild_plugin;; let package_default = { MyOCamlbuildBase.lib_ocaml = [("mustache", ["lib"], [])]; lib_c = []; flags = []; - includes = [("lib_test", ["lib"])] + includes = [("lib_test", ["lib"]); ("examples", ["lib"])] } ;; @@ -618,6 +896,6 @@ let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false} let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;; -# 622 "myocamlbuild.ml" +# 900 "myocamlbuild.ml" (* OASIS_STOP *) Ocamlbuild_plugin.dispatch dispatch_default;; diff --git a/setup.ml b/setup.ml index 4600e6c..7aeeaaa 100644 --- a/setup.ml +++ b/setup.ml @@ -1,9 +1,9 @@ (* setup.ml generated for the first time by OASIS v0.4.5 *) (* OASIS_START *) -(* DO NOT EDIT (digest: d6d8fa16f2e6190051b8ee9bec2e6d3d) *) +(* DO NOT EDIT (digest: 9216d5dd622a35c9b5dfcb4a61b7d3e4) *) (* - Regenerated by OASIS v0.4.5 + Regenerated by OASIS v0.4.8 Visit http://oasis.forge.ocamlcore.org for more information and documentation about functions used in this file. *) @@ -11,16 +11,9 @@ module OASISGettext = struct (* # 22 "src/oasis/OASISGettext.ml" *) - let ns_ str = - str - - - let s_ str = - str - - - let f_ (str: ('a, 'b, 'c, 'd) format4) = - str + let ns_ str = str + let s_ str = str + let f_ (str: ('a, 'b, 'c, 'd) format4) = str let fn_ fmt1 fmt2 n = @@ -30,90 +23,7 @@ module OASISGettext = struct fmt2^^"" - let init = - [] - - -end - -module OASISContext = struct -(* # 22 "src/oasis/OASISContext.ml" *) - - - open OASISGettext - - - type level = - [ `Debug - | `Info - | `Warning - | `Error] - - - type t = - { - (* TODO: replace this by a proplist. *) - quiet: bool; - info: bool; - debug: bool; - ignore_plugins: bool; - ignore_unknown_fields: bool; - printf: level -> string -> unit; - } - - - let printf lvl str = - let beg = - match lvl with - | `Error -> s_ "E: " - | `Warning -> s_ "W: " - | `Info -> s_ "I: " - | `Debug -> s_ "D: " - in - prerr_endline (beg^str) - - - let default = - ref - { - quiet = false; - info = false; - debug = false; - ignore_plugins = false; - ignore_unknown_fields = false; - printf = printf; - } - - - let quiet = - {!default with quiet = true} - - - let fspecs () = - (* TODO: don't act on default. *) - let ignore_plugins = ref false in - ["-quiet", - Arg.Unit (fun () -> default := {!default with quiet = true}), - s_ " Run quietly"; - - "-info", - Arg.Unit (fun () -> default := {!default with info = true}), - s_ " Display information message"; - - - "-debug", - Arg.Unit (fun () -> default := {!default with debug = true}), - s_ " Output debug message"; - - "-ignore-plugins", - Arg.Set ignore_plugins, - s_ " Ignore plugin's field."; - - "-C", - (* TODO: remove this chdir. *) - Arg.String (fun str -> Sys.chdir str), - s_ "dir Change directory before running."], - fun () -> {!default with ignore_plugins = !ignore_plugins} + let init = [] end module OASISString = struct @@ -125,7 +35,7 @@ module OASISString = struct Mostly inspired by extlib and batteries ExtString and BatString libraries. @author Sylvain Le Gall - *) + *) let nsplitf str f = @@ -139,19 +49,19 @@ 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) @@ -159,18 +69,18 @@ module OASISString = struct 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 + while !str_idx < String.length str && + !what_idx < String.length what do + if str.[!str_idx] = what.[!what_idx] then + incr what_idx else - !str_idx - !what_idx + 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 = @@ -193,19 +103,19 @@ module OASISString = struct 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 + 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 - false + ok := false; + incr str_idx + done; + if !what_idx = String.length what then + true + else + false let strip_starts_with ~what str = @@ -219,19 +129,19 @@ module OASISString = struct 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 + while !ok && + offset <= !str_idx && + 0 <= !what_idx do + if str.[!str_idx] = what.[!what_idx] then + decr what_idx else - false + ok := false; + decr str_idx + done; + if !what_idx = -1 then + true + else + false let strip_ends_with ~what str = @@ -246,6 +156,33 @@ module OASISString = struct 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 @@ -315,19 +252,15 @@ module OASISUtils = struct 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 = - (String.lowercase s1) = (String.lowercase s2) - - let hash s = - Hashtbl.hash (String.lowercase s) + let equal s1 s2 = (compare_csl s1 s2) = 0 + let hash s = Hashtbl.hash (OASISString.lowercase_ascii s) end) module SetStringCsl = @@ -365,7 +298,7 @@ module OASISUtils = struct else buf in - String.lowercase buf + OASISString.lowercase_ascii buf end @@ -393,6 +326,398 @@ module OASISUtils = struct 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_ "" + + + 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 @@ -413,27 +738,27 @@ module PropList = struct 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 @@ -442,27 +767,27 @@ module PropList = struct Hashtbl.clear t -(* # 78 "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 = { @@ -471,7 +796,7 @@ module PropList = struct order = Queue.create (); name_norm = (if case_insensitive then - String.lowercase + OASISString.lowercase_ascii else fun s -> s); } @@ -481,21 +806,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 @@ -521,7 +846,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 @@ -539,20 +864,20 @@ module PropList = struct 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 *) @@ -591,33 +916,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 *) @@ -629,9 +954,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 *) @@ -639,22 +964,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 @@ -676,7 +1001,7 @@ module PropList = struct 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 @@ -698,13 +1023,13 @@ 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 = @@ -731,12 +1056,6 @@ module OASISVersion = struct open OASISGettext - - - - type s = string - - type t = string @@ -750,20 +1069,10 @@ module OASISVersion = struct | VAnd of comparator * comparator - (* Range of allowed characters *) - let is_digit c = - '0' <= c && c <= '9' - - - let is_alpha c = - ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') - - - let is_special = - function - | '.' | '+' | '-' | '~' -> true - | _ -> false + let is_digit c = '0' <= c && c <= '9' + let is_alpha c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') + let is_special = function | '.' | '+' | '-' | '~' -> true | _ -> false let rec version_compare v1 v2 = @@ -771,7 +1080,7 @@ module OASISVersion = struct 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 @@ -806,45 +1115,44 @@ 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 @@ -853,16 +1161,12 @@ module OASISVersion = struct let string_of_version t = t - let version_compare_string s1 s2 = - version_compare (version_of_string s1) (version_of_string s2) - - let chop t = try let pos = String.rindex t '.' in - String.sub t 0 pos + String.sub t 0 pos with Not_found -> t @@ -870,19 +1174,19 @@ module OASISVersion = struct 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 = @@ -893,9 +1197,9 @@ 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 = @@ -905,28 +1209,16 @@ module OASISVersion = struct (OASISUtils.varname_of_string (string_of_version v)) in - function - | VGreater v -> concat "gt" v - | VLesser v -> concat "lt" v - | VEqual v -> concat "eq" v - | VGreaterEqual v -> concat "ge" v - | VLesserEqual v -> concat "le" v - | VOr (c1, c2) -> - (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2) - | VAnd (c1, c2) -> - (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2) - - - let rec comparator_ge v' = - let cmp v = version_compare v v' >= 0 in function - | VEqual v - | VGreaterEqual v - | VGreater v -> cmp v - | VLesserEqual _ - | VLesser _ -> false - | VOr (c1, c2) -> comparator_ge v' c1 || comparator_ge v' c2 - | VAnd (c1, c2) -> comparator_ge v' c1 && comparator_ge v' c2 + | VGreater v -> concat "gt" v + | VLesser v -> concat "lt" v + | VEqual v -> concat "eq" v + | VGreaterEqual v -> concat "ge" v + | VLesserEqual v -> concat "le" v + | VOr (c1, c2) -> + (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2) + | VAnd (c1, c2) -> + (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2) end @@ -937,15 +1229,10 @@ module OASISLicense = struct (** License for _oasis fields @author Sylvain Le Gall - *) - - - + *) type license = string - - type license_exception = string @@ -955,7 +1242,6 @@ module OASISLicense = struct | NoVersion - type license_dep_5_unit = { license: license; @@ -964,7 +1250,6 @@ module OASISLicense = struct } - type license_dep_5 = | DEP5Unit of license_dep_5_unit | DEP5Or of license_dep_5 list @@ -976,22 +1261,17 @@ module OASISLicense = struct | OtherLicense of string (* URL *) - end module OASISExpr = struct (* # 22 "src/oasis/OASISExpr.ml" *) - - - open OASISGettext + open OASISUtils type test = string - - type flag = string @@ -1004,7 +1284,6 @@ module OASISExpr = struct | ETest of test * string - type 'a choices = (t * 'a) list @@ -1076,20 +1355,148 @@ module OASISExpr = struct choose_aux (List.rev lst) -end +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 -module OASISText = struct -(* # 22 "src/oasis/OASISText.ml" *) + 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 - type elt = - | Para of string - | Verbatim of string - | BlankLine + let to_string t = t.Templater.origin - type t = elt list end @@ -1097,16 +1504,13 @@ module OASISTypes = struct (* # 22 "src/oasis/OASISTypes.ml" *) - - - type name = string type package_name = string type url = string type unix_dirname = string - type unix_filename = string - type host_dirname = string - type host_filename = string + type 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 @@ -1123,19 +1527,16 @@ module OASISTypes = struct | Best - type dependency = | FindlibPackage of findlib_full * OASISVersion.comparator option | InternalLibrary of name - type tool = | ExternalTool of name | InternalExecutable of name - type vcs = | Darcs | Git @@ -1148,30 +1549,29 @@ module OASISTypes = struct | 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 @@ -1183,129 +1583,128 @@ module OASISTypes = struct type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list -(* # 115 "src/oasis/OASISTypes.ml" *) - - type 'a conditional = 'a OASISExpr.choices type custom = - { - pre_command: (command_line option) conditional; - post_command: (command_line option) conditional; - } - + { + pre_command: (command_line option) conditional; + post_command: (command_line option) conditional; + } type common_section = - { - cs_name: name; - cs_data: PropList.Data.t; - cs_plugin_data: plugin_data; - } - + { + cs_name: name; + cs_data: PropList.Data.t; + cs_plugin_data: plugin_data; + } type build_section = - { - bs_build: bool conditional; - bs_install: bool conditional; - bs_path: unix_dirname; - bs_compiled_object: compiled_object; - bs_build_depends: dependency list; - bs_build_tools: tool list; - bs_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; - } - + { + 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_containers: findlib_name list; - } + { + 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_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; - } + { + exec_custom: bool; + exec_main_is: unix_filename; + } type flag = - { - flag_description: string option; - flag_default: bool conditional; - } + { + 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; - } + { + 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; - } + { + 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 + | HTML of unix_filename (* TODO: source filename. *) | DocText | PDF | PostScript - | Info of unix_filename + | 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; - 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; - } + { + 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 = @@ -1318,50 +1717,51 @@ module OASISTypes = struct | Doc of common_section * doc - type section_kind = - [ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ] + [ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ] type package = - { - oasis_version: OASISVersion.t; - ocaml_version: OASISVersion.comparator option; - findlib_version: OASISVersion.comparator option; - alpha_features: string list; - beta_features: string list; - name: package_name; - version: OASISVersion.t; - license: OASISLicense.t; - license_file: unix_filename option; - copyrights: string list; - maintainers: string list; - authors: string list; - homepage: url option; - synopsis: string; - description: OASISText.t option; - categories: url list; - - conf_type: [`Configure] plugin; - conf_custom: custom; - - build_type: [`Build] plugin; - build_custom: custom; - - install_type: [`Install] plugin; - install_custom: custom; - uninstall_custom: custom; - - clean_custom: custom; - distclean_custom: custom; - - files_ab: unix_filename list; - sections: section list; - plugins: [`Extra] plugin list; - disable_oasis_section: unix_filename list; - schema_data: PropList.Data.t; - plugin_data: plugin_data; - } + { + 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 @@ -1377,19 +1777,19 @@ module OASISFeatures = struct module MapPlugin = Map.Make (struct - type t = plugin_kind * name - let compare = Pervasives.compare - end) + type t = plugin_kind * name + let compare = Pervasives.compare + end) module Data = struct type t = - { - oasis_version: OASISVersion.t; - plugin_versions: OASISVersion.t option MapPlugin.t; - alpha_features: string list; - beta_features: string list; - } + { + oasis_version: OASISVersion.t; + plugin_versions: OASISVersion.t option MapPlugin.t; + alpha_features: string list; + beta_features: string list; + } let create oasis_version alpha_features beta_features = { @@ -1407,10 +1807,10 @@ module OASISFeatures = struct 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} + 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 @@ -1419,17 +1819,17 @@ module OASISFeatures = struct Printf.sprintf "oasis_version: %s; alpha_features: %s; beta_features: %s; \ plugins_version: %s" - (OASISVersion.string_of_version t.oasis_version) + (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 -> "")) + (match ver_opt with + | Some v -> + " "^(OASISVersion.string_of_version v) + | None -> "")) :: acc) t.plugin_versions [])) end @@ -1444,24 +1844,24 @@ module OASISFeatures = struct let string_of_stage = function - | Alpha -> "alpha" - | Beta -> "beta" + | Alpha -> "alpha" + | Beta -> "beta" let field_of_stage = function - | Alpha -> "AlphaFeatures" - | Beta -> "BetaFeatures" + | 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; - } + { + name: string; + plugin: all_plugin option; + publication: publication; + description: unit -> string; + } (* TODO: mutex protect this. *) let all_features = Hashtbl.create 13 @@ -1475,35 +1875,35 @@ module OASISFeatures = struct let to_string t = Printf.sprintf "feature: %s; plugin: %s; publication: %s" - t.name + (t:t).name (match t.plugin with - | None -> "" - | Some (_, nm, _) -> nm) + | None -> "" + | Some (_, nm, _) -> nm) (match t.publication with - | InDev stage -> string_of_stage stage - | SinceVersion ver -> ">= "^(OASISVersion.string_of_version ver)) + | InDev stage -> string_of_stage stage + | SinceVersion ver -> ">= "^(OASISVersion.string_of_version ver)) let data_check t data origin = let no_message = "no message" in let check_feature features stage = - let has_feature = List.mem t.name features in + let has_feature = List.mem (t:t).name features in if not has_feature then - match origin with - | Field (fld, where) -> - Some - (Printf.sprintf - (f_ "Field %s in %s is only available when feature %s \ - is in field %s.") - fld where t.name (field_of_stage stage)) - | Section sct -> - Some - (Printf.sprintf - (f_ "Section %s is only available when features %s \ - is in field %s.") - sct t.name (field_of_stage stage)) - | NoOrigin -> - Some no_message + 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 @@ -1513,132 +1913,128 @@ module OASISFeatures = struct OASISVersion.comparator_apply version (OASISVersion.VGreaterEqual min_version) in - Printf.ksprintf - (fun str -> - if version_is_good then - None - else - Some str) - fmt + Printf.ksprintf + (fun str -> if version_is_good then None else Some str) + fmt in match origin, t.plugin, t.publication with - | _, _, InDev Alpha -> check_feature data.Data.alpha_features Alpha - | _, _, InDev Beta -> check_feature data.Data.beta_features Beta - | Field(fld, where), None, SinceVersion min_version -> - version_is_good ~min_version data.Data.oasis_version - (f_ "Field %s in %s is only valid since OASIS v%s, update \ - OASISFormat field from '%s' to '%s' after checking \ - OASIS changelog.") - fld where (string_of_version min_version) - (string_of_version data.Data.oasis_version) - (string_of_version min_version) - - | Field(fld, where), Some(plugin_knd, plugin_name, _), - SinceVersion min_version -> - begin + | _, _, InDev Alpha -> check_feature data.Data.alpha_features Alpha + | _, _, InDev Beta -> check_feature data.Data.beta_features Beta + | Field(fld, where), None, SinceVersion min_version -> + version_is_good ~min_version data.Data.oasis_version + (f_ "Field %s in %s is only valid since OASIS v%s, update \ + OASISFormat field from '%s' to '%s' after checking \ + OASIS changelog.") + fld where (string_of_version min_version) + (string_of_version data.Data.oasis_version) + (string_of_version min_version) + + | Field(fld, where), Some(plugin_knd, plugin_name, _), + SinceVersion min_version -> + begin + try + let plugin_version_current = try - 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 + match Data.plugin_version plugin_knd plugin_name data with + | Some ver -> ver + | None -> + failwithf + (f_ "Field %s in %s is only valid for the OASIS \ + plugin %s since v%s, but no plugin version is \ + defined in the _oasis file, change '%s' to \ + '%s (%s)' in your _oasis file.") + fld where plugin_name (string_of_version min_version) + plugin_name + plugin_name (string_of_version min_version) + with Not_found -> + failwithf + (f_ "Field %s in %s is only valid when the OASIS plugin %s \ + is defined.") + fld where plugin_name + in + version_is_good ~min_version plugin_version_current + (f_ "Field %s in %s is only valid for the OASIS plugin %s \ + since v%s, update your plugin from '%s (%s)' to \ + '%s (%s)' after checking the plugin's changelog.") + fld where plugin_name (string_of_version min_version) + plugin_name (string_of_version plugin_version_current) + plugin_name (string_of_version min_version) + with Failure msg -> + Some msg + end - | Section sct, None, SinceVersion min_version -> - version_is_good ~min_version data.Data.oasis_version - (f_ "Section %s is only valid for since OASIS v%s, update \ - OASISFormat field from '%s' to '%s' after checking OASIS \ - changelog.") - sct (string_of_version min_version) - (string_of_version data.Data.oasis_version) - (string_of_version min_version) - - | Section sct, Some(plugin_knd, plugin_name, _), - SinceVersion min_version -> - begin + | 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 - 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 + match Data.plugin_version plugin_knd plugin_name data with + | Some ver -> ver + | None -> + failwithf + (f_ "Section %s is only valid for the OASIS \ + plugin %s since v%s, but no plugin version is \ + defined in the _oasis file, change '%s' to \ + '%s (%s)' in your _oasis file.") + sct plugin_name (string_of_version min_version) + plugin_name + plugin_name (string_of_version min_version) + with Not_found -> + failwithf + (f_ "Section %s is only valid when the OASIS plugin %s \ + is defined.") + sct plugin_name + in + version_is_good ~min_version plugin_version_current + (f_ "Section %s is only valid for the OASIS plugin %s \ + since v%s, update your plugin from '%s (%s)' to \ + '%s (%s)' after checking the plugin's changelog.") + sct plugin_name (string_of_version min_version) + plugin_name (string_of_version plugin_version_current) + plugin_name (string_of_version min_version) + with Failure msg -> + Some msg + end - | NoOrigin, None, SinceVersion min_version -> - version_is_good ~min_version data.Data.oasis_version "%s" no_message + | NoOrigin, None, SinceVersion min_version -> + version_is_good ~min_version data.Data.oasis_version "%s" no_message - | NoOrigin, Some(plugin_knd, plugin_name, _), SinceVersion min_version -> - begin - try - let plugin_version_current = - match Data.plugin_version plugin_knd plugin_name data with - | Some ver -> ver - | None -> raise Not_found - in - version_is_good ~min_version plugin_version_current - "%s" no_message - with Not_found -> - Some no_message - end + | NoOrigin, Some(plugin_knd, plugin_name, _), SinceVersion min_version -> + begin + try + let plugin_version_current = + match Data.plugin_version plugin_knd plugin_name data with + | Some ver -> ver + | None -> raise Not_found + in + version_is_good ~min_version plugin_version_current + "%s" no_message + with Not_found -> + Some no_message + end let data_assert t data origin = match data_check t data origin with - | None -> () - | Some str -> failwith str + | None -> () + | Some str -> failwith str let data_test t data = match data_check t data NoOrigin with - | None -> true - | Some str -> false + | None -> true + | Some _ -> false let package_test t pkg = @@ -1658,8 +2054,8 @@ module OASISFeatures = struct description = description; } in - Hashtbl.add all_features name t; - t + Hashtbl.add all_features name t; + t let get_stage name = @@ -1688,14 +2084,14 @@ module OASISFeatures = struct create "flag_docs" (since_version "0.3") (fun () -> - s_ "Building docs require '-docs' flag at configure.") + s_ "Make building docs require '-docs' flag at configure.") let flag_tests = create "flag_tests" (since_version "0.3") (fun () -> - s_ "Running tests require '-tests' flag at configure.") + s_ "Make running tests require '-tests' flag at configure.") let pack = @@ -1720,13 +2116,13 @@ module OASISFeatures = struct let compiled_setup_ml = create "compiled_setup_ml" alpha (fun () -> - s_ "It compiles the setup.ml and speed-up actions done with it.") + s_ "Compile the setup.ml and speed-up actions done with it.") let disable_oasis_section = create "disable_oasis_section" alpha (fun () -> - s_ "Allows the OASIS section comments and digest to be omitted in \ - generated files.") + s_ "Allow the OASIS section comments and digests to be omitted in \ + generated files.") let no_automatic_syntax = create "no_automatic_syntax" alpha @@ -1734,139 +2130,22 @@ module OASISFeatures = struct s_ "Disable the automatic inclusion of -syntax camlp4o for packages \ that matches the internal heuristic (if a dependency ends with \ a .syntax or is a well known syntax).") -end - -module OASISUnixPath = struct -(* # 22 "src/oasis/OASISUnixPath.ml" *) - - - type unix_filename = string - type unix_dirname = string - - - type host_filename = string - type host_dirname = string - - - let current_dir_name = "." - - - let parent_dir_name = ".." - - - let is_current_dir fn = - fn = current_dir_name || fn = "" - - - let concat f1 f2 = - if is_current_dir f1 then - f2 - else - let f1' = - try OASISString.strip_ends_with ~what:"/" f1 with Not_found -> f1 - in - f1'^"/"^f2 - - - let make = - function - | hd :: tl -> - List.fold_left - (fun f p -> concat f p) - hd - tl - | [] -> - invalid_arg "OASISUnixPath.make" - - - let dirname f = - try - String.sub f 0 (String.rindex f '/') - with Not_found -> - current_dir_name - - - let basename f = - try - let pos_start = - (String.rindex f '/') + 1 - in - String.sub f pos_start ((String.length f) - pos_start) - with Not_found -> - f - - - let chop_extension f = - try - let last_dot = - String.rindex f '.' - in - let sub = - String.sub f 0 last_dot - in - try - let last_slash = - String.rindex f '/' - in - if last_slash < last_dot then - sub - else - f - with Not_found -> - sub - - with Not_found -> - f - - - let capitalize_file f = - let dir = dirname f in - let base = basename f in - concat dir (String.capitalize base) - - - let uncapitalize_file f = - let dir = dirname f in - let base = basename f in - concat dir (String.uncapitalize base) - - -end - -module OASISHostPath = struct -(* # 22 "src/oasis/OASISHostPath.ml" *) - - - open Filename - - - module Unix = OASISUnixPath - - - let make = - function - | [] -> - invalid_arg "OASISHostPath.make" - | hd :: tl -> - List.fold_left Filename.concat hd tl - - let of_unix ufn = - if Sys.os_type = "Unix" then - ufn - else - make - (List.map - (fun p -> - if p = Unix.current_dir_name then - current_dir_name - else if p = Unix.parent_dir_name then - parent_dir_name - else - p) - (OASISString.nsplit ufn '/')) + 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 @@ -1879,19 +2158,19 @@ module OASISSection = struct let section_kind_common = function | 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 = @@ -1910,27 +2189,28 @@ module OASISSection = struct (** Key used to identify section - *) + *) 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 = @@ -1965,6 +2245,32 @@ end module OASISBuildSection = struct (* # 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 @@ -1988,16 +2294,16 @@ module OASISExecutable = struct | 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 @@ -2007,99 +2313,57 @@ module OASISLibrary = struct 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_module modul = - match find_module source_file_exists bs modul with - | `Sources (base_fn, [fn]) when ext <> "cmi" - && Filename.check_suffix fn ".mli" -> - None (* No implementation files for pure interface. *) - | `Sources (base_fn, _) -> - Some [base_fn] - | `No_sources lst -> - OASISMessage.warning - ~ctxt - (f_ "Cannot find source file matching \ - module '%s' in library %s") - modul cs.cs_name; - Some lst + 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) + match find_module nm with + | None -> acc + | Some base_fns -> + List.map (fun base_fn -> base_fn ^"."^ext) base_fns :: acc) [] lst in @@ -2108,21 +2372,21 @@ module OASISLibrary = struct let cmxs = let should_be_built = 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 lib.lib_pack then - find_modules - [cs.cs_name] - "cmx" - else - find_modules - (lib.lib_modules @ lib.lib_internal_modules) - "cmx" + if should_be_built then + if lib.lib_pack then + find_modules + [cs.cs_name] + "cmx" else - [] + find_modules + (lib.lib_modules @ lib.lib_internal_modules) + "cmx" + else + [] in let acc_nopath = @@ -2137,15 +2401,12 @@ module OASISLibrary = struct else [".cmi"; ".cmti"; ".cmt"; ".annot"] in List.map - begin - List.fold_left - begin fun accu s -> + (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 - end - [] - end + List.map ((^) base) sufx @ accu) + []) (find_modules lib.lib_modules "cmi") in @@ -2168,38 +2429,35 @@ module OASISLibrary = struct [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 @@ -2212,62 +2470,64 @@ module OASISObject = struct 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 @@ -2279,7 +2539,6 @@ module OASISFindlib = struct open OASISTypes open OASISUtils open OASISGettext - open OASISSection type library_name = name @@ -2297,12 +2556,13 @@ module OASISFindlib = struct 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 @@ -2320,53 +2580,53 @@ module OASISFindlib = struct let name = String.concat "." (lib.lib_findlib_containers @ [name]) in - name + name in - List.fold_left - (fun mp -> - function - | Library (cs, _, lib) -> - begin - let lib_name = cs.cs_name in - let fndlb_parts = fndlb_parts cs lib in - if MapString.mem lib_name mp then - failwithf - (f_ "The library name '%s' is used more than once.") - lib_name; - match lib.lib_findlib_parent with - | Some lib_name_parent -> - MapString.add - lib_name - (`Unsolved (lib_name_parent, fndlb_parts)) - mp - | None -> - MapString.add - lib_name - (`Solved fndlb_parts) - mp - end - - | Object (cs, _, obj) -> - begin - let obj_name = cs.cs_name in - if MapString.mem obj_name mp then - failwithf - (f_ "The object name '%s' is used more than once.") - obj_name; - let findlib_full_name = match obj.obj_findlib_fullname with - | Some ns -> String.concat "." ns - | None -> obj_name - in + List.fold_left + (fun mp -> + function + | Library (cs, _, lib) -> + begin + let lib_name = cs.cs_name in + let fndlb_parts = fndlb_parts cs lib in + if MapString.mem lib_name mp then + failwithf + (f_ "The library name '%s' is used more than once.") + lib_name; + match lib.lib_findlib_parent with + | Some lib_name_parent -> + MapString.add + lib_name + (`Unsolved (lib_name_parent, fndlb_parts)) + mp + | None -> MapString.add - obj_name - (`Solved findlib_full_name) + lib_name + (`Solved fndlb_parts) mp - end + end - | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ -> - mp) - MapString.empty - pkg.sections + | Object (cs, _, obj) -> + begin + let obj_name = cs.cs_name in + if MapString.mem obj_name mp then + failwithf + (f_ "The object name '%s' is used more than once.") + obj_name; + let findlib_full_name = match obj.obj_findlib_fullname with + | Some ns -> String.concat "." ns + | None -> obj_name + in + MapString.add + obj_name + (`Solved findlib_full_name) + mp + end + + | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ -> + mp) + MapString.empty + pkg.sections in (* Solve the above graph to be only library name to full findlib name. *) @@ -2378,40 +2638,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 "" in - mp) + let _, mp = solve SetString.empty mp lib_name "" 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. *) @@ -2423,75 +2683,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) = 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 @@ -2500,18 +2774,16 @@ 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 begin @@ -2529,15 +2801,15 @@ 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 = @@ -2545,24 +2817,24 @@ module OASISFindlib = struct (* We do a DFS in the group. *) function | Container (_, children) -> - List.fold_left - (fun res grp -> - if res = None then - root_lib_aux grp - else - res) - None - children - | Package (_, cs, bs, lib, _) -> - Some (cs, bs, lib) + List.fold_left + (fun res grp -> + if res = None then + root_lib_aux grp + else + res) + None + children + | Package (_, cs, bs, lib, _, _) -> + Some (cs, bs, lib) in - match root_lib_aux grp with - | Some res -> - res - | None -> - failwithf - (f_ "Unable to determine root library of findlib library '%s'") - (findlib_of_group grp) + match root_lib_aux grp with + | Some res -> + res + | None -> + failwithf + (f_ "Unable to determine root library of findlib library '%s'") + (findlib_of_group grp) end @@ -2608,7 +2880,7 @@ module OASISExec = struct (* 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 @@ -2626,57 +2898,57 @@ 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 @@ -2689,15 +2961,15 @@ module OASISFileUtil = struct 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 = @@ -2716,16 +2988,16 @@ 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 = @@ -2737,46 +3009,46 @@ module OASISFileUtil = struct p ^ e) ((combined_paths paths) * exts) in - List.find (fun file -> - (if case_sensitive then - file_exists_case file - else - Sys.file_exists file) - && not (Sys.is_directory file) - ) alternatives + 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 @@ -2787,24 +3059,24 @@ module OASISFileUtil = struct 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] @@ -2812,32 +3084,32 @@ module OASISFileUtil = struct 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 + if Sys.file_exists tgt then + begin + if not (Sys.is_directory tgt) then + OASISUtils.failwithf + (f_ "Cannot create directory '%s', a file of the same name already \ + exists") + tgt + end + else + begin + mkdir_parent ~ctxt f (Filename.dirname tgt); + if not (Sys.file_exists tgt) then + begin + f tgt; + mkdir ~ctxt tgt + end + end let rmdir ~ctxt tgt = if Sys.readdir tgt = [||] then begin match Sys.os_type with | "Win32" -> - OASISExec.run ~ctxt "rd" [q tgt] + OASISExec.run ~ctxt "rd" [q tgt] | _ -> - OASISExec.run ~ctxt "rm" ["-r"; q tgt] + OASISExec.run ~ctxt "rm" ["-r"; q tgt] end else begin OASISMessage.error ~ctxt (f_ "Cannot remove directory '%s': not empty.") @@ -2846,51 +3118,51 @@ module OASISFileUtil = struct 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 -# 2893 "setup.ml" +# 3165 "setup.ml" module BaseEnvLight = struct (* # 22 "src/base/BaseEnvLight.ml" *) @@ -2901,101 +3173,76 @@ module BaseEnvLight = struct type t = string MapString.t - let default_filename = - Filename.concat - (Sys.getcwd ()) - "setup.data" + 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 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 rec var_expand str env = - let buff = - Buffer.create ((String.length str) * 2) - in - Buffer.add_substitute - buff - (fun var -> - try - var_expand (MapString.find var env) env - with Not_found -> - failwith - (Printf.sprintf - "No variable %s defined when trying to expand %S." - var - str)) - str; - Buffer.contents buff - - - let var_get name env = - var_expand (MapString.find name env) env - - - let var_choose lst env = - OASISExpr.choose - (fun nm -> var_get nm env) - lst + let buff = Buffer.create ((String.length str) * 2) in + Buffer.add_substitute + buff + (fun var -> + try + var_expand (MapString.find var env) env + with Not_found -> + failwith + (Printf.sprintf + "No variable %s defined when trying to expand %S." + var + str)) + str; + Buffer.contents buff + + + let var_get name env = var_expand (MapString.find name env) env + let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst end -# 2998 "setup.ml" +# 3245 "setup.ml" module BaseContext = struct (* # 22 "src/base/BaseContext.ml" *) @@ -3016,7 +3263,7 @@ module BaseMessage = struct (** Message to user, overrid for Base @author Sylvain Le Gall - *) + *) open OASISMessage open BaseContext @@ -3039,6 +3286,7 @@ module BaseEnv = struct open OASISGettext open OASISUtils + open OASISContext open PropList @@ -3061,83 +3309,79 @@ module BaseEnv = struct 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 = @@ -3152,7 +3396,7 @@ module BaseEnv = struct raise e end in - var_expand vl + var_expand vl let var_choose ?printer ?name lst = @@ -3167,24 +3411,24 @@ module BaseEnv = struct 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 = [ @@ -3205,22 +3449,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) @@ -3230,13 +3474,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 = @@ -3252,24 +3496,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 () *) @@ -3290,7 +3534,7 @@ module BaseEnv = struct end - let var_ignore (e: unit -> string) = () + let var_ignore (_: unit -> string) = () let print_hidden = @@ -3315,12 +3559,34 @@ 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 () = @@ -3328,40 +3594,32 @@ module BaseEnv = struct 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 = @@ -3370,20 +3628,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) @@ -3395,123 +3648,122 @@ 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) + 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 @@ -3525,25 +3777,25 @@ module BaseArgExt = struct 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 @@ -3565,18 +3817,18 @@ 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 = @@ -3592,45 +3844,45 @@ module BaseCheck = struct 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 = @@ -3651,13 +3903,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 @@ -3665,19 +3917,19 @@ 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 @@ -3699,46 +3951,46 @@ module BaseOCamlcConfig = struct 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 = @@ -3752,13 +4004,13 @@ 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 = @@ -3773,30 +4025,30 @@ module BaseOCamlcConfig = struct String.sub s 0 (String.index s '+') with _ -> s - in + in let nm_config, value_config = match nm with | "ocaml_version" -> - "version", chop_version_suffix + "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 @@ -3806,7 +4058,6 @@ module BaseStandardVar = struct open OASISGettext open OASISTypes - open OASISExpr open BaseCheck open BaseEnv @@ -3836,11 +4087,11 @@ module BaseStandardVar = struct 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 () (**/**) @@ -3901,11 +4152,11 @@ module BaseStandardVar = struct 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) (**/**) @@ -3921,7 +4172,7 @@ module BaseStandardVar = struct 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") @@ -3935,12 +4186,12 @@ module BaseStandardVar = struct (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 = @@ -4076,12 +4327,12 @@ module BaseStandardVar = struct let _s: string = ocamlopt () in - "true" + "true" with PropList.Not_set _ -> let _s: string = ocamlc () in - "false") + "false") let ext_program = @@ -4134,7 +4385,7 @@ module BaseStandardVar = struct (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")) @@ -4173,35 +4424,35 @@ module BaseStandardVar = struct in let has_native_dynlink = let ocamlfind = ocamlfind () in - try - let fn = - OASISExec.run_read_one_line - ~ctxt:!BaseContext.default - ocamlfind - ["query"; "-predicates"; "native"; "dynlink"; - "-format"; "%d/%a"] - in - Sys.file_exists fn - with _ -> - false - in - if not has_native_dynlink then + 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 = @@ -4217,48 +4468,29 @@ module BaseFileAB = struct 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 @@ -4266,126 +4498,92 @@ module BaseLog = struct open OASISUtils + open OASISContext + open OASISGettext + open OASISFileSystem - let default_filename = - Filename.concat - (Filename.dirname BaseEnv.default_filename) - "setup.log" - - - module SetTupleString = - Set.Make - (struct - type t = string * string - let compare (s11, s12) (s21, s22) = - match String.compare s11 s21 with - | 0 -> String.compare s12 s22 - | n -> n - end) + let default_filename = in_srcdir "setup.log" - let load () = - if Sys.file_exists default_filename then - begin - let chn = - open_in default_filename - in - let scbuf = - Scanf.Scanning.from_file default_filename - in - let rec read_aux (st, lst) = - if not (Scanf.Scanning.end_of_input scbuf) then - begin - let acc = - try - Scanf.bscanf scbuf "%S %S\n" - (fun e d -> - let t = - e, d - in - if SetTupleString.mem t st then - st, lst - else - SetTupleString.add t st, - t :: lst) - with Scanf.Scan_failure _ -> - failwith - (Scanf.bscanf scbuf - "%l" - (fun line -> - Printf.sprintf - "Malformed log file '%s' at line %d" - default_filename - line)) - in - read_aux acc - end - else - begin - close_in chn; - List.rev lst - end - in - read_aux (SetTupleString.empty, []) - end - else - begin - [] - end + let 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 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 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 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 unregister ~ctxt event data = + let lst = load ~ctxt () in + let buf = Buffer.create 13 in + List.iter + (fun (e, d) -> + if e <> event || d <> data then + Printf.bprintf buf "%S %S\n" e d) + lst; + if Buffer.length buf > 0 then + defer_close + (ctxt.srcfs#open_out default_filename) + (fun wrtr -> wrtr#output buf) + else + ctxt.srcfs#remove default_filename - let filter 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 filter ~ctxt events = + let st_events = SetString.of_list events in + List.filter + (fun (e, _) -> SetString.mem e st_events) + (load ~ctxt ()) - let exists event data = + let exists ~ctxt event data = List.exists (fun v -> (event, data) = v) - (load ()) + (load ~ctxt ()) end module BaseBuilt = struct @@ -4408,100 +4606,81 @@ module BaseBuilt = struct let to_log_event_file t nm = "built_"^ - (match t with - | BExec -> "exec" - | BExecLib -> "exec_lib" - | BLib -> "lib" - | BObj -> "obj" - | BDoc -> "doc")^ - "_"^nm + (match t with + | BExec -> "exec" + | BExecLib -> "exec_lib" + | BLib -> "lib" + | BObj -> "obj" + | BDoc -> "doc")^ + "_"^nm let to_log_event_done t nm = "is_"^(to_log_event_file t nm) - let register t nm lst = - BaseLog.register - (to_log_event_done t nm) - "true"; + let register ~ctxt t nm lst = + BaseLog.register ~ctxt (to_log_event_done t nm) "true"; List.iter (fun alt -> let registered = List.fold_left (fun registered fn -> - if OASISFileUtil.file_exists_case fn then - begin - BaseLog.register - (to_log_event_file t nm) - (if Filename.is_relative fn then - Filename.concat (Sys.getcwd ()) fn - else - fn); - true - end - else - registered) + if OASISFileUtil.file_exists_case fn then begin + BaseLog.register ~ctxt + (to_log_event_file t nm) + (if Filename.is_relative fn then + Filename.concat (Sys.getcwd ()) fn + else + fn); + true + end else begin + registered + end) false alt in - if not registered then - warning - (f_ "Cannot find an existing alternative files among: %s") - (String.concat (s_ ", ") alt)) + if not registered then + warning + (f_ "Cannot find an existing alternative files among: %s") + (String.concat (s_ ", ") alt)) lst - let unregister t nm = + let unregister ~ctxt t nm = List.iter - (fun (e, d) -> - BaseLog.unregister e d) - (BaseLog.filter - [to_log_event_file t nm; - to_log_event_done t nm]) + (fun (e, d) -> BaseLog.unregister ~ctxt e d) + (BaseLog.filter ~ctxt [to_log_event_file t nm; to_log_event_done t nm]) - let fold t nm f acc = + let fold ~ctxt t nm f acc = List.fold_left (fun acc (_, fn) -> - if OASISFileUtil.file_exists_case fn then - begin - f acc fn - end - else - begin - warning - (f_ "File '%s' has been marked as built \ + if OASISFileUtil.file_exists_case fn then begin + f acc fn + end else begin + warning + (f_ "File '%s' has been marked as built \ for %s but doesn't exist") - fn - (Printf.sprintf - (match t with - | BExec | BExecLib -> - (f_ "executable %s") - | BLib -> - (f_ "library %s") - | BObj -> - (f_ "object %s") - | BDoc -> - (f_ "documentation %s")) - nm); - acc - end) + fn + (Printf.sprintf + (match t with + | BExec | BExecLib -> (f_ "executable %s") + | BLib -> (f_ "library %s") + | BObj -> (f_ "object %s") + | BDoc -> (f_ "documentation %s")) + nm); + acc + end) acc - (BaseLog.filter - [to_log_event_file t nm]) + (BaseLog.filter ~ctxt [to_log_event_file t nm]) - let is_built t nm = + let is_built ~ctxt t nm = List.fold_left - (fun is_built (_, d) -> - (try - bool_of_string d - with _ -> - false)) + (fun _ (_, d) -> try bool_of_string d with _ -> false) false - (BaseLog.filter - [to_log_event_done t nm]) + (BaseLog.filter ~ctxt [to_log_event_done t nm]) let of_executable ffn (cs, bs, exec) = @@ -4517,15 +4696,15 @@ module BaseBuilt = struct let evs = (BExec, cs.cs_name, [[ffn unix_exec_is]]) :: - (match unix_dll_opt with - | Some fn -> - [BExecLib, cs.cs_name, [[ffn fn]]] - | None -> - []) + (match unix_dll_opt with + | Some fn -> + [BExecLib, cs.cs_name, [[ffn fn]]] + | None -> + []) in - evs, - unix_exec_is, - unix_dll_opt + evs, + unix_exec_is, + unix_dll_opt let of_library ffn (cs, bs, lib) = @@ -4533,7 +4712,7 @@ module BaseBuilt = struct 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 ()) @@ -4545,7 +4724,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) = @@ -4553,7 +4732,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 @@ -4562,7 +4741,7 @@ module BaseBuilt = struct cs.cs_name, List.map (List.map ffn) unix_lst] in - evs, unix_lst + evs, unix_lst end @@ -4591,32 +4770,32 @@ 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 @@ -4629,41 +4808,38 @@ module BaseDynVar = struct open BaseBuilt - let init pkg = + let init ~ctxt pkg = (* TODO: disambiguate exec vs other variable by adding exec_VARNAME. *) (* TODO: provide compile option for library libary_byte_args_VARNAME... *) List.iter (function - | Executable (cs, bs, exec) -> - if var_choose bs.bs_build then - var_ignore - (var_redefine - (* We don't save this variable *) - ~dump:false - ~short_desc:(fun () -> - Printf.sprintf - (f_ "Filename of executable '%s'") - cs.cs_name) - (OASISUtils.varname_of_string cs.cs_name) - (fun () -> - let fn_opt = - fold - BExec cs.cs_name - (fun _ fn -> Some fn) - None - in - match fn_opt with - | Some fn -> fn - | None -> - raise - (PropList.Not_set - (cs.cs_name, - Some (Printf.sprintf - (f_ "Executable '%s' not yet built.") - cs.cs_name))))) - - | Library _ | Object _ | Flag _ | Test _ | SrcRepo _ | Doc _ -> - ()) + | Executable (cs, bs, _) -> + if var_choose bs.bs_build then + var_ignore + (var_redefine + (* We don't save this variable *) + ~dump:false + ~short_desc:(fun () -> + Printf.sprintf + (f_ "Filename of executable '%s'") + cs.cs_name) + (OASISUtils.varname_of_string cs.cs_name) + (fun () -> + let fn_opt = + fold ~ctxt BExec cs.cs_name (fun _ fn -> Some fn) None + in + match fn_opt with + | Some fn -> fn + | None -> + raise + (PropList.Not_set + (cs.cs_name, + Some (Printf.sprintf + (f_ "Executable '%s' not yet built.") + cs.cs_name))))) + + | Library _ | Object _ | Flag _ | Test _ | SrcRepo _ | Doc _ -> + ()) pkg.sections end @@ -4674,53 +4850,48 @@ module BaseTest = struct 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 @@ -4728,35 +4899,25 @@ module BaseTest = struct (failure, n) end in - let failed, n = - List.fold_left - one_test - (0.0, 0) - lst - in - let failure_percent = - if n = 0 then - 0.0 - else - failed /. (float_of_int n) - in + let failed, n = List.fold_left one_test (0.0, 0) lst in + let failure_percent = if n = 0 then 0.0 else failed /. (float_of_int n) in let msg = Printf.sprintf (f_ "Tests had a %.2f%% failure rate") (100. *. failure_percent) in - if failure_percent > 0.0 then - failwith msg - else - info "%s" msg; - - (* Possible explanation why the tests where not run. *) - if 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'" + if failure_percent > 0.0 then + failwith msg + else + info "%s" msg; + + (* Possible explanation why the tests where not run. *) + if OASISFeatures.package_test OASISFeatures.flag_tests pkg && + not (bool_of_string (BaseStandardVar.tests ())) && + lst <> [] then + BaseMessage.warning + "Tests are turned off, consider enabling with \ + 'ocaml setup.ml -configure --enable-tests'" end module BaseDoc = struct @@ -4769,74 +4930,79 @@ module BaseDoc = struct open OASISGettext - let doc lst pkg extra_args = + let doc ~ctxt lst pkg extra_args = let one_doc (doc_plugin, cs, doc) = if var_choose - ~name:(Printf.sprintf - (f_ "documentation %s build") - cs.cs_name) - ~printer:string_of_bool - doc.doc_build then + ~name:(Printf.sprintf + (f_ "documentation %s build") + cs.cs_name) + ~printer:string_of_bool + doc.doc_build then begin info (f_ "Building documentation '%s'") cs.cs_name; BaseCustom.hook doc.doc_custom - (doc_plugin pkg (cs, doc)) + (doc_plugin ~ctxt pkg (cs, doc)) extra_args end in - List.iter one_doc lst; - - if 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'" + List.iter one_doc lst; + + if OASISFeatures.package_test OASISFeatures.flag_docs pkg && + not (bool_of_string (BaseStandardVar.docs ())) && + lst <> [] then + BaseMessage.warning + "Docs are turned off, consider enabling with \ + 'ocaml setup.ml -configure --enable-docs'" end module BaseSetup = struct (* # 22 "src/base/BaseSetup.ml" *) + open 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 *) @@ -4846,9 +5012,9 @@ module BaseSetup = struct (fun acc sct -> match filter_map sct with | Some e -> - e :: acc + e :: acc | None -> - acc) + acc) [] lst) @@ -4865,7 +5031,7 @@ module BaseSetup = struct action - let configure t args = + let configure ~ctxt t args = (* Run configure *) BaseCustom.hook t.package.conf_custom @@ -4874,154 +5040,137 @@ module BaseSetup = struct 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 - let arg_rest = - ref [] - 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"; + [ + "-no-doc", + Arg.Set rno_doc, + s_ "Don't run doc 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'")) - ""; + "-no-test", + Arg.Set rno_test, + s_ "Don't run test target"; - info "Running configure step"; - configure t (Array.of_list (List.rev !arg_rest)); + "--", + Arg.Rest (fun arg -> arg_rest := arg :: !arg_rest), + s_ "All arguments for configure."; + ] + (failwithf (f_ "Don't know what to do with '%s'")) + ""; - info "Running build step"; - build t [||]; + info "Running configure step"; + configure ~ctxt t (Array.of_list (List.rev !arg_rest)); - (* Load setup.log dynamic variables *) - BaseDynVar.init t.package; + info "Running build step"; + build ~ctxt t [||]; - if not !rno_doc then - begin - info "Running doc step"; - doc t [||]; - end - else - begin - info "Skipping doc step" - end; + (* Load setup.log dynamic variables *) + BaseDynVar.init ~ctxt t.package; - if not !rno_test then - begin - info "Running test step"; - test t [||] - end - else - begin - info "Skipping test step" - end + if not !rno_doc then begin + info "Running doc step"; + doc ~ctxt t [||] + end else begin + info "Skipping doc step" + end; + if not !rno_test then begin + info "Running test step"; + test ~ctxt t [||] + end else begin + info "Skipping test step" + end - let install t args = - BaseCustom.hook - t.package.install_custom - (t.install t.package) - args + let install ~ctxt t args = + BaseCustom.hook t.package.install_custom (t.install ~ctxt 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 t args = - uninstall t args; - install t args + let reinstall ~ctxt t args = + uninstall ~ctxt t args; + install ~ctxt t args let clean, distclean = @@ -5032,11 +5181,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 @@ -5044,45 +5193,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 @@ -5091,12 +5227,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 @@ -5104,36 +5241,31 @@ 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 t _ = - print_endline t.oasis_version + let version ~ctxt:_ (t: 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" @@ -5154,16 +5286,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 @@ -5174,64 +5306,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 @@ -5248,7 +5378,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, \ @@ -5262,158 +5392,287 @@ module BaseSetup = struct 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 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 -# 5409 "setup.ml" +# 5668 "setup.ml" module InternalConfigurePlugin = struct (* # 22 "src/plugins/internal/InternalConfigurePlugin.ml" *) (** Configure using internal scheme @author Sylvain Le Gall - *) + *) open BaseEnv @@ -5424,9 +5683,9 @@ module InternalConfigurePlugin = struct (** Configure build using provided series of check to be done - * and then output corresponding file. - *) - let configure pkg argv = + 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 @@ -5448,29 +5707,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 @@ -5494,39 +5753,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 @@ -5538,50 +5797,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 = @@ -5606,37 +5865,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 *) @@ -5665,6 +5924,8 @@ module InternalInstallPlugin = struct *) + (* TODO: rewrite this module with OASISFileSystem. *) + open BaseEnv open BaseStandardVar open BaseMessage @@ -5674,34 +5935,17 @@ module InternalInstallPlugin = struct open OASISUtils - let exec_hook = - ref (fun (cs, bs, exec) -> cs, bs, exec) - - - let lib_hook = - ref (fun (cs, bs, lib) -> cs, bs, lib, []) - - - let obj_hook = - ref (fun (cs, bs, obj) -> cs, bs, obj, []) - - - let doc_hook = - ref (fun (cs, doc) -> cs, doc) - - - let install_file_ev = - "install-file" - - - let install_dir_ev = - "install-dir" + let 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_findlib_ev = - "install-findlib" + let install_file_ev = "install-file" + 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 @@ -5770,7 +6014,7 @@ module InternalInstallPlugin = struct ["install" :: findlib_name :: meta :: files] - let install pkg argv = + let install = let in_destdir = try @@ -5785,9 +6029,9 @@ module InternalInstallPlugin = struct fun 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 @@ -5800,20 +6044,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 @@ -5830,7 +6102,7 @@ module InternalInstallPlugin = struct src; List.iter (fun fn -> - install_file + install_file ~ctxt fn (fun () -> match tgt_opt with @@ -5845,8 +6117,8 @@ module InternalInstallPlugin = struct let make_fnames modul sufx = List.fold_right begin fun sufx accu -> - (String.capitalize modul ^ sufx) :: - (String.uncapitalize modul ^ sufx) :: + (OASISString.capitalize_ascii modul ^ sufx) :: + (OASISString.uncapitalize_ascii modul ^ sufx) :: accu end sufx @@ -5854,149 +6126,146 @@ module InternalInstallPlugin = struct in (** Install all libraries *) - let install_libs pkg = - - let files_of_library (f_data, acc) data_lib = - let cs, bs, lib, lib_extra = - !lib_hook data_lib - in - if var_choose bs.bs_install && - BaseBuilt.is_built BaseBuilt.BLib cs.cs_name then - begin - let acc = - (* Start with acc + lib_extra *) - List.rev_append lib_extra acc - in - let acc = - (* Add uncompiled header from the source tree *) - let path = - OASISHostPath.of_unix bs.bs_path - in - List.fold_left - begin fun acc modul -> - begin - try - [List.find - OASISFileUtil.file_exists_case - (List.map - (Filename.concat path) - (make_fnames modul [".mli"; ".ml"]))] - with Not_found -> - warning - (f_ "Cannot find source header for module %s \ - in library %s") - modul cs.cs_name; - [] - end - @ - List.filter - OASISFileUtil.file_exists_case - (List.map - (Filename.concat path) - (make_fnames modul [".annot";".cmti";".cmt"])) - @ acc - end - acc - lib.lib_modules - in + let 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 - begin fun acc modul -> - begin - try - [List.find - OASISFileUtil.file_exists_case - (List.map - (Filename.concat path) - (make_fnames modul [".mli"; ".ml"]))] - with Not_found -> - warning - (f_ "Cannot find source header for module %s \ - in object %s") - modul cs.cs_name; - [] - end - @ - List.filter - OASISFileUtil.file_exists_case - (List.map - (Filename.concat path) - (make_fnames modul [".annot";".cmti";".cmt"])) - @ acc - end - acc - obj.obj_modules - in - - let acc = - (* Get generated files *) - BaseBuilt.fold - BaseBuilt.BObj - cs.cs_name - (fun acc fn -> fn :: acc) - acc - in + let f_data () = + (* Install data associated with the library *) + install_data + ~ctxt + bs.bs_path + bs.bs_data_files + (Filename.concat + (datarootdir ()) + pkg.name); + f_data () + in + f_data, new_files @ extra_files + in - let f_data () = - (* Install data associated with the object *) - install_data - bs.bs_path - bs.bs_data_files - (Filename.concat - (datarootdir ()) - pkg.name); - f_data () - in + let files_of_library (f_data, acc) data_lib = + let cs, bs, lib, dn, lib_extra = !lib_hook data_lib in + if var_choose bs.bs_install && + BaseBuilt.is_built ~ctxt BaseBuilt.BLib cs.cs_name then begin + (* Start with lib_extra *) + let new_files = lib_extra in + let new_files = + files_of_modules new_files "library" cs bs lib.lib_modules + in + let f_data, new_files = + files_of_build_section (f_data, new_files) "library" cs bs + in + let new_files = + (* Get generated files *) + BaseBuilt.fold + ~ctxt + BaseBuilt.BLib + cs.cs_name + (fun acc fn -> fn :: acc) + new_files + in + let acc = (dn, new_files) :: acc in + + let f_data () = + (* Install data associated with the library *) + install_data + ~ctxt + bs.bs_path + bs.bs_data_files + (Filename.concat + (datarootdir ()) + pkg.name); + f_data () + in - (f_data, acc) - end - else - begin - (f_data, acc) - end + (f_data, acc) + end else begin + (f_data, acc) + end + and files_of_object (f_data, acc) data_obj = + let cs, bs, obj, dn, obj_extra = !obj_hook data_obj in + if var_choose bs.bs_install && + BaseBuilt.is_built ~ctxt BaseBuilt.BObj cs.cs_name then begin + (* Start with obj_extra *) + let new_files = obj_extra in + let new_files = + files_of_modules new_files "object" cs bs obj.obj_modules + in + let f_data, new_files = + files_of_build_section (f_data, new_files) "object" cs bs + in + let new_files = + (* Get generated files *) + BaseBuilt.fold + ~ctxt + BaseBuilt.BObj + cs.cs_name + (fun acc fn -> fn :: acc) + new_files + in + let acc = (dn, new_files) :: acc in + + let f_data () = + (* Install data associated with the object *) + install_data + ~ctxt + bs.bs_path + bs.bs_data_files + (Filename.concat (datarootdir ()) pkg.name); + f_data () + in + (f_data, acc) + end else begin + (f_data, acc) + end in (* Install one group of library *) @@ -6007,10 +6276,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 @@ -6019,264 +6288,196 @@ 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 - - install_libs pkg; - install_execs pkg; - install_docs pkg + fun ~ctxt pkg _ -> + install_libs ~ctxt pkg; + install_execs ~ctxt pkg; + install_docs ~ctxt 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 -# 6273 "setup.ml" +# 6474 "setup.ml" module OCamlbuildCommon = struct (* # 22 "src/plugins/ocamlbuild/OCamlbuildCommon.ml" *) (** Functions common to OCamlbuild build and doc plugin - *) + *) open OASISGettext @@ -6285,8 +6486,6 @@ module OCamlbuildCommon = struct open OASISTypes - - type extra_args = string list @@ -6309,6 +6508,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") ] @@ -6345,35 +6552,32 @@ module OCamlbuildCommon = struct (** 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 *) @@ -6381,13 +6585,13 @@ module OCamlbuildCommon = struct 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 @@ -6408,17 +6612,12 @@ module OCamlbuildPlugin = struct open BaseEnv open OCamlbuildCommon open BaseStandardVar - open BaseMessage - - + let cond_targets_hook = ref (fun lst -> lst) - let cond_targets_hook = - ref (fun lst -> lst) - - let build extra_args pkg argv = + let build ~ctxt extra_args pkg argv = (* Return the filename in build directory *) let in_build_dir fn = Filename.concat @@ -6482,8 +6681,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 @@ -6498,10 +6697,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 = @@ -6515,7 +6712,7 @@ module OCamlbuildPlugin = struct (* 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, _ when nm = cs.cs_name -> BaseBuilt.BExec, nm, [[in_build_dir_of_unix unix_tgt]] | ev -> @@ -6559,27 +6756,30 @@ module OCamlbuildPlugin = struct (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 (* Run the hook *) let cond_targets = !cond_targets_hook cond_targets in (* Run a list of target... *) - run_ocamlbuild (List.flatten (List.map snd cond_targets) @ extra_args) argv; + 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 @@ -6593,16 +6793,12 @@ module OCamlbuildDocPlugin = struct (* Create documentation using ocamlbuild .odocl files @author Sylvain Le Gall - *) + *) open OASISTypes open OASISGettext - open OASISMessage open OCamlbuildCommon - open BaseStandardVar - - type run_t = @@ -6612,7 +6808,7 @@ module OCamlbuildDocPlugin = struct } - let doc_build run pkg (cs, doc) argv = + let doc_build ~ctxt run _ (cs, _) argv = let index_html = OASISUnixPath.make [ @@ -6629,139 +6825,126 @@ module OCamlbuildDocPlugin = struct cs.cs_name^".docdir"; ] in - run_ocamlbuild (index_html :: run.extra_args) argv; - List.iter - (fun glb -> - BaseBuilt.register - BaseBuilt.BDoc - cs.cs_name - [OASISFileUtil.glob ~ctxt:!BaseContext.default - (Filename.concat tgt_dir glb)]) - ["*.html"; "*.css"] + run_ocamlbuild ~ctxt (index_html :: run.extra_args) argv; + List.iter + (fun glb -> + BaseBuilt.register + ~ctxt + BaseBuilt.BDoc + cs.cs_name + [OASISFileUtil.glob ~ctxt (Filename.concat tgt_dir glb)]) + ["*.html"; "*.css"] - let doc_clean run pkg (cs, doc) argv = - run_clean argv; - BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name + let doc_clean ~ctxt _ _ (cs, _) argv = + run_clean ~ctxt argv; + BaseBuilt.unregister ~ctxt BaseBuilt.BDoc cs.cs_name end -# 6651 "setup.ml" +# 6847 "setup.ml" module CustomPlugin = struct (* # 22 "src/plugins/custom/CustomPlugin.ml" *) (** Generate custom configure/build/doc/test/install system @author - *) + *) open BaseEnv open OASISGettext open OASISTypes - - - - type t = - { - cmd_main: command_line conditional; - cmd_clean: (command_line option) conditional; - cmd_distclean: (command_line option) conditional; - } + { + cmd_main: command_line conditional; + cmd_clean: (command_line option) conditional; + cmd_distclean: (command_line option) conditional; + } let run = BaseCustom.run - let main t _ extra_args = - let cmd, args = - var_choose - ~name:(s_ "main command") - t.cmd_main - in - run cmd args extra_args + let main ~ctxt:_ t _ extra_args = + let cmd, args = var_choose ~name:(s_ "main command") t.cmd_main in + run cmd args extra_args - let clean t pkg extra_args = + let clean ~ctxt:_ t _ extra_args = match var_choose t.cmd_clean with - | Some (cmd, args) -> - run cmd args extra_args - | _ -> - () + | Some (cmd, args) -> run cmd args extra_args + | _ -> () - let distclean t pkg extra_args = + let distclean ~ctxt:_ t _ extra_args = match var_choose t.cmd_distclean with - | Some (cmd, args) -> - run cmd args extra_args - | _ -> - () + | Some (cmd, args) -> run cmd args extra_args + | _ -> () module Build = struct - let main t pkg extra_args = - main t pkg extra_args; + let main ~ctxt t pkg extra_args = + main ~ctxt t pkg extra_args; List.iter (fun sct -> let evs = match sct with | Library (cs, bs, lib) when var_choose bs.bs_build -> - begin - let evs, _ = - BaseBuilt.of_library - OASISHostPath.of_unix - (cs, bs, lib) - in - evs - end + begin + let evs, _ = + BaseBuilt.of_library + OASISHostPath.of_unix + (cs, bs, lib) + in + evs + end | Executable (cs, bs, exec) when var_choose bs.bs_build -> - begin - let evs, _, _ = - BaseBuilt.of_executable - OASISHostPath.of_unix - (cs, bs, exec) - in - evs - end + begin + let evs, _, _ = + BaseBuilt.of_executable + OASISHostPath.of_unix + (cs, bs, exec) + in + evs + end | _ -> - [] + [] in - List.iter - (fun (bt, bnm, lst) -> BaseBuilt.register bt bnm lst) - evs) + List.iter + (fun (bt, bnm, lst) -> BaseBuilt.register ~ctxt bt bnm lst) + evs) pkg.sections - let clean t pkg extra_args = - clean t pkg extra_args; + let clean ~ctxt t pkg extra_args = + clean ~ctxt t pkg extra_args; (* TODO: this seems to be pretty generic (at least wrt to ocamlbuild * considering moving this to BaseSetup? *) List.iter (function - | Library (cs, _, _) -> - BaseBuilt.unregister BaseBuilt.BLib cs.cs_name - | Executable (cs, _, _) -> - BaseBuilt.unregister BaseBuilt.BExec cs.cs_name; - BaseBuilt.unregister BaseBuilt.BExecLib cs.cs_name - | _ -> - ()) + | Library (cs, _, _) -> + BaseBuilt.unregister ~ctxt BaseBuilt.BLib cs.cs_name + | Executable (cs, _, _) -> + BaseBuilt.unregister ~ctxt BaseBuilt.BExec cs.cs_name; + BaseBuilt.unregister ~ctxt BaseBuilt.BExecLib cs.cs_name + | _ -> + ()) pkg.sections - let distclean t pkg extra_args = - distclean t pkg extra_args + let distclean ~ctxt t pkg extra_args = distclean ~ctxt t pkg extra_args end module Test = struct - let main t pkg (cs, test) extra_args = + let main ~ctxt t pkg (cs, _) extra_args = try - main t pkg extra_args; + main ~ctxt t pkg extra_args; 0.0 with Failure s -> BaseMessage.warning @@ -6770,33 +6953,30 @@ module CustomPlugin = struct s; 1.0 - let clean t pkg (cs, test) extra_args = - clean t pkg extra_args + let clean ~ctxt t pkg _ extra_args = clean ~ctxt t pkg extra_args - let distclean t pkg (cs, test) extra_args = - distclean t pkg extra_args + let distclean ~ctxt t pkg _ extra_args = distclean ~ctxt t pkg extra_args end module Doc = struct - let main t pkg (cs, _) extra_args = - main t pkg extra_args; - BaseBuilt.register BaseBuilt.BDoc cs.cs_name [] + let main ~ctxt t pkg (cs, _) extra_args = + main ~ctxt t pkg extra_args; + BaseBuilt.register ~ctxt BaseBuilt.BDoc cs.cs_name [] - let clean t pkg (cs, _) extra_args = - clean t pkg extra_args; - BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name + let clean ~ctxt t pkg (cs, _) extra_args = + clean ~ctxt t pkg extra_args; + BaseBuilt.unregister ~ctxt BaseBuilt.BDoc cs.cs_name - let distclean t pkg (cs, _) extra_args = - distclean t pkg extra_args + let distclean ~ctxt t pkg _ extra_args = distclean ~ctxt t pkg extra_args end end -# 6799 "setup.ml" +# 6979 "setup.ml" open OASISTypes;; let setup_t = @@ -6847,10 +7027,6 @@ let setup_t = { oasis_version = "0.4"; ocaml_version = None; - findlib_version = None; - alpha_features = []; - beta_features = []; - name = "mustache"; version = "2.1.0"; license = OASISLicense.DEP5License @@ -6860,47 +7036,20 @@ let setup_t = excption = None; version = OASISLicense.NoVersion }); + findlib_version = None; + alpha_features = []; + beta_features = []; + name = "mustache"; license_file = None; copyrights = []; maintainers = []; authors = ["Rudi Grinberg"]; homepage = None; + bugreports = None; synopsis = "Mustache.js templates in OCaml"; description = None; + tags = []; categories = []; - conf_type = (`Configure, "internal", Some "0.4"); - conf_custom = - { - pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)] - }; - build_type = (`Build, "ocamlbuild", Some "0.4"); - build_custom = - { - pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)] - }; - install_type = (`Install, "internal", Some "0.4"); - install_custom = - { - pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)] - }; - uninstall_custom = - { - pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)] - }; - clean_custom = - { - pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)] - }; - distclean_custom = - { - pre_command = [(OASISExpr.EBool true, None)]; - post_command = [(OASISExpr.EBool true, None)] - }; files_ab = []; sections = [ @@ -6919,8 +7068,119 @@ let setup_t = bs_build_tools = [ExternalTool "ocamlbuild"; 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, [])]; @@ -6939,6 +7199,7 @@ let setup_t = ]; lib_findlib_parent = None; lib_findlib_name = None; + lib_findlib_directory = None; lib_findlib_containers = [] }); Flag @@ -7000,8 +7261,119 @@ let setup_t = InternalLibrary "mustache" ]; 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, [])]; @@ -7010,6 +7382,140 @@ let setup_t = bs_nativeopt = [(OASISExpr.EBool true, [])] }, {exec_custom = true; exec_main_is = "test_mustache.ml"}); + Executable + ({ + cs_name = "mustache_example"; + cs_data = PropList.Data.create (); + cs_plugin_data = [] + }, + { + bs_build = [(OASISExpr.EBool true, true)]; + bs_install = [(OASISExpr.EBool true, false)]; + bs_path = "examples"; + bs_compiled_object = Best; + bs_build_depends = [InternalLibrary "mustache"]; + 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 = true; exec_main_is = "mustache_example.ml"}); Executable ({ cs_name = "mustache_cli"; @@ -7031,8 +7537,119 @@ let setup_t = FindlibPackage ("ezjsonm", None) ]; 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, [])]; @@ -7042,15 +7659,47 @@ let setup_t = }, {exec_custom = true; exec_main_is = "mustache_cli.ml"}) ]; - plugins = [(`Extra, "META", Some "0.4")]; 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, "META", Some "0.4")]; schema_data = PropList.Data.create (); plugin_data = [] }; oasis_fn = Some "_oasis"; - oasis_version = "0.4.5"; - oasis_digest = - Some "\171[F\254\198\240\243\135\205\162\0217\242\225\209^"; + oasis_version = "0.4.8"; + oasis_digest = Some "\198n$\163L\201S\176\146\142n\155\181\191\128y"; oasis_exec = None; oasis_setup_args = []; setup_update = false @@ -7058,6 +7707,8 @@ let setup_t = let setup () = BaseSetup.setup setup_t;; -# 7062 "setup.ml" +# 7711 "setup.ml" +let setup_t = BaseCompat.Compat_0_4.adapt_setup_t setup_t +open BaseCompat.Compat_0_4 (* OASIS_STOP *) let () = setup ();;