diff --git a/.gitignore b/.gitignore index 7d88fbb..e6d4072 100644 --- a/.gitignore +++ b/.gitignore @@ -8,4 +8,5 @@ setup.log *.swo *.cmi *.swn - +*.byte +*.native diff --git a/Makefile b/Makefile index 8e051e8..68f2e0e 100644 --- a/Makefile +++ b/Makefile @@ -1,17 +1,38 @@ -default all: - @echo "==== Building ocaml-zmq ====" - $(MAKE) -C src all - @echo "==== Successfully built ocaml-zmq ====" - -install: all - @echo "==== Installing ocaml-zmq ====" - $(MAKE) -C src install - @echo "==== Successfully installed ocaml-zmq ====" - -uninstall: - @echo "==== Uninstalling ocaml-zmq ====" - $(MAKE) -C src uninstall - @echo "==== Successfully uninstalled ocaml-zmq ====" -clean: - $(MAKE) -C src clean +# OASIS_START +# DO NOT EDIT (digest: bc1e05bfc8b39b664f29dae8dbd3ebbb) +SETUP = ocaml setup.ml + +build: setup.data + $(SETUP) -build $(BUILDFLAGS) + +doc: setup.data build + $(SETUP) -doc $(DOCFLAGS) + +test: setup.data build + $(SETUP) -test $(TESTFLAGS) + +all: + $(SETUP) -all $(ALLFLAGS) + +install: setup.data + $(SETUP) -install $(INSTALLFLAGS) + +uninstall: setup.data + $(SETUP) -uninstall $(UNINSTALLFLAGS) + +reinstall: setup.data + $(SETUP) -reinstall $(REINSTALLFLAGS) + +clean: + $(SETUP) -clean $(CLEANFLAGS) + +distclean: + $(SETUP) -distclean $(DISTCLEANFLAGS) + +setup.data: + $(SETUP) -configure $(CONFIGUREFLAGS) + +.PHONY: build doc test all install uninstall reinstall clean distclean configure + +# OASIS_STOP diff --git a/_oasis b/_oasis new file mode 100644 index 0000000..b90bf0c --- /dev/null +++ b/_oasis @@ -0,0 +1,44 @@ +OASISFormat: 0.2 +Name: ZMQ +Version: 0.0.3 +Synopsis: Bindings for the ZMQ library +Authors: Pedro Borges +License: MIT +Plugins: DevFiles (0.2), META (0.2) +BuildTools: ocamlbuild + +Library ZMQB + Path: src + FindlibName: ZMQ + Modules: ZMQ + CSources: caml_zmq_stubs.c, + socket.h, + socket.c, + context.h, + context.c, + fail.h, + fail.c, + poll.h, + poll.c, + uint64.h, + uint64.c + BuildDepends: uint.uint64 + CCLib: -lzmq + CCOpt: -Wall -W -Wextra -O2 + CompiledObject: best + +Flag tests + Description: Build and run tests + +Executable test + Path: test + MainIs: test.ml + Install: false + Build$: flag(tests) + BuildDepends: oUnit (>= 1.1.0), ZMQ + CompiledObject: best + +Test main + Run$: flag(tests) + Command: $test + \ No newline at end of file diff --git a/_tags b/_tags new file mode 100644 index 0000000..9427389 --- /dev/null +++ b/_tags @@ -0,0 +1,32 @@ +# OASIS_START +# DO NOT EDIT (digest: e6e8a800542cd56362cc34bbeb34731b) +# Library ZMQB +"src": include +: oasis_library_zmqb_ccopt +"src/caml_zmq_stubs.c": oasis_library_zmqb_ccopt +"src/socket.c": oasis_library_zmqb_ccopt +"src/context.c": oasis_library_zmqb_ccopt +"src/fail.c": oasis_library_zmqb_ccopt +"src/poll.c": oasis_library_zmqb_ccopt +"src/uint64.c": oasis_library_zmqb_ccopt +: oasis_library_zmqb_cclib +"src/libZMQB.lib": oasis_library_zmqb_cclib +"src/dllZMQB.dll": oasis_library_zmqb_cclib +"src/libZMQB.a": oasis_library_zmqb_cclib +"src/dllZMQB.so": oasis_library_zmqb_cclib +: use_libZMQB +: pkg_uint.uint64 +"src/caml_zmq_stubs.c": pkg_uint.uint64 +"src/socket.c": pkg_uint.uint64 +"src/context.c": pkg_uint.uint64 +"src/fail.c": pkg_uint.uint64 +"src/poll.c": pkg_uint.uint64 +"src/uint64.c": pkg_uint.uint64 +# Executable test +: use_ZMQB +: pkg_uint.uint64 +: pkg_oUnit +: use_ZMQB +: pkg_uint.uint64 +: pkg_oUnit +# OASIS_STOP diff --git a/configure b/configure new file mode 100755 index 0000000..6719c7c --- /dev/null +++ b/configure @@ -0,0 +1,8 @@ +#!/bin/sh + +# OASIS_START +# DO NOT EDIT (digest: ed33e59fe00e48bc31edf413bbc8b8d6) +set -e + +ocaml setup.ml -configure $* +# OASIS_STOP diff --git a/myocamlbuild.ml b/myocamlbuild.ml new file mode 100644 index 0000000..bcef4fa --- /dev/null +++ b/myocamlbuild.ml @@ -0,0 +1,495 @@ +(* OASIS_START *) +(* DO NOT EDIT (digest: 73a77de4d16c08026f49ad3ea4212686) *) +module OASISGettext = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISGettext.ml" + + let ns_ str = + str + + let s_ str = + str + + let f_ (str : ('a, 'b, 'c, 'd) format4) = + str + + let fn_ fmt1 fmt2 n = + if n = 1 then + fmt1^^"" + else + fmt2^^"" + + let init = + [] + +end + +module OASISExpr = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISExpr.ml" + + + + open OASISGettext + + type test = string + + type flag = string + + type t = + | EBool of bool + | ENot of t + | EAnd of t * t + | EOr of t * t + | EFlag of flag + | ETest of test * string + + + type 'a choices = (t * 'a) list + + let eval var_get t = + let rec eval' = + function + | EBool b -> + b + + | ENot e -> + not (eval' e) + + | EAnd (e1, e2) -> + (eval' e1) && (eval' e2) + + | EOr (e1, e2) -> + (eval' e1) || (eval' e2) + + | EFlag nm -> + let v = + var_get nm + in + assert(v = "true" || v = "false"); + (v = "true") + + | ETest (nm, vl) -> + let v = + var_get nm + in + (v = vl) + in + eval' t + + let choose ?printer ?name var_get lst = + let rec choose_aux = + function + | (cond, vl) :: tl -> + if eval var_get cond then + vl + else + choose_aux tl + | [] -> + let str_lst = + if lst = [] then + s_ "" + else + String.concat + (s_ ", ") + (List.map + (fun (cond, vl) -> + match printer with + | Some p -> p vl + | None -> s_ "") + 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 BaseEnvLight = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseEnvLight.ml" + + module MapString = Map.Make(String) + + type t = string MapString.t + + let default_filename = + Filename.concat + (Sys.getcwd ()) + "setup.data" + + let load ?(allow_empty=false) ?(filename=default_filename) () = + if Sys.file_exists filename then + begin + let chn = + open_in_bin filename + in + let st = + Stream.of_channel chn + in + let line = + ref 1 + in + let st_line = + Stream.from + (fun _ -> + try + match Stream.next st with + | '\n' -> incr line; Some '\n' + | c -> Some c + with Stream.Failure -> None) + in + let lexer = + Genlex.make_lexer ["="] st_line + in + let rec read_file mp = + match Stream.npeek 3 lexer with + | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] -> + Stream.junk lexer; + Stream.junk lexer; + Stream.junk lexer; + read_file (MapString.add nm value mp) + | [] -> + mp + | _ -> + failwith + (Printf.sprintf + "Malformed data file '%s' line %d" + filename !line) + in + let mp = + read_file MapString.empty + in + close_in chn; + mp + end + else if allow_empty then + begin + MapString.empty + end + else + begin + failwith + (Printf.sprintf + "Unable to load environment, the file '%s' doesn't exist." + filename) + end + + let var_get name env = + let rec var_expand str = + let buff = + Buffer.create ((String.length str) * 2) + in + Buffer.add_substitute + buff + (fun var -> + try + var_expand (MapString.find var env) + with Not_found -> + failwith + (Printf.sprintf + "No variable %s defined when trying to expand %S." + var + str)) + str; + Buffer.contents buff + in + var_expand (MapString.find name env) + + let var_choose lst env = + OASISExpr.choose + (fun nm -> var_get nm env) + lst +end + + +module MyOCamlbuildFindlib = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" + + (** OCamlbuild extension, copied from + * http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild + * by N. Pouillard and others + * + * Updated on 2009/02/28 + * + * Modified by Sylvain Le Gall + *) + open Ocamlbuild_plugin + + (* these functions are not really officially exported *) + let run_and_read = + Ocamlbuild_pack.My_unix.run_and_read + + let blank_sep_strings = + Ocamlbuild_pack.Lexers.blank_sep_strings + + let split s ch = + let x = + ref [] + in + let rec go s = + let pos = + String.index s ch + in + x := (String.before s pos)::!x; + go (String.after s (pos + 1)) + in + try + go s + with Not_found -> !x + + let split_nl s = split s '\n' + + let before_space s = + try + String.before s (String.index s ' ') + with Not_found -> s + + (* this lists all supported packages *) + let find_packages () = + List.map before_space (split_nl & run_and_read "ocamlfind list") + + (* this is supposed to list available syntaxes, but I don't know how to do it. *) + let find_syntaxes () = ["camlp4o"; "camlp4r"] + + (* ocamlfind command *) + let ocamlfind x = S[A"ocamlfind"; x] + + let dispatch = + function + | Before_options -> + (* by using Before_options one let command line options have an higher priority *) + (* on the contrary using After_options will guarantee to have the higher priority *) + (* override default commands by ocamlfind ones *) + Options.ocamlc := ocamlfind & A"ocamlc"; + Options.ocamlopt := ocamlfind & A"ocamlopt"; + Options.ocamldep := ocamlfind & A"ocamldep"; + Options.ocamldoc := ocamlfind & A"ocamldoc"; + Options.ocamlmktop := ocamlfind & A"ocamlmktop" + + | After_rules -> + + (* When one link an OCaml library/binary/package, one should use -linkpkg *) + flag ["ocaml"; "link"; "program"] & A"-linkpkg"; + + (* For each ocamlfind package one inject the -package option when + * compiling, computing dependencies, generating documentation and + * linking. *) + List.iter + begin fun pkg -> + flag ["ocaml"; "compile"; "pkg_"^pkg] & S[A"-package"; A pkg]; + flag ["ocaml"; "ocamldep"; "pkg_"^pkg] & S[A"-package"; A pkg]; + flag ["ocaml"; "doc"; "pkg_"^pkg] & S[A"-package"; A pkg]; + flag ["ocaml"; "link"; "pkg_"^pkg] & S[A"-package"; A pkg]; + flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S[A"-package"; A pkg]; + 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"; "link"] (S[A "-thread"]); + flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]) + + | _ -> + () + +end + +module MyOCamlbuildBase = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/plugins/ocamlbuild/MyOCamlbuildBase.ml" + + (** Base functions for writing myocamlbuild.ml + @author Sylvain Le Gall + *) + + + + open Ocamlbuild_plugin + + type dir = string + type file = string + type name = string + type tag = string + +# 55 "/Users/joelr/work/ocaml/oasis-0.2.0/src/plugins/ocamlbuild/MyOCamlbuildBase.ml" + + type t = + { + lib_ocaml: (name * dir list) list; + lib_c: (name * dir * file list) list; + flags: (tag list * (spec OASISExpr.choices)) list; + } + + let env_filename = + Pathname.basename + BaseEnvLight.default_filename + + let dispatch_combine lst = + fun e -> + List.iter + (fun dispatch -> dispatch e) + lst + + let dispatch t e = + let env = + BaseEnvLight.load + ~filename:env_filename + ~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" var) + [ + Options.ext_obj, "ext_obj"; + Options.ext_lib, "ext_lib"; + Options.ext_dll, "ext_dll"; + ] + + | After_rules -> + (* Declare OCaml libraries *) + List.iter + (function + | lib, [] -> + ocaml_lib lib; + | lib, dir :: tl -> + ocaml_lib ~dir:dir lib; + List.iter + (fun dir -> + flag + ["ocaml"; "use_"^lib; "compile"] + (S[A"-I"; P dir])) + tl) + t.lib_ocaml; + + (* Declare C libraries *) + List.iter + (fun (lib, dir, headers) -> + (* Handle C part of library *) + flag ["link"; "library"; "ocaml"; "byte"; "use_lib"^lib] + (S[A"-dllib"; A("-l"^lib); A"-cclib"; A("-l"^lib)]); + + flag ["link"; "library"; "ocaml"; "native"; "use_lib"^lib] + (S[A"-cclib"; A("-l"^lib)]); + + flag ["link"; "program"; "ocaml"; "byte"; "use_lib"^lib] + (S[A"-dllib"; A("dll"^lib)]); + + (* When ocaml link something that use the C library, then one + need that file to be up to date. + *) + dep ["link"; "ocaml"; "use_lib"^lib] + [dir/"lib"^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 + flag tags & spec) + t.flags + | _ -> + () + + let dispatch_default t = + dispatch_combine + [ + dispatch t; + MyOCamlbuildFindlib.dispatch; + ] + +end + + +open Ocamlbuild_plugin;; +let package_default = + { + MyOCamlbuildBase.lib_ocaml = [("src/ZMQB", ["src"])]; + lib_c = + [ + ("ZMQB", + "src", + [ + "src/socket.h"; + "src/context.h"; + "src/fail.h"; + "src/poll.h"; + "src/uint64.h" + ]) + ]; + flags = + [ + (["oasis_library_zmqb_ccopt"; "compile"], + [ + (OASISExpr.EBool true, + S + [ + A "-ccopt"; + A "-Wall"; + A "-ccopt"; + A "-W"; + A "-ccopt"; + A "-Wextra"; + A "-ccopt"; + A "-O2" + ]) + ]); + (["oasis_library_zmqb_cclib"; "link"], + [(OASISExpr.EBool true, S [A "-cclib"; A "-lzmq"])]); + (["oasis_library_zmqb_cclib"; "ocamlmklib"; "c"], + [(OASISExpr.EBool true, S [A "-lzmq"])]) + ]; + } + ;; + +let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;; + +(* OASIS_STOP *) +Ocamlbuild_plugin.dispatch dispatch_default;; diff --git a/setup.ml b/setup.ml new file mode 100644 index 0000000..c74fdb7 --- /dev/null +++ b/setup.ml @@ -0,0 +1,5304 @@ +(* setup.ml generated for the first time by OASIS v0.2.0 *) + +(* OASIS_START *) +(* DO NOT EDIT (digest: 59d5caf2fccff218a5f8bcf4704be3e9) *) +(* + Regenerated by OASIS v0.2.0 + Visit http://oasis.forge.ocamlcore.org for more information and + documentation about functions used in this file. +*) +module OASISGettext = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISGettext.ml" + + let ns_ str = + str + + let s_ str = + str + + let f_ (str : ('a, 'b, 'c, 'd) format4) = + str + + let fn_ fmt1 fmt2 n = + if n = 1 then + fmt1^^"" + else + fmt2^^"" + + let init = + [] + +end + +module OASISContext = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISContext.ml" + + open OASISGettext + + type level = + [ `Debug + | `Info + | `Warning + | `Error] + + type t = + { + verbose: bool; + debug: bool; + ignore_plugins: 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 + match lvl with + | `Error -> + prerr_endline (beg^str) + | _ -> + print_endline (beg^str) + + let default = + ref + { + verbose = true; + debug = false; + ignore_plugins = false; + printf = printf; + } + + let quiet = + {!default with + verbose = false; + debug = false; + } + + + let args () = + ["-quiet", + Arg.Unit (fun () -> default := {!default with verbose = false}), + (s_ " Run quietly"); + + "-debug", + Arg.Unit (fun () -> default := {!default with debug = true}), + (s_ " Output debug message")] +end + +module OASISUtils = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISUtils.ml" + + module MapString = Map.Make(String) + + let map_string_of_assoc assoc = + List.fold_left + (fun acc (k, v) -> MapString.add k v acc) + MapString.empty + assoc + + module SetString = Set.Make(String) + + let set_string_add_list st lst = + List.fold_left + (fun acc e -> SetString.add e acc) + st + lst + + let set_string_of_list = + set_string_add_list + SetString.empty + + + let compare_csl s1 s2 = + String.compare (String.lowercase s1) (String.lowercase s2) + + module HashStringCsl = + Hashtbl.Make + (struct + type t = string + + let equal s1 s2 = + (String.lowercase s1) = (String.lowercase s2) + + let hash s = + Hashtbl.hash (String.lowercase s) + end) + + let split sep str = + let str_len = + String.length str + in + let rec split_aux acc pos = + if pos < str_len then + ( + let pos_sep = + try + String.index_from str pos sep + with Not_found -> + str_len + in + let part = + String.sub str pos (pos_sep - pos) + in + let acc = + part :: acc + in + if pos_sep >= str_len then + ( + (* Nothing more in the string *) + List.rev acc + ) + else if pos_sep = (str_len - 1) then + ( + (* String end with a separator *) + List.rev ("" :: acc) + ) + else + ( + split_aux acc (pos_sep + 1) + ) + ) + else + ( + List.rev acc + ) + in + split_aux [] 0 + + + let varname_of_string ?(hyphen='_') s = + if String.length s = 0 then + begin + invalid_arg "varname_of_string" + end + else + begin + let buff = + Buffer.create (String.length s) + in + (* Start with a _ if digit *) + if '0' <= s.[0] && s.[0] <= '9' then + Buffer.add_char buff hyphen; + + String.iter + (fun c -> + if ('a' <= c && c <= 'z') + || + ('A' <= c && c <= 'Z') + || + ('0' <= c && c <= '9') then + Buffer.add_char buff c + else + Buffer.add_char buff hyphen) + s; + + String.lowercase (Buffer.contents buff) + end + + let varname_concat ?(hyphen='_') p s = + let p = + let p_len = + String.length p + in + if p_len > 0 && p.[p_len - 1] = hyphen then + String.sub p 0 (p_len - 1) + else + p + in + let s = + let s_len = + String.length s + in + if s_len > 0 && s.[0] = hyphen then + String.sub s 1 (s_len - 1) + else + s + in + Printf.sprintf "%s%c%s" p hyphen s + + + let is_varname str = + str = varname_of_string str + + let failwithf1 fmt a = + failwith (Printf.sprintf fmt a) + + let failwithf2 fmt a b = + failwith (Printf.sprintf fmt a b) + + let failwithf3 fmt a b c = + failwith (Printf.sprintf fmt a b c) + + let failwithf4 fmt a b c d = + failwith (Printf.sprintf fmt a b c d) + + let failwithf5 fmt a b c d e = + failwith (Printf.sprintf fmt a b c d e) + +end + +module PropList = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/PropList.ml" + + open OASISGettext + + type name = string + + exception Not_set of name * string option + exception No_printer of name + exception Unknown_field of name * name + + let string_of_exception = + function + | Not_set (nm, Some rsn) -> + Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn + | Not_set (nm, None) -> + Printf.sprintf (f_ "Field '%s' is not set") nm + | No_printer nm -> + Printf.sprintf (f_ "No default printer for value %s") nm + | Unknown_field (nm, schm) -> + Printf.sprintf (f_ "Field %s is not defined in schema %s") nm schm + | e -> + raise e + + module Data = + struct + + type t = + (name, unit -> unit) Hashtbl.t + + let create () = + Hashtbl.create 13 + + let clear t = + Hashtbl.clear t + +# 59 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/PropList.ml" + end + + module Schema = + struct + + type ('ctxt, 'extra) value = + { + get: Data.t -> string; + set: Data.t -> ?context:'ctxt -> string -> unit; + help: (unit -> string) option; + extra: 'extra; + } + + type ('ctxt, 'extra) t = + { + name: name; + fields: (name, ('ctxt, 'extra) value) Hashtbl.t; + order: name Queue.t; + name_norm: string -> string; + } + + let create ?(case_insensitive=false) nm = + { + name = nm; + fields = Hashtbl.create 13; + order = Queue.create (); + name_norm = + (if case_insensitive then + String.lowercase + else + fun s -> s); + } + + let add t nm set get extra help = + let key = + t.name_norm nm + in + + if Hashtbl.mem t.fields key then + failwith + (Printf.sprintf + (f_ "Field '%s' is already defined in schema '%s'") + nm t.name); + Hashtbl.add + t.fields + key + { + set = set; + get = get; + help = help; + extra = extra; + }; + Queue.add nm t.order + + let mem t nm = + Hashtbl.mem t.fields nm + + let find t nm = + try + Hashtbl.find t.fields (t.name_norm nm) + with Not_found -> + raise (Unknown_field (nm, t.name)) + + let get t data nm = + (find t nm).get data + + let set t data nm ?context x = + (find t nm).set + data + ?context + x + + let fold f acc t = + Queue.fold + (fun acc k -> + let v = + find t k + in + f acc k v.extra v.help) + acc + t.order + + let iter f t = + fold + (fun () -> f) + () + t + + let name t = + t.name + end + + module Field = + struct + + type ('ctxt, 'value, 'extra) t = + { + set: Data.t -> ?context:'ctxt -> 'value -> unit; + get: Data.t -> 'value; + sets: Data.t -> ?context:'ctxt -> string -> unit; + gets: Data.t -> string; + help: (unit -> string) option; + extra: 'extra; + } + + let new_id = + let last_id = + ref 0 + in + fun () -> incr last_id; !last_id + + let create ?schema ?name ?parse ?print ?default ?update ?help extra = + (* Default value container *) + let v = + ref None + in + + (* If name is not given, create unique one *) + let nm = + match name with + | Some s -> s + | None -> Printf.sprintf "_anon_%d" (new_id ()) + in + + (* Last chance to get a value: the default *) + let default () = + match default with + | Some d -> d + | None -> raise (Not_set (nm, Some (s_ "no default value"))) + in + + (* Get data *) + let get data = + (* Get value *) + try + (Hashtbl.find data nm) (); + match !v with + | Some x -> x + | None -> default () + with Not_found -> + default () + in + + (* Set data *) + let set data ?context x = + let x = + match update with + | Some f -> + begin + try + f ?context (get data) x + with Not_set _ -> + x + end + | None -> + x + in + Hashtbl.replace + data + nm + (fun () -> v := Some x) + in + + (* Parse string value, if possible *) + let parse = + match parse with + | Some f -> + f + | None -> + fun ?context s -> + failwith + (Printf.sprintf + (f_ "Cannot parse field '%s' when setting value %S") + nm + s) + in + + (* Set data, from string *) + let sets data ?context s = + set ?context data (parse ?context s) + in + + (* Output value as string, if possible *) + let print = + match print with + | Some f -> + f + | None -> + fun _ -> raise (No_printer nm) + in + + (* Get data, as a string *) + let gets data = + print (get data) + in + + begin + match schema with + | Some t -> + Schema.add t nm sets gets extra help + | None -> + () + end; + + { + set = set; + get = get; + sets = sets; + gets = gets; + help = help; + extra = extra; + } + + let fset data t ?context x = + t.set data ?context x + + let fget data t = + t.get data + + let fsets data t ?context s = + t.sets data ?context s + + let fgets data t = + t.gets data + + end + + module FieldRO = + struct + + let create ?schema ?name ?parse ?print ?default ?update ?help extra = + let fld = + Field.create ?schema ?name ?parse ?print ?default ?update ?help extra + in + fun data -> Field.fget data fld + + end +end + +module OASISMessage = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISMessage.ml" + + + open OASISGettext + open OASISContext + + let generic_message ~ctxt lvl fmt = + let cond = + match lvl with + | `Debug -> ctxt.debug + | _ -> ctxt.verbose + 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 + + + let string_of_exception e = + try + PropList.string_of_exception e + with + | Failure s -> + s + | e -> + Printexc.to_string e + + (* TODO + let register_exn_printer f = + *) + +end + +module OASISVersion = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISVersion.ml" + + open OASISGettext + + + + type s = string + + type t = string + + type comparator = + | VGreater of t + | VGreaterEqual of t + | VEqual of t + | VLesser of t + | VLesserEqual of t + | VOr of comparator * comparator + | VAnd of comparator * comparator + + + (* Range of allowed characters *) + let is_digit c = + '0' <= c && c <= '9' + + let is_alpha c = + ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z') + + let is_special = + function + | '.' | '+' | '-' | '~' -> true + | _ -> false + + let rec version_compare v1 v2 = + if v1 <> "" || v2 <> "" then + begin + (* Compare ascii string, using special meaning for version + * related char + *) + let val_ascii c = + if c = '~' then -1 + else if is_digit c then 0 + else if c = '\000' then 0 + else if is_alpha c then Char.code c + else (Char.code c) + 256 + in + + let len1 = String.length v1 in + let len2 = String.length v2 in + + let p = ref 0 in + + (** Compare ascii part *) + let compare_vascii () = + let cmp = ref 0 in + while !cmp = 0 && + !p < len1 && !p < len2 && + not (is_digit v1.[!p] && is_digit v2.[!p]) do + cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]); + incr p + done; + if !cmp = 0 && !p < len1 && !p = len2 then + val_ascii v1.[!p] + else if !cmp = 0 && !p = len1 && !p < len2 then + - (val_ascii v2.[!p]) + else + !cmp + in + + (** Compare digit part *) + let compare_digit () = + let extract_int v p = + let start_p = !p in + while !p < String.length v && is_digit v.[!p] do + incr p + done; + match String.sub v start_p (!p - start_p) with + | "" -> 0, + v + | s -> int_of_string s, + String.sub v !p ((String.length v) - !p) + 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 = + String.iter + (fun c -> + if is_alpha c || is_digit c || is_special c then + () + else + failwith + (Printf.sprintf + (f_ "Char %C is not allowed in version '%s'") + c str)) + 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 +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISLicense.ml" + + (** License for _oasis fields + @author Sylvain Le Gall + *) + + + + type license = string + + type license_exception = string + + type license_version = + | Version of OASISVersion.t + | VersionOrLater of OASISVersion.t + | NoVersion + + + type license_dep_5 = + { + license: license; + exceptions: license_exception list; + version: license_version; + } + + type t = + | DEP5License of license_dep_5 + | OtherLicense of string (* URL *) + + +end + +module OASISExpr = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISExpr.ml" + + + + open OASISGettext + + type test = string + + type flag = string + + type t = + | EBool of bool + | ENot of t + | EAnd of t * t + | EOr of t * t + | EFlag of flag + | ETest of test * string + + + type 'a choices = (t * 'a) list + + let eval var_get t = + let rec eval' = + function + | EBool b -> + b + + | ENot e -> + not (eval' e) + + | EAnd (e1, e2) -> + (eval' e1) && (eval' e2) + + | EOr (e1, e2) -> + (eval' e1) || (eval' e2) + + | EFlag nm -> + let v = + var_get nm + in + assert(v = "true" || v = "false"); + (v = "true") + + | ETest (nm, vl) -> + let v = + var_get nm + in + (v = vl) + in + eval' t + + let choose ?printer ?name var_get lst = + let rec choose_aux = + function + | (cond, vl) :: tl -> + if eval var_get cond then + vl + else + choose_aux tl + | [] -> + let str_lst = + if lst = [] then + s_ "" + else + String.concat + (s_ ", ") + (List.map + (fun (cond, vl) -> + match printer with + | Some p -> p vl + | None -> s_ "") + lst) + in + match name with + | Some nm -> + failwith + (Printf.sprintf + (f_ "No result for the choice list '%s': %s") + nm str_lst) + | None -> + failwith + (Printf.sprintf + (f_ "No result for a choice list: %s") + str_lst) + in + choose_aux (List.rev lst) + +end + +module OASISTypes = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISTypes.ml" + + + + + type name = string + type package_name = string + type url = string + type unix_dirname = string + type unix_filename = string + type host_dirname = string + type host_filename = string + type prog = string + type arg = string + type args = string list + type command_line = (prog * arg list) + + type findlib_name = string + type findlib_full = string + + type compiled_object = + | Byte + | Native + | Best + + + type dependency = + | FindlibPackage of findlib_full * OASISVersion.comparator option + | InternalLibrary of name + + + type tool = + | ExternalTool of name + | InternalExecutable of name + + + type vcs = + | Darcs + | Git + | Svn + | Cvs + | Hg + | Bzr + | Arch + | Monotone + | OtherVCS of url + + + type plugin_kind = + [ `Configure + | `Build + | `Doc + | `Test + | `Install + | `Extra + ] + + type plugin_data_purpose = + [ `Configure + | `Build + | `Install + | `Clean + | `Distclean + | `Install + | `Uninstall + | `Test + | `Doc + | `Extra + | `Other of string + ] + + type 'a plugin = 'a * name * OASISVersion.t option + + type all_plugin = plugin_kind plugin + + type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list + +# 102 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISTypes.ml" + + type 'a conditional = 'a OASISExpr.choices + + type custom = + { + pre_command: (command_line option) conditional; + post_command: (command_line option) conditional; + } + + + type common_section = + { + cs_name: name; + cs_data: PropList.Data.t; + cs_plugin_data: plugin_data; + } + + + type build_section = + { + bs_build: bool conditional; + bs_install: bool conditional; + bs_path: unix_dirname; + bs_compiled_object: compiled_object; + bs_build_depends: dependency list; + bs_build_tools: tool list; + bs_c_sources: unix_filename list; + bs_data_files: (unix_filename * unix_filename option) list; + bs_ccopt: args conditional; + bs_cclib: args conditional; + bs_dlllib: args conditional; + bs_dllpath: args conditional; + bs_byteopt: args conditional; + bs_nativeopt: args conditional; + } + + + type library = + { + lib_modules: string list; + lib_internal_modules: string list; + lib_findlib_parent: findlib_name option; + lib_findlib_name: findlib_name option; + lib_findlib_containers: findlib_name list; + } + + type executable = + { + exec_custom: bool; + exec_main_is: unix_filename; + } + + type flag = + { + flag_description: string option; + flag_default: bool conditional; + } + + type source_repository = + { + src_repo_type: vcs; + src_repo_location: url; + src_repo_browser: url option; + src_repo_module: string option; + src_repo_branch: string option; + src_repo_tag: string option; + src_repo_subdir: unix_filename option; + } + + type test = + { + test_type: [`Test] plugin; + test_command: command_line conditional; + test_custom: custom; + test_working_directory: unix_filename option; + test_run: bool conditional; + test_tools: tool list; + } + + type doc_format = + | HTML of unix_filename + | DocText + | PDF + | PostScript + | Info of unix_filename + | DVI + | OtherDoc + + + type doc = + { + doc_type: [`Doc] plugin; + doc_custom: custom; + doc_build: bool conditional; + doc_install: bool conditional; + doc_install_dir: unix_filename; + doc_title: string; + doc_authors: string list; + doc_abstract: string option; + doc_format: doc_format; + doc_data_files: (unix_filename * unix_filename option) list; + doc_build_tools: tool list; + } + + type section = + | Library of common_section * build_section * library + | Executable of common_section * build_section * executable + | Flag of common_section * flag + | SrcRepo of common_section * source_repository + | Test of common_section * test + | Doc of common_section * doc + + + type package = + { + oasis_version: OASISVersion.t; + ocaml_version: OASISVersion.comparator option; + findlib_version: OASISVersion.comparator option; + name: package_name; + version: OASISVersion.t; + license: OASISLicense.t; + license_file: unix_filename option; + copyrights: string list; + maintainers: string list; + authors: string list; + homepage: url option; + synopsis: string; + description: string option; + categories: url list; + + conf_type: [`Configure] plugin; + conf_custom: custom; + + build_type: [`Build] plugin; + build_custom: custom; + + install_type: [`Install] plugin; + install_custom: custom; + uninstall_custom: custom; + + clean_custom: custom; + distclean_custom: custom; + + files_ab: unix_filename list; + sections: section list; + plugins: [`Extra] plugin list; + schema_data: PropList.Data.t; + plugin_data: plugin_data; + } + +end + +module OASISUnixPath = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISUnixPath.ml" + + type unix_filename = string + type unix_dirname = string + + type host_filename = string + type host_dirname = string + + let current_dir_name = "." + + let parent_dir_name = ".." + + let concat f1 f2 = + if f1 = current_dir_name then + f2 + else if f2 = current_dir_name then + f1 + else + 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 + +end + +module OASISSection = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISSection.ml" + + (** Manipulate section + @author Sylvain Le Gall + *) + + open OASISTypes + + type section_kind = + | KLibrary + | KExecutable + | KFlag + | KSrcRepo + | KTest + | KDoc + + (** Extract generic information + *) + let section_kind_common = + function + | Library (cs, _, _) -> + KLibrary, cs + | Executable (cs, _, _) -> + KExecutable, cs + | Flag (cs, _) -> + KFlag, cs + | SrcRepo (cs, _) -> + KSrcRepo, cs + | Test (cs, _) -> + KTest, cs + | Doc (cs, _) -> + KDoc, cs + + (** Common section of a section + *) + let section_common sct = + snd (section_kind_common sct) + + (** Key used to identify section + *) + let section_id sct = + let k, cs = + section_kind_common sct + in + k, cs.cs_name + + let string_of_section sct = + let k, nm = + section_id sct + in + (match k with + | KLibrary -> "library" + | KExecutable -> "executable" + | KFlag -> "flag" + | KSrcRepo -> "src repository" + | KTest -> "test" + | KDoc -> "doc") + ^" "^nm + +end + +module OASISBuildSection = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISBuildSection.ml" + +end + +module OASISExecutable = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISExecutable.ml" + + open OASISTypes + + let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program = + let dir = + OASISUnixPath.concat + bs.bs_path + (OASISUnixPath.dirname exec.exec_main_is) + in + let is_native_exec = + match bs.bs_compiled_object with + | Native -> true + | Best -> is_native () + | Byte -> false + in + + OASISUnixPath.concat + dir + (cs.cs_name^(suffix_program ())), + + if not is_native_exec && + not exec.exec_custom && + bs.bs_c_sources <> [] then + Some (dir^"/dll"^cs.cs_name^(ext_dll ())) + else + None + +end + +module OASISLibrary = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISLibrary.ml" + + open OASISTypes + open OASISUtils + open OASISGettext + + type library_name = name + + let generated_unix_files ~ctxt (cs, bs, lib) + source_file_exists is_native ext_lib ext_dll = + (* The headers that should be compiled along *) + let headers = + List.fold_left + (fun hdrs modul -> + try + let base_fn = + List.find + (fun fn -> + source_file_exists (fn^".ml") || + source_file_exists (fn^".mli") || + source_file_exists (fn^".mll") || + source_file_exists (fn^".mly")) + (List.map + (OASISUnixPath.concat bs.bs_path) + [modul; + String.uncapitalize modul; + String.capitalize modul]) + in + [base_fn^".cmi"] :: hdrs + with Not_found -> + OASISMessage.warning + ~ctxt + (f_ "Cannot find source file matching \ + module '%s' in library %s") + modul cs.cs_name; + (List.map (OASISUnixPath.concat bs.bs_path) + [modul^".cmi"; + String.uncapitalize modul ^ ".cmi"; + String.capitalize modul ^ ".cmi"]) + :: hdrs) + [] + lib.lib_modules + in + + let acc_nopath = + [] + in + + (* Compute what libraries should be built *) + let acc_nopath = + let byte acc = + [cs.cs_name^".cma"] :: acc + in + let native 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 + in + + (* Add C library to be built *) + let acc_nopath = + if bs.bs_c_sources <> [] then + begin + ["lib"^cs.cs_name^(ext_lib ())] + :: + ["dll"^cs.cs_name^(ext_dll ())] + :: + acc_nopath + end + else + acc_nopath + in + + (* All the files generated *) + List.rev_append + (List.rev_map + (List.rev_map + (OASISUnixPath.concat bs.bs_path)) + acc_nopath) + headers + + + type group_t = + | Container of findlib_name * (group_t list) + | Package of (findlib_name * + common_section * + build_section * + library * + (group_t list)) + + let group_libs pkg = + (** Associate a name with its children *) + let children = + List.fold_left + (fun mp -> + function + | Library (cs, bs, lib) -> + begin + match lib.lib_findlib_parent with + | Some p_nm -> + begin + let children = + try + MapString.find p_nm mp + with Not_found -> + [] + in + MapString.add p_nm ((cs, bs, lib) :: children) mp + end + | None -> + mp + end + | _ -> + mp) + MapString.empty + pkg.sections + in + + (* Compute findlib name of a single node *) + let findlib_name (cs, _, lib) = + match lib.lib_findlib_name with + | Some nm -> nm + | None -> cs.cs_name + in + + (** Build a package tree *) + let rec tree_of_library containers ((cs, bs, lib) as acc) = + match containers with + | hd :: tl -> + Container (hd, [tree_of_library tl acc]) + | [] -> + (* TODO: allow merging containers with the same + * name + *) + Package + (findlib_name acc, cs, bs, lib, + (try + List.rev_map + (fun ((_, _, child_lib) as child_acc) -> + tree_of_library + child_lib.lib_findlib_containers + child_acc) + (MapString.find cs.cs_name children) + with Not_found -> + [])) + in + + (* TODO: check that libraries are unique *) + List.fold_left + (fun acc -> + function + | Library (cs, bs, lib) when lib.lib_findlib_parent = None -> + (tree_of_library lib.lib_findlib_containers (cs, bs, lib)) :: acc + | _ -> + acc) + [] + pkg.sections + + (** Compute internal to findlib library matchings, including subpackage + and return a map of it. + *) + let findlib_name_map pkg = + + (* Compute names in a tree *) + let rec findlib_names_aux path mp grp = + let fndlb_nm, children, mp = + match grp with + | Container (fndlb_nm, children) -> + fndlb_nm, children, mp + + | Package (fndlb_nm, {cs_name = nm}, _, _, children) -> + fndlb_nm, children, (MapString.add nm (path, fndlb_nm) mp) + in + let fndlb_nm_full = + (match path with + | Some pth -> pth^"." + | None -> "")^ + fndlb_nm + in + List.fold_left + (findlib_names_aux (Some fndlb_nm_full)) + mp + children + in + + List.fold_left + (findlib_names_aux None) + MapString.empty + (group_libs pkg) + + + let findlib_of_name ?(recurse=false) map nm = + try + let (path, fndlb_nm) = + MapString.find nm map + in + match path with + | Some pth when recurse -> pth^"."^fndlb_nm + | _ -> fndlb_nm + + with Not_found -> + failwithf1 + (f_ "Unable to translate internal library '%s' to findlib name") + nm + + let name_findlib_map pkg = + let mp = + findlib_name_map pkg + in + MapString.fold + (fun nm _ acc -> + let fndlb_nm_full = + findlib_of_name + ~recurse:true + mp + nm + in + MapString.add fndlb_nm_full nm acc) + mp + MapString.empty + + let findlib_of_group = + function + | Container (fndlb_nm, _) + | Package (fndlb_nm, _, _, _, _) -> fndlb_nm + + let root_of_group grp = + let rec root_lib_aux = + function + | Container (_, children) -> + root_lib_lst children + | Package (_, cs, bs, lib, children) -> + if lib.lib_findlib_parent = None then + cs, bs, lib + else + root_lib_lst children + and root_lib_lst = + function + | [] -> + raise Not_found + | hd :: tl -> + try + root_lib_aux hd + with Not_found -> + root_lib_lst tl + in + try + root_lib_aux grp + with Not_found -> + failwithf1 + (f_ "Unable to determine root library of findlib library '%s'") + (findlib_of_group grp) + + +end + +module OASISFlag = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISFlag.ml" + +end + +module OASISPackage = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISPackage.ml" + +end + +module OASISSourceRepository = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISSourceRepository.ml" + +end + +module OASISTest = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISTest.ml" + +end + +module OASISDocument = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/oasis/OASISDocument.ml" + +end + + +module BaseEnvLight = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseEnvLight.ml" + + module MapString = Map.Make(String) + + type t = string MapString.t + + let default_filename = + Filename.concat + (Sys.getcwd ()) + "setup.data" + + let load ?(allow_empty=false) ?(filename=default_filename) () = + if Sys.file_exists filename then + begin + let chn = + open_in_bin filename + in + let st = + Stream.of_channel chn + in + let line = + ref 1 + in + let st_line = + Stream.from + (fun _ -> + try + match Stream.next st with + | '\n' -> incr line; Some '\n' + | c -> Some c + with Stream.Failure -> None) + in + let lexer = + Genlex.make_lexer ["="] st_line + in + let rec read_file mp = + match Stream.npeek 3 lexer with + | [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] -> + Stream.junk lexer; + Stream.junk lexer; + Stream.junk lexer; + read_file (MapString.add nm value mp) + | [] -> + mp + | _ -> + failwith + (Printf.sprintf + "Malformed data file '%s' line %d" + filename !line) + in + let mp = + read_file MapString.empty + in + close_in chn; + mp + end + else if allow_empty then + begin + MapString.empty + end + else + begin + failwith + (Printf.sprintf + "Unable to load environment, the file '%s' doesn't exist." + filename) + end + + let var_get name env = + let rec var_expand str = + let buff = + Buffer.create ((String.length str) * 2) + in + Buffer.add_substitute + buff + (fun var -> + try + var_expand (MapString.find var env) + with Not_found -> + failwith + (Printf.sprintf + "No variable %s defined when trying to expand %S." + var + str)) + str; + Buffer.contents buff + in + var_expand (MapString.find name env) + + let var_choose lst env = + OASISExpr.choose + (fun nm -> var_get nm env) + lst +end + + +module BaseContext = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseContext.ml" + + open OASISContext + + let args = args + + let default = default + +end + +module BaseMessage = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseMessage.ml" + + (** Message to user, overrid for Base + @author Sylvain Le Gall + *) + open OASISMessage + open BaseContext + + let debug fmt = debug ~ctxt:!default fmt + + let info fmt = info ~ctxt:!default fmt + + let warning fmt = warning ~ctxt:!default fmt + + let error fmt = error ~ctxt:!default fmt + + let string_of_exception = string_of_exception + +end + +module BaseFilePath = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseFilePath.ml" + + + open Filename + + module Unix = OASISUnixPath + + let make = + function + | [] -> + invalid_arg "BaseFilename.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) + (OASISUtils.split '/' ufn)) + +end + +module BaseEnv = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseEnv.ml" + + open OASISTypes + open OASISGettext + open OASISUtils + open PropList + + module MapString = BaseEnvLight.MapString + + type origin_t = + | ODefault + | OGetEnv + | OFileLoad + | OCommandLine + + type cli_handle_t = + | CLINone + | CLIAuto + | CLIWith + | CLIEnable + | CLIUser of (Arg.key * Arg.spec * Arg.doc) list + + type definition_t = + { + hide: bool; + dump: bool; + cli: cli_handle_t; + arg_help: string option; + group: string option; + } + + let schema = + Schema.create "environment" + + (* Environment data *) + let env = + Data.create () + + (* Environment data from file *) + let env_from_file = + ref MapString.empty + + (* Lexer for var *) + let var_lxr = + Genlex.make_lexer [] + + let rec var_expand str = + let buff = + Buffer.create ((String.length str) * 2) + in + Buffer.add_substitute + buff + (fun var -> + try + (* TODO: this is a quick hack to allow calling Test.Command + * without defining executable name really. I.e. if there is + * an exec Executable toto, then $(toto) should be replace + * by its real name. It is however useful to have this function + * for other variable that depend on the host and should be + * written better than that. + *) + let st = + var_lxr (Stream.of_string var) + in + match Stream.npeek 3 st with + | [Genlex.Ident "utoh"; Genlex.Ident nm] -> + BaseFilePath.of_unix (var_get nm) + | [Genlex.Ident "utoh"; Genlex.String s] -> + BaseFilePath.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 + | _ -> + failwithf2 + (f_ "Unknown expression '%s' in variable expansion of %s.") + var + str + with + | Unknown_field (_, _) -> + failwithf2 + (f_ "No variable %s defined when trying to expand %S.") + var + str + | Stream.Error e -> + failwithf3 + (f_ "Syntax error when parsing '%s' when trying to \ + expand %S: %s") + var + str + e) + str; + Buffer.contents buff + + and var_get name = + let vl = + try + Schema.get schema env name + with Unknown_field _ as e -> + begin + try + MapString.find name !env_from_file + with Not_found -> + raise e + end + in + var_expand vl + + let var_choose ?printer ?name lst = + OASISExpr.choose + ?printer + ?name + var_get + lst + + let var_protect vl = + let buff = + Buffer.create (String.length vl) + in + String.iter + (function + | '$' -> Buffer.add_string buff "\\$" + | c -> Buffer.add_char buff c) + vl; + Buffer.contents buff + + let var_define + ?(hide=false) + ?(dump=true) + ?short_desc + ?(cli=CLINone) + ?arg_help + ?group + name (* TODO: type constraint on the fact that name must be a valid OCaml + id *) + dflt = + + let default = + [ + OFileLoad, lazy (MapString.find name !env_from_file); + ODefault, dflt; + OGetEnv, lazy (Sys.getenv name); + ] + in + + let extra = + { + hide = hide; + dump = dump; + cli = cli; + arg_help = arg_help; + group = group; + } + in + + (* Try to find a value that can be defined + *) + let var_get_low lst = + let errors, res = + List.fold_left + (fun (errors, res) (_, v) -> + if res = None then + begin + try + errors, Some (Lazy.force v) + with + | Not_found -> + errors, res + | Failure rsn -> + (rsn :: errors), res + | e -> + (Printexc.to_string e) :: errors, res + end + else + errors, res) + ([], None) + (List.sort + (fun (o1, _) (o2, _) -> + if o1 < o2 then + 1 + else if o1 = o2 then + 0 + else + -1) + lst) + in + match res, errors with + | Some v, _ -> + v + | None, [] -> + raise (Not_set (name, None)) + | None, lst -> + raise (Not_set (name, Some (String.concat (s_ ", ") lst))) + in + + let help = + match short_desc with + | Some fs -> Some fs + | None -> None + in + + let var_get_lst = + FieldRO.create + ~schema + ~name + ~parse:(fun ?(context=ODefault) s -> [context, lazy s]) + ~print:var_get_low + ~default + ~update:(fun ?context x old_x -> x @ old_x) + ?help + extra + in + + fun () -> + var_expand (var_get_low (var_get_lst env)) + + let var_redefine + ?hide + ?dump + ?short_desc + ?cli + ?arg_help + ?group + name + dflt = + if Schema.mem schema name then + begin + Schema.set schema env ~context:ODefault name (Lazy.force dflt); + fun () -> var_get name + end + else + begin + var_define + ?hide + ?dump + ?short_desc + ?cli + ?arg_help + ?group + name + dflt + end + + let var_ignore (e : unit -> string) = + () + + let print_hidden = + var_define + ~hide:true + ~dump:false + ~cli:CLIAuto + ~arg_help:"Print even non-printable variable. (debug)" + "print_hidden" + (lazy "false") + + let var_all () = + List.rev + (Schema.fold + (fun acc nm def _ -> + if not def.hide || bool_of_string (print_hidden ()) then + nm :: acc + else + acc) + [] + schema) + + let default_filename = + BaseEnvLight.default_filename + + let load ?allow_empty ?filename () = + env_from_file := BaseEnvLight.load ?allow_empty ?filename () + + let unload () = + (* TODO: reset lazy values *) + env_from_file := MapString.empty; + Data.clear env + + let dump ?(filename=default_filename) () = + let chn = + open_out_bin filename + in + Schema.iter + (fun nm def _ -> + if def.dump then + begin + try + let value = + Schema.get + schema + env + nm + in + Printf.fprintf chn "%s = %S\n" nm value + with Not_set _ -> + () + end) + schema; + close_out chn + + let print () = + let printable_vars = + Schema.fold + (fun acc nm def short_descr_opt -> + if not def.hide || bool_of_string (print_hidden ()) then + begin + try + let value = + Schema.get + schema + env + nm + in + let txt = + match short_descr_opt with + | Some s -> s () + | None -> nm + in + (txt, value) :: acc + with Not_set _ -> + acc + end + else + acc) + [] + schema + in + let max_length = + List.fold_left max 0 + (List.rev_map String.length + (List.rev_map fst printable_vars)) + in + let dot_pad str = + String.make ((max_length - (String.length str)) + 3) '.' + in + + print_newline (); + print_endline "Configuration: "; + print_newline (); + List.iter + (fun (name,value) -> + Printf.printf "%s: %s %s\n" name (dot_pad name) value) + printable_vars; + Printf.printf "%!"; + print_newline () + + let args () = + let arg_concat = + OASISUtils.varname_concat ~hyphen:'-' + in + [ + "--override", + Arg.Tuple + ( + let rvr = ref "" + in + let rvl = ref "" + in + [ + Arg.Set_string rvr; + Arg.Set_string rvl; + Arg.Unit + (fun () -> + Schema.set + schema + env + ~context:OCommandLine + !rvr + !rvl) + ] + ), + "var+val Override any configuration variable."; + + ] + @ + List.flatten + (Schema.fold + (fun acc name def short_descr_opt -> + let var_set s = + Schema.set + schema + env + ~context:OCommandLine + name + s + in + + let arg_name = + OASISUtils.varname_of_string ~hyphen:'-' name + in + + let hlp = + match short_descr_opt with + | Some txt -> txt () + | None -> "" + in + + let arg_hlp = + match def.arg_help with + | Some s -> s + | None -> "str" + in + + let default_value = + try + Printf.sprintf + (f_ " [%s]") + (Schema.get + schema + env + name) + with Not_set _ -> + "" + in + + let args = + match def.cli with + | CLINone -> + [] + | CLIAuto -> + [ + arg_concat "--" arg_name, + Arg.String var_set, + Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value + ] + | CLIWith -> + [ + arg_concat "--with-" arg_name, + Arg.String var_set, + Printf.sprintf (f_ "%s %s%s") arg_hlp hlp default_value + ] + | CLIEnable -> + [ + arg_concat "--enable-" arg_name, + Arg.Unit (fun () -> var_set "true"), + Printf.sprintf (f_ " %s%s") hlp + (if default_value = " [true]" then + (s_ " [default]") + else + ""); + + arg_concat "--disable-" arg_name, + Arg.Unit (fun () -> var_set "false"), + Printf.sprintf (f_ " %s%s") hlp + (if default_value = " [false]" then + (s_ " [default]") + else + ""); + ] + | CLIUser lst -> + lst + in + args :: acc) + [] + schema) +end + +module BaseExec = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseExec.ml" + + open OASISGettext + open OASISUtils + open BaseMessage + + let run ?f_exit_code cmd args = + let cmdline = + String.concat " " (cmd :: args) + in + info (f_ "Running command '%s'") cmdline; + match f_exit_code, Sys.command cmdline with + | None, 0 -> () + | None, i -> + failwithf2 + (f_ "Command '%s' terminated with error code %d") + cmdline i + | Some f, i -> + f i + + let run_read_output cmd args = + let fn = + Filename.temp_file "oasis-" ".txt" + in + let () = + try + run cmd (args @ [">"; Filename.quote fn]) + with e -> + Sys.remove fn; + raise e + in + let chn = + open_in fn + in + let routput = + ref [] + in + ( + try + while true do + routput := (input_line chn) :: !routput + done + with End_of_file -> + () + ); + close_in chn; + Sys.remove fn; + List.rev !routput + + let run_read_one_line cmd args = + match run_read_output cmd args with + | [fst] -> + fst + | lst -> + failwithf1 + (f_ "Command return unexpected output %S") + (String.concat "\n" lst) +end + +module BaseFileUtil = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseFileUtil.ml" + + open OASISGettext + + let find_file paths exts = + + (* Cardinal product of two list *) + let ( * ) lst1 lst2 = + List.flatten + (List.map + (fun a -> + List.map + (fun b -> a,b) + lst2) + lst1) + in + + let rec combined_paths lst = + match lst with + | p1 :: p2 :: tl -> + let acc = + (List.map + (fun (a,b) -> Filename.concat a b) + (p1 * p2)) + in + combined_paths (acc :: tl) + | [e] -> + e + | [] -> + [] + in + + let alternatives = + List.map + (fun (p,e) -> + if String.length e > 0 && e.[0] <> '.' then + p ^ "." ^ e + else + p ^ e) + ((combined_paths paths) * exts) + in + List.find + Sys.file_exists + alternatives + + let which prg = + let path_sep = + match Sys.os_type with + | "Win32" -> + ';' + | _ -> + ':' + in + let path_lst = + OASISUtils.split + path_sep + (Sys.getenv "PATH") + in + let exec_ext = + match Sys.os_type with + | "Win32" -> + "" + :: + (OASISUtils.split + path_sep + (Sys.getenv "PATHEXT")) + | _ -> + [""] + in + find_file [path_lst; [prg]] exec_ext + + (**/**) + let rec fix_dir dn = + (* Windows hack because Sys.file_exists "src\\" = false when + * Sys.file_exists "src" = true + *) + let ln = + String.length dn + in + if Sys.os_type = "Win32" && ln > 0 && dn.[ln - 1] = '\\' then + fix_dir (String.sub dn 0 (ln - 1)) + else + dn + + let q = Filename.quote + (**/**) + + let cp src tgt = + BaseExec.run + (match Sys.os_type with + | "Win32" -> "copy" + | _ -> "cp") + [q src; q tgt] + + let mkdir tgt = + BaseExec.run + (match Sys.os_type with + | "Win32" -> "md" + | _ -> "mkdir") + [q tgt] + + let rec mkdir_parent f tgt = + let tgt = + fix_dir tgt + in + if Sys.file_exists tgt then + begin + if not (Sys.is_directory tgt) then + OASISUtils.failwithf1 + (f_ "Cannot create directory '%s', a file of the same name already \ + exists") + tgt + end + else + begin + mkdir_parent f (Filename.dirname tgt); + if not (Sys.file_exists tgt) then + begin + f tgt; + mkdir tgt + end + end + + let rmdir tgt = + if Sys.readdir tgt = [||] then + begin + match Sys.os_type with + | "Win32" -> + BaseExec.run "rd" [q tgt] + | _ -> + BaseExec.run "rm" ["-r"; q tgt] + end + + let glob 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 Sys.file_exists fn then + [fn] + else + [] + end +end + +module BaseArgExt = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseArgExt.ml" + + open OASISUtils + open OASISGettext + + let parse argv args = + (* Simulate command line for Arg *) + let current = + ref 0 + in + + try + Arg.parse_argv + ~current:current + (Array.concat [[|"none"|]; argv]) + (Arg.align args) + (failwithf1 (f_ "Don't know what to do with arguments: '%s'")) + (s_ "configure options:") + with + | Arg.Help txt -> + print_endline txt; + exit 0 + | Arg.Bad txt -> + prerr_endline txt; + exit 1 +end + +module BaseCheck = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseCheck.ml" + + open BaseEnv + open BaseMessage + open OASISUtils + open OASISGettext + + let prog_best prg prg_lst = + var_redefine + prg + (lazy + (let alternate = + List.fold_left + (fun res e -> + match res with + | Some _ -> + res + | None -> + try + Some (BaseFileUtil.which e) + with Not_found -> + None) + None + prg_lst + in + match alternate with + | Some prg -> prg + | None -> raise Not_found)) + + let prog prg = + prog_best prg [prg] + + let prog_opt prg = + prog_best prg [prg^".opt"; prg] + + let ocamlfind = + prog "ocamlfind" + + let version + var_prefix + cmp + fversion + () = + (* Really compare version provided *) + let var = + var_prefix^"_version_"^(OASISVersion.varname_of_comparator cmp) + in + var_redefine + ~hide:true + var + (lazy + (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 + failwithf3 + (f_ "Cannot satisfy version constraint on %s: %s (version: %s)") + var_prefix + (OASISVersion.string_of_comparator cmp) + version_str)) + () + + let package_version pkg = + BaseExec.run_read_one_line + (ocamlfind ()) + ["query"; "-format"; "%v"; pkg] + + let package ?version_comparator pkg () = + let var = + OASISUtils.varname_concat + "pkg_" + (OASISUtils.varname_of_string pkg) + in + let findlib_dir pkg = + let dir = + BaseExec.run_read_one_line + (ocamlfind ()) + ["query"; "-format"; "%d"; pkg] + in + if Sys.file_exists dir && Sys.is_directory dir then + dir + else + failwithf2 + (f_ "When looking for findlib package %s, \ + directory %s return doesn't exist") + pkg dir + in + let vl = + var_redefine + var + (lazy (findlib_dir pkg)) + () + in + ( + match version_comparator with + | Some ver_cmp -> + ignore + (version + var + ver_cmp + (fun _ -> package_version pkg) + ()) + | None -> + () + ); + vl +end + +module BaseOCamlcConfig = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseOCamlcConfig.ml" + + + open BaseEnv + open OASISUtils + open OASISGettext + + module SMap = Map.Make(String) + + let ocamlc = + BaseCheck.prog_opt "ocamlc" + + let ocamlc_config_map = + (* Map name to value for ocamlc -config output + (name ^": "^value) + *) + let rec split_field mp lst = + match lst with + | line :: tl -> + let mp = + try + let pos_semicolon = + String.index line ':' + in + if pos_semicolon > 1 then + ( + let name = + String.sub line 0 pos_semicolon + in + let linelen = + String.length line + in + let value = + if linelen > pos_semicolon + 2 then + String.sub + line + (pos_semicolon + 2) + (linelen - pos_semicolon - 2) + else + "" + in + SMap.add name value mp + ) + else + ( + mp + ) + with Not_found -> + ( + mp + ) + in + split_field mp tl + | [] -> + mp + in + + var_redefine + "ocamlc_config_map" + ~hide:true + ~dump:false + (lazy + (var_protect + (Marshal.to_string + (split_field + SMap.empty + (BaseExec.run_read_output + (ocamlc ()) ["-config"])) + []))) + + let var_define nm = + (* Extract data from ocamlc -config *) + let avlbl_config_get () = + Marshal.from_string + (ocamlc_config_map ()) + 0 + in + let nm_config = + match nm with + | "ocaml_version" -> "version" + | _ -> nm + in + var_redefine + nm + (lazy + (try + let map = + avlbl_config_get () + in + let value = + SMap.find nm_config map + in + value + with Not_found -> + failwithf2 + (f_ "Cannot find field '%s' in '%s -config' output") + nm + (ocamlc ()))) + +end + +module BaseStandardVar = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseStandardVar.ml" + + + open OASISGettext + open OASISTypes + open OASISExpr + open BaseCheck + open BaseEnv + + let ocamlfind = BaseCheck.ocamlfind + let ocamlc = BaseOCamlcConfig.ocamlc + let ocamlopt = prog_opt "ocamlopt" + let ocamlbuild = prog "ocamlbuild" + + + (**/**) + let rpkg = + ref None + + let pkg_get () = + match !rpkg with + | Some pkg -> pkg + | None -> failwith (s_ "OASIS Package is not set") + (**/**) + + let pkg_name = + var_define + ~short_desc:(fun () -> s_ "Package name") + "pkg_name" + (lazy (pkg_get ()).name) + + let pkg_version = + var_define + ~short_desc:(fun () -> s_ "Package version") + "pkg_version" + (lazy + (OASISVersion.string_of_version (pkg_get ()).version)) + + let c = BaseOCamlcConfig.var_define + + let os_type = c "os_type" + let system = c "system" + let architecture = c "architecture" + let ccomp_type = c "ccomp_type" + let ocaml_version = c "ocaml_version" + + (* TODO: Check standard variable presence at runtime *) + + let standard_library_default = c "standard_library_default" + let standard_library = c "standard_library" + let standard_runtime = c "standard_runtime" + let bytecomp_c_compiler = c "bytecomp_c_compiler" + let native_c_compiler = c "native_c_compiler" + let model = c "model" + let ext_obj = c "ext_obj" + let ext_asm = c "ext_asm" + let ext_lib = c "ext_lib" + let ext_dll = c "ext_dll" + let default_executable_name = c "default_executable_name" + let systhread_supported = c "systhread_supported" + + + (**/**) + let p name hlp dflt = + var_define + ~short_desc:hlp + ~cli:CLIAuto + ~arg_help:"dir" + name + dflt + + let (/) a b = + if os_type () = Sys.os_type then + Filename.concat a b + else if os_type () = "Unix" then + BaseFilePath.Unix.concat a b + else + OASISUtils.failwithf1 + (f_ "Cannot handle os_type %s filename concat") + (os_type ()) + (**/**) + + let prefix = + p "prefix" + (fun () -> s_ "Install architecture-independent files dir") + (lazy + (match os_type () with + | "Win32" -> + let program_files = + Sys.getenv "PROGRAMFILES" + in + program_files/(pkg_name ()) + | _ -> + "/usr/local")) + + let exec_prefix = + p "exec_prefix" + (fun () -> s_ "Install architecture-dependent files in dir") + (lazy "$prefix") + + let bindir = + p "bindir" + (fun () -> s_ "User executables") + (lazy ("$exec_prefix"/"bin")) + + let sbindir = + p "sbindir" + (fun () -> s_ "System admin executables") + (lazy ("$exec_prefix"/"sbin")) + + let libexecdir = + p "libexecdir" + (fun () -> s_ "Program executables") + (lazy ("$exec_prefix"/"libexec")) + + let sysconfdir = + p "sysconfdir" + (fun () -> s_ "Read-only single-machine data") + (lazy ("$prefix"/"etc")) + + let sharedstatedir = + p "sharedstatedir" + (fun () -> s_ "Modifiable architecture-independent data") + (lazy ("$prefix"/"com")) + + let localstatedir = + p "localstatedir" + (fun () -> s_ "Modifiable single-machine data") + (lazy ("$prefix"/"var")) + + let libdir = + p "libdir" + (fun () -> s_ "Object code libraries") + (lazy ("$exec_prefix"/"lib")) + + let datarootdir = + p "datarootdir" + (fun () -> s_ "Read-only arch-independent data root") + (lazy ("$prefix"/"share")) + + let datadir = + p "datadir" + (fun () -> s_ "Read-only architecture-independent data") + (lazy ("$datarootdir")) + + let infodir = + p "infodir" + (fun () -> s_ "Info documentation") + (lazy ("$datarootdir"/"info")) + + let localedir = + p "localedir" + (fun () -> s_ "Locale-dependent data") + (lazy ("$datarootdir"/"locale")) + + let mandir = + p "mandir" + (fun () -> s_ "Man documentation") + (lazy ("$datarootdir"/"man")) + + let docdir = + p "docdir" + (fun () -> s_ "Documentation root") + (lazy ("$datarootdir"/"doc"/"$pkg_name")) + + let htmldir = + p "htmldir" + (fun () -> s_ "HTML documentation") + (lazy ("$docdir")) + + let dvidir = + p "dvidir" + (fun () -> s_ "DVI documentation") + (lazy ("$docdir")) + + let pdfdir = + p "pdfdir" + (fun () -> s_ "PDF documentation") + (lazy ("$docdir")) + + let psdir = + p "psdir" + (fun () -> s_ "PS documentation") + (lazy ("$docdir")) + + let destdir = + p "destdir" + (fun () -> s_ "Prepend a path when installing package") + (lazy + (raise + (PropList.Not_set + ("destdir", + Some (s_ "undefined by construct"))))) + + let findlib_version = + var_define + "findlib_version" + (lazy + (BaseCheck.package_version "findlib")) + + let is_native = + var_define + "is_native" + (lazy + (try + let _s : string = + ocamlopt () + in + "true" + with PropList.Not_set _ -> + let _s : string = + ocamlc () + in + "false")) + + let ext_program = + var_define + "suffix_program" + (lazy + (match os_type () with + | "Win32" -> ".exe" + | _ -> "" + )) + + let rm = + var_define + ~short_desc:(fun () -> s_ "Remove a file.") + "rm" + (lazy + (match os_type () with + | "Win32" -> "del" + | _ -> "rm -f")) + + let rmdir = + var_define + ~short_desc:(fun () -> s_ "Remove a directory.") + "rmdir" + (lazy + (match os_type () with + | "Win32" -> "rd" + | _ -> "rm -rf")) + + let debug = + var_define + ~short_desc:(fun () -> s_ "Compile with ocaml debug flag on.") + "debug" + (lazy "true") + + let profile = + var_define + ~short_desc:(fun () -> s_ "Compile with ocaml profile flag on.") + "profile" + (lazy "false") + + let init pkg = + rpkg := Some pkg + +end + +module BaseFileAB = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseFileAB.ml" + + open BaseEnv + open OASISGettext + open BaseMessage + + let to_filename fn = + let fn = + BaseFilePath.of_unix fn + in + if not (Filename.check_suffix fn ".ab") then + warning + (f_ "File '%s' doesn't have '.ab' extension") + fn; + Filename.chop_extension fn + + let replace fn_lst = + let buff = + Buffer.create 13 + in + List.iter + (fun fn -> + let fn = + BaseFilePath.of_unix fn + in + let chn_in = + open_in fn + in + let chn_out = + open_out (to_filename fn) + in + ( + try + while true do + Buffer.add_string buff (var_expand (input_line chn_in)); + Buffer.add_char buff '\n' + done + with End_of_file -> + () + ); + Buffer.output_buffer chn_out buff; + Buffer.clear buff; + close_in chn_in; + close_out chn_out) + fn_lst +end + +module BaseLog = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseLog.ml" + + open OASISUtils + + let default_filename = + Filename.concat + (Filename.dirname BaseEnv.default_filename) + "setup.log" + + module SetTupleString = + Set.Make + (struct + type t = string * string + let compare (s11, s12) (s21, s22) = + match String.compare s11 s21 with + | 0 -> String.compare s12 s22 + | n -> n + end) + + let load () = + if Sys.file_exists default_filename then + begin + let chn = + open_in default_filename + in + let scbuf = + Scanf.Scanning.from_file default_filename + in + let rec read_aux (st, lst) = + if not (Scanf.Scanning.end_of_input scbuf) then + begin + let acc = + try + Scanf.bscanf scbuf "%S %S@\n" + (fun e d -> + let t = + e, d + in + if SetTupleString.mem t st then + st, lst + else + SetTupleString.add t st, + t :: lst) + with Scanf.Scan_failure _ -> + failwith + (Scanf.bscanf scbuf + "%l" + (fun line -> + Printf.sprintf + "Malformed log file '%s' at line %d" + default_filename + line)) + in + read_aux acc + end + else + begin + close_in chn; + List.rev lst + end + in + read_aux (SetTupleString.empty, []) + end + else + begin + [] + end + + let register event data = + let chn_out = + open_out_gen [Open_append; Open_creat; Open_text] 0o644 default_filename + in + Printf.fprintf chn_out "%S %S\n" event data; + close_out chn_out + + let unregister event data = + if Sys.file_exists default_filename then + begin + let lst = + load () + in + let chn_out = + open_out default_filename + in + let write_something = + ref false + in + List.iter + (fun (e, d) -> + if e <> event || d <> data then + begin + write_something := true; + Printf.fprintf chn_out "%S %S\n" e d + end) + lst; + close_out chn_out; + if not !write_something then + Sys.remove default_filename + end + + let filter events = + let st_events = + List.fold_left + (fun st e -> + SetString.add e st) + SetString.empty + events + in + List.filter + (fun (e, _) -> SetString.mem e st_events) + (load ()) + + let exists event data = + List.exists + (fun v -> (event, data) = v) + (load ()) +end + +module BaseBuilt = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseBuilt.ml" + + open OASISTypes + open OASISGettext + open BaseStandardVar + open BaseMessage + + type t = + | BExec (* Executable *) + | BExecLib (* Library coming with executable *) + | BLib (* Library *) + | BDoc (* Document *) + + let to_log_event_file t nm = + "built_"^ + (match t with + | BExec -> "exec" + | BExecLib -> "exec_lib" + | BLib -> "lib" + | BDoc -> "doc")^ + "_"^nm + + let to_log_event_done t nm = + "is_"^(to_log_event_file t nm) + + let register t nm lst = + BaseLog.register + (to_log_event_done t nm) + "true"; + List.iter + (fun alt -> + let registered = + List.fold_left + (fun registered fn -> + if Sys.file_exists fn then + begin + BaseLog.register + (to_log_event_file t nm) + (if Filename.is_relative fn then + Filename.concat (Sys.getcwd ()) fn + else + fn); + true + end + else + registered) + false + alt + in + if not registered then + warning + (f_ "Cannot find an existing alternative files among: %s") + (String.concat (s_ ", ") alt)) + lst + + let unregister t nm = + List.iter + (fun (e, d) -> + BaseLog.unregister e d) + (BaseLog.filter + [to_log_event_file t nm; + to_log_event_done t nm]) + + let fold t nm f acc = + List.fold_left + (fun acc (_, fn) -> + if Sys.file_exists fn then + begin + f acc fn + end + else + begin + warning + (f_ "File '%s' has been marked as built \ + for %s but doesn't exist") + fn + (Printf.sprintf + (match t with + | BExec | BExecLib -> + (f_ "executable %s") + | BLib -> + (f_ "library %s") + | BDoc -> + (f_ "documentation %s")) + nm); + acc + end) + acc + (BaseLog.filter + [to_log_event_file t nm]) + + let is_built t nm = + List.fold_left + (fun is_built (_, d) -> + (try + bool_of_string d + with _ -> + false)) + false + (BaseLog.filter + [to_log_event_done t nm]) + + let of_executable ffn (cs, bs, exec) = + let unix_exec_is, unix_dll_opt = + OASISExecutable.unix_exec_is + (cs, bs, exec) + (fun () -> + bool_of_string + (is_native ())) + ext_dll + ext_program + in + let evs = + (BExec, cs.cs_name, [[ffn unix_exec_is]]) + :: + (match unix_dll_opt with + | Some fn -> + [BExecLib, cs.cs_name, [[ffn fn]]] + | None -> + []) + in + evs, + unix_exec_is, + unix_dll_opt + + let of_library ffn (cs, bs, lib) = + let unix_lst = + OASISLibrary.generated_unix_files + ~ctxt:!BaseContext.default + (cs, bs, lib) + (fun fn -> + Sys.file_exists (BaseFilePath.of_unix fn)) + (fun () -> + bool_of_string (is_native ())) + ext_lib + ext_dll + in + let evs = + [BLib, + cs.cs_name, + List.map (List.map ffn) unix_lst] + in + evs, unix_lst + +end + +module BaseCustom = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseCustom.ml" + + open BaseEnv + open BaseMessage + open OASISTypes + open OASISGettext + + let run cmd args extra_args = + BaseExec.run + (var_expand cmd) + (List.map + var_expand + (args @ (Array.to_list extra_args))) + + let hook ?(failsafe=false) cstm f e = + let optional_command lst = + let printer = + function + | Some (cmd, args) -> String.concat " " (cmd :: args) + | None -> s_ "No command" + in + match + var_choose + ~name:(s_ "Pre/Post Command") + ~printer + lst with + | Some (cmd, args) -> + begin + try + run cmd args [||] + with e when failsafe -> + warning + (f_ "Command '%s' fail with error: %s") + (String.concat " " (cmd :: args)) + (match e with + | Failure msg -> msg + | e -> Printexc.to_string e) + end + | None -> + () + in + let res = + optional_command cstm.pre_command; + f e + in + optional_command cstm.post_command; + res +end + +module BaseDynVar = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseDynVar.ml" + + + open OASISTypes + open OASISGettext + open BaseEnv + open BaseBuilt + + let init pkg = + List.iter + (function + | Executable (cs, bs, exec) -> + 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) + cs.cs_name + (lazy + (let fn_opt = + fold + BExec cs.cs_name + (fun _ fn -> Some fn) + None + in + match fn_opt with + | Some fn -> fn + | None -> + raise + (PropList.Not_set + (cs.cs_name, + Some (Printf.sprintf + (f_ "Executable '%s' not yet built.") + cs.cs_name)))))) + + | Library _ | Flag _ | Test _ | SrcRepo _ | Doc _ -> + ()) + pkg.sections +end + +module BaseTest = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseTest.ml" + + open BaseEnv + open BaseMessage + open OASISTypes + open OASISExpr + open OASISGettext + + let test lst pkg extra_args = + + let one_test (failure, n) (test_plugin, cs, test) = + if var_choose + ~name:(Printf.sprintf + (f_ "test %s run") + cs.cs_name) + ~printer:string_of_bool + test.test_run then + begin + let () = + info (f_ "Running test '%s'") cs.cs_name + in + let back_cwd = + match test.test_working_directory with + | Some dir -> + let cwd = + Sys.getcwd () + in + let chdir d = + info (f_ "Changing directory to '%s'") d; + Sys.chdir d + in + chdir dir; + fun () -> chdir cwd + + | None -> + fun () -> () + in + try + let failure_percent = + BaseCustom.hook + test.test_custom + (test_plugin pkg (cs, test)) + extra_args + in + back_cwd (); + (failure_percent +. failure, n + 1) + with e -> + begin + back_cwd (); + raise e + end + end + else + begin + info (f_ "Skipping test '%s'") cs.cs_name; + (failure, n) + end + in + let (failed, n) = + List.fold_left + one_test + (0.0, 0) + lst + in + let failure_percent = + if n = 0 then + 0.0 + else + failed /. (float_of_int n) + in + let msg = + Printf.sprintf + (f_ "Tests had a %.2f%% failure rate") + (100. *. failure_percent) + in + if failure_percent > 0.0 then + failwith msg + else + info "%s" msg +end + +module BaseDoc = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseDoc.ml" + + open BaseEnv + open BaseMessage + open OASISTypes + open OASISGettext + + let doc lst pkg extra_args = + + let one_doc (doc_plugin, cs, doc) = + if var_choose + ~name:(Printf.sprintf + (f_ "documentation %s build") + cs.cs_name) + ~printer:string_of_bool + doc.doc_build then + begin + info (f_ "Building documentation '%s'") cs.cs_name; + BaseCustom.hook + doc.doc_custom + (doc_plugin pkg (cs, doc)) + extra_args + end + in + List.iter + one_doc + lst +end + +module BaseSetup = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseSetup.ml" + + open BaseEnv + open BaseMessage + open OASISTypes + open OASISSection + open OASISGettext + open OASISUtils + + type std_args_fun = + package -> string array -> unit + + type ('a, 'b) section_args_fun = + name * (package -> (common_section * 'a) -> string array -> 'b) + + type t = + { + configure: std_args_fun; + build: std_args_fun; + doc: ((doc, unit) section_args_fun) list; + test: ((test, float) section_args_fun) list; + install: std_args_fun; + uninstall: std_args_fun; + clean: std_args_fun list; + clean_doc: (doc, unit) section_args_fun list; + clean_test: (test, unit) section_args_fun list; + distclean: std_args_fun list; + distclean_doc: (doc, unit) section_args_fun list; + distclean_test: (test, unit) section_args_fun list; + package: package; + version: string; + } + + (* Associate a plugin function with data from package *) + let join_plugin_sections filter_map lst = + List.rev + (List.fold_left + (fun acc sct -> + match filter_map sct with + | Some e -> + e :: acc + | None -> + acc) + [] + lst) + + (* Search for plugin data associated with a section name *) + let lookup_plugin_section plugin action nm lst = + try + List.assoc nm lst + with Not_found -> + failwithf3 + (f_ "Cannot find plugin %s matching section %s for %s action") + plugin + nm + action + + let configure t args = + (* Run configure *) + BaseCustom.hook + t.package.conf_custom + (t.configure t.package) + args; + + (* Reload environment *) + unload (); + load (); + + (* Replace data in file *) + BaseFileAB.replace t.package.files_ab + + let build t args = + BaseCustom.hook + t.package.build_custom + (t.build t.package) + args + + let doc t args = + BaseDoc.doc + (join_plugin_sections + (function + | Doc (cs, e) -> + Some + (lookup_plugin_section + "documentation" + (s_ "build") + cs.cs_name + t.doc, + cs, + e) + | _ -> + None) + t.package.sections) + t.package + args + + let test t args = + BaseTest.test + (join_plugin_sections + (function + | Test (cs, e) -> + Some + (lookup_plugin_section + "test" + (s_ "run") + cs.cs_name + t.test, + cs, + e) + | _ -> + None) + t.package.sections) + t.package + args + + let all t args = + let rno_doc = + ref false + in + let rno_test = + ref false + in + Arg.parse_argv + ~current:(ref 0) + (Array.of_list + ((Sys.executable_name^" all") :: + (Array.to_list args))) + [ + "-no-doc", + Arg.Set rno_doc, + s_ "Don't run doc target"; + + "-no-test", + Arg.Set rno_test, + s_ "Don't run test target"; + ] + (failwithf1 (f_ "Don't know what to do with '%s'")) + ""; + + info "Running configure step"; + configure t [||]; + + info "Running build step"; + build t [||]; + + (* Load setup.log dynamic variables *) + BaseDynVar.init t.package; + + if not !rno_doc then + begin + info "Running doc step"; + doc t [||]; + end + else + begin + info "Skipping doc step" + end; + + if not !rno_test then + begin + info "Running test step"; + test t [||] + end + else + begin + info "Skipping test step" + end + + let install t args = + BaseCustom.hook + t.package.install_custom + (t.install t.package) + args + + let uninstall t args = + BaseCustom.hook + t.package.uninstall_custom + (t.uninstall t.package) + args + + let reinstall t args = + uninstall t args; + install t args + + let clean, distclean = + let failsafe f a = + try + f a + with e -> + warning + (f_ "Action fail with error: %s") + (match e with + | Failure msg -> msg + | e -> Printexc.to_string e) + in + + let generic_clean t cstm mains docs tests args = + BaseCustom.hook + ~failsafe:true + cstm + (fun () -> + (* Clean section *) + List.iter + (function + | Test (cs, test) -> + let f = + try + List.assoc cs.cs_name tests + with Not_found -> + fun _ _ _ -> () + in + failsafe + (f t.package (cs, test)) + args + | Doc (cs, doc) -> + let f = + try + List.assoc cs.cs_name docs + with Not_found -> + fun _ _ _ -> () + in + failsafe + (f t.package (cs, doc)) + args + | Library _ + | Executable _ + | Flag _ + | SrcRepo _ -> + ()) + t.package.sections; + (* Clean whole package *) + List.iter + (fun f -> + failsafe + (f t.package) + args) + mains) + () + in + + let clean t args = + generic_clean + t + t.package.clean_custom + t.clean + t.clean_doc + t.clean_test + args + in + + let distclean t args = + (* Call clean *) + clean t args; + + (* Remove generated file *) + List.iter + (fun fn -> + if Sys.file_exists fn then + begin + info (f_ "Remove '%s'") fn; + Sys.remove fn + end) + (BaseEnv.default_filename + :: + BaseLog.default_filename + :: + (List.rev_map BaseFileAB.to_filename t.package.files_ab)); + + (* Call distclean code *) + generic_clean + t + t.package.distclean_custom + t.distclean + t.distclean_doc + t.distclean_test + args + in + + clean, distclean + + let version t _ = + print_endline t.version + + let setup t = + let catch_exn = + ref true + in + try + let act_ref = + ref (fun _ -> + failwithf2 + (f_ "No action defined, run '%s %s -help'") + Sys.executable_name + Sys.argv.(0)) + + in + let extra_args_ref = + ref [] + in + let allow_empty_env_ref = + ref false + in + let arg_handle ?(allow_empty_env=false) act = + Arg.Tuple + [ + Arg.Rest (fun str -> extra_args_ref := str :: !extra_args_ref); + + Arg.Unit + (fun () -> + allow_empty_env_ref := allow_empty_env; + act_ref := act); + ] + in + + Arg.parse + (Arg.align + [ + "-configure", + arg_handle ~allow_empty_env:true configure, + s_ "[options*] Configure the whole build process."; + + "-build", + arg_handle build, + s_ "[options*] Build executables and libraries."; + + "-doc", + arg_handle doc, + s_ "[options*] Build documents."; + + "-test", + arg_handle test, + s_ "[options*] Run tests."; + + "-all", + arg_handle ~allow_empty_env:true all, + s_ "[options*] Run configure, build, doc and test targets."; + + "-install", + arg_handle install, + s_ "[options*] Install libraries, data, executables \ + and documents."; + + "-uninstall", + arg_handle uninstall, + s_ "[options*] Uninstall libraries, data, executables \ + and documents."; + + "-reinstall", + arg_handle reinstall, + s_ "[options*] Uninstall and install libraries, data, \ + executables and documents."; + + "-clean", + arg_handle ~allow_empty_env:true clean, + s_ "[options*] Clean files generated by a build."; + + "-distclean", + arg_handle ~allow_empty_env:true distclean, + s_ "[options*] Clean files generated by a build and configure."; + + "-version", + arg_handle ~allow_empty_env:true version, + s_ " Display version of OASIS used to generate this setup.ml."; + + "-no-catch-exn", + Arg.Clear catch_exn, + s_ " Don't catch exception, useful for debugging."; + ] + @ (BaseContext.args ())) + (failwithf1 (f_ "Don't know what to do with '%s'")) + (s_ "Setup and run build process current package\n"); + + (* Build initial environment *) + load ~allow_empty:!allow_empty_env_ref (); + + (** Initialize flags *) + List.iter + (function + | Flag (cs, {flag_description = hlp; + flag_default = choices}) -> + begin + let apply ?short_desc () = + var_ignore + (var_define + ~cli:CLIEnable + ?short_desc + (OASISUtils.varname_of_string cs.cs_name) + (lazy (string_of_bool + (var_choose + ~name:(Printf.sprintf + (f_ "default value of flag %s") + cs.cs_name) + ~printer:string_of_bool + choices)))) + in + match hlp with + | Some hlp -> + apply ~short_desc:(fun () -> hlp) () + | None -> + apply () + end + | _ -> + ()) + t.package.sections; + + BaseStandardVar.init t.package; + + BaseDynVar.init t.package; + + !act_ref t (Array.of_list (List.rev !extra_args_ref)) + + with e when !catch_exn -> + error "%s" (string_of_exception e); + exit 1 + +end + +module BaseDev = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/base/BaseDev.ml" + + + + open OASISGettext + open BaseMessage + + type t = + { + oasis_cmd: string; + } + + let update_and_run t = + (* Command line to run setup-dev *) + let oasis_args = + "setup-dev" :: "-run" :: + Sys.executable_name :: + (Array.to_list Sys.argv) + in + + let exit_on_child_error = + function + | 0 -> () + | 2 -> + (* Bad CLI arguments *) + error + (f_ "The command '%s %s' exit with code 2. It often means that we \ + don't use the right command-line arguments, rerun \ + 'oasis setup-dev'.") + t.oasis_cmd + (String.concat " " oasis_args) + + | 127 -> + (* Cannot find OASIS *) + error + (f_ "Cannot find executable '%s', check where 'oasis' is located \ + and rerun 'oasis setup-dev'") + t.oasis_cmd + + | i -> + exit i + in + + let () = + (* Run OASIS to generate a temporary setup.ml + *) + BaseExec.run + ~f_exit_code:exit_on_child_error + t.oasis_cmd + oasis_args + in + + () + +end + + +module InternalConfigurePlugin = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/plugins/internal/InternalConfigurePlugin.ml" + + (** Configure using internal scheme + @author Sylvain Le Gall + *) + + open BaseEnv + open OASISTypes + open OASISUtils + open OASISGettext + open BaseMessage + + (** Configure build using provided series of check to be done + * and then output corresponding file. + *) + let configure pkg argv = + let var_ignore_eval var = + let _s : string = + var () + in + () + in + + let errors = + ref SetString.empty + in + + let buff = + Buffer.create 13 + in + + let add_errors fmt = + Printf.kbprintf + (fun b -> + errors := SetString.add (Buffer.contents b) !errors; + Buffer.clear b) + buff + fmt + in + + let warn_exception e = + warning "%s" (string_of_exception e) + in + + (* Check tools *) + let check_tools lst = + List.iter + (function + | ExternalTool tool -> + begin + try + var_ignore_eval (BaseCheck.prog tool) + with e -> + warn_exception e; + add_errors (f_ "Cannot find external tool '%s'") tool + end + | InternalExecutable nm1 -> + (* Check that matching tool is built *) + List.iter + (function + | Executable ({cs_name = nm2}, + {bs_build = build}, + _) when nm1 = nm2 -> + if not (var_choose build) then + add_errors + (f_ "Cannot find buildable internal executable \ + '%s' when checking build depends") + nm1 + | _ -> + ()) + pkg.sections) + lst + in + + let build_checks sct bs = + if var_choose bs.bs_build then + begin + if bs.bs_compiled_object = Native then + begin + try + var_ignore_eval BaseStandardVar.ocamlopt + with e -> + warn_exception e; + add_errors + (f_ "Section %s requires native compilation") + (OASISSection.string_of_section sct) + end; + + (* Check tools *) + check_tools bs.bs_build_tools; + + (* Check depends *) + List.iter + (function + | FindlibPackage (findlib_pkg, version_comparator) -> + begin + try + var_ignore_eval + (BaseCheck.package ?version_comparator findlib_pkg) + with e -> + warn_exception e; + match version_comparator with + | None -> + add_errors + (f_ "Cannot find findlib package %s") + findlib_pkg + | Some ver_cmp -> + add_errors + (f_ "Cannot find findlib package %s (%s)") + findlib_pkg + (OASISVersion.string_of_comparator ver_cmp) + end + | InternalLibrary nm1 -> + (* Check that matching library is built *) + List.iter + (function + | Library ({cs_name = nm2}, + {bs_build = build}, + _) when nm1 = nm2 -> + if not (var_choose build) then + add_errors + (f_ "Cannot find buildable internal library \ + '%s' when checking build depends") + nm1 + | _ -> + ()) + pkg.sections) + bs.bs_build_depends + end + in + + (* Parse command line *) + BaseArgExt.parse argv (BaseEnv.args ()); + + (* OCaml version *) + begin + match pkg.ocaml_version with + | Some ver_cmp -> + begin + try + var_ignore_eval + (BaseCheck.version + "ocaml" + ver_cmp + BaseStandardVar.ocaml_version) + with e -> + warn_exception e; + add_errors + (f_ "OCaml version %s doesn't match version constraint %s") + (BaseStandardVar.ocaml_version ()) + (OASISVersion.string_of_comparator ver_cmp) + end + | None -> + () + end; + + (* Findlib version *) + begin + match pkg.findlib_version with + | Some ver_cmp -> + begin + try + var_ignore_eval + (BaseCheck.version + "findlib" + ver_cmp + BaseStandardVar.findlib_version) + with e -> + warn_exception e; + add_errors + (f_ "Findlib version %s doesn't match version constraint %s") + (BaseStandardVar.findlib_version ()) + (OASISVersion.string_of_comparator ver_cmp) + end + | None -> + () + end; + + (* 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 + | _ -> + ()) + pkg.sections; + + (* Save and print environment *) + if SetString.empty = !errors then + begin + dump (); + print () + end + else + begin + List.iter + (fun e -> error "%s" e) + (SetString.elements !errors); + failwithf1 + (fn_ + "%d configuration error" + "%d configuration errors" + (SetString.cardinal !errors)) + (SetString.cardinal !errors) + end + +end + +module InternalInstallPlugin = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/plugins/internal/InternalInstallPlugin.ml" + + (** Install using internal scheme + @author Sylvain Le Gall + *) + + open BaseEnv + open BaseStandardVar + open BaseMessage + open OASISTypes + open OASISLibrary + open OASISGettext + open OASISUtils + + let exec_hook = + ref (fun (cs, bs, exec) -> cs, bs, exec) + + let lib_hook = + ref (fun (cs, bs, lib) -> cs, bs, lib, []) + + let doc_hook = + ref (fun (cs, doc) -> cs, doc) + + let install_file_ev = + "install-file" + + let install_dir_ev = + "install-dir" + + let install_findlib_ev = + "install-findlib" + + let install pkg argv = + + let in_destdir = + try + let destdir = + destdir () + in + (* Practically speaking destdir is prepended + * at the beginning of the target filename + *) + fun fn -> destdir^fn + with PropList.Not_set _ -> + fun fn -> fn + in + + let install_file src_file envdir = + let tgt_dir = + in_destdir (envdir ()) + in + let tgt_file = + Filename.concat + tgt_dir + (Filename.basename src_file) + in + (* Create target directory if needed *) + BaseFileUtil.mkdir_parent + (fun dn -> + info (f_ "Creating directory '%s'") dn; + BaseLog.register install_dir_ev dn) + tgt_dir; + + (* Really install files *) + info (f_ "Copying file '%s' to '%s'") src_file tgt_file; + BaseFileUtil.cp src_file tgt_file; + BaseLog.register install_file_ev tgt_file + in + + (* Install data into defined directory *) + let install_data srcdir lst tgtdir = + let tgtdir = + BaseFilePath.of_unix (var_expand tgtdir) + in + List.iter + (fun (src, tgt_opt) -> + let real_srcs = + BaseFileUtil.glob + (Filename.concat srcdir src) + in + if real_srcs = [] then + failwithf1 + (f_ "Wildcard '%s' doesn't match any files") + src; + List.iter + (fun fn -> + install_file + fn + (fun () -> + match tgt_opt with + | Some s -> + BaseFilePath.of_unix (var_expand s) + | None -> + tgtdir)) + real_srcs) + lst + 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 = + BaseFilePath.of_unix bs.bs_path + in + List.fold_left + (fun acc modul -> + try + List.find + Sys.file_exists + (List.map + (Filename.concat path) + [modul^".mli"; + modul^".ml"; + String.uncapitalize modul^".mli"; + String.capitalize modul^".mli"; + String.uncapitalize modul^".ml"; + String.capitalize modul^".ml"]) + :: acc + with Not_found -> + begin + warning + (f_ "Cannot find source header for module %s \ + in library %s") + modul cs.cs_name; + acc + end) + acc + lib.lib_modules + in + + let acc = + (* Get generated files *) + BaseBuilt.fold + BaseBuilt.BLib + cs.cs_name + (fun acc fn -> fn :: acc) + acc + 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 + + (f_data, acc) + end + else + begin + (f_data, acc) + end + in + + (* Install one group of library *) + let install_group_lib grp = + (* Iterate through all group nodes *) + let rec install_group_lib_aux data_and_files grp = + let data_and_files, children = + match grp with + | Container (_, children) -> + data_and_files, children + | Package (_, cs, bs, lib, children) -> + files_of_library data_and_files (cs, bs, lib), children + in + List.fold_left + install_group_lib_aux + data_and_files + children + in + + (* Findlib name of the root library *) + let findlib_name = + findlib_of_group grp + in + + (* Determine root library *) + 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 + + (* 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 (Sys.file_exists res) then + failwithf2 + (f_ "Cannot find file '%s' for findlib library %s") + res + findlib_name; + res + in + info + (f_ "Installing findlib library '%s'") + findlib_name; + BaseExec.run + (ocamlfind ()) + ("install" :: findlib_name :: meta :: files); + BaseLog.register install_findlib_ev findlib_name + end; + + (* Install data files *) + f_data (); + + in + + (* We install libraries in groups *) + List.iter + install_group_lib + (group_libs pkg) + in + + let install_execs 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 + 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 + in + List.iter + (function + | Executable (cs, bs, exec)-> + install_exec (cs, bs, exec) + | _ -> + ()) + pkg.sections + in + + let install_docs 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 = + BaseFilePath.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 + in + List.iter + (function + | Doc (cs, doc) -> + install_doc (cs, doc) + | _ -> + ()) + pkg.sections + in + + install_libs pkg; + install_execs pkg; + install_docs pkg + + (* Uninstall already installed data *) + let uninstall _ argv = + List.iter + (fun (ev, data) -> + if ev = install_file_ev then + begin + if Sys.file_exists 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; + BaseFileUtil.rmdir 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; + BaseExec.run (ocamlfind ()) ["remove"; data] + end + else + failwithf1 (f_ "Unknown log event '%s'") ev; + BaseLog.unregister ev data) + (* We process event in reverse order *) + (List.rev + (BaseLog.filter + [install_file_ev; + install_dir_ev; + install_findlib_ev;])) + +end + + +module OCamlbuildCommon = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/plugins/ocamlbuild/OCamlbuildCommon.ml" + + (** Functions common to OCamlbuild build and doc plugin + *) + + open OASISGettext + open BaseEnv + open BaseStandardVar + + let ocamlbuild_clean_ev = + "ocamlbuild-clean" + + let ocamlbuildflags = + var_define + ~short_desc:(fun () -> "OCamlbuild additional flags") + "ocamlbuildflags" + (lazy "") + + (** Fix special arguments depending on environment *) + let fix_args args extra_argv = + List.flatten + [ + if (os_type ()) = "Win32" then + [ + "-classic-display"; + "-no-log"; + "-no-links"; + "-install-lib-dir"; + (Filename.concat (standard_library ()) "ocamlbuild") + ] + else + []; + + if not (bool_of_string (is_native ())) || (os_type ()) = "Win32" then + [ + "-byte-plugin" + ] + else + []; + args; + + if bool_of_string (debug ()) then + ["-tag"; "debug"] + else + []; + + if bool_of_string (profile ()) then + ["-tag"; "profile"] + else + []; + + OASISUtils.split ' ' (ocamlbuildflags ()); + + Array.to_list extra_argv; + ] + + (** Run 'ocamlbuild -clean' if not already done *) + let run_clean 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 + BaseExec.run (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 ocamlbuild, unregister all clean events *) + let run_ocamlbuild args extra_argv = + (* TODO: enforce that target in args must be UNIX encoded i.e. toto/index.html + *) + BaseExec.run (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]) + + (** Determine real build directory *) + let build_dir extra_argv = + let rec search_args dir = + function + | "-build-dir" :: dir :: tl -> + search_args dir tl + | _ :: tl -> + search_args dir tl + | [] -> + dir + in + search_args "_build" (fix_args [] extra_argv) + +end + +module OCamlbuildPlugin = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/plugins/ocamlbuild/OCamlbuildPlugin.ml" + + (** Build using ocamlbuild + @author Sylvain Le Gall + *) + + open OASISTypes + open OASISGettext + open OASISUtils + open BaseEnv + open OCamlbuildCommon + open BaseStandardVar + open BaseMessage + + type target = + | Std of string list + | StdRename of string * string + + let cond_targets_hook = + ref (fun lst -> lst) + + let build pkg argv = + + (* Return the filename in build directory *) + let in_build_dir fn = + Filename.concat + (build_dir argv) + fn + in + + (* Return the unix filename in host build directory *) + let in_build_dir_of_unix fn = + in_build_dir (BaseFilePath.of_unix fn) + in + + let cond_targets = + List.fold_left + (fun acc -> + function + | Library (cs, bs, lib) when var_choose bs.bs_build -> + begin + let evs, unix_files = + BaseBuilt.of_library + in_build_dir_of_unix + (cs, bs, lib) + in + + let ends_with nd fn = + let nd_len = + String.length nd + in + (String.length fn >= nd_len) + && + (String.sub + fn + (String.length fn - nd_len) + nd_len) = nd + in + + let tgts = + List.filter + (fun l -> l <> []) + (List.map + (List.filter + (fun fn -> + ends_with ".cma" fn || + ends_with ".cmxa" fn || + ends_with (ext_lib ()) fn || + ends_with (ext_dll ()) fn)) + unix_files) + in + + match tgts with + | hd :: tl -> + (evs, Std hd) + :: + (List.map (fun tgts -> [], Std tgts) tl) + @ + acc + | [] -> + failwithf2 + (f_ "No possible ocamlbuild targets \ + in generated files %s for library %s") + (String.concat (s_ ", " ) (List.map (String.concat (s_ ", ")) tgts)) + cs.cs_name + end + + | 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) + in + + let host_exec_is = + in_build_dir_of_unix unix_exec_is + in + + let target ext = + let unix_tgt = + (BaseFilePath.Unix.concat + bs.bs_path + (BaseFilePath.Unix.chop_extension + exec.exec_main_is))^ext + in + + evs, + (if unix_tgt = unix_exec_is then + Std [unix_tgt] + else + StdRename (unix_tgt, host_exec_is)) + in + + (* Add executable *) + let acc = + match bs.bs_compiled_object with + | Native -> + (target ".native") :: acc + | Best when bool_of_string (is_native ()) -> + (target ".native") :: acc + | Byte + | Best -> + (target ".byte") :: acc + in + acc + end + + | Library _ | Executable _ | Test _ + | SrcRepo _ | Flag _ | Doc _ -> + acc) + [] + (* Keep the pkg.sections ordered *) + (List.rev pkg.sections); + in + + (* Check and register built files *) + let check_and_register (bt, bnm, lst) = + List.iter + (fun fns -> + if not (List.exists Sys.file_exists fns) then + failwithf1 + (f_ "No one of expected built files %s exists") + (String.concat (s_ ", ") (List.map (Printf.sprintf "'%s'") fns))) + lst; + (BaseBuilt.register bt bnm lst) + in + + (* Run a list of target + post process *) + let run_ocamlbuild rtargets = + run_ocamlbuild + (List.rev_map snd rtargets) + argv; + List.iter + check_and_register + (List.flatten (List.rev_map fst rtargets)) + in + + (* Compare two files, return true if they differ *) + let diff fn1 fn2 = + if Sys.file_exists fn1 && Sys.file_exists fn2 then + begin + let chn1 = open_in fn1 in + let chn2 = open_in fn2 in + let res = + if in_channel_length chn1 = in_channel_length chn2 then + begin + let len = + 4096 + in + let str1 = + String.make len '\000' + in + let str2 = + String.copy str1 + in + try + while (String.compare str1 str2) = 0 do + really_input chn1 str1 0 len; + really_input chn2 str2 0 len + done; + true + with End_of_file -> + false + end + else + true + in + close_in chn1; close_in chn2; + res + end + else + true + in + + let last_rtargets = + List.fold_left + (fun acc (built, tgt) -> + match tgt with + | Std nms -> + (built, List.hd nms) :: acc + | StdRename (src, tgt) -> + begin + (* We run with a fake list for event registering *) + run_ocamlbuild (([], src) :: acc); + + (* And then copy and register *) + begin + let src_fn = + in_build_dir_of_unix src + in + if diff src_fn tgt then + BaseFileUtil.cp src_fn tgt + else + info + (f_ "No need to copy file '%s' to '%s', same content") + src_fn tgt + end; + List.iter check_and_register built; + [] + end) + [] + (!cond_targets_hook cond_targets) + in + if last_rtargets <> [] then + run_ocamlbuild last_rtargets + + let clean pkg extra_args = + run_clean extra_args; + 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 + | _ -> + ()) + pkg.sections + +end + +module OCamlbuildDocPlugin = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml" + + (* Create documentation using ocamlbuild .odocl files + @author Sylvain Le Gall + *) + + open OASISTypes + open OASISGettext + open OASISMessage + open OCamlbuildCommon + open BaseStandardVar + + + + let doc_build path pkg (cs, doc) argv = + let index_html = + BaseFilePath.Unix.make + [ + path; + cs.cs_name^".docdir"; + "index.html"; + ] + in + let tgt_dir = + BaseFilePath.make + [ + build_dir argv; + BaseFilePath.of_unix path; + cs.cs_name^".docdir"; + ] + in + run_ocamlbuild [index_html] argv; + List.iter + (fun glb -> + BaseBuilt.register + BaseBuilt.BDoc + cs.cs_name + [BaseFileUtil.glob + (Filename.concat tgt_dir glb)]) + ["*.html"; "*.css"] + + let doc_clean t pkg (cs, doc) argv = + run_clean argv; + BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name + +end + + +module CustomPlugin = struct +# 21 "/Users/joelr/work/ocaml/oasis-0.2.0/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; + } + + 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 clean t pkg extra_args = + match var_choose t.cmd_clean with + | Some (cmd, args) -> + run cmd args extra_args + | _ -> + () + + let distclean t pkg extra_args = + match var_choose t.cmd_distclean with + | Some (cmd, args) -> + run cmd args extra_args + | _ -> + () + + module Build = + struct + let main t pkg extra_args = + main 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 + BaseFilePath.of_unix + (cs, bs, lib) + in + evs + end + | Executable (cs, bs, exec) when var_choose bs.bs_build -> + begin + let evs, _, _ = + BaseBuilt.of_executable + BaseFilePath.of_unix + (cs, bs, exec) + in + evs + end + | _ -> + [] + in + List.iter + (fun (bt, bnm, lst) -> BaseBuilt.register bt bnm lst) + evs) + pkg.sections + + let clean t pkg extra_args = + clean 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 + | _ -> + ()) + pkg.sections + + let distclean t pkg extra_args = + distclean t pkg extra_args + end + + module Test = + struct + let main t pkg (cs, test) extra_args = + try + main t pkg extra_args; + 0.0 + with Failure s -> + BaseMessage.warning + (f_ "Test '%s' fails: %s") + cs.cs_name + s; + 1.0 + + let clean t pkg (cs, test) extra_args = + clean t pkg extra_args + + let distclean t pkg (cs, test) extra_args = + distclean 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 clean t pkg (cs, _) extra_args = + clean t pkg extra_args; + BaseBuilt.unregister BaseBuilt.BDoc cs.cs_name + + let distclean t pkg (cs, _) extra_args = + distclean t pkg extra_args + end + +end + + +open OASISTypes;; + +let setup_t = + { + BaseSetup.configure = InternalConfigurePlugin.configure; + build = OCamlbuildPlugin.build; + test = + [ + ("main", + CustomPlugin.Test.main + { + CustomPlugin.cmd_main = + [(OASISExpr.EBool true, ("$test", []))]; + cmd_clean = [(OASISExpr.EBool true, None)]; + cmd_distclean = [(OASISExpr.EBool true, None)]; + }) + ]; + doc = []; + install = InternalInstallPlugin.install; + uninstall = InternalInstallPlugin.uninstall; + clean = [OCamlbuildPlugin.clean]; + clean_test = + [ + ("main", + CustomPlugin.Test.clean + { + CustomPlugin.cmd_main = + [(OASISExpr.EBool true, ("$test", []))]; + cmd_clean = [(OASISExpr.EBool true, None)]; + cmd_distclean = [(OASISExpr.EBool true, None)]; + }) + ]; + clean_doc = []; + distclean = []; + distclean_test = + [ + ("main", + CustomPlugin.Test.distclean + { + CustomPlugin.cmd_main = + [(OASISExpr.EBool true, ("$test", []))]; + cmd_clean = [(OASISExpr.EBool true, None)]; + cmd_distclean = [(OASISExpr.EBool true, None)]; + }) + ]; + distclean_doc = []; + package = + { + oasis_version = "0.2"; + ocaml_version = None; + findlib_version = None; + name = "ZMQ"; + version = "0.0.3"; + license = + OASISLicense.DEP5License + { + OASISLicense.license = "MIT"; + exceptions = []; + version = OASISLicense.NoVersion; + }; + license_file = None; + copyrights = []; + maintainers = []; + authors = ["Pedro Borges"]; + homepage = None; + synopsis = "Bindings for the ZMQ library"; + description = None; + categories = []; + conf_type = (`Configure, "internal", Some "0.2"); + conf_custom = + { + pre_command = [(OASISExpr.EBool true, None)]; + post_command = [(OASISExpr.EBool true, None)]; + }; + build_type = (`Build, "ocamlbuild", Some "0.2"); + build_custom = + { + pre_command = [(OASISExpr.EBool true, None)]; + post_command = [(OASISExpr.EBool true, None)]; + }; + install_type = (`Install, "internal", Some "0.2"); + 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 = + [ + Library + ({ + cs_name = "ZMQB"; + cs_data = PropList.Data.create (); + cs_plugin_data = []; + }, + { + bs_build = [(OASISExpr.EBool true, true)]; + bs_install = [(OASISExpr.EBool true, true)]; + bs_path = "src"; + bs_compiled_object = Best; + bs_build_depends = + [FindlibPackage ("uint.uint64", None)]; + bs_build_tools = [ExternalTool "ocamlbuild"]; + bs_c_sources = + [ + "caml_zmq_stubs.c"; + "socket.h"; + "socket.c"; + "context.h"; + "context.c"; + "fail.h"; + "fail.c"; + "poll.h"; + "poll.c"; + "uint64.h"; + "uint64.c" + ]; + bs_data_files = []; + bs_ccopt = + [ + (OASISExpr.EBool true, + ["-Wall"; "-W"; "-Wextra"; "-O2"]) + ]; + bs_cclib = [(OASISExpr.EBool true, ["-lzmq"])]; + bs_dlllib = [(OASISExpr.EBool true, [])]; + bs_dllpath = [(OASISExpr.EBool true, [])]; + bs_byteopt = [(OASISExpr.EBool true, [])]; + bs_nativeopt = [(OASISExpr.EBool true, [])]; + }, + { + lib_modules = ["ZMQ"]; + lib_internal_modules = []; + lib_findlib_parent = None; + lib_findlib_name = Some "ZMQ"; + lib_findlib_containers = []; + }); + Test + ({ + cs_name = "main"; + cs_data = PropList.Data.create (); + cs_plugin_data = []; + }, + { + test_type = (`Test, "custom", Some "0.2"); + test_command = [(OASISExpr.EBool true, ("$test", []))]; + test_custom = + { + pre_command = [(OASISExpr.EBool true, None)]; + post_command = [(OASISExpr.EBool true, None)]; + }; + test_working_directory = None; + test_run = + [ + (OASISExpr.EBool true, false); + (OASISExpr.EFlag "tests", true) + ]; + test_tools = [ExternalTool "ocamlbuild"]; + }); + Executable + ({ + cs_name = "test"; + cs_data = PropList.Data.create (); + cs_plugin_data = []; + }, + { + bs_build = + [ + (OASISExpr.EBool true, false); + (OASISExpr.EFlag "tests", true) + ]; + bs_install = [(OASISExpr.EBool true, false)]; + bs_path = "test"; + bs_compiled_object = Best; + bs_build_depends = + [ + FindlibPackage + ("oUnit", + Some (OASISVersion.VGreaterEqual "1.1.0")); + InternalLibrary "ZMQB" + ]; + bs_build_tools = [ExternalTool "ocamlbuild"]; + bs_c_sources = []; + bs_data_files = []; + bs_ccopt = [(OASISExpr.EBool true, [])]; + bs_cclib = [(OASISExpr.EBool true, [])]; + bs_dlllib = [(OASISExpr.EBool true, [])]; + bs_dllpath = [(OASISExpr.EBool true, [])]; + bs_byteopt = [(OASISExpr.EBool true, [])]; + bs_nativeopt = [(OASISExpr.EBool true, [])]; + }, + {exec_custom = false; exec_main_is = "test.ml"; }); + Flag + ({ + cs_name = "tests"; + cs_data = PropList.Data.create (); + cs_plugin_data = []; + }, + { + flag_description = Some "Build and run tests"; + flag_default = [(OASISExpr.EBool true, true)]; + }) + ]; + plugins = + [(`Extra, "DevFiles", Some "0.2"); (`Extra, "META", Some "0.2")]; + schema_data = PropList.Data.create (); + plugin_data = []; + }; + version = "0.2.0"; + };; + +let setup () = BaseSetup.setup setup_t;; + +(* OASIS_STOP *) +let () = setup ();; diff --git a/src/META b/src/META index da21b01..b908be6 100644 --- a/src/META +++ b/src/META @@ -1,6 +1,10 @@ -# Specifications for the "ZMQ" library: -requires = "uint.uint64, unix" -description = "ZMQ bindings for ocaml" -version = "alpha 0.0.4" +# OASIS_START +# DO NOT EDIT (digest: 01600ee8b071795506563041f7fcbc09) +version = "0.0.3" +description = "Bindings for the ZMQ library" +requires = "uint.uint64" archive(byte) = "ZMQB.cma" archive(native) = "ZMQB.cmxa" +exists_if = "ZMQB.cma" +# OASIS_STOP + diff --git a/src/Makefile b/src/Makefile index 459eb42..94772ca 100644 --- a/src/Makefile +++ b/src/Makefile @@ -1,6 +1,6 @@ OCAMLFIND= ocamlfind -OCAMLC= ocamlc -OCAMLOPT= ocamlopt +OCAMLC= ocamlc -g -ccopt -g +OCAMLOPT= ocamlopt -g -ccopt -g OCAMLMKLIB= ocamlmklib LIB_NAME= ZMQ @@ -46,4 +46,6 @@ install: all uninstall: $(OCAMLFIND) remove $(LIB_NAME) +reinstall: uninstall install + .PHONY: clean diff --git a/src/ZMQ.ml b/src/ZMQ.ml index ff26cb5..202e5a6 100644 --- a/src/ZMQ.ml +++ b/src/ZMQ.ml @@ -39,24 +39,13 @@ external version : unit -> int * int * int = "caml_zmq_version" module Socket = struct - type +'a t + type 'a t (** This is an int so we know which socket we * are building inside the external functions *) type 'a kind = int - type generic - type pair = private generic - type pub = private generic - type sub = private generic - type req = private generic - type rep = private generic - type dealer = private generic - type router = private generic - type pull = private generic - type push = private generic - let pair = 0 let pub = 1 let sub = 2 @@ -269,13 +258,13 @@ module Poll = struct type t - type event_mask = In | Out | In_out - type 'a poll_item = ('a Socket.t * event_mask) + type poll_event = In | Out | In_out + type poll_socket = [`Pair|`Pub|`Sub|`Req|`Rep|`Dealer|`Router|`Pull|`Push] Socket.t + type poll_mask = (poll_socket * poll_event) - external of_poll_items : 'a poll_item array -> t = "caml_zmq_poll_of_pollitem_array" + external mask_of : poll_mask array -> t = "caml_zmq_poll_of_pollitem_array" + external native_poll: t -> int -> poll_event option array = "caml_zmq_poll" - external native_poll: t -> int -> 'a poll_item array = "caml_zmq_poll" + let poll ?(timeout = -1) items = native_poll items timeout - let poll ?(timeout = -1) items = - native_poll items timeout end diff --git a/src/ZMQ.mli b/src/ZMQ.mli index 70b9b53..26e706c 100644 --- a/src/ZMQ.mli +++ b/src/ZMQ.mli @@ -29,31 +29,20 @@ val term : context -> unit val version : unit -> int * int * int -module Socket : -sig - type +'a t +module Socket : sig + + type 'a t type 'a kind - type generic - type pair = private generic - type pub = private generic - type sub = private generic - type req = private generic - type rep = private generic - type dealer = private generic - type router = private generic - type pull = private generic - type push = private generic - - val pair : pair kind - val pub : pub kind - val sub : sub kind - val req : req kind - val rep : rep kind - val dealer : dealer kind - val router : router kind - val pull : pull kind - val push : push kind + val pair : [>`Pair] kind + val pub : [>`Pub] kind + val sub : [>`Sub] kind + val req : [>`Req] kind + val rep : [>`Rep] kind + val dealer : [>`Dealer] kind + val router : [>`Router] kind + val pull : [>`Pull] kind + val push : [>`Push] kind (** Creation and Destruction *) val create : context -> 'a kind -> 'a t @@ -87,8 +76,8 @@ sig val set_reconnect_interval_max : 'a t -> int -> unit val set_backlog : 'a t -> int -> unit - val subscribe : sub t -> string -> unit - val unsubscribe : sub t -> string -> unit + val subscribe : [>`Sub] t -> string -> unit + val unsubscribe : [>`Sub] t -> string -> unit (** Option Getters *) val has_more : 'a t -> bool @@ -116,26 +105,23 @@ sig end +module Device : sig -module Device : -sig - - val streamer : Socket.pull Socket.t -> Socket.push Socket.t -> unit - val forwarder : Socket.sub Socket.t -> Socket.pub Socket.t -> unit - val queue : Socket.router Socket.t -> Socket.dealer Socket.t -> unit + val streamer : [>`Pull] Socket.t -> [>`Push] Socket.t -> unit + val forwarder : [>`Sub] Socket.t -> [>`Pub] Socket.t -> unit + val queue : [>`Router] Socket.t -> [>`Dealer] Socket.t -> unit end -module Poll : -sig +module Poll : sig type t - type event_mask = In | Out | In_out - type 'a poll_item = ('a Socket.t * event_mask) - - val of_poll_items : 'a poll_item array -> t + type poll_event = In | Out | In_out + type poll_socket = [`Pair|`Pub|`Sub|`Req|`Rep|`Dealer|`Router|`Pull|`Push] Socket.t + type poll_mask = (poll_socket * poll_event) - val poll : ?timeout: int -> t -> 'a poll_item array + val mask_of : poll_mask array -> t + val poll : ?timeout: int -> t -> poll_event option array end diff --git a/src/ZMQ.mllib b/src/ZMQ.mllib new file mode 100644 index 0000000..09e5e4a --- /dev/null +++ b/src/ZMQ.mllib @@ -0,0 +1,4 @@ +# OASIS_START +# DO NOT EDIT (digest: 38cf8f016825407fb4e79e319d87bd5e) +ZMQ +# OASIS_STOP diff --git a/src/ZMQB.mllib b/src/ZMQB.mllib new file mode 100644 index 0000000..09e5e4a --- /dev/null +++ b/src/ZMQB.mllib @@ -0,0 +1,4 @@ +# OASIS_START +# DO NOT EDIT (digest: 38cf8f016825407fb4e79e319d87bd5e) +ZMQ +# OASIS_STOP diff --git a/src/libZMQ.clib b/src/libZMQ.clib new file mode 100644 index 0000000..027b6d1 --- /dev/null +++ b/src/libZMQ.clib @@ -0,0 +1,9 @@ +# OASIS_START +# DO NOT EDIT (digest: 763fe4e973ad27989541c2c881f7daa5) +caml_zmq_stubs.o +socket.o +context.o +fail.o +poll.o +uint64.o +# OASIS_STOP diff --git a/src/libZMQB.clib b/src/libZMQB.clib new file mode 100644 index 0000000..027b6d1 --- /dev/null +++ b/src/libZMQB.clib @@ -0,0 +1,9 @@ +# OASIS_START +# DO NOT EDIT (digest: 763fe4e973ad27989541c2c881f7daa5) +caml_zmq_stubs.o +socket.o +context.o +fail.o +poll.o +uint64.o +# OASIS_STOP diff --git a/src/poll.c b/src/poll.c index de6fd06..c5bbdd4 100644 --- a/src/poll.c +++ b/src/poll.c @@ -6,10 +6,11 @@ #include #include - #include "fail.h" #include "socket.h" +#include + static void custom_finalize_poll(value poll) { free(CAML_ZMQ_Poll_val(poll)->poll_items); } @@ -32,7 +33,7 @@ CAMLprim value caml_zmq_poll_of_pollitem_array(value pollitem_array) { caml_zmq_raise_if(items == NULL); int i; for(i = 0; i < n; i++) { - current_elem = Field(pollitem_array, n); + current_elem = Field(pollitem_array, i); items[i].socket = CAML_ZMQ_Socket_val(Field(current_elem, 0)); items[i].events = CAML_ZMQ_Mask_val(Field(current_elem, 1)); } @@ -76,7 +77,7 @@ short CAML_ZMQ_Mask_val (value mask) { CAMLprim value caml_zmq_poll(value poll, value timeout) { CAMLparam2 (poll, timeout); - CAMLlocal2 (poll_itemarray, curr_elem); + CAMLlocal2 (events, some); int n = CAML_ZMQ_Poll_val(poll)->num_elems; zmq_pollitem_t *items = CAML_ZMQ_Poll_val(poll)->poll_items; int tm = Int_val(timeout); @@ -86,22 +87,18 @@ CAMLprim value caml_zmq_poll(value poll, value timeout) { caml_acquire_runtime_system(); caml_zmq_raise_if(num_event_sockets == -1); - if(num_event_sockets == 0) { /* It's invalid to allocate a zero sized array */ - poll_itemarray = Atom(0); - } else { - poll_itemarray = caml_alloc_tuple(num_event_sockets); - int i, j; - for(i = 0, j = 0; i < num_event_sockets; i++) { - while(!((items[j].revents | ZMQ_POLLIN) || (items[j].revents | ZMQ_POLLOUT))) { - j++; - } - curr_elem = caml_alloc_tuple(2); - Store_field(curr_elem, 0, caml_zmq_copy_socket(items[j].socket)); - Store_field(curr_elem, 1, CAML_ZMQ_Val_mask(items[j].revents)); - Store_field(poll_itemarray, i, curr_elem); - j++; + events = caml_alloc(n, 0); + + int i; + for(i = 0; i < n; i++) { + if (!((items[i].revents & ZMQ_POLLIN) || (items[i].revents & ZMQ_POLLOUT))) { + Store_field(events, i, Val_int(0)); /* None */ + } else { + some = caml_alloc(1, 0); + Store_field(some, 0, CAML_ZMQ_Val_mask(items[i].revents)); + Store_field(events, i, some); } } - CAMLreturn (poll_itemarray); + CAMLreturn (events); } diff --git a/src/poll.h b/src/poll.h index 83e7cbb..24eaf2d 100644 --- a/src/poll.h +++ b/src/poll.h @@ -10,7 +10,7 @@ struct caml_zmq_poll { int num_elems; }; -#define CAML_ZMQ_Poll_val(v) (*((struct caml_zmq_poll **) Data_custom_val(v))) +#define CAML_ZMQ_Poll_val(v) ((struct caml_zmq_poll *) Data_custom_val(v)) value caml_zmq_poll_of_pollitem_array(value pollitem_array); value caml_zmq_poll(value poll, value timeout); diff --git a/test/test.ml b/test/test.ml new file mode 100644 index 0000000..b0a4a60 --- /dev/null +++ b/test/test.ml @@ -0,0 +1,10 @@ +open OUnit;; + +let suite = "ZMQ" >::: + [ + Zmq_test.suite; + ] + +let _ = + run_test_tt_main suite + diff --git a/test/zmq_test.ml b/test/zmq_test.ml new file mode 100644 index 0000000..6b85088 --- /dev/null +++ b/test/zmq_test.ml @@ -0,0 +1,78 @@ +open OUnit + +open ZMQ +open ZMQ.Socket +open ZMQ.Poll + +let debug fmt = + Printf.ksprintf (fun s -> print_endline s; flush stdout) fmt + +let sleep t = ignore(Unix.select [] [] [] t) + +let dump_events l = + let f = function + | None -> "None" + | Some In -> "In" + | Some Out -> " Out" + | Some In_out -> "In/Out" + in + let l = Array.to_list (Array.map f l) in + "[|" ^ (String.concat "; " l) ^ "|]" + +let suite = + "zmq test" >::: + [ + "request reply" >:: + (bracket + (fun () -> + let ctx = init () in + let req = create ctx req + and rep = create ctx rep in + ctx, req, rep + ) + (fun (_, req, rep) -> + let endpoint = "inproc://endpoint" in + bind rep endpoint; + connect req endpoint; + send req "request"; + let msg = recv rep in + assert_equal "request" msg; + send rep "reply"; + let msg = recv req in + assert_equal "reply" msg + ) + (fun (ctx, req, rep) -> + close req; + close rep; + term ctx + )); + + "poll" >:: + (bracket + (fun () -> + let ctx = init () in + let req = create ctx req + and rep = create ctx rep in + ctx, req, rep + ) + (fun (_, req, rep) -> + let endpoint = "inproc://endpoint" in + bind rep endpoint; + connect req endpoint; + let mask = mask_of [| req, In_out; rep, In_out |] in + assert_equal [| Some Out; None |] (poll ~timeout:1000 mask); + send req "request"; + assert_equal [| None; Some In |] (poll ~timeout:1000 mask); + let msg = recv ~opt:R_no_block rep in + assert_equal "request" msg; + send rep "reply"; + assert_equal [| Some In; None |] (poll ~timeout:1000 mask); + let msg = recv req in + assert_equal "reply" msg; + ) + (fun (ctx, req, rep) -> + close req; + close rep; + term ctx + )); + ]