commit 62e6a4998b05a93a7e3859c7e464997debaf6ecf Author: Jan Rękorajski <bagg...@pld-linux.org> Date: Sat Nov 24 15:46:51 2018 +0100
- up to 0.7.1 google-drive-ocamlfuse.spec | 23 +- jbuilder.patch | 8512 ------------------------------------------- noopt-fuse.patch | 11 - 3 files changed, 6 insertions(+), 8540 deletions(-) --- diff --git a/google-drive-ocamlfuse.spec b/google-drive-ocamlfuse.spec index 9d8b452..1be3d14 100644 --- a/google-drive-ocamlfuse.spec +++ b/google-drive-ocamlfuse.spec @@ -1,18 +1,11 @@ -# -# Conditional build: -%bcond_without opt # build opt - -%ifarch x32 -%undefine with_opt -%endif Summary: FUSE filesystem over Google Drive Name: google-drive-ocamlfuse -Version: 0.6.24 -Release: 2 +Version: 0.7.1 +Release: 1 License: BSD Group: Applications/Networking Source0: https://github.com/astrada/google-drive-ocamlfuse/archive/v%{version}/%{name}-%{version}.tar.gz -# Source0-md5: 36d98c9b038993e4fa910259a4deab0e +# Source0-md5: acb4837c6717bc75cdcc4095beeee287 Patch0: noopt-fuse.patch Patch1: jbuilder.patch URL: https://github.com/astrada/google-drive-ocamlfuse @@ -21,6 +14,7 @@ BuildRequires: ocaml >= 4.02.3 BuildRequires: ocaml-biniou-devel >= 1.0.6 BuildRequires: ocaml-cryptokit-devel >= 1.9 BuildRequires: ocaml-curl-devel >= 0.6.0 +BuildRequires: ocaml-dune BuildRequires: ocaml-easy-format-devel >= 1.0.1 BuildRequires: ocaml-extlib-devel >= 1.5.4 BuildRequires: ocaml-findlib >= 1.4 @@ -64,19 +58,14 @@ tej biblioteki. %prep %setup -q -%patch1 -p1 -R -%{!?with_opt:%patch0 -p1} %build -ocaml setup.ml -configure \ - --prefix $RPM_BUILD_ROOT/%{_prefix} - -ocaml setup.ml -build +dune build @install --verbose %install rm -rf $RPM_BUILD_ROOT -ocaml setup.ml -install +DESTDIR=$RPM_BUILD_ROOT dune install %clean rm -rf $RPM_BUILD_ROOT diff --git a/jbuilder.patch b/jbuilder.patch deleted file mode 100644 index b333f20..0000000 --- a/jbuilder.patch +++ /dev/null @@ -1,8512 +0,0 @@ -From a38afe51455173069af5a5950471944b3863b166 Mon Sep 17 00:00:00 2001 -From: Rudi Grinberg <rudi.grinb...@gmail.com> -Date: Fri, 24 Nov 2017 17:48:57 +0800 -Subject: [PATCH] Port build system to jbuilder - -Requires the tests and the binary to live in different directories ---- - _oasis | 46 - - _tags | 37 - - {src => bin}/gdfuse.ml | 0 - bin/jbuild | 9 + - opam/descr => google-drive-ocamlfuse.descr | 0 - google-drive-ocamlfuse.install | 5 - - opam/opam => google-drive-ocamlfuse.opam | 15 +- - myocamlbuild.ml | 890 ---- - setup.ml | 7441 ---------------------------- - src/jbuild | 5 + - test/jbuild | 10 + - {src => test}/testBufferPool.ml | 0 - {src => test}/testBuffering.ml | 0 - {src => test}/testSuite.ml | 0 - {src => test}/testThreadPool.ml | 0 - 15 files changed, 27 insertions(+), 8431 deletions(-) - delete mode 100644 _oasis - delete mode 100644 _tags - rename {src => bin}/gdfuse.ml (100%) - create mode 100644 bin/jbuild - rename opam/descr => google-drive-ocamlfuse.descr (100%) - delete mode 100644 google-drive-ocamlfuse.install - rename opam/opam => google-drive-ocamlfuse.opam (55%) - delete mode 100644 myocamlbuild.ml - delete mode 100644 setup.ml - create mode 100644 src/jbuild - create mode 100644 test/jbuild - rename {src => test}/testBufferPool.ml (100%) - rename {src => test}/testBuffering.ml (100%) - rename {src => test}/testSuite.ml (100%) - rename {src => test}/testThreadPool.ml (100%) - -diff --git a/_oasis b/_oasis -deleted file mode 100644 -index da49fed..0000000 ---- a/_oasis -+++ /dev/null -@@ -1,46 +0,0 @@ --OASISFormat: 0.4 --OCamlVersion: >= 4.02.3 --Name: google-drive-ocamlfuse --Version: 0.6.22 --LicenseFile: LICENSE --License: MIT --BuildType: ocamlbuild (0.3) --Authors: Alessandro Strada --Maintainers: Alessandro Strada <alessandro.str...@gmail.com> --Copyrights: (C) 2012-2017 Alessandro Strada --Homepage: http://gdfuse.forge.ocamlcore.org/ --BuildTools: ocamlbuild -- --Synopsis: A FUSE filesystem over Google Drive --Description: -- google-drive-ocamlfuse is a FUSE-based file system backed by Google Drive, -- written in OCaml. -- --# Executables --Executable "google-drive-ocamlfuse" -- Path: src -- MainIs: gdfuse.ml -- Install: true -- CompiledObject: best -- BuildDepends: gapi-ocaml (>= 0.3.5), Fuse, sqlite3, threads, camlidl -- --# Executables --Executable "test_suite" -- Build$: flag(tests) -- Path: src -- MainIs: testSuite.ml -- Install: false -- BuildDepends: oUnit, gapi-ocaml (>= 0.3.5), threads -- --Test core -- Run$: flag(tests) -- Command: $test_suite -- TestTools: test_suite -- --# VCS --SourceRepository head -- Type: git -- Location: https://github.com/astrada/google-drive-ocamlfuse.git -- Browser: https://github.com/astrada/google-drive-ocamlfuse -- Branch: master -- -diff --git a/_tags b/_tags -deleted file mode 100644 -index 6fa8639..0000000 ---- a/_tags -+++ /dev/null -@@ -1,37 +0,0 @@ --# Disable warning 3 (Deprecated feature), and 58 (Missing cmx file) for --# compatibility with old compilers --<src/*.ml>: warn(-d-58) -- --# OASIS_START --# DO NOT EDIT (digest: 9432052b171f53269959183289307973) --# Ignore VCS directories, you can use the same kind of rule outside --# OASIS_START/STOP if you want to exclude directories that contains --# useless stuff for the build process --true: annot, bin_annot --<**/.svn>: -traverse --<**/.svn>: not_hygienic --".bzr": -traverse --".bzr": not_hygienic --".hg": -traverse --".hg": not_hygienic --".git": -traverse --".git": not_hygienic --"_darcs": -traverse --"_darcs": not_hygienic --# Executable google-drive-ocamlfuse --<src/gdfuse.{native,byte}>: package(Fuse) --<src/gdfuse.{native,byte}>: package(camlidl) --<src/gdfuse.{native,byte}>: package(gapi-ocaml) --<src/gdfuse.{native,byte}>: package(sqlite3) --<src/gdfuse.{native,byte}>: package(threads) --<src/*.ml{,i,y}>: package(Fuse) --<src/*.ml{,i,y}>: package(camlidl) --<src/*.ml{,i,y}>: package(sqlite3) --# Executable test_suite --"src/testSuite.byte": package(gapi-ocaml) --"src/testSuite.byte": package(oUnit) --"src/testSuite.byte": package(threads) --<src/*.ml{,i,y}>: package(gapi-ocaml) --<src/*.ml{,i,y}>: package(oUnit) --<src/*.ml{,i,y}>: package(threads) --# OASIS_STOP -diff --git a/src/gdfuse.ml b/bin/gdfuse.ml -similarity index 100% -rename from src/gdfuse.ml -rename to bin/gdfuse.ml -diff --git a/opam/descr b/google-drive-ocamlfuse.descr -similarity index 100% -rename from opam/descr -rename to google-drive-ocamlfuse.descr -diff --git a/google-drive-ocamlfuse.install b/google-drive-ocamlfuse.install -deleted file mode 100644 -index 075d452..0000000 ---- a/google-drive-ocamlfuse.install -+++ /dev/null -@@ -1,5 +0,0 @@ --etc: [ -- "setup.ml" -- "setup.data" -- "setup.log" --] -diff --git a/myocamlbuild.ml b/myocamlbuild.ml -deleted file mode 100644 -index 5924578..0000000 ---- a/myocamlbuild.ml -+++ /dev/null -@@ -1,890 +0,0 @@ --(* OASIS_START *) --(* DO NOT EDIT (digest: 9bd78b75e5e0b109a1abb54bf043b292) *) --module OASISGettext = struct --(* # 22 "src/oasis/OASISGettext.ml" *) -- -- -- let ns_ str = str -- let s_ str = str -- let f_ (str: ('a, 'b, 'c, 'd) format4) = str -- -- -- let fn_ fmt1 fmt2 n = -- if n = 1 then -- fmt1^^"" -- else -- fmt2^^"" -- -- -- let init = [] --end -- --module OASISString = struct --(* # 22 "src/oasis/OASISString.ml" *) -- -- -- (** Various string utilities. -- -- Mostly inspired by extlib and batteries ExtString and BatString libraries. -- -- @author Sylvain Le Gall -- *) -- -- -- let nsplitf str f = -- if str = "" then -- [] -- else -- let buf = Buffer.create 13 in -- let lst = ref [] in -- let push () = -- lst := Buffer.contents buf :: !lst; -- Buffer.clear buf -- in -- let str_len = String.length str in -- for i = 0 to str_len - 1 do -- if f str.[i] then -- push () -- else -- Buffer.add_char buf str.[i] -- done; -- push (); -- List.rev !lst -- -- -- (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the -- separator. -- *) -- let nsplit str c = -- nsplitf str ((=) c) -- -- -- let find ~what ?(offset=0) str = -- let what_idx = ref 0 in -- let str_idx = ref offset in -- while !str_idx < String.length str && -- !what_idx < String.length what do -- if str.[!str_idx] = what.[!what_idx] then -- incr what_idx -- else -- what_idx := 0; -- incr str_idx -- done; -- if !what_idx <> String.length what then -- raise Not_found -- else -- !str_idx - !what_idx -- -- -- let sub_start str len = -- let str_len = String.length str in -- if len >= str_len then -- "" -- else -- String.sub str len (str_len - len) -- -- -- let sub_end ?(offset=0) str len = -- let str_len = String.length str in -- if len >= str_len then -- "" -- else -- String.sub str 0 (str_len - len) -- -- -- let starts_with ~what ?(offset=0) str = -- let what_idx = ref 0 in -- let str_idx = ref offset in -- let ok = ref true in -- while !ok && -- !str_idx < String.length str && -- !what_idx < String.length what do -- if str.[!str_idx] = what.[!what_idx] then -- incr what_idx -- else -- ok := false; -- incr str_idx -- done; -- !what_idx = String.length what -- -- -- let strip_starts_with ~what str = -- if starts_with ~what str then -- sub_start str (String.length what) -- else -- raise Not_found -- -- -- let ends_with ~what ?(offset=0) str = -- let what_idx = ref ((String.length what) - 1) in -- let str_idx = ref ((String.length str) - 1) in -- let ok = ref true in -- while !ok && -- offset <= !str_idx && -- 0 <= !what_idx do -- if str.[!str_idx] = what.[!what_idx] then -- decr what_idx -- else -- ok := false; -- decr str_idx -- done; -- !what_idx = -1 -- -- -- let strip_ends_with ~what str = -- if ends_with ~what str then -- sub_end str (String.length what) -- else -- raise Not_found -- -- -- let replace_chars f s = -- let buf = Buffer.create (String.length s) in -- String.iter (fun c -> Buffer.add_char buf (f c)) s; -- Buffer.contents buf -- -- let lowercase_ascii = -- replace_chars -- (fun c -> -- if (c >= 'A' && c <= 'Z') then -- Char.chr (Char.code c + 32) -- else -- c) -- -- let uncapitalize_ascii s = -- if s <> "" then -- (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) -- else -- s -- -- let uppercase_ascii = -- replace_chars -- (fun c -> -- if (c >= 'a' && c <= 'z') then -- Char.chr (Char.code c - 32) -- else -- c) -- -- let capitalize_ascii s = -- if s <> "" then -- (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) -- else -- s -- --end -- --module OASISUtils = struct --(* # 22 "src/oasis/OASISUtils.ml" *) -- -- -- open OASISGettext -- -- -- module MapExt = -- struct -- module type S = -- sig -- include Map.S -- val add_list: 'a t -> (key * 'a) list -> 'a t -- val of_list: (key * 'a) list -> 'a t -- val to_list: 'a t -> (key * 'a) list -- end -- -- module Make (Ord: Map.OrderedType) = -- struct -- include Map.Make(Ord) -- -- let rec add_list t = -- function -- | (k, v) :: tl -> add_list (add k v t) tl -- | [] -> t -- -- let of_list lst = add_list empty lst -- -- let to_list t = fold (fun k v acc -> (k, v) :: acc) t [] -- end -- end -- -- -- module MapString = MapExt.Make(String) -- -- -- module SetExt = -- struct -- module type S = -- sig -- include Set.S -- val add_list: t -> elt list -> t -- val of_list: elt list -> t -- val to_list: t -> elt list -- end -- -- module Make (Ord: Set.OrderedType) = -- struct -- include Set.Make(Ord) -- -- let rec add_list t = -- function -- | e :: tl -> add_list (add e t) tl -- | [] -> t -- -- let of_list lst = add_list empty lst -- -- let to_list = elements -- end -- end -- -- -- module SetString = SetExt.Make(String) -- -- -- let compare_csl s1 s2 = -- String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2) -- -- -- module HashStringCsl = -- Hashtbl.Make -- (struct -- type t = string -- let equal s1 s2 = (compare_csl s1 s2) = 0 -- let hash s = Hashtbl.hash (OASISString.lowercase_ascii s) -- end) -- -- module SetStringCsl = -- SetExt.Make -- (struct -- type t = string -- let compare = compare_csl -- end) -- -- -- let varname_of_string ?(hyphen='_') s = -- if String.length s = 0 then -- begin -- invalid_arg "varname_of_string" -- end -- else -- begin -- let buf = -- OASISString.replace_chars -- (fun c -> -- if ('a' <= c && c <= 'z') -- || -- ('A' <= c && c <= 'Z') -- || -- ('0' <= c && c <= '9') then -- c -- else -- hyphen) -- s; -- in -- let buf = -- (* Start with a _ if digit *) -- if '0' <= s.[0] && s.[0] <= '9' then -- "_"^buf -- else -- buf -- in -- OASISString.lowercase_ascii buf -- end -- -- -- let varname_concat ?(hyphen='_') p s = -- let what = String.make 1 hyphen in -- let p = -- try -- OASISString.strip_ends_with ~what p -- with Not_found -> -- p -- in -- let s = -- try -- OASISString.strip_starts_with ~what s -- with Not_found -> -- s -- in -- p^what^s -- -- -- let is_varname str = -- str = varname_of_string str -- -- -- let failwithf fmt = Printf.ksprintf failwith fmt -- -- -- let rec file_location ?pos1 ?pos2 ?lexbuf () = -- match pos1, pos2, lexbuf with -- | Some p, None, _ | None, Some p, _ -> -- file_location ~pos1:p ~pos2:p ?lexbuf () -- | Some p1, Some p2, _ -> -- let open Lexing in -- let fn, lineno = p1.pos_fname, p1.pos_lnum in -- let c1 = p1.pos_cnum - p1.pos_bol in -- let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in -- Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2 -- | _, _, Some lexbuf -> -- file_location -- ~pos1:(Lexing.lexeme_start_p lexbuf) -- ~pos2:(Lexing.lexeme_end_p lexbuf) -- () -- | None, None, None -> -- s_ "<position undefined>" -- -- -- let failwithpf ?pos1 ?pos2 ?lexbuf fmt = -- let loc = file_location ?pos1 ?pos2 ?lexbuf () in -- Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt -- -- --end -- --module OASISExpr = struct --(* # 22 "src/oasis/OASISExpr.ml" *) -- -- -- open OASISGettext -- open OASISUtils -- -- -- type test = string -- type flag = string -- -- -- type t = -- | EBool of bool -- | ENot of t -- | EAnd of t * t -- | EOr of t * t -- | EFlag of flag -- | ETest of test * string -- -- -- type 'a choices = (t * 'a) list -- -- -- let eval var_get t = -- let rec eval' = -- function -- | EBool b -> -- b -- -- | ENot e -> -- not (eval' e) -- -- | EAnd (e1, e2) -> -- (eval' e1) && (eval' e2) -- -- | EOr (e1, e2) -> -- (eval' e1) || (eval' e2) -- -- | EFlag nm -> -- let v = -- var_get nm -- in -- assert(v = "true" || v = "false"); -- (v = "true") -- -- | ETest (nm, vl) -> -- let v = -- var_get nm -- in -- (v = vl) -- in -- eval' t -- -- -- let choose ?printer ?name var_get lst = -- let rec choose_aux = -- function -- | (cond, vl) :: tl -> -- if eval var_get cond then -- vl -- else -- choose_aux tl -- | [] -> -- let str_lst = -- if lst = [] then -- s_ "<empty>" -- else -- String.concat -- (s_ ", ") -- (List.map -- (fun (cond, vl) -> -- match printer with -- | Some p -> p vl -- | None -> s_ "<no printer>") -- lst) -- in -- match name with -- | Some nm -> -- failwith -- (Printf.sprintf -- (f_ "No result for the choice list '%s': %s") -- nm str_lst) -- | None -> -- failwith -- (Printf.sprintf -- (f_ "No result for a choice list: %s") -- str_lst) -- in -- choose_aux (List.rev lst) -- -- --end -- -- --# 437 "myocamlbuild.ml" --module BaseEnvLight = struct --(* # 22 "src/base/BaseEnvLight.ml" *) -- -- -- module MapString = Map.Make(String) -- -- -- type t = string MapString.t -- -- -- let default_filename = Filename.concat (Sys.getcwd ()) "setup.data" -- -- -- let load ?(allow_empty=false) ?(filename=default_filename) ?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 -- failwith -- (Printf.sprintf -- "Unable to load environment, the file '%s' doesn't exist." -- filename) -- end -- -- let rec var_expand str env = -- let buff = Buffer.create ((String.length str) * 2) in -- Buffer.add_substitute -- buff -- (fun var -> -- try -- var_expand (MapString.find var env) env -- with Not_found -> -- failwith -- (Printf.sprintf -- "No variable %s defined when trying to expand %S." -- var -- str)) -- str; -- Buffer.contents buff -- -- -- let var_get name env = var_expand (MapString.find name env) env -- let var_choose lst env = OASISExpr.choose (fun nm -> var_get nm env) lst --end -- -- --# 517 "myocamlbuild.ml" --module MyOCamlbuildFindlib = struct --(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *) -- -- -- (** OCamlbuild extension, copied from -- * https://ocaml.org/learn/tutorials/ocamlbuild/Using_ocamlfind_with_ocamlbuild.html -- * by N. Pouillard and others -- * -- * Updated on 2016-06-02 -- * -- * Modified by Sylvain Le Gall -- *) -- open Ocamlbuild_plugin -- -- -- type conf = {no_automatic_syntax: bool} -- -- -- let run_and_read = Ocamlbuild_pack.My_unix.run_and_read -- -- -- let blank_sep_strings = Ocamlbuild_pack.Lexers.blank_sep_strings -- -- -- let exec_from_conf exec = -- let exec = -- let env = BaseEnvLight.load ~allow_empty:true () in -- try -- BaseEnvLight.var_get exec env -- with Not_found -> -- Printf.eprintf "W: Cannot get variable %s\n" exec; -- exec -- in -- let fix_win32 str = -- if Sys.os_type = "Win32" then begin -- let buff = Buffer.create (String.length str) in -- (* Adapt for windowsi, ocamlbuild + win32 has a hard time to handle '\\'. -- *) -- String.iter -- (fun c -> Buffer.add_char buff (if c = '\\' then '/' else c)) -- str; -- Buffer.contents buff -- end else begin -- str -- end -- in -- fix_win32 exec -- -- -- let split s ch = -- let buf = Buffer.create 13 in -- let x = ref [] in -- let flush () = -- 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 -- -- -- let split_nl s = split s '\n' -- -- -- let before_space s = -- try -- String.before s (String.index s ' ') -- with Not_found -> s -- -- (* ocamlfind command *) -- let ocamlfind x = S[Sh (exec_from_conf "ocamlfind"); x] -- -- (* This lists all supported packages. *) -- let find_packages () = -- List.map before_space (split_nl & run_and_read (exec_from_conf "ocamlfind" ^ " list")) -- -- -- (* Mock to list available syntaxes. *) -- let find_syntaxes () = ["camlp4o"; "camlp4r"] -- -- -- let well_known_syntax = [ -- "camlp4.quotations.o"; -- "camlp4.quotations.r"; -- "camlp4.exceptiontracer"; -- "camlp4.extend"; -- "camlp4.foldgenerator"; -- "camlp4.listcomprehension"; -- "camlp4.locationstripper"; -- "camlp4.macro"; -- "camlp4.mapgenerator"; -- "camlp4.metagenerator"; -- "camlp4.profiler"; -- "camlp4.tracer" -- ] -- -- -- let dispatch conf = -- function -- | After_options -> -- (* By using Before_options one let command line options have an higher -- * priority on the contrary using After_options will guarantee to have -- * the higher priority override default commands by ocamlfind ones *) -- Options.ocamlc := ocamlfind & A"ocamlc"; -- Options.ocamlopt := ocamlfind & A"ocamlopt"; -- Options.ocamldep := ocamlfind & A"ocamldep"; -- Options.ocamldoc := ocamlfind & A"ocamldoc"; -- Options.ocamlmktop := ocamlfind & A"ocamlmktop"; -- Options.ocamlmklib := ocamlfind & A"ocamlmklib" -- -- | After_rules -> -- -- (* 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 ["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 --(* # 22 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) -- -- -- (** Base functions for writing myocamlbuild.ml -- @author Sylvain Le Gall -- *) -- -- -- open Ocamlbuild_plugin -- module OC = Ocamlbuild_pack.Ocaml_compiler -- -- -- type dir = string -- type file = string -- type name = string -- type tag = string -- -- -- type t = -- { -- lib_ocaml: (name * dir list * string list) list; -- lib_c: (name * dir * file list) list; -- flags: (tag list * (spec OASISExpr.choices)) list; -- (* Replace the 'dir: include' from _tags by a precise interdepends in -- * directory. -- *) -- includes: (dir * dir list) list; -- } -- -- --(* # 110 "src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *) -- -- -- let env_filename = Pathname.basename BaseEnvLight.default_filename -- -- -- let dispatch_combine lst = -- fun e -> -- List.iter -- (fun dispatch -> dispatch e) -- lst -- -- -- let tag_libstubs nm = -- "use_lib"^nm^"_stubs" -- -- -- let nm_libstubs nm = -- nm^"_stubs" -- -- -- let dispatch t e = -- let env = BaseEnvLight.load ~allow_empty:true () in -- match e with -- | Before_options -> -- let no_trailing_dot s = -- if String.length s >= 1 && s.[0] = '.' then -- String.sub s 1 ((String.length s) - 1) -- else -- s -- in -- List.iter -- (fun (opt, var) -> -- try -- opt := no_trailing_dot (BaseEnvLight.var_get var env) -- with Not_found -> -- Printf.eprintf "W: Cannot get variable %s\n" var) -- [ -- Options.ext_obj, "ext_obj"; -- Options.ext_lib, "ext_lib"; -- Options.ext_dll, "ext_dll"; -- ] -- -- | After_rules -> -- (* Declare OCaml libraries *) -- List.iter -- (function -- | nm, [], intf_modules -> -- ocaml_lib nm; -- let cmis = -- List.map (fun m -> (OASISString.uncapitalize_ascii m) ^ ".cmi") -- intf_modules in -- dep ["ocaml"; "link"; "library"; "file:"^nm^".cma"] cmis -- | nm, dir :: tl, intf_modules -> -- ocaml_lib ~dir:dir (dir^"/"^nm); -- List.iter -- (fun dir -> -- List.iter -- (fun str -> -- flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir])) -- ["compile"; "infer_interface"; "doc"]) -- tl; -- let cmis = -- List.map (fun m -> dir^"/"^(OASISString.uncapitalize_ascii m)^".cmi") -- intf_modules in -- dep ["ocaml"; "link"; "library"; "file:"^dir^"/"^nm^".cma"] -- cmis) -- t.lib_ocaml; -- -- (* Declare directories dependencies, replace "include" in _tags. *) -- List.iter -- (fun (dir, include_dirs) -> -- Pathname.define_context dir include_dirs) -- t.includes; -- -- (* Declare C libraries *) -- List.iter -- (fun (lib, dir, headers) -> -- (* Handle C part of library *) -- flag ["link"; "library"; "ocaml"; "byte"; tag_libstubs lib] -- (S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib"; -- A("-l"^(nm_libstubs lib))]); -- -- flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib] -- (S[A"-cclib"; A("-l"^(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 ["compile"; "ocaml"; tag_libstubs lib] -- [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; -- -- (* TODO: be more specific about what depends on headers *) -- (* Depends on .h files *) -- dep ["compile"; "c"] -- headers; -- -- (* Setup search path for lib *) -- flag ["link"; "ocaml"; "use_"^lib] -- (S[A"-I"; P(dir)]); -- ) -- t.lib_c; -- -- (* Add flags *) -- List.iter -- (fun (tags, cond_specs) -> -- let spec = BaseEnvLight.var_choose cond_specs env in -- let rec eval_specs = -- function -- | S lst -> S (List.map eval_specs lst) -- | A str -> A (BaseEnvLight.var_expand str env) -- | spec -> spec -- in -- flag tags & (eval_specs spec)) -- t.flags -- | _ -> -- () -- -- -- let dispatch_default conf t = -- dispatch_combine -- [ -- dispatch t; -- MyOCamlbuildFindlib.dispatch conf; -- ] -- -- --end -- -- --# 878 "myocamlbuild.ml" --open Ocamlbuild_plugin;; --let package_default = -- {MyOCamlbuildBase.lib_ocaml = []; lib_c = []; flags = []; includes = []} -- ;; -- --let conf = {MyOCamlbuildFindlib.no_automatic_syntax = false} -- --let dispatch_default = MyOCamlbuildBase.dispatch_default conf package_default;; -- --# 889 "myocamlbuild.ml" --(* OASIS_STOP *) --Ocamlbuild_plugin.dispatch dispatch_default;; -diff --git a/setup.ml b/setup.ml -deleted file mode 100644 -index 267b6c9..0000000 ---- a/setup.ml -+++ /dev/null -@@ -1,7441 +0,0 @@ --(* setup.ml generated for the first time by OASIS v0.2.1~alpha1 *) -- --(* OASIS_START *) --(* DO NOT EDIT (digest: 6d0395f376a201274c938a7195749cc3) *) --(* -- Regenerated by OASIS v0.4.10 -- Visit http://oasis.forge.ocamlcore.org for more information and -- documentation about functions used in this file. --*) --module OASISGettext = struct --(* # 22 "src/oasis/OASISGettext.ml" *) -- -- -- let ns_ str = str -- let s_ str = str -- let f_ (str: ('a, 'b, 'c, 'd) format4) = str -- -- -- let fn_ fmt1 fmt2 n = -- if n = 1 then -- fmt1^^"" -- else -- fmt2^^"" -- -- -- let init = [] --end -- --module OASISString = struct --(* # 22 "src/oasis/OASISString.ml" *) -- -- -- (** Various string utilities. -- -- Mostly inspired by extlib and batteries ExtString and BatString libraries. -- -- @author Sylvain Le Gall -- *) -- -- -- let nsplitf str f = -- if str = "" then -- [] -- else -- let buf = Buffer.create 13 in -- let lst = ref [] in -- let push () = -- lst := Buffer.contents buf :: !lst; -- Buffer.clear buf -- in -- let str_len = String.length str in -- for i = 0 to str_len - 1 do -- if f str.[i] then -- push () -- else -- Buffer.add_char buf str.[i] -- done; -- push (); -- List.rev !lst -- -- -- (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the -- separator. -- *) -- let nsplit str c = -- nsplitf str ((=) c) -- -- -- let find ~what ?(offset=0) str = -- let what_idx = ref 0 in -- let str_idx = ref offset in -- while !str_idx < String.length str && -- !what_idx < String.length what do -- if str.[!str_idx] = what.[!what_idx] then -- incr what_idx -- else -- what_idx := 0; -- incr str_idx -- done; -- if !what_idx <> String.length what then -- raise Not_found -- else -- !str_idx - !what_idx -- -- -- let sub_start str len = -- let str_len = String.length str in -- if len >= str_len then -- "" -- else -- String.sub str len (str_len - len) -- -- -- let sub_end ?(offset=0) str len = -- let str_len = String.length str in -- if len >= str_len then -- "" -- else -- String.sub str 0 (str_len - len) -- -- -- let starts_with ~what ?(offset=0) str = -- let what_idx = ref 0 in -- let str_idx = ref offset in -- let ok = ref true in -- while !ok && -- !str_idx < String.length str && -- !what_idx < String.length what do -- if str.[!str_idx] = what.[!what_idx] then -- incr what_idx -- else -- ok := false; -- incr str_idx -- done; -- !what_idx = String.length what -- -- -- let strip_starts_with ~what str = -- if starts_with ~what str then -- sub_start str (String.length what) -- else -- raise Not_found -- -- -- let ends_with ~what ?(offset=0) str = -- let what_idx = ref ((String.length what) - 1) in -- let str_idx = ref ((String.length str) - 1) in -- let ok = ref true in -- while !ok && -- offset <= !str_idx && -- 0 <= !what_idx do -- if str.[!str_idx] = what.[!what_idx] then -- decr what_idx -- else -- ok := false; -- decr str_idx -- done; -- !what_idx = -1 -- -- -- let strip_ends_with ~what str = -- if ends_with ~what str then -- sub_end str (String.length what) -- else -- raise Not_found -- -- -- let replace_chars f s = -- let buf = Buffer.create (String.length s) in -- String.iter (fun c -> Buffer.add_char buf (f c)) s; -- Buffer.contents buf -- -- let lowercase_ascii = -- replace_chars -- (fun c -> -- if (c >= 'A' && c <= 'Z') then -- Char.chr (Char.code c + 32) -- else -- c) -- -- let uncapitalize_ascii s = -- if s <> "" then -- (lowercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) -- else -- s -- -- let uppercase_ascii = -- replace_chars -- (fun c -> -- if (c >= 'a' && c <= 'z') then -- Char.chr (Char.code c - 32) -- else -- c) -- -- let capitalize_ascii s = -- if s <> "" then -- (uppercase_ascii (String.sub s 0 1)) ^ (String.sub s 1 ((String.length s) - 1)) -- else -- s -- --end -- --module OASISUtils = struct --(* # 22 "src/oasis/OASISUtils.ml" *) -- -- -- open OASISGettext -- -- -- module MapExt = -- struct -- module type S = -- sig -- include Map.S -- val add_list: 'a t -> (key * 'a) list -> 'a t -- val of_list: (key * 'a) list -> 'a t -- val to_list: 'a t -> (key * 'a) list -- end -- -- module Make (Ord: Map.OrderedType) = -- struct -- include Map.Make(Ord) -- -- let rec add_list t = -- function -- | (k, v) :: tl -> add_list (add k v t) tl -- | [] -> t -- -- let of_list lst = add_list empty lst -- -- let to_list t = fold (fun k v acc -> (k, v) :: acc) t [] -- end -- end -- -- -- module MapString = MapExt.Make(String) -- -- -- module SetExt = -- struct -- module type S = -- sig -- include Set.S -- val add_list: t -> elt list -> t -- val of_list: elt list -> t -- val to_list: t -> elt list -- end -- -- module Make (Ord: Set.OrderedType) = -- struct -- include Set.Make(Ord) -- -- let rec add_list t = -- function -- | e :: tl -> add_list (add e t) tl -- | [] -> t -- -- let of_list lst = add_list empty lst -- -- let to_list = elements -- end -- end -- -- -- module SetString = SetExt.Make(String) -- -- -- let compare_csl s1 s2 = -- String.compare (OASISString.lowercase_ascii s1) (OASISString.lowercase_ascii s2) -- -- -- module HashStringCsl = -- Hashtbl.Make -- (struct -- type t = string -- let equal s1 s2 = (compare_csl s1 s2) = 0 -- let hash s = Hashtbl.hash (OASISString.lowercase_ascii s) -- end) -- -- module SetStringCsl = -- SetExt.Make -- (struct -- type t = string -- let compare = compare_csl -- end) -- -- -- let varname_of_string ?(hyphen='_') s = -- if String.length s = 0 then -- begin -- invalid_arg "varname_of_string" -- end -- else -- begin -- let buf = -- OASISString.replace_chars -- (fun c -> -- if ('a' <= c && c <= 'z') -- || -- ('A' <= c && c <= 'Z') -- || -- ('0' <= c && c <= '9') then -- c -- else -- hyphen) -- s; -- in -- let buf = -- (* Start with a _ if digit *) -- if '0' <= s.[0] && s.[0] <= '9' then -- "_"^buf -- else -- buf -- in -- OASISString.lowercase_ascii buf -- end -- -- -- let varname_concat ?(hyphen='_') p s = -- let what = String.make 1 hyphen in -- let p = -- try -- OASISString.strip_ends_with ~what p -- with Not_found -> -- p -- in -- let s = -- try -- OASISString.strip_starts_with ~what s -- with Not_found -> -- s -- in -- p^what^s -- -- -- let is_varname str = -- str = varname_of_string str -- -- -- let failwithf fmt = Printf.ksprintf failwith fmt -- -- -- let rec file_location ?pos1 ?pos2 ?lexbuf () = -- match pos1, pos2, lexbuf with -- | Some p, None, _ | None, Some p, _ -> -- file_location ~pos1:p ~pos2:p ?lexbuf () -- | Some p1, Some p2, _ -> -- let open Lexing in -- let fn, lineno = p1.pos_fname, p1.pos_lnum in -- let c1 = p1.pos_cnum - p1.pos_bol in -- let c2 = c1 + (p2.pos_cnum - p1.pos_cnum) in -- Printf.sprintf (f_ "file %S, line %d, characters %d-%d") fn lineno c1 c2 -- | _, _, Some lexbuf -> -- file_location -- ~pos1:(Lexing.lexeme_start_p lexbuf) -- ~pos2:(Lexing.lexeme_end_p lexbuf) -- () -- | None, None, None -> -- s_ "<position undefined>" -- -- -- let failwithpf ?pos1 ?pos2 ?lexbuf fmt = -- let loc = file_location ?pos1 ?pos2 ?lexbuf () in -- Printf.ksprintf (fun s -> failwith (Printf.sprintf "%s: %s" loc s)) fmt -- -- --end -- --module 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 --(* # 22 "src/oasis/PropList.ml" *) -- -- -- open OASISGettext -- -- -- type name = string -- -- -- exception Not_set of name * string option -- exception No_printer of name -- exception Unknown_field of name * name -- -- -- let () = -- Printexc.register_printer -- (function -- | Not_set (nm, Some rsn) -> -- Some -- (Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn) -- | Not_set (nm, None) -> -- Some -- (Printf.sprintf (f_ "Field '%s' is not set") nm) -- | No_printer nm -> -- Some -- (Printf.sprintf (f_ "No default printer for value %s") nm) -- | Unknown_field (nm, schm) -> -- Some -- (Printf.sprintf -- (f_ "Field %s is not defined in schema %s") nm schm) -- | _ -> -- None) -- -- -- module Data = -- struct -- type t = -- (name, unit -> unit) Hashtbl.t -- -- let create () = -- Hashtbl.create 13 -- -- let clear t = -- Hashtbl.clear t -- -- --(* # 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; -- } -- -- type ('ctxt, 'extra) t = -- { -- name: name; -- fields: (name, ('ctxt, 'extra) value) Hashtbl.t; -- order: name Queue.t; -- name_norm: string -> string; -- } -- -- let create ?(case_insensitive=false) nm = -- { -- name = nm; -- fields = Hashtbl.create 13; -- order = Queue.create (); -- name_norm = -- (if case_insensitive then -- OASISString.lowercase_ascii -- else -- fun s -> s); -- } -- -- let add t nm set get extra help = -- let key = -- t.name_norm nm -- in -- -- if Hashtbl.mem t.fields key then -- failwith -- (Printf.sprintf -- (f_ "Field '%s' is already defined in schema '%s'") -- nm t.name); -- Hashtbl.add -- t.fields -- key -- { -- set = set; -- get = get; -- help = help; -- extra = extra; -- }; -- Queue.add nm t.order -- -- let mem t nm = -- Hashtbl.mem t.fields nm -- -- let find t nm = -- try -- Hashtbl.find t.fields (t.name_norm nm) -- with Not_found -> -- raise (Unknown_field (nm, t.name)) -- -- let get t data nm = -- (find t nm).get data -- -- let set t data nm ?context x = -- (find t nm).set -- data -- ?context -- x -- -- let fold f acc t = -- Queue.fold -- (fun acc k -> -- let v = -- find t k -- in -- f acc k v.extra v.help) -- acc -- t.order -- -- let iter f t = -- fold -- (fun () -> f) -- () -- t -- -- let name t = -- t.name -- end -- -- -- module Field = -- struct -- type ('ctxt, 'value, 'extra) t = -- { -- set: Data.t -> ?context:'ctxt -> 'value -> unit; -- get: Data.t -> 'value; -- sets: Data.t -> ?context:'ctxt -> string -> unit; -- gets: Data.t -> string; -- help: (unit -> string) option; -- extra: 'extra; -- } -- -- let new_id = -- let last_id = -- ref 0 -- in -- fun () -> incr last_id; !last_id -- -- let create ?schema ?name ?parse ?print ?default ?update ?help extra = -- (* Default value container *) -- let v = -- ref None -- in -- -- (* If name is not given, create unique one *) -- let nm = -- match name with -- | Some s -> s -- | None -> Printf.sprintf "_anon_%d" (new_id ()) -- in -- -- (* Last chance to get a value: the default *) -- let default () = -- match default with -- | Some d -> d -- | None -> raise (Not_set (nm, Some (s_ "no default value"))) -- in -- -- (* Get data *) -- let get data = -- (* Get value *) -- try -- (Hashtbl.find data nm) (); -- match !v with -- | Some x -> x -- | None -> default () -- with Not_found -> -- default () -- in -- -- (* Set data *) -- let set data ?context x = -- let x = -- match update with -- | Some f -> -- begin -- try -- f ?context (get data) x -- with Not_set _ -> -- x -- end -- | None -> -- x -- in -- Hashtbl.replace -- data -- nm -- (fun () -> v := Some x) -- in -- -- (* Parse string value, if possible *) -- let parse = -- match parse with -- | Some f -> -- f -- | None -> -- fun ?context s -> -- failwith -- (Printf.sprintf -- (f_ "Cannot parse field '%s' when setting value %S") -- nm -- s) -- in -- -- (* Set data, from string *) -- let sets data ?context s = -- set ?context data (parse ?context s) -- in -- -- (* Output value as string, if possible *) -- let print = -- match print with -- | Some f -> -- f -- | None -> -- fun _ -> raise (No_printer nm) -- in -- -- (* Get data, as a string *) -- let gets data = -- print (get data) -- in -- -- begin -- match schema with -- | Some t -> -- Schema.add t nm sets gets extra help -- | None -> -- () -- end; -- -- { -- set = set; -- get = get; -- sets = sets; -- gets = gets; -- help = help; -- extra = extra; -- } -- -- let fset data t ?context x = -- t.set data ?context x -- -- let fget data t = -- t.get data -- -- let fsets data t ?context s = -- t.sets data ?context s -- -- let fgets data t = -- t.gets data -- end -- -- -- module FieldRO = -- struct -- let create ?schema ?name ?parse ?print ?default ?update ?help extra = -- let fld = -- Field.create ?schema ?name ?parse ?print ?default ?update ?help extra -- in -- fun data -> Field.fget data fld -- end --end -- --module OASISMessage = struct --(* # 22 "src/oasis/OASISMessage.ml" *) -- -- -- open OASISGettext -- open OASISContext -- -- -- let generic_message ~ctxt lvl fmt = -- let cond = -- if ctxt.quiet then -- false -- else -- match lvl with -- | `Debug -> ctxt.debug -- | `Info -> ctxt.info -- | _ -> true -- in -- Printf.ksprintf -- (fun str -> -- if cond then -- begin -- ctxt.printf lvl str -- end) -- fmt -- -- -- let debug ~ctxt fmt = -- generic_message ~ctxt `Debug fmt -- -- -- let info ~ctxt fmt = -- generic_message ~ctxt `Info fmt -- -- -- let warning ~ctxt fmt = -- generic_message ~ctxt `Warning fmt -- -- -- let error ~ctxt fmt = -- generic_message ~ctxt `Error fmt -- --end -- --module OASISVersion = struct --(* # 22 "src/oasis/OASISVersion.ml" *) -- -- -- open OASISGettext -- -- -- type t = string -- -- -- type comparator = -- | VGreater of t -- | VGreaterEqual of t -- | VEqual of t -- | VLesser of t -- | VLesserEqual of t -- | VOr of comparator * comparator -- | VAnd of comparator * comparator -- -- -- (* Range of allowed characters *) -- let is_digit c = '0' <= c && c <= '9' -- let is_alpha c = ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') -- let is_special = function | '.' | '+' | '-' | '~' -> true | _ -> false -- -- -- let rec version_compare v1 v2 = -- if v1 <> "" || v2 <> "" then -- begin -- (* Compare ascii string, using special meaning for version -- * related char -- *) -- let val_ascii c = -- if c = '~' then -1 -- else if is_digit c then 0 -- else if c = '\000' then 0 -- else if is_alpha c then Char.code c -- else (Char.code c) + 256 -- in -- -- let len1 = String.length v1 in -- let len2 = String.length v2 in -- -- let p = ref 0 in -- -- (** Compare ascii part *) -- let compare_vascii () = -- let cmp = ref 0 in -- while !cmp = 0 && -- !p < len1 && !p < len2 && -- not (is_digit v1.[!p] && is_digit v2.[!p]) do -- cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]); -- incr p -- done; -- if !cmp = 0 && !p < len1 && !p = len2 then -- val_ascii v1.[!p] -- else if !cmp = 0 && !p = len1 && !p < len2 then -- - (val_ascii v2.[!p]) -- else -- !cmp -- in -- -- (** Compare digit part *) -- let compare_digit () = -- let extract_int v p = -- let start_p = !p in -- while !p < String.length v && is_digit v.[!p] do -- incr p -- done; -- let substr = -- String.sub v !p ((String.length v) - !p) -- in -- let res = -- match String.sub v start_p (!p - start_p) with -- | "" -> 0 -- | s -> int_of_string s -- in -- res, substr -- in -- let i1, tl1 = extract_int v1 (ref !p) in -- let i2, tl2 = extract_int v2 (ref !p) in -- i1 - i2, tl1, tl2 -- in -- -- match compare_vascii () with -- | 0 -> -- begin -- match compare_digit () with -- | 0, tl1, tl2 -> -- if tl1 <> "" && is_digit tl1.[0] then -- 1 -- else if tl2 <> "" && is_digit tl2.[0] then -- -1 -- else -- version_compare tl1 tl2 -- | n, _, _ -> -- n -- end -- | n -> -- n -- end -- else begin -- 0 -- end -- -- -- let version_of_string str = str -- -- -- let string_of_version t = t -- -- -- let chop t = -- try -- let pos = -- String.rindex t '.' -- in -- String.sub t 0 pos -- with Not_found -> -- t -- -- -- let rec comparator_apply v op = -- match op with -- | VGreater cv -> -- (version_compare v cv) > 0 -- | VGreaterEqual cv -> -- (version_compare v cv) >= 0 -- | VLesser cv -> -- (version_compare v cv) < 0 -- | VLesserEqual cv -> -- (version_compare v cv) <= 0 -- | VEqual cv -> -- (version_compare v cv) = 0 -- | VOr (op1, op2) -> -- (comparator_apply v op1) || (comparator_apply v op2) -- | VAnd (op1, op2) -> -- (comparator_apply v op1) && (comparator_apply v op2) -- -- -- let rec string_of_comparator = -- function -- | VGreater v -> "> "^(string_of_version v) -- | VEqual v -> "= "^(string_of_version v) -- | VLesser v -> "< "^(string_of_version v) -- | VGreaterEqual v -> ">= "^(string_of_version v) -- | VLesserEqual v -> "<= "^(string_of_version v) -- | VOr (c1, c2) -> -- (string_of_comparator c1)^" || "^(string_of_comparator c2) -- | VAnd (c1, c2) -> -- (string_of_comparator c1)^" && "^(string_of_comparator c2) -- -- -- let rec varname_of_comparator = -- let concat p v = -- OASISUtils.varname_concat -- p -- (OASISUtils.varname_of_string -- (string_of_version v)) -- in -- function -- | VGreater v -> concat "gt" v -- | VLesser v -> concat "lt" v -- | VEqual v -> concat "eq" v -- | VGreaterEqual v -> concat "ge" v -- | VLesserEqual v -> concat "le" v -- | VOr (c1, c2) -> -- (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2) -- | VAnd (c1, c2) -> -- (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2) -- -- --end -- --module OASISLicense = struct --(* # 22 "src/oasis/OASISLicense.ml" *) -- -- -- (** License for _oasis fields -- @author Sylvain Le Gall -- *) -- -- -- type license = string -- type license_exception = string -- -- -- type license_version = -- | Version of OASISVersion.t -- | VersionOrLater of OASISVersion.t -- | NoVersion -- -- -- type license_dep_5_unit = -- { -- license: license; -- excption: license_exception option; -- version: license_version; -- } -- -- -- type license_dep_5 = -- | DEP5Unit of license_dep_5_unit -- | DEP5Or of license_dep_5 list -- | DEP5And of license_dep_5 list -- -- -- type t = -- | DEP5License of license_dep_5 -- | OtherLicense of string (* URL *) -- -- --end -- --module OASISExpr = struct --(* # 22 "src/oasis/OASISExpr.ml" *) -- -- -- open OASISGettext -- open OASISUtils -- -- -- type test = string -- type flag = string -- -- -- type t = -- | EBool of bool -- | ENot of t -- | EAnd of t * t -- | EOr of t * t -- | EFlag of flag -- | ETest of test * string -- -- -- type 'a choices = (t * 'a) list -- -- -- let eval var_get t = -- let rec eval' = -- function -- | EBool b -> -- b -- -- | ENot e -> -- not (eval' e) -- -- | EAnd (e1, e2) -> -- (eval' e1) && (eval' e2) -- -- | EOr (e1, e2) -> -- (eval' e1) || (eval' e2) -- -- | EFlag nm -> -- let v = -- var_get nm -- in -- assert(v = "true" || v = "false"); -- (v = "true") -- -- | ETest (nm, vl) -> -- let v = -- var_get nm -- in -- (v = vl) -- in -- eval' t -- -- -- let choose ?printer ?name var_get lst = -- let rec choose_aux = -- function -- | (cond, vl) :: tl -> -- if eval var_get cond then -- vl -- else -- choose_aux tl -- | [] -> -- let str_lst = -- if lst = [] then -- s_ "<empty>" -- else -- String.concat -- (s_ ", ") -- (List.map -- (fun (cond, vl) -> -- match printer with -- | Some p -> p vl -- | None -> s_ "<no printer>") -- lst) -- in -- match name with -- | Some nm -> -- failwith -- (Printf.sprintf -- (f_ "No result for the choice list '%s': %s") -- nm str_lst) -- | None -> -- failwith -- (Printf.sprintf -- (f_ "No result for a choice list: %s") -- str_lst) -- in -- choose_aux (List.rev lst) -- -- --end -- --module OASISText = struct --(* # 22 "src/oasis/OASISText.ml" *) -- -- type elt = -- | Para of string -- | Verbatim of string -- | BlankLine -- -- type t = elt list -- --end -- --module OASISSourcePatterns = struct --(* # 22 "src/oasis/OASISSourcePatterns.ml" *) -- -- open OASISUtils -- open OASISGettext -- -- module Templater = -- struct -- (* TODO: use this module in BaseEnv.var_expand and BaseFileAB, at least. *) -- type t = -- { -- atoms: atom list; -- origin: string -- } -- and atom = -- | Text of string -- | Expr of expr -- and expr = -- | Ident of string -- | String of string -- | Call of string * expr -- -- -- type env = -- { -- variables: string MapString.t; -- functions: (string -> string) MapString.t; -- } -- -- -- let eval env t = -- let rec eval_expr env = -- function -- | String str -> str -- | Ident nm -> -- begin -- try -- MapString.find nm env.variables -- with Not_found -> -- (* TODO: add error location within the string. *) -- failwithf -- (f_ "Unable to find variable %S in source pattern %S") -- nm t.origin -- end -- -- | Call (fn, expr) -> -- begin -- try -- (MapString.find fn env.functions) (eval_expr env expr) -- with Not_found -> -- (* TODO: add error location within the string. *) -- failwithf -- (f_ "Unable to find function %S in source pattern %S") -- fn t.origin -- end -- in -- String.concat "" -- (List.map -- (function -- | Text str -> str -- | Expr expr -> eval_expr env expr) -- t.atoms) -- -- -- let parse env s = -- let lxr = Genlex.make_lexer [] in -- let parse_expr s = -- let st = lxr (Stream.of_string s) in -- match Stream.npeek 3 st with -- | [Genlex.Ident fn; Genlex.Ident nm] -> Call(fn, Ident nm) -- | [Genlex.Ident fn; Genlex.String str] -> Call(fn, String str) -- | [Genlex.String str] -> String str -- | [Genlex.Ident nm] -> Ident nm -- (* TODO: add error location within the string. *) -- | _ -> failwithf (f_ "Unable to parse expression %S") s -- in -- let parse s = -- let lst_exprs = ref [] in -- let ss = -- let buff = Buffer.create (String.length s) in -- Buffer.add_substitute -- buff -- (fun s -> lst_exprs := (parse_expr s) :: !lst_exprs; "\000") -- s; -- Buffer.contents buff -- in -- let rec join = -- function -- | hd1 :: tl1, hd2 :: tl2 -> Text hd1 :: Expr hd2 :: join (tl1, tl2) -- | [], tl -> List.map (fun e -> Expr e) tl -- | tl, [] -> List.map (fun e -> Text e) tl -- in -- join (OASISString.nsplit ss '\000', List.rev (!lst_exprs)) -- in -- let t = {atoms = parse s; origin = s} in -- (* We rely on a simple evaluation for checking variables/functions. -- It works because there is no if/loop statement. -- *) -- let _s : string = eval env t in -- t -- --(* # 144 "src/oasis/OASISSourcePatterns.ml" *) -- end -- -- -- type t = Templater.t -- -- -- let env ~modul () = -- { -- Templater. -- variables = MapString.of_list ["module", modul]; -- functions = MapString.of_list -- [ -- "capitalize_file", OASISUnixPath.capitalize_file; -- "uncapitalize_file", OASISUnixPath.uncapitalize_file; -- ]; -- } -- -- let all_possible_files lst ~path ~modul = -- let eval = Templater.eval (env ~modul ()) in -- List.fold_left -- (fun acc pat -> OASISUnixPath.concat path (eval pat) :: acc) -- [] lst -- -- -- let to_string t = t.Templater.origin -- -- --end -- --module OASISTypes = struct --(* # 22 "src/oasis/OASISTypes.ml" *) -- -- -- type name = string -- type package_name = string -- type url = string -- type unix_dirname = string -- type unix_filename = string (* TODO: replace everywhere. *) -- type host_dirname = string (* TODO: replace everywhere. *) -- type host_filename = string (* TODO: replace everywhere. *) -- type prog = string -- type arg = string -- type args = string list -- type command_line = (prog * arg list) -- -- -- type findlib_name = string -- type findlib_full = string -- -- -- type compiled_object = -- | Byte -- | Native -- | Best -- -- -- type dependency = -- | FindlibPackage of findlib_full * OASISVersion.comparator option -- | InternalLibrary of name -- -- -- type tool = -- | ExternalTool of name -- | InternalExecutable of name -- -- -- type vcs = -- | Darcs -- | Git -- | Svn -- | Cvs -- | Hg -- | Bzr -- | Arch -- | Monotone -- | OtherVCS of url -- -- -- type plugin_kind = -- [ `Configure -- | `Build -- | `Doc -- | `Test -- | `Install -- | `Extra -- ] -- -- -- type plugin_data_purpose = -- [ `Configure -- | `Build -- | `Install -- | `Clean -- | `Distclean -- | `Install -- | `Uninstall -- | `Test -- | `Doc -- | `Extra -- | `Other of string -- ] -- -- -- type 'a plugin = 'a * name * OASISVersion.t option -- -- -- type all_plugin = plugin_kind plugin -- -- -- type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list -- -- -- type 'a conditional = 'a OASISExpr.choices -- -- -- type custom = -- { -- pre_command: (command_line option) conditional; -- post_command: (command_line option) conditional; -- } -- -- -- type common_section = -- { -- cs_name: name; -- cs_data: PropList.Data.t; -- cs_plugin_data: plugin_data; -- } -- -- -- type build_section = -- { -- bs_build: bool conditional; -- bs_install: bool conditional; -- bs_path: unix_dirname; -- bs_compiled_object: compiled_object; -- bs_build_depends: dependency list; -- bs_build_tools: tool list; -- bs_interface_patterns: OASISSourcePatterns.t list; -- bs_implementation_patterns: OASISSourcePatterns.t list; -- bs_c_sources: unix_filename list; -- bs_data_files: (unix_filename * unix_filename option) list; -- bs_findlib_extra_files: unix_filename list; -- bs_ccopt: args conditional; -- bs_cclib: args conditional; -- bs_dlllib: args conditional; -- bs_dllpath: args conditional; -- bs_byteopt: args conditional; -- bs_nativeopt: args conditional; -- } -- -- -- type library = -- { -- lib_modules: string list; -- lib_pack: bool; -- lib_internal_modules: string list; -- lib_findlib_parent: findlib_name option; -- lib_findlib_name: findlib_name option; -- lib_findlib_directory: unix_dirname option; -- lib_findlib_containers: findlib_name list; -- } -- -- -- type object_ = -- { -- obj_modules: string list; -- obj_findlib_fullname: findlib_name list option; -- obj_findlib_directory: unix_dirname option; -- } -- -- -- type executable = -- { -- exec_custom: bool; -- exec_main_is: unix_filename; -- } -- -- -- type flag = -- { -- flag_description: string option; -- flag_default: bool conditional; -- } -- -- -- type source_repository = -- { -- src_repo_type: vcs; -- src_repo_location: url; -- src_repo_browser: url option; -- src_repo_module: string option; -- src_repo_branch: string option; -- src_repo_tag: string option; -- src_repo_subdir: unix_filename option; -- } -- -- -- type test = -- { -- test_type: [`Test] plugin; -- test_command: command_line conditional; -- test_custom: custom; -- test_working_directory: unix_filename option; -- test_run: bool conditional; -- test_tools: tool list; -- } -- -- -- type doc_format = -- | HTML of unix_filename (* TODO: source filename. *) -- | DocText -- | PDF -- | PostScript -- | Info of unix_filename (* TODO: source filename. *) -- | DVI -- | OtherDoc -- -- -- type doc = -- { -- doc_type: [`Doc] plugin; -- doc_custom: custom; -- doc_build: bool conditional; -- doc_install: bool conditional; -- doc_install_dir: unix_filename; (* TODO: dest filename ?. *) -- doc_title: string; -- doc_authors: string list; -- doc_abstract: string option; -- doc_format: doc_format; -- (* TODO: src filename. *) -- doc_data_files: (unix_filename * unix_filename option) list; -- doc_build_tools: tool list; -- } -- -- -- type section = -- | Library of common_section * build_section * library -- | Object of common_section * build_section * object_ -- | Executable of common_section * build_section * executable -- | Flag of common_section * flag -- | SrcRepo of common_section * source_repository -- | Test of common_section * test -- | Doc of common_section * doc -- -- -- type section_kind = -- [ `Library | `Object | `Executable | `Flag | `SrcRepo | `Test | `Doc ] -- -- -- type package = -- { -- oasis_version: OASISVersion.t; -- ocaml_version: OASISVersion.comparator option; -- findlib_version: OASISVersion.comparator option; -- alpha_features: string list; -- beta_features: string list; -- name: package_name; -- version: OASISVersion.t; -- license: OASISLicense.t; -- license_file: unix_filename option; (* TODO: source filename. *) -- copyrights: string list; -- maintainers: string list; -- authors: string list; -- homepage: url option; -- bugreports: url option; -- synopsis: string; -- description: OASISText.t option; -- tags: string list; -- categories: url list; -- -- conf_type: [`Configure] plugin; -- conf_custom: custom; -- -- build_type: [`Build] plugin; -- build_custom: custom; -- -- install_type: [`Install] plugin; -- install_custom: custom; -- uninstall_custom: custom; -- -- clean_custom: custom; -- distclean_custom: custom; -- -- files_ab: unix_filename list; (* TODO: source filename. *) -- sections: section list; -- plugins: [`Extra] plugin list; -- disable_oasis_section: unix_filename list; (* TODO: source filename. *) -- schema_data: PropList.Data.t; -- plugin_data: plugin_data; -- } -- -- --end -- --module OASISFeatures = struct --(* # 22 "src/oasis/OASISFeatures.ml" *) -- -- open OASISTypes -- open OASISUtils -- open OASISGettext -- open OASISVersion -- -- module MapPlugin = -- Map.Make -- (struct -- type t = plugin_kind * name -- let compare = Pervasives.compare -- end) -- -- module Data = -- struct -- type t = -- { -- oasis_version: OASISVersion.t; -- plugin_versions: OASISVersion.t option MapPlugin.t; -- alpha_features: string list; -- beta_features: string list; -- } -- -- let create oasis_version alpha_features beta_features = -- { -- oasis_version = oasis_version; -- plugin_versions = MapPlugin.empty; -- alpha_features = alpha_features; -- beta_features = beta_features -- } -- -- let of_package pkg = -- create -- pkg.OASISTypes.oasis_version -- pkg.OASISTypes.alpha_features -- pkg.OASISTypes.beta_features -- -- let add_plugin (plugin_kind, plugin_name, plugin_version) t = -- {t with -- plugin_versions = MapPlugin.add -- (plugin_kind, plugin_name) -- plugin_version -- t.plugin_versions} -- -- let plugin_version plugin_kind plugin_name t = -- MapPlugin.find (plugin_kind, plugin_name) t.plugin_versions -- -- let to_string t = -- Printf.sprintf -- "oasis_version: %s; alpha_features: %s; beta_features: %s; \ -- plugins_version: %s" -- (OASISVersion.string_of_version (t:t).oasis_version) -- (String.concat ", " t.alpha_features) -- (String.concat ", " t.beta_features) -- (String.concat ", " -- (MapPlugin.fold -- (fun (_, plg) ver_opt acc -> -- (plg^ -- (match ver_opt with -- | Some v -> -- " "^(OASISVersion.string_of_version v) -- | None -> "")) -- :: acc) -- t.plugin_versions [])) -- end -- -- type origin = -- | Field of string * string -- | Section of string -- | NoOrigin -- -- type stage = Alpha | Beta -- -- -- let string_of_stage = -- function -- | Alpha -> "alpha" -- | Beta -> "beta" -- -- -- let field_of_stage = -- function -- | Alpha -> "AlphaFeatures" -- | Beta -> "BetaFeatures" -- -- type publication = InDev of stage | SinceVersion of OASISVersion.t -- -- type t = -- { -- name: string; -- plugin: all_plugin option; -- publication: publication; -- description: unit -> string; -- } -- -- (* TODO: mutex protect this. *) -- let all_features = Hashtbl.create 13 -- -- -- let since_version ver_str = SinceVersion (version_of_string ver_str) -- let alpha = InDev Alpha -- let beta = InDev Beta -- -- -- let to_string t = -- Printf.sprintf -- "feature: %s; plugin: %s; publication: %s" -- (t:t).name -- (match t.plugin with -- | None -> "<none>" -- | Some (_, nm, _) -> nm) -- (match t.publication with -- | InDev stage -> string_of_stage stage -- | SinceVersion ver -> ">= "^(OASISVersion.string_of_version ver)) -- -- let data_check t data origin = -- let no_message = "no message" in -- -- let check_feature features stage = -- let has_feature = List.mem (t:t).name features in -- if not has_feature then -- match (origin:origin) with -- | Field (fld, where) -> -- Some -- (Printf.sprintf -- (f_ "Field %s in %s is only available when feature %s \ -- is in field %s.") -- fld where t.name (field_of_stage stage)) -- | Section sct -> -- Some -- (Printf.sprintf -- (f_ "Section %s is only available when features %s \ -- is in field %s.") -- sct t.name (field_of_stage stage)) -- | NoOrigin -> -- Some no_message -- else -- None -- in -- -- let version_is_good ~min_version version fmt = -- let version_is_good = -- OASISVersion.comparator_apply -- version (OASISVersion.VGreaterEqual min_version) -- in -- Printf.ksprintf -- (fun str -> if version_is_good then None else Some str) -- fmt -- in -- -- match origin, t.plugin, t.publication with -- | _, _, InDev Alpha -> check_feature data.Data.alpha_features Alpha -- | _, _, InDev Beta -> check_feature data.Data.beta_features Beta -- | Field(fld, where), None, SinceVersion min_version -> -- version_is_good ~min_version data.Data.oasis_version -- (f_ "Field %s in %s is only valid since OASIS v%s, update \ -- OASISFormat field from '%s' to '%s' after checking \ -- OASIS changelog.") -- fld where (string_of_version min_version) -- (string_of_version data.Data.oasis_version) -- (string_of_version min_version) -- -- | Field(fld, where), Some(plugin_knd, plugin_name, _), -- SinceVersion min_version -> -- begin -- try -- let plugin_version_current = -- try -- match Data.plugin_version plugin_knd plugin_name data with -- | Some ver -> ver -- | None -> -- failwithf -- (f_ "Field %s in %s is only valid for the OASIS \ -- plugin %s since v%s, but no plugin version is \ -- defined in the _oasis file, change '%s' to \ -- '%s (%s)' in your _oasis file.") -- fld where plugin_name (string_of_version min_version) -- plugin_name -- plugin_name (string_of_version min_version) -- with Not_found -> -- failwithf -- (f_ "Field %s in %s is only valid when the OASIS plugin %s \ -- is defined.") -- fld where plugin_name -- in -- version_is_good ~min_version plugin_version_current -- (f_ "Field %s in %s is only valid for the OASIS plugin %s \ -- since v%s, update your plugin from '%s (%s)' to \ -- '%s (%s)' after checking the plugin's changelog.") -- fld where plugin_name (string_of_version min_version) -- plugin_name (string_of_version plugin_version_current) -- plugin_name (string_of_version min_version) -- with Failure msg -> -- Some msg -- end -- -- | Section sct, None, SinceVersion min_version -> -- version_is_good ~min_version data.Data.oasis_version -- (f_ "Section %s is only valid for since OASIS v%s, update \ -- OASISFormat field from '%s' to '%s' after checking OASIS \ -- changelog.") -- sct (string_of_version min_version) -- (string_of_version data.Data.oasis_version) -- (string_of_version min_version) -- -- | Section sct, Some(plugin_knd, plugin_name, _), -- SinceVersion min_version -> -- begin -- try -- let plugin_version_current = -- try -- match Data.plugin_version plugin_knd plugin_name data with -- | Some ver -> ver -- | None -> -- failwithf -- (f_ "Section %s is only valid for the OASIS \ -- plugin %s since v%s, but no plugin version is \ -- defined in the _oasis file, change '%s' to \ -- '%s (%s)' in your _oasis file.") -- sct plugin_name (string_of_version min_version) -- plugin_name -- plugin_name (string_of_version min_version) -- with Not_found -> -- failwithf -- (f_ "Section %s is only valid when the OASIS plugin %s \ -- is defined.") -- sct plugin_name -- in -- version_is_good ~min_version plugin_version_current -- (f_ "Section %s is only valid for the OASIS plugin %s \ -- since v%s, update your plugin from '%s (%s)' to \ -- '%s (%s)' after checking the plugin's changelog.") -- sct plugin_name (string_of_version min_version) -- plugin_name (string_of_version plugin_version_current) -- plugin_name (string_of_version min_version) -- with Failure msg -> -- Some msg -- end -- -- | NoOrigin, None, SinceVersion min_version -> -- version_is_good ~min_version data.Data.oasis_version "%s" no_message -- -- | NoOrigin, Some(plugin_knd, plugin_name, _), SinceVersion min_version -> -- begin -- try -- let plugin_version_current = -- match Data.plugin_version plugin_knd plugin_name data with -- | Some ver -> ver -- | None -> raise Not_found -- in -- version_is_good ~min_version plugin_version_current -- "%s" no_message -- with Not_found -> -- Some no_message -- end -- -- -- let data_assert t data origin = -- match data_check t data origin with -- | None -> () -- | Some str -> failwith str -- -- -- let data_test t data = -- match data_check t data NoOrigin with -- | None -> true -- | Some _ -> false -- -- -- let package_test t pkg = -- data_test t (Data.of_package pkg) -- -- -- let create ?plugin name publication description = -- let () = -- if Hashtbl.mem all_features name then -- failwithf "Feature '%s' is already declared." name -- in -- let t = -- { -- name = name; -- plugin = plugin; -- publication = publication; -- description = description; -- } -- in -- Hashtbl.add all_features name t; -- t -- -- -- let get_stage name = -- try -- (Hashtbl.find all_features name).publication -- with Not_found -> -- failwithf (f_ "Feature %s doesn't exist.") name -- -- -- let list () = -- Hashtbl.fold (fun _ v acc -> v :: acc) all_features [] -- -- (* -- * Real flags. -- *) -- -- -- let features = -- create "features_fields" -- (since_version "0.4") -- (fun () -> -- s_ "Enable to experiment not yet official features.") -- -- -- let flag_docs = -- create "flag_docs" -- (since_version "0.3") -- (fun () -> -- s_ "Make building docs require '-docs' flag at configure.") -- -- -- let flag_tests = -- create "flag_tests" -- (since_version "0.3") -- (fun () -> -- s_ "Make running tests require '-tests' flag at configure.") -- -- -- let pack = -- create "pack" -- (since_version "0.3") -- (fun () -> -- s_ "Allow to create packed library.") -- -- -- let section_object = -- create "section_object" beta -- (fun () -> -- s_ "Implement an object section.") -- -- -- let dynrun_for_release = -- create "dynrun_for_release" alpha -- (fun () -> -- s_ "Make '-setup-update dynamic' suitable for releasing project.") -- -- -- let compiled_setup_ml = -- create "compiled_setup_ml" alpha -- (fun () -> -- s_ "Compile the setup.ml and speed-up actions done with it.") -- -- let disable_oasis_section = -- create "disable_oasis_section" alpha -- (fun () -> -- s_ "Allow the OASIS section comments and digests to be omitted in \ -- generated files.") -- -- let no_automatic_syntax = -- create "no_automatic_syntax" alpha -- (fun () -> -- s_ "Disable the automatic inclusion of -syntax camlp4o for packages \ -- that matches the internal heuristic (if a dependency ends with \ -- a .syntax or is a well known syntax).") -- -- let 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 --(* # 22 "src/oasis/OASISSection.ml" *) -- -- -- open OASISTypes -- -- -- let section_kind_common = -- function -- | Library (cs, _, _) -> -- `Library, cs -- | Object (cs, _, _) -> -- `Object, cs -- | Executable (cs, _, _) -> -- `Executable, cs -- | Flag (cs, _) -> -- `Flag, cs -- | SrcRepo (cs, _) -> -- `SrcRepo, cs -- | Test (cs, _) -> -- `Test, cs -- | Doc (cs, _) -> -- `Doc, cs -- -- -- let section_common sct = -- snd (section_kind_common sct) -- -- -- let section_common_set cs = -- function -- | Library (_, bs, lib) -> Library (cs, bs, lib) -- | Object (_, bs, obj) -> Object (cs, bs, obj) -- | Executable (_, bs, exec) -> Executable (cs, bs, exec) -- | Flag (_, flg) -> Flag (cs, flg) -- | SrcRepo (_, src_repo) -> SrcRepo (cs, src_repo) -- | Test (_, tst) -> Test (cs, tst) -- | Doc (_, doc) -> Doc (cs, doc) -- -- -- (** Key used to identify section -- *) -- let section_id sct = -- let k, cs = -- section_kind_common sct -- in -- k, cs.cs_name -- -- -- let string_of_section_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 -- (string_of_section_kind k)^" "^nm -- -- -- let section_find id scts = -- List.find -- (fun sct -> id = section_id sct) -- scts -- -- -- module CSection = -- struct -- type t = section -- -- let id = section_id -- -- let compare t1 t2 = -- compare (id t1) (id t2) -- -- let equal t1 t2 = -- (id t1) = (id t2) -- -- let hash t = -- Hashtbl.hash (id t) -- end -- -- -- module MapSection = Map.Make(CSection) -- module SetSection = Set.Make(CSection) -- -- --end -- --module OASISBuildSection = struct --(* # 22 "src/oasis/OASISBuildSection.ml" *) -- -- open OASISTypes -- -- (* Look for a module file, considering capitalization or not. *) -- let find_module source_file_exists bs modul = -- let possible_lst = -- OASISSourcePatterns.all_possible_files -- (bs.bs_interface_patterns @ bs.bs_implementation_patterns) -- ~path:bs.bs_path -- ~modul -- in -- match List.filter source_file_exists possible_lst with -- | (fn :: _) as fn_lst -> `Sources (OASISUnixPath.chop_extension fn, fn_lst) -- | [] -> -- let open OASISUtils in -- let _, rev_lst = -- List.fold_left -- (fun (set, acc) fn -> -- let base_fn = OASISUnixPath.chop_extension fn in -- if SetString.mem base_fn set then -- set, acc -- else -- SetString.add base_fn set, base_fn :: acc) -- (SetString.empty, []) possible_lst -- in -- `No_sources (List.rev rev_lst) -- -- --end -- --module OASISExecutable = struct --(* # 22 "src/oasis/OASISExecutable.ml" *) -- -- -- open OASISTypes -- -- -- let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program = -- let dir = -- OASISUnixPath.concat -- bs.bs_path -- (OASISUnixPath.dirname exec.exec_main_is) -- in -- let is_native_exec = -- match bs.bs_compiled_object with -- | Native -> true -- | Best -> is_native () -- | Byte -> false -- in -- -- OASISUnixPath.concat -- dir -- (cs.cs_name^(suffix_program ())), -- -- if not is_native_exec && -- not exec.exec_custom && -- bs.bs_c_sources <> [] then -- Some (dir^"/dll"^cs.cs_name^"_stubs"^(ext_dll ())) -- else -- None -- -- --end -- --module OASISLibrary = struct --(* # 22 "src/oasis/OASISLibrary.ml" *) -- -- -- open OASISTypes -- open 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 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 ~ctxt source_file_exists cs bs modul with -- | `Sources (base_fn, lst) -> (base_fn, lst) :: acc -- | `No_sources _ -> acc) -- [] -- (lib.lib_modules @ lib.lib_internal_modules) -- -- -- let generated_unix_files -- ~ctxt -- ~is_native -- ~has_native_dynlink -- ~ext_lib -- ~ext_dll -- ~source_file_exists -- (cs, bs, lib) = -- -- let find_modules lst ext = -- let find_module modul = -- 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) -- [] -- lst -- in -- -- (* The .cmx that be compiled along *) -- let cmxs = -- let should_be_built = -- match bs.bs_compiled_object with -- | Native -> true -- | Best -> is_native -- | Byte -> false -- in -- if should_be_built then -- if lib.lib_pack then -- find_modules -- [cs.cs_name] -- "cmx" -- else -- find_modules -- (lib.lib_modules @ lib.lib_internal_modules) -- "cmx" -- else -- [] -- in -- -- let acc_nopath = -- [] -- in -- -- (* The headers and annot/cmt files that should be compiled along *) -- let headers = -- let sufx = -- if lib.lib_pack -- then [".cmti"; ".cmt"; ".annot"] -- else [".cmi"; ".cmti"; ".cmt"; ".annot"] -- in -- List.map -- (List.fold_left -- (fun accu s -> -- let dot = String.rindex s '.' in -- let base = String.sub s 0 dot in -- List.map ((^) base) sufx @ accu) -- []) -- (find_modules lib.lib_modules "cmi") -- in -- -- (* Compute what libraries should be built *) -- let acc_nopath = -- (* Add the packed header file if required *) -- let add_pack_header acc = -- if lib.lib_pack then -- [cs.cs_name^".cmi"; cs.cs_name^".cmti"; cs.cs_name^".cmt"] :: acc -- else -- acc -- in -- let byte acc = -- add_pack_header ([cs.cs_name^".cma"] :: acc) -- in -- let native acc = -- let acc = -- add_pack_header -- (if has_native_dynlink then -- [cs.cs_name^".cmxs"] :: acc -- else acc) -- in -- [cs.cs_name^".cmxa"] :: [cs.cs_name^ext_lib] :: acc -- in -- match bs.bs_compiled_object with -- | Native -> byte (native acc_nopath) -- | Best when is_native -> byte (native acc_nopath) -- | Byte | Best -> byte acc_nopath -- in -- -- (* Add C library to be built *) -- let acc_nopath = -- if bs.bs_c_sources <> [] then begin -- ["lib"^cs.cs_name^"_stubs"^ext_lib] -- :: -- if has_native_dynlink then -- ["dll"^cs.cs_name^"_stubs"^ext_dll] :: acc_nopath -- else -- acc_nopath -- 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) -- -- --end -- --module OASISObject = struct --(* # 22 "src/oasis/OASISObject.ml" *) -- -- -- open OASISTypes -- open OASISGettext -- -- -- let find_module ~ctxt source_file_exists cs bs modul = -- match OASISBuildSection.find_module source_file_exists bs modul with -- | `Sources _ as res -> res -- | `No_sources _ as res -> -- OASISMessage.warning -- ~ctxt -- (f_ "Cannot find source file matching module '%s' in object %s.") -- modul cs.cs_name; -- OASISMessage.warning -- ~ctxt -- (f_ "Use InterfacePatterns or ImplementationPatterns to define \ -- this file with feature %S.") -- (OASISFeatures.source_patterns.OASISFeatures.name); -- res -- -- let source_unix_files ~ctxt (cs, bs, obj) source_file_exists = -- List.fold_left -- (fun acc modul -> -- match 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) = -- -- let find_module ext modul = -- 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) -- | _ -> ([cs.cs_name ^ ".cmi"], -- [cs.cs_name ^ ".cmo"], -- [cs.cs_name ^ ".cmx"], -- [cs.cs_name ^ ".o"], -- OASISUnixPath.concat bs.bs_path) -- in -- List.map (List.map f) ( -- match bs.bs_compiled_object with -- | Native -> -- native :: c_object :: byte :: header :: [] -- | Best when is_native -> -- native :: c_object :: byte :: header :: [] -- | Byte | Best -> -- byte :: header :: []) -- -- --end -- --module OASISFindlib = struct --(* # 22 "src/oasis/OASISFindlib.ml" *) -- -- -- open OASISTypes -- open OASISUtils -- open OASISGettext -- -- -- type library_name = name -- type findlib_part_name = name -- type 'a map_of_findlib_part_name = 'a OASISUtils.MapString.t -- -- -- exception InternalLibraryNotFound of library_name -- exception FindlibPackageNotFound of findlib_name -- -- -- type group_t = -- | Container of findlib_name * group_t list -- | Package of (findlib_name * -- common_section * -- build_section * -- [`Library of library | `Object of object_] * -- unix_dirname option * -- group_t list) -- -- -- type data = common_section * -- build_section * -- [`Library of library | `Object of object_] -- type tree = -- | Node of (data option) * (tree MapString.t) -- | Leaf of data -- -- -- let findlib_mapping pkg = -- (* Map from library name to either full findlib name or parts + parent. *) -- let fndlb_parts_of_lib_name = -- let fndlb_parts cs lib = -- let name = -- match lib.lib_findlib_name with -- | Some nm -> nm -- | None -> cs.cs_name -- in -- let name = -- String.concat "." (lib.lib_findlib_containers @ [name]) -- in -- name -- in -- List.fold_left -- (fun mp -> -- function -- | Library (cs, _, lib) -> -- begin -- let lib_name = cs.cs_name in -- let fndlb_parts = fndlb_parts cs lib in -- if MapString.mem lib_name mp then -- failwithf -- (f_ "The library name '%s' is used more than once.") -- lib_name; -- match lib.lib_findlib_parent with -- | Some lib_name_parent -> -- MapString.add -- lib_name -- (`Unsolved (lib_name_parent, fndlb_parts)) -- mp -- | None -> -- MapString.add -- lib_name -- (`Solved fndlb_parts) -- mp -- end -- -- | Object (cs, _, obj) -> -- begin -- let obj_name = cs.cs_name in -- if MapString.mem obj_name mp then -- failwithf -- (f_ "The object name '%s' is used more than once.") -- obj_name; -- let findlib_full_name = match obj.obj_findlib_fullname with -- | Some ns -> String.concat "." ns -- | None -> obj_name -- in -- MapString.add -- obj_name -- (`Solved findlib_full_name) -- mp -- end -- -- | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ -> -- mp) -- MapString.empty -- pkg.sections -- in -- -- (* Solve the above graph to be only library name to full findlib name. *) -- let fndlb_name_of_lib_name = -- let rec solve visited mp lib_name lib_name_child = -- if SetString.mem lib_name visited then -- failwithf -- (f_ "Library '%s' is involved in a cycle \ -- with regard to findlib naming.") -- lib_name; -- let visited = SetString.add lib_name visited in -- try -- match MapString.find lib_name mp with -- | `Solved fndlb_nm -> -- fndlb_nm, mp -- | `Unsolved (lib_nm_parent, post_fndlb_nm) -> -- let pre_fndlb_nm, mp = -- solve visited mp lib_nm_parent lib_name -- in -- let fndlb_nm = pre_fndlb_nm^"."^post_fndlb_nm in -- fndlb_nm, MapString.add lib_name (`Solved fndlb_nm) mp -- with Not_found -> -- failwithf -- (f_ "Library '%s', which is defined as the findlib parent of \ -- library '%s', doesn't exist.") -- lib_name lib_name_child -- in -- let mp = -- MapString.fold -- (fun lib_name status mp -> -- match status with -- | `Solved _ -> -- (* Solved initialy, no need to go further *) -- mp -- | `Unsolved _ -> -- let _, mp = solve SetString.empty mp lib_name "<none>" in -- mp) -- fndlb_parts_of_lib_name -- fndlb_parts_of_lib_name -- in -- MapString.map -- (function -- | `Solved fndlb_nm -> fndlb_nm -- | `Unsolved _ -> assert false) -- mp -- in -- -- (* Convert an internal library name to a findlib name. *) -- let findlib_name_of_library_name lib_nm = -- try -- MapString.find lib_nm fndlb_name_of_lib_name -- with Not_found -> -- raise (InternalLibraryNotFound lib_nm) -- in -- -- (* Add a library to the tree. -- *) -- let add sct mp = -- let fndlb_fullname = -- let cs, _, _ = sct in -- let lib_name = cs.cs_name in -- findlib_name_of_library_name lib_name -- in -- let rec add_children nm_lst (children: tree MapString.t) = -- match nm_lst with -- | (hd :: tl) -> -- begin -- let node = -- try -- add_node tl (MapString.find hd children) -- with Not_found -> -- (* New node *) -- new_node tl -- in -- MapString.add hd node children -- end -- | [] -> -- (* Should not have a nameless library. *) -- assert false -- and add_node tl node = -- if tl = [] then -- begin -- match node with -- | Node (None, children) -> -- Node (Some sct, children) -- | Leaf (cs', _, _) | Node (Some (cs', _, _), _) -> -- (* TODO: allow to merge Package, i.e. -- * archive(byte) = "foo.cma foo_init.cmo" -- *) -- let cs, _, _ = sct in -- failwithf -- (f_ "Library '%s' and '%s' have the same findlib name '%s'") -- cs.cs_name cs'.cs_name fndlb_fullname -- end -- else -- begin -- match node with -- | Leaf data -> -- Node (Some data, add_children tl MapString.empty) -- | Node (data_opt, children) -> -- Node (data_opt, add_children tl children) -- end -- and new_node = -- function -- | [] -> -- Leaf sct -- | hd :: tl -> -- Node (None, MapString.add hd (new_node tl) MapString.empty) -- in -- add_children (OASISString.nsplit fndlb_fullname '.') mp -- in -- -- let unix_directory dn lib = -- let directory = -- match lib with -- | `Library lib -> lib.lib_findlib_directory -- | `Object obj -> obj.obj_findlib_directory -- in -- 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 dn mp = -- MapString.fold -- (fun nm node acc -> -- let cur = -- match node with -- | 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) -- mp [] -- in -- -- let group_mp = -- List.fold_left -- (fun mp -> -- function -- | Library (cs, bs, lib) -> -- add (cs, bs, `Library lib) mp -- | Object (cs, bs, obj) -> -- add (cs, bs, `Object obj) mp -- | _ -> -- mp) -- MapString.empty -- pkg.sections -- in -- -- let groups = group_of_tree None group_mp in -- -- let library_name_of_findlib_name = -- lazy begin -- (* Revert findlib_name_of_library_name. *) -- MapString.fold -- (fun k v mp -> MapString.add v k mp) -- fndlb_name_of_lib_name -- MapString.empty -- end -- in -- let library_name_of_findlib_name fndlb_nm = -- try -- MapString.find fndlb_nm (Lazy.force library_name_of_findlib_name) -- with Not_found -> -- raise (FindlibPackageNotFound fndlb_nm) -- in -- -- groups, -- findlib_name_of_library_name, -- library_name_of_findlib_name -- -- -- let findlib_of_group = -- function -- | Container (fndlb_nm, _) -- | Package (fndlb_nm, _, _, _, _, _) -> fndlb_nm -- -- -- let root_of_group grp = -- let rec root_lib_aux = -- (* We do a DFS in the group. *) -- function -- | Container (_, children) -> -- List.fold_left -- (fun res grp -> -- if res = None then -- root_lib_aux grp -- else -- res) -- None -- children -- | Package (_, cs, bs, lib, _, _) -> -- Some (cs, bs, lib) -- in -- match root_lib_aux grp with -- | Some res -> -- res -- | None -> -- failwithf -- (f_ "Unable to determine root library of findlib library '%s'") -- (findlib_of_group grp) -- -- --end -- --module OASISFlag = struct --(* # 22 "src/oasis/OASISFlag.ml" *) -- -- --end -- --module OASISPackage = struct --(* # 22 "src/oasis/OASISPackage.ml" *) -- -- --end -- --module OASISSourceRepository = struct --(* # 22 "src/oasis/OASISSourceRepository.ml" *) -- -- --end -- --module OASISTest = struct --(* # 22 "src/oasis/OASISTest.ml" *) -- -- <Skipped 4616 lines> ================================================================ ---- gitweb: http://git.pld-linux.org/gitweb.cgi/packages/google-drive-ocamlfuse.git/commitdiff/62e6a4998b05a93a7e3859c7e464997debaf6ecf _______________________________________________ pld-cvs-commit mailing list pld-cvs-commit@lists.pld-linux.org http://lists.pld-linux.org/mailman/listinfo/pld-cvs-commit