Menu
▾
▴
[Krobot-commits] [SCM] krobot branch, master, updated. eeb73f1c3ad69e4a5ae65feaedd84bd2e62da327
|
From: Jérémie D. <Ba...@us...> - 2011-01-14 15:41:06
|
This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "krobot".
The branch, master has been updated
via eeb73f1c3ad69e4a5ae65feaedd84bd2e62da327 (commit)
via c61005f50cfb0fdc91506a9987e9789c9954ac06 (commit)
from e88cc49a1eee15a8ce66cc36233a3b6f07ba638c (commit)
Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.
- Log -----------------------------------------------------------------
commit eeb73f1c3ad69e4a5ae65feaedd84bd2e62da327
Author: Jérémie Dimino <je...@di...>
Date: Fri Jan 14 16:37:38 2011 +0100
Add an emacs mode for krobot protocol files
commit c61005f50cfb0fdc91506a9987e9789c9954ac06
Author: Jérémie Dimino <je...@di...>
Date: Fri Jan 14 16:22:13 2011 +0100
Start the implementation of the protocol generator
-----------------------------------------------------------------------
Changes:
diff --git a/info/generator/Makefile b/info/generator/Makefile
new file mode 100644
index 0000000..68f2e0e
--- /dev/null
+++ b/info/generator/Makefile
@@ -0,0 +1,38 @@
+# 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/info/generator/_oasis b/info/generator/_oasis
new file mode 100644
index 0000000..a6ac733
--- /dev/null
+++ b/info/generator/_oasis
@@ -0,0 +1,26 @@
+OASISFormat: 0.1
+Name: krobot-generator
+Version: 0.1
+LicenseFile: LICENSE
+License: BSD3
+Authors: Jérémie Dimino
+Homepage: http://sourceforge.net/projects/krobot/
+BuildTools:ocamlbuild
+Plugins: DevFiles (0.2), META (0.2)
+Synopsis: krobot-generator
+Description: Generate source code from a protocol description
+
+Library "krobot-protocol"
+ Path: src
+ Install: true
+ Modules: Kgen_message
+ BuildDepends: camlp4.lib, camlp4.quotations.o, camlp4.extend
+ XMETARequires: camlp4.lib
+ XMETADescription: Parsing of messages
+
+Executable "krobot-proto2c"
+ Path: src
+ Install: true
+ CompiledObject: best
+ MainIs: krobot_proto2c.ml
+ BuildDepends: krobot-protocol
diff --git a/info/generator/_tags b/info/generator/_tags
new file mode 100644
index 0000000..03dbf89
--- /dev/null
+++ b/info/generator/_tags
@@ -0,0 +1,16 @@
+<src/*.ml>: syntax_camlp4o
+
+# OASIS_START
+# DO NOT EDIT (digest: 60cf244464842fbaf3a5b92f9af0378a)
+# Library krobot-protocol
+"src": include
+# Executable krobot-proto2c
+<src/krobot_proto2c.{native,byte}>: use_krobot-protocol
+<src/krobot_proto2c.{native,byte}>: pkg_camlp4.quotations.o
+<src/krobot_proto2c.{native,byte}>: pkg_camlp4.lib
+<src/krobot_proto2c.{native,byte}>: pkg_camlp4.extend
+<src/*.ml{,i}>: use_krobot-protocol
+<src/*.ml{,i}>: pkg_camlp4.quotations.o
+<src/*.ml{,i}>: pkg_camlp4.lib
+<src/*.ml{,i}>: pkg_camlp4.extend
+# OASIS_STOP
diff --git a/info/generator/configure b/info/generator/configure
new file mode 100755
index 0000000..6719c7c
--- /dev/null
+++ b/info/generator/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/info/generator/myocamlbuild.ml b/info/generator/myocamlbuild.ml
new file mode 100644
index 0000000..ca266a4
--- /dev/null
+++ b/info/generator/myocamlbuild.ml
@@ -0,0 +1,463 @@
+(* OASIS_START *)
+(* DO NOT EDIT (digest: 957944806563727d68327ca1f79abf66) *)
+module OASISGettext = struct
+# 21 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/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_ "<empty>"
+ else
+ String.concat
+ (s_ ", ")
+ (List.map
+ (fun (cond, vl) ->
+ match printer with
+ | Some p -> p vl
+ | None -> s_ "<no printer>")
+ lst)
+ in
+ match name with
+ | Some nm ->
+ failwith
+ (Printf.sprintf
+ (f_ "No result for the choice list '%s': %s")
+ nm str_lst)
+ | None ->
+ failwith
+ (Printf.sprintf
+ (f_ "No result for a choice list: %s")
+ str_lst)
+ in
+ choose_aux (List.rev lst)
+
+end
+
+
+module BaseEnvLight = struct
+# 21 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/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/krobot-protocol", ["src"])];
+ lib_c = [];
+ flags = [];
+ }
+ ;;
+
+let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;;
+
+(* OASIS_STOP *)
+Ocamlbuild_plugin.dispatch dispatch_default;;
diff --git a/info/generator/setup.ml b/info/generator/setup.ml
new file mode 100644
index 0000000..24e265f
--- /dev/null
+++ b/info/generator/setup.ml
@@ -0,0 +1,5114 @@
+(* setup.ml generated for the first time by OASIS v0.2.0~alpha1 *)
+
+(* OASIS_START *)
+(* DO NOT EDIT (digest: c6c71a26c456b58aefa0d72b3f80d8da) *)
+(*
+ Regenerated by OASIS v0.2.0~alpha1
+ Visit http://oasis.forge.ocamlcore.org for more information and
+ documentation about functions used in this file.
+*)
+module OASISGettext = struct
+# 21 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/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_ "<empty>"
+ else
+ String.concat
+ (s_ ", ")
+ (List.map
+ (fun (cond, vl) ->
+ match printer with
+ | Some p -> p vl
+ | None -> s_ "<no printer>")
+ lst)
+ in
+ match name with
+ | Some nm ->
+ failwith
+ (Printf.sprintf
+ (f_ "No result for the choice list '%s': %s")
+ nm str_lst)
+ | None ->
+ failwith
+ (Printf.sprintf
+ (f_ "No result for a choice list: %s")
+ str_lst)
+ in
+ choose_aux (List.rev lst)
+
+end
+
+module OASISTypes = struct
+# 21 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/src/oasis/OASISBuildSection.ml"
+
+end
+
+module OASISExecutable = struct
+# 21 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/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])
+ | [] ->
+ 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
+
+ (** Merge containers with the same name *)
+ let rec merge_containers groups =
+ (* Collect packages and create the map "container name -> merged children" *)
+ let packages, containers =
+ List.fold_left
+ (fun (packages, containers) group ->
+ match group with
+ | Container(name, children) ->
+ let children' =
+ try
+ MapString.find name containers
+ with Not_found ->
+ []
+ in
+ (packages,
+ MapString.add name (children' @ children) containers)
+ | Package(name, cs, bs, lib, children) ->
+ (Package(name, cs, bs, lib, merge_containers children) :: packages,
+ containers))
+ ([], MapString.empty)
+ groups
+ in
+ (* Recreate the list of groups *)
+ packages @
+ (MapString.fold
+ (fun name children acc ->
+ Container(name, merge_containers children) :: acc)
+ containers [])
+ in
+
+ (* TODO: check that libraries are unique *)
+ merge_containers
+ (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 "/home/dim/sources/oasis/src/oasis/OASISFlag.ml"
+
+end
+
+module OASISPackage = struct
+# 21 "/home/dim/sources/oasis/src/oasis/OASISPackage.ml"
+
+end
+
+module OASISSourceRepository = struct
+# 21 "/home/dim/sources/oasis/src/oasis/OASISSourceRepository.ml"
+
+end
+
+module OASISTest = struct
+# 21 "/home/dim/sources/oasis/src/oasis/OASISTest.ml"
+
+end
+
+module OASISDocument = struct
+# 21 "/home/dim/sources/oasis/src/oasis/OASISDocument.ml"
+
+end
+
+
+module BaseEnvLight = struct
+# 21 "/home/dim/sources/oasis/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 "/home/dim/sources/oasis/src/base/BaseContext.ml"
+
+ open OASISContext
+
+ let args = args
+
+ let default = default
+
+end
+
+module BaseMessage = struct
+# 21 "/home/dim/sources/oasis/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
+
+ ...
[truncated message content] |
