From 04e26a3fc35798d54a99c0bfba8af82d2c513141 Mon Sep 17 00:00:00 2001
From: xthirioux <xthirioux@041b043f-8d7c-46b2-b46e-ef0dd855326e>
Date: Wed, 5 Mar 2014 15:32:51 +0000
Subject: [PATCH] answer to #feature 50: - arrows are now factorized out and
become part of include as files arrow.h and arrow.c - no more arrows in
generated code - compiling and linking arrow.c is only necessary in case
of dynamic allocation - version now includes installation prefix (for the
standard lib) and svn number
git-svn-id: https://cavale.enseeiht.fr/svn/lustrec/lustre_compiler/trunk@180 041b043f-8d7c-46b2-b46e-ef0dd855326e
---
_oasis | 4 +-
_tags | 23 +-
configure | 23 +-
include/arrow.c | 10 +
include/arrow.h | 20 +
myocamlbuild.ml | 251 ++-
setup.ml | 5045 ++++++++++++++++++++++++++--------------------
src/c_backend.ml | 88 +-
svn_version.sh | 8 +-
9 files changed, 3106 insertions(+), 2366 deletions(-)
create mode 100644 include/arrow.c
create mode 100644 include/arrow.h
diff --git a/_oasis b/_oasis
index b420ac7b..17ad1b3b 100644
--- a/_oasis
+++ b/_oasis
@@ -6,8 +6,8 @@ Authors:
License: LGPL-2.1
Plugins: DevFiles (0.2)
# , Custom (0.2)
-PreBuildCommand: ./svn_version.sh
-PostInstallCommand: mkdir -p $(prefix)/include; cp -rf include $(prefix)/include/lustrec
+PreBuildCommand: ./svn_version.sh $(prefix)
+PostInstallCommand: mkdir -p $(prefix)/include/lustrec; cp -rf include/*.[ch] $(prefix)/include/lustrec; cp -rf include/*.java $(prefix)/include/lustrec
Executable lustrec
Path: src
diff --git a/_tags b/_tags
index e615d37c..6786ff52 100644
--- a/_tags
+++ b/_tags
@@ -1,10 +1,23 @@
# OASIS_START
-# DO NOT EDIT (digest: 54aa7498411485980381101fb69226dd)
+# DO NOT EDIT (digest: 98bcbc21d29d2f6266238c1025fff223)
+# Ignore VCS directories, you can use the same kind of rule outside
+# OASIS_START/STOP if you want to exclude directories that contains
+# useless stuff for the build process
+<**/.svn>: -traverse
+<**/.svn>: not_hygienic
+".bzr": -traverse
+".bzr": not_hygienic
+".hg": -traverse
+".hg": not_hygienic
+".git": -traverse
+".git": not_hygienic
+"_darcs": -traverse
+"_darcs": not_hygienic
# Executable lustrec
-"src/main_lustre_compiler.native": pkg_unix
-"src/main_lustre_compiler.native": pkg_str
"src/main_lustre_compiler.native": pkg_ocamlgraph
-<src/*.ml{,i}>: pkg_unix
-<src/*.ml{,i}>: pkg_str
+"src/main_lustre_compiler.native": pkg_str
+"src/main_lustre_compiler.native": pkg_unix
<src/*.ml{,i}>: pkg_ocamlgraph
+<src/*.ml{,i}>: pkg_str
+<src/*.ml{,i}>: pkg_unix
# OASIS_STOP
diff --git a/configure b/configure
index 6719c7c3..97ed012e 100755
--- a/configure
+++ b/configure
@@ -1,8 +1,27 @@
#!/bin/sh
# OASIS_START
-# DO NOT EDIT (digest: ed33e59fe00e48bc31edf413bbc8b8d6)
+# DO NOT EDIT (digest: 425187ed8bfdbdd207fd76392dd243a7)
set -e
-ocaml setup.ml -configure $*
+FST=true
+for i in "$@"; do
+ if $FST; then
+ set --
+ FST=false
+ fi
+
+ case $i in
+ --*=*)
+ ARG=${i%%=*}
+ VAL=${i##*=}
+ set -- "$@" "$ARG" "$VAL"
+ ;;
+ *)
+ set -- "$@" "$i"
+ ;;
+ esac
+done
+
+ocaml setup.ml -configure "$@"
# OASIS_STOP
diff --git a/include/arrow.c b/include/arrow.c
new file mode 100644
index 00000000..950b46a6
--- /dev/null
+++ b/include/arrow.c
@@ -0,0 +1,10 @@
+#include <stdlib.h>
+#include <assert.h>
+#include "arrow.h"
+
+struct _arrow_mem *arrow_alloc() {
+ struct _arrow_mem *_alloc;
+ _alloc = (struct _arrow_mem *) malloc(sizeof(struct _arrow_mem *));
+ assert (_alloc);
+ return _alloc;
+}
diff --git a/include/arrow.h b/include/arrow.h
new file mode 100644
index 00000000..f2fa3bf7
--- /dev/null
+++ b/include/arrow.h
@@ -0,0 +1,20 @@
+
+#ifndef _ARROW
+#define _ARROW
+
+struct _arrow_mem {struct _arrow_reg {_Bool _first; } _reg; };
+
+extern struct _arrow_mem *arrow_alloc ();
+
+#define _arrow_DECLARE(inst)\
+ struct _arrow_mem inst;
+
+#define _arrow_LINK(inst) do {\
+ ;\
+} while (0)
+
+#define _arrow_step(x,y,output,self) ((self)->_reg._first?((self)->_reg._first=0,(*output = x)):(*output = y))
+
+#define _arrow_reset(self) {(self)->_reg._first = 1;}
+
+#endif
diff --git a/myocamlbuild.ml b/myocamlbuild.ml
index 55d782fb..fed8e1f8 100644
--- a/myocamlbuild.ml
+++ b/myocamlbuild.ml
@@ -1,39 +1,39 @@
(* OASIS_START *)
-(* DO NOT EDIT (digest: 7eabc0106cad87d67c960d9a2ff80b28) *)
+(* DO NOT EDIT (digest: 00359f2e15a7ed8f31f1d7ce086345f9) *)
module OASISGettext = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISGettext.ml"
-
- let ns_ str =
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISGettext.ml" *)
+
+ let ns_ str =
str
-
- let s_ 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 =
+
+ let init =
[]
-
+
end
module OASISExpr = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISExpr.ml"
-
-
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISExpr.ml" *)
+
+
+
open OASISGettext
-
+
type test = string
-
+
type flag = string
-
+
type t =
| EBool of bool
| ENot of t
@@ -42,31 +42,31 @@ module OASISExpr = struct
| EFlag of flag
| ETest of test * string
-
+
type 'a choices = (t * 'a) list
-
+
let eval var_get t =
- let rec eval' =
+ let rec eval' =
function
| EBool b ->
b
-
- | ENot e ->
+
+ | ENot e ->
not (eval' e)
-
+
| EAnd (e1, e2) ->
(eval' e1) && (eval' e2)
-
- | EOr (e1, 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
@@ -74,21 +74,21 @@ module OASISExpr = struct
(v = vl)
in
eval' t
-
+
let choose ?printer ?name var_get lst =
- let rec choose_aux =
+ let rec choose_aux =
function
| (cond, vl) :: tl ->
- if eval var_get cond then
- vl
+ if eval var_get cond then
+ vl
else
choose_aux tl
| [] ->
- let str_lst =
+ let str_lst =
if lst = [] then
s_ "<empty>"
else
- String.concat
+ String.concat
(s_ ", ")
(List.map
(fun (cond, vl) ->
@@ -97,10 +97,10 @@ module OASISExpr = struct
| None -> s_ "<no printer>")
lst)
in
- match name with
+ match name with
| Some nm ->
failwith
- (Printf.sprintf
+ (Printf.sprintf
(f_ "No result for the choice list '%s': %s")
nm str_lst)
| None ->
@@ -110,22 +110,23 @@ module OASISExpr = struct
str_lst)
in
choose_aux (List.rev lst)
-
+
end
+# 117 "myocamlbuild.ml"
module BaseEnvLight = struct
-# 21 "/build/buildd/oasis-0.2.0/src/base/BaseEnvLight.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseEnvLight.ml" *)
+
module MapString = Map.Make(String)
-
+
type t = string MapString.t
-
+
let default_filename =
- Filename.concat
+ Filename.concat
(Sys.getcwd ())
"setup.data"
-
+
let load ?(allow_empty=false) ?(filename=default_filename) () =
if Sys.file_exists filename then
begin
@@ -138,23 +139,23 @@ module BaseEnvLight = struct
let line =
ref 1
in
- let st_line =
+ let st_line =
Stream.from
(fun _ ->
try
- match Stream.next st with
+ match Stream.next st with
| '\n' -> incr line; Some '\n'
| c -> Some c
with Stream.Failure -> None)
in
- let lexer =
+ let lexer =
Genlex.make_lexer ["="] st_line
in
let rec read_file mp =
- match Stream.npeek 3 lexer with
+ match Stream.npeek 3 lexer with
| [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
- Stream.junk lexer;
- Stream.junk lexer;
+ Stream.junk lexer;
+ Stream.junk lexer;
Stream.junk lexer;
read_file (MapString.add nm value mp)
| [] ->
@@ -177,43 +178,44 @@ module BaseEnvLight = struct
end
else
begin
- failwith
- (Printf.sprintf
+ 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
+ Buffer.add_substitute
buff
- (fun var ->
- try
+ (fun var ->
+ try
var_expand (MapString.find var env)
with Not_found ->
- failwith
- (Printf.sprintf
+ failwith
+ (Printf.sprintf
"No variable %s defined when trying to expand %S."
- var
+ var
str))
str;
Buffer.contents buff
in
var_expand (MapString.find name env)
-
- let var_choose lst env =
+
+ let var_choose lst env =
OASISExpr.choose
(fun nm -> var_get nm env)
lst
end
+# 215 "myocamlbuild.ml"
module MyOCamlbuildFindlib = struct
-# 21 "/build/buildd/oasis-0.2.0/src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.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
@@ -223,14 +225,14 @@ module MyOCamlbuildFindlib = struct
* 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 []
@@ -245,24 +247,24 @@ module MyOCamlbuildFindlib = struct
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 ->
@@ -292,7 +294,7 @@ module MyOCamlbuildFindlib = struct
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 ->
@@ -301,7 +303,7 @@ module MyOCamlbuildFindlib = struct
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
@@ -311,49 +313,61 @@ module MyOCamlbuildFindlib = struct
* the "threads" package using the previous plugin.
*)
flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]);
+ flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]);
flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]);
flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"])
-
+
| _ ->
()
-
+
end
module MyOCamlbuildBase = struct
-# 21 "/build/buildd/oasis-0.2.0/src/plugins/ocamlbuild/MyOCamlbuildBase.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
+
(** Base functions for writing myocamlbuild.ml
@author Sylvain Le Gall
*)
-
-
-
+
+
+
open Ocamlbuild_plugin
-
+ module OC = Ocamlbuild_pack.Ocaml_compiler
+
type dir = string
type file = string
type name = string
type tag = string
-
-# 55 "/build/buildd/oasis-0.2.0/src/plugins/ocamlbuild/MyOCamlbuildBase.ml"
-
+
+(* # 56 "/build/buildd/oasis-0.3.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;
+ (* Replace the 'dir: include' from _tags by a precise interdepends in
+ * directory.
+ *)
+ includes: (dir * dir list) list;
}
-
+
let env_filename =
Pathname.basename
BaseEnvLight.default_filename
-
+
let dispatch_combine lst =
fun e ->
List.iter
(fun dispatch -> dispatch e)
lst
-
+
+ let tag_libstubs nm =
+ "use_lib"^nm^"_stubs"
+
+ let nm_libstubs nm =
+ nm^"_stubs"
+
let dispatch t e =
let env =
BaseEnvLight.load
@@ -380,53 +394,64 @@ module MyOCamlbuildBase = struct
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;
+ | nm, [] ->
+ ocaml_lib nm
+ | nm, dir :: tl ->
+ ocaml_lib ~dir:dir (dir^"/"^nm);
List.iter
(fun dir ->
- flag
- ["ocaml"; "use_"^lib; "compile"]
- (S[A"-I"; P dir]))
+ List.iter
+ (fun str ->
+ flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir]))
+ ["compile"; "infer_interface"; "doc"])
tl)
t.lib_ocaml;
-
+
+ (* Declare directories dependencies, replace "include" in _tags. *)
+ List.iter
+ (fun (dir, include_dirs) ->
+ Pathname.define_context dir include_dirs)
+ t.includes;
+
(* Declare C libraries *)
List.iter
(fun (lib, dir, headers) ->
(* Handle C part of library *)
- flag ["link"; "library"; "ocaml"; "byte"; "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"; "library"; "ocaml"; "byte"; tag_libstubs lib]
+ (S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib";
+ A("-l"^(nm_libstubs lib))]);
+
+ flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib]
+ (S[A"-cclib"; A("-l"^(nm_libstubs lib))]);
- flag ["link"; "program"; "ocaml"; "byte"; "use_lib"^lib]
- (S[A"-dllib"; A("dll"^lib)]);
-
+ flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib]
+ (S[A"-dllib"; A("dll"^(nm_libstubs lib))]);
+
(* When ocaml link something that use the C library, then one
need that file to be up to date.
*)
- dep ["link"; "ocaml"; "use_lib"^lib]
- [dir/"lib"^lib^"."^(!Options.ext_lib)];
-
+ dep ["link"; "ocaml"; "program"; tag_libstubs lib]
+ [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
+
+ dep ["compile"; "ocaml"; "program"; tag_libstubs lib]
+ [dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)];
+
(* TODO: be more specific about what depends on headers *)
(* Depends on .h files *)
dep ["compile"; "c"]
headers;
-
+
(* Setup search path for lib *)
flag ["link"; "ocaml"; "use_"^lib]
(S[A"-I"; P(dir)]);
)
t.lib_c;
-
+
(* Add flags *)
List.iter
(fun (tags, cond_specs) ->
@@ -437,23 +462,25 @@ module MyOCamlbuildBase = struct
t.flags
| _ ->
()
-
+
let dispatch_default t =
dispatch_combine
[
dispatch t;
MyOCamlbuildFindlib.dispatch;
]
-
+
end
+# 476 "myocamlbuild.ml"
open Ocamlbuild_plugin;;
let package_default =
- {MyOCamlbuildBase.lib_ocaml = []; lib_c = []; flags = []; }
+ {MyOCamlbuildBase.lib_ocaml = []; lib_c = []; flags = []; includes = []; }
;;
let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;;
+# 485 "myocamlbuild.ml"
(* OASIS_STOP *)
Ocamlbuild_plugin.dispatch dispatch_default;;
diff --git a/setup.ml b/setup.ml
index 178ddc51..49132274 100644
--- a/setup.ml
+++ b/setup.ml
@@ -1,288 +1,363 @@
(* setup.ml generated for the first time by OASIS v0.2.0 *)
(* OASIS_START *)
-(* DO NOT EDIT (digest: 6666f62d55895fd4c2e5dbbf8e9d4998) *)
+(* DO NOT EDIT (digest: 199ddf56e2399fc7ababf7124443bcc9) *)
(*
- Regenerated by OASIS v0.2.0
+ Regenerated by OASIS v0.3.0
Visit http://oasis.forge.ocamlcore.org for more information and
documentation about functions used in this file.
*)
module OASISGettext = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISGettext.ml"
-
- let ns_ str =
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISGettext.ml" *)
+
+ let ns_ str =
str
-
- let s_ 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 =
+
+ let init =
[]
-
+
end
module OASISContext = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISContext.ml"
-
- open OASISGettext
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISContext.ml" *)
+
+ open OASISGettext
+
type level =
[ `Debug
- | `Info
+ | `Info
| `Warning
| `Error]
-
+
type t =
{
- verbose: bool;
- debug: bool;
- ignore_plugins: bool;
- printf: level -> string -> unit;
+ quiet: bool;
+ info: bool;
+ debug: bool;
+ ignore_plugins: bool;
+ ignore_unknown_fields: bool;
+ printf: level -> string -> unit;
}
-
- let printf lvl str =
- let beg =
- match lvl with
+
+ 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)
-
+ prerr_endline (beg^str)
+
let default =
- ref
+ ref
{
- verbose = true;
- debug = false;
- ignore_plugins = false;
- printf = printf;
+ quiet = false;
+ info = false;
+ debug = false;
+ ignore_plugins = false;
+ ignore_unknown_fields = false;
+ printf = printf;
}
-
- let quiet =
- {!default with
- verbose = false;
- debug = false;
- }
-
-
+
+ let quiet =
+ {!default with quiet = true}
+
+
let args () =
["-quiet",
- Arg.Unit (fun () -> default := {!default with verbose = false}),
+ Arg.Unit (fun () -> default := {!default with quiet = true}),
(s_ " Run quietly");
-
+
+ "-info",
+ Arg.Unit (fun () -> default := {!default with info = true}),
+ (s_ " Display information message");
+
+
"-debug",
Arg.Unit (fun () -> default := {!default with debug = true}),
(s_ " Output debug message")]
end
+module OASISString = struct
+(* # 1 "/build/buildd/oasis-0.3.0/src/oasis/OASISString.ml" *)
+
+
+
+ (** Various string utilities.
+
+ Mostly inspired by extlib and batteries ExtString and BatString libraries.
+
+ @author Sylvain Le Gall
+ *)
+
+ let nsplitf str f =
+ if str = "" then
+ []
+ else
+ let buf = Buffer.create 13 in
+ let lst = ref [] in
+ let push () =
+ lst := Buffer.contents buf :: !lst;
+ Buffer.clear buf
+ in
+ let str_len = String.length str in
+ for i = 0 to str_len - 1 do
+ if f str.[i] then
+ push ()
+ else
+ Buffer.add_char buf str.[i]
+ done;
+ push ();
+ List.rev !lst
+
+ (** [nsplit c s] Split the string [s] at char [c]. It doesn't include the
+ separator.
+ *)
+ let nsplit str c =
+ nsplitf str ((=) c)
+
+ let find ~what ?(offset=0) str =
+ let what_idx = ref 0 in
+ let str_idx = ref offset in
+ while !str_idx < String.length str &&
+ !what_idx < String.length what do
+ if str.[!str_idx] = what.[!what_idx] then
+ incr what_idx
+ else
+ what_idx := 0;
+ incr str_idx
+ done;
+ if !what_idx <> String.length what then
+ raise Not_found
+ else
+ !str_idx - !what_idx
+
+ let sub_start str len =
+ let str_len = String.length str in
+ if len >= str_len then
+ ""
+ else
+ String.sub str len (str_len - len)
+
+ let sub_end ?(offset=0) str len =
+ let str_len = String.length str in
+ if len >= str_len then
+ ""
+ else
+ String.sub str 0 (str_len - len)
+
+ let starts_with ~what ?(offset=0) str =
+ let what_idx = ref 0 in
+ let str_idx = ref offset in
+ let ok = ref true in
+ while !ok &&
+ !str_idx < String.length str &&
+ !what_idx < String.length what do
+ if str.[!str_idx] = what.[!what_idx] then
+ incr what_idx
+ else
+ ok := false;
+ incr str_idx
+ done;
+ if !what_idx = String.length what then
+ true
+ else
+ false
+
+ let strip_starts_with ~what str =
+ if starts_with ~what str then
+ sub_start str (String.length what)
+ else
+ raise Not_found
+
+ let ends_with ~what ?(offset=0) str =
+ let what_idx = ref ((String.length what) - 1) in
+ let str_idx = ref ((String.length str) - 1) in
+ let ok = ref true in
+ while !ok &&
+ offset <= !str_idx &&
+ 0 <= !what_idx do
+ if str.[!str_idx] = what.[!what_idx] then
+ decr what_idx
+ else
+ ok := false;
+ decr str_idx
+ done;
+ if !what_idx = -1 then
+ true
+ else
+ false
+
+ let strip_ends_with ~what str =
+ if ends_with ~what str then
+ sub_end str (String.length what)
+ else
+ raise Not_found
+
+ let replace_chars f s =
+ let buf = String.make (String.length s) 'X' in
+ for i = 0 to String.length s - 1 do
+ buf.[i] <- f s.[i]
+ done;
+ buf
+
+end
+
module OASISUtils = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISUtils.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISUtils.ml" *)
+
+ open OASISGettext
+
module MapString = Map.Make(String)
-
+
let map_string_of_assoc assoc =
List.fold_left
(fun acc (k, v) -> MapString.add k v acc)
MapString.empty
assoc
-
+
module SetString = Set.Make(String)
-
+
let set_string_add_list st lst =
- List.fold_left
+ 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 =
+
+
+ let compare_csl s1 s2 =
String.compare (String.lowercase s1) (String.lowercase s2)
-
- module HashStringCsl =
+
+ module HashStringCsl =
Hashtbl.Make
(struct
type t = string
-
- let equal s1 s2 =
+
+ 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 =
+
+ let varname_of_string ?(hyphen='_') s =
if String.length s = 0 then
begin
- invalid_arg "varname_of_string"
+ 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
+ let buf =
+ OASISString.replace_chars
(fun c ->
- if ('a' <= c && c <= 'z')
- ||
- ('A' <= c && c <= 'Z')
- ||
+ if ('a' <= c && c <= 'z')
+ ||
+ ('A' <= c && c <= 'Z')
+ ||
('0' <= c && c <= '9') then
- Buffer.add_char buff c
+ c
else
- Buffer.add_char buff hyphen)
+ hyphen)
s;
-
- String.lowercase (Buffer.contents buff)
+ in
+ let buf =
+ (* Start with a _ if digit *)
+ if '0' <= s.[0] && s.[0] <= '9' then
+ "_"^buf
+ else
+ buf
+ in
+ String.lowercase buf
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
+
+ let varname_concat ?(hyphen='_') p s =
+ let what = String.make 1 hyphen in
+ let p =
+ try
+ OASISString.strip_ends_with ~what p
+ with Not_found ->
+ p
in
- let s =
- let s_len =
- String.length s
- in
- if s_len > 0 && s.[0] = hyphen then
- String.sub s 1 (s_len - 1)
- else
- s
+ let s =
+ try
+ OASISString.strip_starts_with ~what s
+ with Not_found ->
+ s
in
- Printf.sprintf "%s%c%s" p hyphen s
-
-
- let is_varname str =
+ p^what^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)
-
+
+ let failwithf fmt = Printf.ksprintf failwith fmt
+
end
module PropList = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/PropList.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/PropList.ml" *)
+
open OASISGettext
-
+
type name = string
-
- exception Not_set of name * string option
+
+ 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
-
+
+ let () =
+ Printexc.register_printer
+ (function
+ | Not_set (nm, Some rsn) ->
+ Some
+ (Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn)
+ | Not_set (nm, None) ->
+ Some
+ (Printf.sprintf (f_ "Field '%s' is not set") nm)
+ | No_printer nm ->
+ Some
+ (Printf.sprintf (f_ "No default printer for value %s") nm)
+ | Unknown_field (nm, schm) ->
+ Some
+ (Printf.sprintf (f_ "Field %s is not defined in schema %s") nm schm)
+ | _ ->
+ None)
+
module Data =
struct
-
- type t =
+
+ type t =
(name, unit -> unit) Hashtbl.t
-
+
let create () =
Hashtbl.create 13
-
+
let clear t =
Hashtbl.clear t
-
-# 59 "/build/buildd/oasis-0.2.0/src/oasis/PropList.ml"
+
+(* # 71 "/build/buildd/oasis-0.3.0/src/oasis/PropList.ml" *)
end
-
- module Schema =
+
+ module Schema =
struct
-
+
type ('ctxt, 'extra) value =
{
get: Data.t -> string;
@@ -290,7 +365,7 @@ module PropList = struct
help: (unit -> string) option;
extra: 'extra;
}
-
+
type ('ctxt, 'extra) t =
{
name: name;
@@ -298,81 +373,81 @@ module PropList = struct
order: name Queue.t;
name_norm: string -> string;
}
-
- let create ?(case_insensitive=false) nm =
+
+ let create ?(case_insensitive=false) nm =
{
name = nm;
fields = Hashtbl.create 13;
order = Queue.create ();
- name_norm =
- (if case_insensitive then
+ name_norm =
+ (if case_insensitive then
String.lowercase
else
fun s -> s);
}
-
- let add t nm set get extra help =
- let key =
+
+ 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
+ (Printf.sprintf
(f_ "Field '%s' is already defined in schema '%s'")
nm t.name);
- Hashtbl.add
- t.fields
- key
+ Hashtbl.add
+ t.fields
+ key
{
- set = set;
- get = get;
+ set = set;
+ get = get;
help = help;
extra = extra;
};
- Queue.add nm t.order
-
+ Queue.add nm t.order
+
let mem t nm =
- Hashtbl.mem t.fields nm
-
- let find 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
+ (find t nm).set
+ data
+ ?context
x
-
+
let fold f acc t =
- Queue.fold
+ Queue.fold
(fun acc k ->
let v =
find t k
in
f acc k v.extra v.help)
- acc
+ acc
t.order
-
+
let iter f t =
- fold
+ fold
(fun () -> f)
()
t
-
- let name t =
+
+ let name t =
t.name
end
-
+
module Field =
struct
-
+
type ('ctxt, 'value, 'extra) t =
{
set: Data.t -> ?context:'ctxt -> 'value -> unit;
@@ -382,52 +457,52 @@ module PropList = struct
help: (unit -> string) option;
extra: 'extra;
}
-
- let new_id =
+
+ 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
+ let v =
+ ref None
in
-
+
(* If name is not given, create unique one *)
- let nm =
- match name with
+ 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
+ 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
+ try
(Hashtbl.find data nm) ();
- match !v with
- | Some x -> x
+ 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
+ let set data ?context x =
+ let x =
+ match update with
| Some f ->
begin
- try
+ try
f ?context (get data) x
with Not_set _ ->
x
@@ -435,31 +510,31 @@ module PropList = struct
| None ->
x
in
- Hashtbl.replace
- data
- nm
- (fun () -> v := Some x)
+ Hashtbl.replace
+ data
+ nm
+ (fun () -> v := Some x)
in
-
+
(* Parse string value, if possible *)
let parse =
- match parse with
- | Some f ->
+ match parse with
+ | Some f ->
f
| None ->
fun ?context s ->
- failwith
- (Printf.sprintf
+ 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
@@ -468,20 +543,20 @@ module PropList = struct
| None ->
fun _ -> raise (No_printer nm)
in
-
+
(* Get data, as a string *)
let gets data =
print (get data)
in
-
- begin
- match schema with
+
+ begin
+ match schema with
| Some t ->
Schema.add t nm sets gets extra help
| None ->
()
end;
-
+
{
set = set;
get = get;
@@ -490,94 +565,84 @@ module PropList = struct
help = help;
extra = extra;
}
-
- let fset data t ?context x =
+
+ 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
-
+ t.gets data
+
end
-
+
module FieldRO =
struct
-
+
let create ?schema ?name ?parse ?print ?default ?update ?help extra =
- let fld =
+ 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 "/build/buildd/oasis-0.2.0/src/oasis/OASISMessage.ml"
-
-
+(* # 21 "/build/buildd/oasis-0.3.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
+ let cond =
+ if ctxt.quiet then
+ false
+ else
+ match lvl with
+ | `Debug -> ctxt.debug
+ | `Info -> ctxt.info
+ | _ -> true
in
- Printf.ksprintf
- (fun str ->
+ 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 =
+
+ 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 "/build/buildd/oasis-0.2.0/src/oasis/OASISVersion.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISVersion.ml" *)
+
open OASISGettext
-
-
-
+
+
+
type s = string
-
+
type t = string
-
- type comparator =
+
+ type comparator =
| VGreater of t
| VGreaterEqual of t
| VEqual of t
@@ -586,77 +651,81 @@ module OASISVersion = struct
| 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
+ function
| '.' | '+' | '-' | '~' -> true
| _ -> false
-
+
let rec version_compare v1 v2 =
if v1 <> "" || v2 <> "" then
begin
- (* Compare ascii string, using special meaning for version
+ (* Compare ascii string, using special meaning for version
* related char
*)
- let val_ascii c =
+ 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 compare_vascii () =
let cmp = ref 0 in
- while !cmp = 0 &&
- !p < len1 && !p < len2 &&
- not (is_digit v1.[!p] && is_digit v2.[!p]) do
+ 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]
+ 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 compare_digit () =
let extract_int v p =
let start_p = !p in
- while !p < String.length v && is_digit v.[!p] do
+ 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)
+ let substr =
+ String.sub v !p ((String.length v) - !p)
+ in
+ let res =
+ match String.sub v start_p (!p - start_p) with
+ | "" -> 0
+ | s -> int_of_string s
+ in
+ res, substr
in
let i1, tl1 = extract_int v1 (ref !p) in
let i2, tl2 = extract_int v2 (ref !p) in
i1 - i2, tl1, tl2
in
-
+
match compare_vascii () with
| 0 ->
begin
- match compare_digit () with
+ match compare_digit () with
| 0, tl1, tl2 ->
if tl1 <> "" && is_digit tl1.[0] then
1
@@ -674,33 +743,21 @@ module OASISVersion = struct
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 '.'
+
+
+ let version_of_string str = str
+
+ let string_of_version t = t
+
+ let chop t =
+ try
+ let pos =
+ String.rindex t '.'
in
String.sub t 0 pos
with Not_found ->
t
-
+
let rec comparator_apply v op =
match op with
| VGreater cv ->
@@ -717,27 +774,27 @@ module OASISVersion = struct
(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
+ 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) ->
+ | VOr (c1, c2) ->
(string_of_comparator c1)^" || "^(string_of_comparator c2)
- | VAnd (c1, c2) ->
+ | VAnd (c1, c2) ->
(string_of_comparator c1)^" && "^(string_of_comparator c2)
-
+
let rec varname_of_comparator =
- let concat p v =
+ let concat p v =
OASISUtils.varname_concat
- p
- (OASISUtils.varname_of_string
+ p
+ (OASISUtils.varname_of_string
(string_of_version v))
in
- function
+ function
| VGreater v -> concat "gt" v
| VLesser v -> concat "lt" v
| VEqual v -> concat "eq" v
@@ -747,53 +804,63 @@ module OASISVersion = struct
(varname_of_comparator c1)^"_or_"^(varname_of_comparator c2)
| VAnd (c1, c2) ->
(varname_of_comparator c1)^"_and_"^(varname_of_comparator c2)
-
+
+ let version_0_3_or_after t =
+ comparator_apply t (VGreaterEqual (string_of_version "0.3"))
+
end
module OASISLicense = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISLicense.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISLicense.ml" *)
+
(** License for _oasis fields
@author Sylvain Le Gall
*)
-
-
-
+
+
+
type license = string
-
+
type license_exception = string
-
- type license_version =
+
+ 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 license_dep_5_unit =
+ {
+ license: license;
+ excption: license_exception option;
+ version: license_version;
+ }
+
+
+ type license_dep_5 =
+ | DEP5Unit of license_dep_5_unit
+ | DEP5Or of license_dep_5 list
+ | DEP5And of license_dep_5 list
+
+
type t =
| DEP5License of license_dep_5
| OtherLicense of string (* URL *)
-
+
end
module OASISExpr = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISExpr.ml"
-
-
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISExpr.ml" *)
+
+
+
open OASISGettext
-
+
type test = string
-
+
type flag = string
-
+
type t =
| EBool of bool
| ENot of t
@@ -802,31 +869,31 @@ module OASISExpr = struct
| EFlag of flag
| ETest of test * string
-
+
type 'a choices = (t * 'a) list
-
+
let eval var_get t =
- let rec eval' =
+ let rec eval' =
function
| EBool b ->
b
-
- | ENot e ->
+
+ | ENot e ->
not (eval' e)
-
+
| EAnd (e1, e2) ->
(eval' e1) && (eval' e2)
-
- | EOr (e1, 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
@@ -834,21 +901,21 @@ module OASISExpr = struct
(v = vl)
in
eval' t
-
+
let choose ?printer ?name var_get lst =
- let rec choose_aux =
+ let rec choose_aux =
function
| (cond, vl) :: tl ->
- if eval var_get cond then
- vl
+ if eval var_get cond then
+ vl
else
choose_aux tl
| [] ->
- let str_lst =
+ let str_lst =
if lst = [] then
s_ "<empty>"
else
- String.concat
+ String.concat
(s_ ", ")
(List.map
(fun (cond, vl) ->
@@ -857,10 +924,10 @@ module OASISExpr = struct
| None -> s_ "<no printer>")
lst)
in
- match name with
+ match name with
| Some nm ->
failwith
- (Printf.sprintf
+ (Printf.sprintf
(f_ "No result for the choice list '%s': %s")
nm str_lst)
| None ->
@@ -870,15 +937,15 @@ module OASISExpr = struct
str_lst)
in
choose_aux (List.rev lst)
-
+
end
module OASISTypes = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISTypes.ml"
-
-
-
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISTypes.ml" *)
+
+
+
+
type name = string
type package_name = string
type url = string
@@ -890,47 +957,47 @@ module OASISTypes = struct
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 =
+
+ type dependency =
| FindlibPackage of findlib_full * OASISVersion.comparator option
| InternalLibrary of name
-
+
type tool =
| ExternalTool of name
- | InternalExecutable of name
+ | InternalExecutable of name
-
- type vcs =
- | Darcs
- | Git
- | Svn
- | Cvs
- | Hg
- | Bzr
- | Arch
+
+ type vcs =
+ | Darcs
+ | Git
+ | Svn
+ | Cvs
+ | Hg
+ | Bzr
+ | Arch
| Monotone
| OtherVCS of url
-
- type plugin_kind =
- [ `Configure
- | `Build
- | `Doc
- | `Test
- | `Install
+
+ type plugin_kind =
+ [ `Configure
+ | `Build
+ | `Doc
+ | `Test
+ | `Install
| `Extra
]
-
+
type plugin_data_purpose =
[ `Configure
| `Build
@@ -944,24 +1011,24 @@ module OASISTypes = struct
| `Extra
| `Other of string
]
-
+
type 'a plugin = 'a * name * OASISVersion.t option
-
- type all_plugin = plugin_kind plugin
-
+
+ type all_plugin = plugin_kind plugin
+
type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list
-
-# 102 "/build/buildd/oasis-0.2.0/src/oasis/OASISTypes.ml"
-
+
+(* # 102 "/build/buildd/oasis-0.3.0/src/oasis/OASISTypes.ml" *)
+
type 'a conditional = 'a OASISExpr.choices
-
- type custom =
+
+ type custom =
{
pre_command: (command_line option) conditional;
- post_command: (command_line option) conditional;
+ post_command: (command_line option) conditional;
}
-
+
type common_section =
{
cs_name: name;
@@ -969,7 +1036,7 @@ module OASISTypes = struct
cs_plugin_data: plugin_data;
}
-
+
type build_section =
{
bs_build: bool conditional;
@@ -988,29 +1055,30 @@ module OASISTypes = struct
bs_nativeopt: args conditional;
}
-
- type library =
+
+ type library =
{
lib_modules: string list;
+ lib_pack: bool;
lib_internal_modules: string list;
lib_findlib_parent: findlib_name option;
lib_findlib_name: findlib_name option;
lib_findlib_containers: findlib_name list;
}
-
- type executable =
+
+ type executable =
{
exec_custom: bool;
exec_main_is: unix_filename;
}
-
- type flag =
+
+ type flag =
{
flag_description: string option;
flag_default: bool conditional;
}
-
- type source_repository =
+
+ type source_repository =
{
src_repo_type: vcs;
src_repo_location: url;
@@ -1020,8 +1088,8 @@ module OASISTypes = struct
src_repo_tag: string option;
src_repo_subdir: unix_filename option;
}
-
- type test =
+
+ type test =
{
test_type: [`Test] plugin;
test_command: command_line conditional;
@@ -1030,7 +1098,7 @@ module OASISTypes = struct
test_run: bool conditional;
test_tools: tool list;
}
-
+
type doc_format =
| HTML of unix_filename
| DocText
@@ -1040,7 +1108,7 @@ module OASISTypes = struct
| DVI
| OtherDoc
-
+
type doc =
{
doc_type: [`Doc] plugin;
@@ -1055,7 +1123,7 @@ module OASISTypes = struct
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
@@ -1064,7 +1132,10 @@ module OASISTypes = struct
| Test of common_section * test
| Doc of common_section * doc
-
+
+ type section_kind =
+ [ `Library | `Executable | `Flag | `SrcRepo | `Test | `Doc ]
+
type package =
{
oasis_version: OASISVersion.t;
@@ -1081,50 +1152,54 @@ module OASISTypes = struct
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 "/build/buildd/oasis-0.2.0/src/oasis/OASISUnixPath.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.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
+
+ let is_current_dir fn =
+ fn = current_dir_name || fn = ""
+
+ let concat f1 f2 =
+ if is_current_dir f1 then
f2
- else if f2 = current_dir_name then
- f1
else
- f1^"/"^f2
-
+ let f1' =
+ try OASISString.strip_ends_with ~what:"/" f1 with Not_found -> f1
+ in
+ f1'^"/"^f2
+
let make =
function
| hd :: tl ->
@@ -1134,31 +1209,31 @@ module OASISUnixPath = struct
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
+ 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
+ try
let last_dot =
String.rindex f '.'
in
let sub =
String.sub f 0 last_dot
in
- try
+ try
let last_slash =
String.rindex f '/'
in
@@ -1168,51 +1243,87 @@ module OASISUnixPath = struct
f
with Not_found ->
sub
-
+
with Not_found ->
f
-
+
+ let capitalize_file f =
+ let dir = dirname f in
+ let base = basename f in
+ concat dir (String.capitalize base)
+
+ let uncapitalize_file f =
+ let dir = dirname f in
+ let base = basename f in
+ concat dir (String.uncapitalize base)
+
+end
+
+module OASISHostPath = struct
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISHostPath.ml" *)
+
+
+ open Filename
+
+ module Unix = OASISUnixPath
+
+ let make =
+ function
+ | [] ->
+ invalid_arg "OASISHostPath.make"
+ | hd :: tl ->
+ List.fold_left Filename.concat hd tl
+
+ let of_unix ufn =
+ if Sys.os_type = "Unix" then
+ ufn
+ else
+ make
+ (List.map
+ (fun p ->
+ if p = Unix.current_dir_name then
+ current_dir_name
+ else if p = Unix.parent_dir_name then
+ parent_dir_name
+ else
+ p)
+ (OASISString.nsplit ufn '/'))
+
+
end
module OASISSection = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISSection.ml"
-
- (** Manipulate section
- @author Sylvain Le Gall
- *)
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISSection.ml" *)
+
open OASISTypes
-
- type section_kind =
- | KLibrary
- | KExecutable
- | KFlag
- | KSrcRepo
- | KTest
- | KDoc
-
- (** Extract generic information
- *)
+
let section_kind_common =
function
| Library (cs, _, _) ->
- KLibrary, cs
+ `Library, cs
| Executable (cs, _, _) ->
- KExecutable, cs
+ `Executable, cs
| Flag (cs, _) ->
- KFlag, cs
+ `Flag, cs
| SrcRepo (cs, _) ->
- KSrcRepo, cs
+ `SrcRepo, cs
| Test (cs, _) ->
- KTest, cs
+ `Test, cs
| Doc (cs, _) ->
- KDoc, cs
-
- (** Common section of a section
- *)
+ `Doc, cs
+
let section_common sct =
snd (section_kind_common sct)
-
+
+ let section_common_set cs =
+ function
+ | Library (_, bs, lib) -> Library (cs, bs, lib)
+ | Executable (_, bs, exec) -> Executable (cs, bs, exec)
+ | Flag (_, flg) -> Flag (cs, flg)
+ | SrcRepo (_, src_repo) -> SrcRepo (cs, src_repo)
+ | Test (_, tst) -> Test (cs, tst)
+ | Doc (_, doc) -> Doc (cs, doc)
+
(** Key used to identify section
*)
let section_id sct =
@@ -1220,32 +1331,56 @@ module OASISSection = struct
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")
+ | `Library -> "library"
+ | `Executable -> "executable"
+ | `Flag -> "flag"
+ | `SrcRepo -> "src repository"
+ | `Test -> "test"
+ | `Doc -> "doc")
^" "^nm
-
+
+ let section_find id scts =
+ List.find
+ (fun sct -> id = section_id sct)
+ scts
+
+ module CSection =
+ struct
+ type t = section
+
+ let id = section_id
+
+ let compare t1 t2 =
+ compare (id t1) (id t2)
+
+ let equal t1 t2 =
+ (id t1) = (id t2)
+
+ let hash t =
+ Hashtbl.hash (id t)
+ end
+
+ module MapSection = Map.Make(CSection)
+ module SetSection = Set.Make(CSection)
+
end
module OASISBuildSection = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISBuildSection.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISBuildSection.ml" *)
+
end
module OASISExecutable = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISExecutable.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISExecutable.ml" *)
+
open OASISTypes
-
+
let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program =
let dir =
OASISUnixPath.concat
@@ -1258,321 +1393,765 @@ module OASISExecutable = struct
| 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 ()))
+ Some (dir^"/dll"^cs.cs_name^"_stubs"^(ext_dll ()))
else
None
-
+
end
module OASISLibrary = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISLibrary.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISLibrary.ml" *)
+
open OASISTypes
open OASISUtils
open OASISGettext
-
+ open OASISSection
+
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 =
+ type findlib_part_name = name
+ type 'a map_of_findlib_part_name = 'a OASISUtils.MapString.t
+
+ exception InternalLibraryNotFound of library_name
+ exception FindlibPackageNotFound of findlib_name
+
+ type group_t =
+ | Container of findlib_name * group_t list
+ | Package of (findlib_name *
+ common_section *
+ build_section *
+ library *
+ group_t list)
+
+ (* Look for a module file, considering capitalization or not. *)
+ let find_module source_file_exists (cs, bs, lib) modul =
+ let possible_base_fn =
+ List.map
+ (OASISUnixPath.concat bs.bs_path)
+ [modul;
+ OASISUnixPath.uncapitalize_file modul;
+ OASISUnixPath.capitalize_file modul]
+ in
+ (* TODO: we should be able to be able to determine the source for every
+ * files. Hence we should introduce a Module(source: fn) for the fields
+ * Modules and InternalModules
+ *)
List.fold_left
- (fun 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)
+ (fun acc base_fn ->
+ match acc with
+ | `No_sources _ ->
+ begin
+ let file_found =
+ List.fold_left
+ (fun acc ext ->
+ if source_file_exists (base_fn^ext) then
+ (base_fn^ext) :: acc
+ else
+ acc)
+ []
+ [".ml"; ".mli"; ".mll"; ".mly"]
+ in
+ match file_found with
+ | [] ->
+ acc
+ | lst ->
+ `Sources (base_fn, lst)
+ end
+ | `Sources _ ->
+ acc)
+ (`No_sources possible_base_fn)
+ possible_base_fn
+
+ let source_unix_files ~ctxt (cs, bs, lib) source_file_exists =
+ List.fold_left
+ (fun acc modul ->
+ match find_module source_file_exists (cs, bs, lib) modul with
+ | `Sources (base_fn, lst) ->
+ (base_fn, lst) :: acc
+ | `No_sources _ ->
+ OASISMessage.warning
+ ~ctxt
+ (f_ "Cannot find source file matching \
+ module '%s' in library %s")
+ modul cs.cs_name;
+ acc)
+ []
+ (lib.lib_modules @ lib.lib_internal_modules)
+
+ let generated_unix_files
+ ~ctxt
+ ~is_native
+ ~has_native_dynlink
+ ~ext_lib
+ ~ext_dll
+ ~source_file_exists
+ (cs, bs, lib) =
+
+ let find_modules lst ext =
+ let find_module modul =
+ match find_module source_file_exists (cs, bs, lib) modul with
+ | `Sources (base_fn, _) ->
+ [base_fn]
+ | `No_sources lst ->
+ OASISMessage.warning
+ ~ctxt
+ (f_ "Cannot find source file matching \
+ module '%s' in library %s")
+ modul cs.cs_name;
+ lst
+ in
+ List.map
+ (fun nm ->
+ List.map
+ (fun base_fn -> base_fn ^"."^ext)
+ (find_module nm))
+ lst
+ in
+
+ (* The headers that should be compiled along *)
+ let headers =
+ if lib.lib_pack then
[]
- lib.lib_modules
+ else
+ find_modules
+ lib.lib_modules
+ "cmi"
+ in
+
+ (* The .cmx that be compiled along *)
+ let cmxs =
+ let should_be_built =
+ (not lib.lib_pack) && (* Do not install .cmx packed submodules *)
+ match bs.bs_compiled_object with
+ | Native -> true
+ | Best -> is_native
+ | Byte -> false
+ in
+ if should_be_built then
+ find_modules
+ (lib.lib_modules @ lib.lib_internal_modules)
+ "cmx"
+ else
+ []
in
-
+
let acc_nopath =
[]
in
-
+
(* Compute what libraries should be built *)
let acc_nopath =
+ (* Add the packed header file if required *)
+ let add_pack_header acc =
+ if lib.lib_pack then
+ [cs.cs_name^".cmi"] :: acc
+ else
+ acc
+ in
let byte acc =
- [cs.cs_name^".cma"] :: acc
+ add_pack_header ([cs.cs_name^".cma"] :: acc)
in
let native acc =
- [cs.cs_name^".cmxa"] :: [cs.cs_name^(ext_lib ())] :: acc
+ let acc =
+ add_pack_header
+ (if has_native_dynlink then
+ [cs.cs_name^".cmxs"] :: acc
+ else acc)
+ in
+ [cs.cs_name^".cmxa"] :: [cs.cs_name^ext_lib] :: acc
in
- match bs.bs_compiled_object with
+ match bs.bs_compiled_object with
| Native ->
byte (native acc_nopath)
- | Best when is_native () ->
+ | Best when is_native ->
byte (native acc_nopath)
| Byte | Best ->
byte acc_nopath
in
-
+
(* Add C library to be built *)
- let acc_nopath =
+ let acc_nopath =
if bs.bs_c_sources <> [] then
begin
- ["lib"^cs.cs_name^(ext_lib ())]
+ ["lib"^cs.cs_name^"_stubs"^ext_lib]
::
- ["dll"^cs.cs_name^(ext_dll ())]
+ ["dll"^cs.cs_name^"_stubs"^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 =
+ (headers @ cmxs)
+
+ type data = common_section * build_section * library
+ type tree =
+ | Node of (data option) * (tree MapString.t)
+ | Leaf of data
+
+ let findlib_mapping pkg =
+ (* Map from library name to either full findlib name or parts + parent. *)
+ let fndlb_parts_of_lib_name =
+ let fndlb_parts cs lib =
+ let name =
+ match lib.lib_findlib_name with
+ | Some nm -> nm
+ | None -> cs.cs_name
+ in
+ let name =
+ String.concat "." (lib.lib_findlib_containers @ [name])
+ in
+ name
+ in
+ List.fold_left
+ (fun mp ->
+ function
+ | Library (cs, _, lib) ->
+ begin
+ let lib_name = cs.cs_name in
+ let fndlb_parts = fndlb_parts cs lib in
+ if MapString.mem lib_name mp then
+ failwithf
+ (f_ "The library name '%s' is used more than once.")
+ lib_name;
+ match lib.lib_findlib_parent with
+ | Some lib_name_parent ->
+ MapString.add
+ lib_name
+ (`Unsolved (lib_name_parent, fndlb_parts))
+ mp
+ | None ->
+ MapString.add
+ lib_name
+ (`Solved fndlb_parts)
+ mp
+ end
+
+ | Executable _ | Test _ | Flag _ | SrcRepo _ | Doc _ ->
+ mp)
+ MapString.empty
+ pkg.sections
+ in
+
+ (* Solve the above graph to be only library name to full findlib name. *)
+ let fndlb_name_of_lib_name =
+ let rec solve visited mp lib_name lib_name_child =
+ if SetString.mem lib_name visited then
+ failwithf
+ (f_ "Library '%s' is involved in a cycle \
+ with regard to findlib naming.")
+ lib_name;
+ let visited = SetString.add lib_name visited in
+ try
+ match MapString.find lib_name mp with
+ | `Solved fndlb_nm ->
+ fndlb_nm, mp
+ | `Unsolved (lib_nm_parent, post_fndlb_nm) ->
+ let pre_fndlb_nm, mp =
+ solve visited mp lib_nm_parent lib_name
+ in
+ let fndlb_nm = pre_fndlb_nm^"."^post_fndlb_nm in
+ fndlb_nm, MapString.add lib_name (`Solved fndlb_nm) mp
+ with Not_found ->
+ failwithf
+ (f_ "Library '%s', which is defined as the findlib parent of \
+ library '%s', doesn't exist.")
+ lib_name lib_name_child
+ in
+ let mp =
+ MapString.fold
+ (fun lib_name status mp ->
+ match status with
+ | `Solved _ ->
+ (* Solved initialy, no need to go further *)
+ mp
+ | `Unsolved _ ->
+ let _, mp = solve SetString.empty mp lib_name "<none>" in
+ mp)
+ fndlb_parts_of_lib_name
+ fndlb_parts_of_lib_name
+ in
+ MapString.map
+ (function
+ | `Solved fndlb_nm -> fndlb_nm
+ | `Unsolved _ -> assert false)
+ mp
+ in
+
+ (* Convert an internal library name to a findlib name. *)
+ let findlib_name_of_library_name lib_nm =
+ try
+ MapString.find lib_nm fndlb_name_of_lib_name
+ with Not_found ->
+ raise (InternalLibraryNotFound lib_nm)
+ in
+
+ (* Add a library to the tree.
+ *)
+ let add sct mp =
+ let fndlb_fullname =
+ let cs, _, _ = sct in
+ let lib_name = cs.cs_name in
+ findlib_name_of_library_name lib_name
+ in
+ let rec add_children nm_lst (children : tree MapString.t) =
+ match nm_lst with
+ | (hd :: tl) ->
+ begin
+ let node =
+ try
+ add_node tl (MapString.find hd children)
+ with Not_found ->
+ (* New node *)
+ new_node tl
+ in
+ MapString.add hd node children
+ end
+ | [] ->
+ (* Should not have a nameless library. *)
+ assert false
+ and add_node tl node =
+ if tl = [] then
+ begin
+ match node with
+ | Node (None, children) ->
+ Node (Some sct, children)
+ | Leaf (cs', _, _) | Node (Some (cs', _, _), _) ->
+ (* TODO: allow to merge Package, i.e.
+ * archive(byte) = "foo.cma foo_init.cmo"
+ *)
+ let cs, _, _ = sct in
+ failwithf
+ (f_ "Library '%s' and '%s' have the same findlib name '%s'")
+ cs.cs_name cs'.cs_name fndlb_fullname
+ end
+ else
+ begin
+ match node with
+ | Leaf data ->
+ Node (Some data, add_children tl MapString.empty)
+ | Node (data_opt, children) ->
+ Node (data_opt, add_children tl children)
+ end
+ and new_node =
+ function
+ | [] ->
+ Leaf sct
+ | hd :: tl ->
+ Node (None, MapString.add hd (new_node tl) MapString.empty)
+ in
+ add_children (OASISString.nsplit fndlb_fullname '.') mp
+ in
+
+ let rec group_of_tree mp =
+ MapString.fold
+ (fun nm node acc ->
+ let cur =
+ match node with
+ | Node (Some (cs, bs, lib), children) ->
+ Package (nm, cs, bs, lib, group_of_tree children)
+ | Node (None, children) ->
+ Container (nm, group_of_tree children)
+ | Leaf (cs, bs, lib) ->
+ Package (nm, cs, bs, lib, [])
+ in
+ cur :: acc)
+ mp []
+ in
+
+ let group_mp =
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
+ add (cs, bs, lib) mp
| _ ->
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 ->
- []))
+
+ let groups =
+ group_of_tree group_mp
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
+
+ let library_name_of_findlib_name =
+ Lazy.lazy_from_fun
+ (fun () ->
+ (* Revert findlib_name_of_library_name. *)
+ MapString.fold
+ (fun k v mp -> MapString.add v k mp)
+ fndlb_name_of_lib_name
+ MapString.empty)
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
+ let library_name_of_findlib_name fndlb_nm =
+ try
+ MapString.find fndlb_nm (Lazy.force library_name_of_findlib_name)
+ with Not_found ->
+ raise (FindlibPackageNotFound fndlb_nm)
in
- 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 =
+
+ groups,
+ findlib_name_of_library_name,
+ library_name_of_findlib_name
+
+ let findlib_of_group =
function
- | Container (fndlb_nm, _)
+ | 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 =
+ (* We do a DFS in the group. *)
function
- | [] ->
- raise Not_found
- | hd :: tl ->
- try
- root_lib_aux hd
- with Not_found ->
- root_lib_lst tl
+ | Container (_, children) ->
+ List.fold_left
+ (fun res grp ->
+ if res = None then
+ root_lib_aux grp
+ else
+ res)
+ None
+ children
+ | Package (_, cs, bs, lib, _) ->
+ Some (cs, bs, lib)
in
- try
- root_lib_aux grp
- with Not_found ->
- failwithf1
- (f_ "Unable to determine root library of findlib library '%s'")
- (findlib_of_group grp)
-
-
+ match root_lib_aux grp with
+ | Some res ->
+ res
+ | None ->
+ failwithf
+ (f_ "Unable to determine root library of findlib library '%s'")
+ (findlib_of_group grp)
+
end
module OASISFlag = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISFlag.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISFlag.ml" *)
+
end
module OASISPackage = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISPackage.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISPackage.ml" *)
+
end
module OASISSourceRepository = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISSourceRepository.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISSourceRepository.ml" *)
+
end
module OASISTest = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISTest.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISTest.ml" *)
+
end
module OASISDocument = struct
-# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISDocument.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISDocument.ml" *)
+
+end
+
+module OASISExec = struct
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISExec.ml" *)
+
+ open OASISGettext
+ open OASISUtils
+ open OASISMessage
+
+ (* TODO: I don't like this quote, it is there because $(rm) foo expands to
+ * 'rm -f' foo...
+ *)
+ let run ~ctxt ?f_exit_code ?(quote=true) cmd args =
+ let cmd =
+ if quote then
+ if Sys.os_type = "Win32" then
+ if String.contains cmd ' ' then
+ (* Double the 1st double quote... win32... sigh *)
+ "\""^(Filename.quote cmd)
+ else
+ cmd
+ else
+ Filename.quote cmd
+ else
+ cmd
+ in
+ let cmdline =
+ String.concat " " (cmd :: args)
+ in
+ info ~ctxt (f_ "Running command '%s'") cmdline;
+ match f_exit_code, Sys.command cmdline with
+ | None, 0 -> ()
+ | None, i ->
+ failwithf
+ (f_ "Command '%s' terminated with error code %d")
+ cmdline i
+ | Some f, i ->
+ f i
+
+ let run_read_output ~ctxt ?f_exit_code cmd args =
+ let fn =
+ Filename.temp_file "oasis-" ".txt"
+ in
+ try
+ begin
+ let () =
+ run ~ctxt ?f_exit_code cmd (args @ [">"; Filename.quote fn])
+ in
+ let chn =
+ open_in fn
+ in
+ let routput =
+ ref []
+ in
+ begin
+ try
+ while true do
+ routput := (input_line chn) :: !routput
+ done
+ with End_of_file ->
+ ()
+ end;
+ close_in chn;
+ Sys.remove fn;
+ List.rev !routput
+ end
+ with e ->
+ (try Sys.remove fn with _ -> ());
+ raise e
+
+ let run_read_one_line ~ctxt ?f_exit_code cmd args =
+ match run_read_output ~ctxt ?f_exit_code cmd args with
+ | [fst] ->
+ fst
+ | lst ->
+ failwithf
+ (f_ "Command return unexpected output %S")
+ (String.concat "\n" lst)
+end
+
+module OASISFileUtil = struct
+(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISFileUtil.ml" *)
+
+ open OASISGettext
+
+ let file_exists_case fn =
+ let dirname = Filename.dirname fn in
+ let basename = Filename.basename fn in
+ if Sys.file_exists dirname then
+ if basename = Filename.current_dir_name then
+ true
+ else
+ List.mem
+ basename
+ (Array.to_list (Sys.readdir dirname))
+ else
+ false
+
+ let find_file ?(case_sensitive=true) 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
+ (if case_sensitive then
+ file_exists_case
+ else
+ Sys.file_exists)
+ alternatives
+
+ let which ~ctxt prg =
+ let path_sep =
+ match Sys.os_type with
+ | "Win32" ->
+ ';'
+ | _ ->
+ ':'
+ in
+ let path_lst = OASISString.nsplit (Sys.getenv "PATH") path_sep in
+ let exec_ext =
+ match Sys.os_type with
+ | "Win32" ->
+ "" :: (OASISString.nsplit (Sys.getenv "PATHEXT") path_sep)
+ | _ ->
+ [""]
+ in
+ find_file ~case_sensitive:false [path_lst; [prg]] exec_ext
+
+ (**/**)
+ let rec fix_dir dn =
+ (* Windows hack because Sys.file_exists "src\\" = false when
+ * Sys.file_exists "src" = true
+ *)
+ let ln =
+ String.length dn
+ in
+ if Sys.os_type = "Win32" && ln > 0 && dn.[ln - 1] = '\\' then
+ fix_dir (String.sub dn 0 (ln - 1))
+ else
+ dn
+
+ let q = Filename.quote
+ (**/**)
+
+ let cp ~ctxt ?(recurse=false) src tgt =
+ if recurse then
+ match Sys.os_type with
+ | "Win32" ->
+ OASISExec.run ~ctxt
+ "xcopy" [q src; q tgt; "/E"]
+ | _ ->
+ OASISExec.run ~ctxt
+ "cp" ["-r"; q src; q tgt]
+ else
+ OASISExec.run ~ctxt
+ (match Sys.os_type with
+ | "Win32" -> "copy"
+ | _ -> "cp")
+ [q src; q tgt]
+
+ let mkdir ~ctxt tgt =
+ OASISExec.run ~ctxt
+ (match Sys.os_type with
+ | "Win32" -> "md"
+ | _ -> "mkdir")
+ [q tgt]
+
+ let rec mkdir_parent ~ctxt f tgt =
+ let tgt =
+ fix_dir tgt
+ in
+ if Sys.file_exists tgt then
+ begin
+ if not (Sys.is_directory tgt) then
+ OASISUtils.failwithf
+ (f_ "Cannot create directory '%s', a file of the same name already \
+ exists")
+ tgt
+ end
+ else
+ begin
+ mkdir_parent ~ctxt f (Filename.dirname tgt);
+ if not (Sys.file_exists tgt) then
+ begin
+ f tgt;
+ mkdir ~ctxt tgt
+ end
+ end
+
+ let rmdir ~ctxt tgt =
+ if Sys.readdir tgt = [||] then
+ begin
+ match Sys.os_type with
+ | "Win32" ->
+ OASISExec.run ~ctxt "rd" [q tgt]
+ | _ ->
+ OASISExec.run ~ctxt "rm" ["-r"; q tgt]
+ end
+
+ let glob ~ctxt fn =
+ let basename =
+ Filename.basename fn
+ in
+ if String.length basename >= 2 &&
+ basename.[0] = '*' &&
+ basename.[1] = '.' then
+ begin
+ let ext_len =
+ (String.length basename) - 2
+ in
+ let ext =
+ String.sub basename 2 ext_len
+ in
+ let dirname =
+ Filename.dirname fn
+ in
+ Array.fold_left
+ (fun acc fn ->
+ try
+ let fn_ext =
+ String.sub
+ fn
+ ((String.length fn) - ext_len)
+ ext_len
+ in
+ if fn_ext = ext then
+ (Filename.concat dirname fn) :: acc
+ else
+ acc
+ with Invalid_argument _ ->
+ acc)
+ []
+ (Sys.readdir dirname)
+ end
+ else
+ begin
+ if file_exists_case fn then
+ [fn]
+ else
+ []
+ end
end
+# 2142 "setup.ml"
module BaseEnvLight = struct
-# 21 "/build/buildd/oasis-0.2.0/src/base/BaseEnvLight.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseEnvLight.ml" *)
+
module MapString = Map.Make(String)
-
+
type t = string MapString.t
-
+
let default_filename =
- Filename.concat
+ Filename.concat
(Sys.getcwd ())
"setup.data"
-
+
let load ?(allow_empty=false) ?(filename=default_filename) () =
if Sys.file_exists filename then
begin
@@ -1585,23 +2164,23 @@ module BaseEnvLight = struct
let line =
ref 1
in
- let st_line =
+ let st_line =
Stream.from
(fun _ ->
try
- match Stream.next st with
+ match Stream.next st with
| '\n' -> incr line; Some '\n'
| c -> Some c
with Stream.Failure -> None)
in
- let lexer =
+ let lexer =
Genlex.make_lexer ["="] st_line
in
let rec read_file mp =
- match Stream.npeek 3 lexer with
+ match Stream.npeek 3 lexer with
| [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] ->
- Stream.junk lexer;
- Stream.junk lexer;
+ Stream.junk lexer;
+ Stream.junk lexer;
Stream.junk lexer;
read_file (MapString.add nm value mp)
| [] ->
@@ -1624,127 +2203,93 @@ module BaseEnvLight = struct
end
else
begin
- failwith
- (Printf.sprintf
+ 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
+ Buffer.add_substitute
buff
- (fun var ->
- try
+ (fun var ->
+ try
var_expand (MapString.find var env)
with Not_found ->
- failwith
- (Printf.sprintf
+ failwith
+ (Printf.sprintf
"No variable %s defined when trying to expand %S."
- var
+ var
str))
str;
Buffer.contents buff
in
var_expand (MapString.find name env)
-
- let var_choose lst env =
+
+ let var_choose lst env =
OASISExpr.choose
(fun nm -> var_get nm env)
lst
end
+# 2240 "setup.ml"
module BaseContext = struct
-# 21 "/build/buildd/oasis-0.2.0/src/base/BaseContext.ml"
-
- open OASISContext
-
- let args = args
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseContext.ml" *)
+
+ open OASISContext
+
+ let args = args
+
let default = default
-
+
end
module BaseMessage = struct
-# 21 "/build/buildd/oasis-0.2.0/src/base/BaseMessage.ml"
-
- (** Message to user, overrid for Base
+(* # 21 "/build/buildd/oasis-0.3.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 "/build/buildd/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 "/build/buildd/oasis-0.2.0/src/base/BaseEnv.ml"
-
- open OASISTypes
+(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseEnv.ml" *)
+
open OASISGettext
open OASISUtils
open PropList
-
+
module MapString = BaseEnvLight.MapString
-
- type origin_t =
+
+ 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;
@@ -1753,45 +2298,45 @@ module BaseEnv = struct
arg_help: string option;
group: string option;
}
-
+
let schema =
Schema.create "environment"
-
+
(* Environment data *)
- let env =
+ let env =
Data.create ()
-
+
(* Environment data from file *)
- let env_from_file =
+ let env_from_file =
ref MapString.empty
-
+
(* Lexer for var *)
- let var_lxr =
+ let var_lxr =
Genlex.make_lexer []
-
+
let rec var_expand str =
let buff =
Buffer.create ((String.length str) * 2)
in
- Buffer.add_substitute
+ Buffer.add_substitute
buff
- (fun var ->
- try
- (* TODO: this is a quick hack to allow calling Test.Command
+ (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
+ * 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
+ match Stream.npeek 3 st with
| [Genlex.Ident "utoh"; Genlex.Ident nm] ->
- BaseFilePath.of_unix (var_get nm)
+ OASISHostPath.of_unix (var_get nm)
| [Genlex.Ident "utoh"; Genlex.String s] ->
- BaseFilePath.of_unix s
+ OASISHostPath.of_unix s
| [Genlex.Ident "ocaml_escaped"; Genlex.Ident nm] ->
String.escaped (var_get nm)
| [Genlex.Ident "ocaml_escaped"; Genlex.String s] ->
@@ -1799,18 +2344,18 @@ module BaseEnv = struct
| [Genlex.Ident nm] ->
var_get nm
| _ ->
- failwithf2
+ failwithf
(f_ "Unknown expression '%s' in variable expansion of %s.")
var
str
- with
+ with
| Unknown_field (_, _) ->
- failwithf2
+ failwithf
(f_ "No variable %s defined when trying to expand %S.")
- var
+ var
str
- | Stream.Error e ->
- failwithf3
+ | Stream.Error e ->
+ failwithf
(f_ "Syntax error when parsing '%s' when trying to \
expand %S: %s")
var
@@ -1818,59 +2363,59 @@ module BaseEnv = struct
e)
str;
Buffer.contents buff
-
+
and var_get name =
- let vl =
- try
+ let vl =
+ try
Schema.get schema env name
with Unknown_field _ as e ->
begin
- try
+ 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
+ OASISExpr.choose
?printer
?name
- var_get
+ var_get
lst
-
- let var_protect vl =
- let buff =
+
+ let var_protect vl =
+ let buff =
Buffer.create (String.length vl)
in
String.iter
- (function
+ (function
| '$' -> Buffer.add_string buff "\\$"
| c -> Buffer.add_char buff c)
vl;
Buffer.contents buff
-
- let var_define
- ?(hide=false)
- ?(dump=true)
+
+ let var_define
+ ?(hide=false)
+ ?(dump=true)
?short_desc
?(cli=CLINone)
?arg_help
- ?group
+ ?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);
+ OFileLoad, (fun () -> MapString.find name !env_from_file);
ODefault, dflt;
- OGetEnv, lazy (Sys.getenv name);
+ OGetEnv, (fun () -> Sys.getenv name);
]
in
-
- let extra =
+
+ let extra =
{
hide = hide;
dump = dump;
@@ -1879,17 +2424,17 @@ module BaseEnv = struct
group = group;
}
in
-
- (* Try to find a value that can be defined
+
+ (* Try to find a value that can be defined
*)
- let var_get_low lst =
+ let var_get_low lst =
let errors, res =
List.fold_left
- (fun (errors, res) (_, v) ->
+ (fun (errors, res) (o, v) ->
if res = None then
begin
- try
- errors, Some (Lazy.force v)
+ try
+ errors, Some (v ())
with
| Not_found ->
errors, res
@@ -1903,15 +2448,10 @@ module BaseEnv = struct
([], None)
(List.sort
(fun (o1, _) (o2, _) ->
- if o1 < o2 then
- 1
- else if o1 = o2 then
- 0
- else
- -1)
+ Pervasives.compare o2 o1)
lst)
in
- match res, errors with
+ match res, errors with
| Some v, _ ->
v
| None, [] ->
@@ -1919,126 +2459,138 @@ module BaseEnv = struct
| None, lst ->
raise (Not_set (name, Some (String.concat (s_ ", ") lst)))
in
-
+
let help =
- match short_desc with
+ match short_desc with
| Some fs -> Some fs
| None -> None
in
-
- let var_get_lst =
+
+ let var_get_lst =
FieldRO.create
~schema
~name
- ~parse:(fun ?(context=ODefault) s -> [context, lazy s])
+ ~parse:(fun ?(context=ODefault) s -> [context, fun () -> 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
+
+ let var_redefine
?hide
?dump
?short_desc
?cli
?arg_help
- ?group
- name
+ ?group
+ name
dflt =
if Schema.mem schema name then
begin
- Schema.set schema env ~context:ODefault name (Lazy.force dflt);
+ (* TODO: look suspsicious, we want to memorize dflt not dflt () *)
+ Schema.set schema env ~context:ODefault name (dflt ());
fun () -> var_get name
end
else
begin
- var_define
+ var_define
?hide
?dump
?short_desc
?cli
?arg_help
- ?group
- name
+ ?group
+ name
dflt
end
-
- let var_ignore (e : unit -> string) =
+
+ let var_ignore (e : unit -> string) =
()
-
+
let print_hidden =
- var_define
+ var_define
~hide:true
~dump:false
~cli:CLIAuto
~arg_help:"Print even non-printable variable. (debug)"
"print_hidden"
- (lazy "false")
-
+ (fun () -> "false")
+
let var_all () =
List.rev
(Schema.fold
- (fun acc nm def _ ->
+ (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 *)
+
+ let unload () =
env_from_file := MapString.empty;
Data.clear env
-
- let dump ?(filename=default_filename) () =
+
+ let dump ?(filename=default_filename) () =
let chn =
open_out_bin filename
in
- Schema.iter
- (fun nm def _ ->
+ let output nm value =
+ Printf.fprintf chn "%s=%S\n" nm value
+ in
+ let mp_todo =
+ (* Dump data from schema *)
+ Schema.fold
+ (fun mp_todo nm def _ ->
if def.dump then
begin
- try
+ try
let value =
- Schema.get
- schema
- env
+ Schema.get
+ schema
+ env
nm
in
- Printf.fprintf chn "%s = %S\n" nm value
+ output nm value
with Not_set _ ->
()
- end)
- schema;
+ end;
+ MapString.remove nm mp_todo)
+ !env_from_file
+ schema
+ in
+ (* Dump data defined outside of schema *)
+ MapString.iter output mp_todo;
+
+ (* End of the dump *)
close_out chn
-
+
let print () =
let printable_vars =
Schema.fold
- (fun acc nm def short_descr_opt ->
+ (fun acc nm def short_descr_opt ->
if not def.hide || bool_of_string (print_hidden ()) then
begin
- try
- let value =
- Schema.get
+ try
+ let value =
+ Schema.get
schema
env
nm
in
- let txt =
- match short_descr_opt with
+ let txt =
+ match short_descr_opt with
| Some s -> s ()
| None -> nm
in
@@ -2051,7 +2603,7 @@ module BaseEnv = struct
[]
schema
in
- let max_length =
+ let max_length =
List.fold_left max 0
(List.rev_map String.length
(List.rev_map fst printable_vars))
@@ -2059,17 +2611,14 @@ module BaseEnv = struct
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 ()
-
+
+ Printf.printf "\nConfiguration: \n";
+ List.iter
+ (fun (name,value) ->
+ Printf.printf "%s: %s %s\n" name (dot_pad name) value)
+ (List.rev printable_vars);
+ Printf.printf "\n%!"
+
let args () =
let arg_concat =
OASISUtils.varname_concat ~hyphen:'-'
@@ -2085,65 +2634,65 @@ module BaseEnv = struct
[
Arg.Set_string rvr;
Arg.Set_string rvl;
- Arg.Unit
- (fun () ->
- Schema.set
+ Arg.Unit
+ (fun () ->
+ Schema.set
schema
env
- ~context:OCommandLine
+ ~context:OCommandLine
!rvr
!rvl)
]
),
"var+val Override any configuration variable.";
-
+
]
@
- List.flatten
+ List.flatten
(Schema.fold
(fun acc name def short_descr_opt ->
- let var_set s =
- Schema.set
+ let var_set s =
+ Schema.set
schema
env
- ~context:OCommandLine
+ ~context:OCommandLine
name
s
in
-
- let arg_name =
+
+ let arg_name =
OASISUtils.varname_of_string ~hyphen:'-' name
in
-
+
let hlp =
- match short_descr_opt with
+ match short_descr_opt with
| Some txt -> txt ()
| None -> ""
in
-
+
let arg_hlp =
- match def.arg_help with
+ match def.arg_help with
| Some s -> s
| None -> "str"
in
-
- let default_value =
- try
- Printf.sprintf
+
+ let default_value =
+ try
+ Printf.sprintf
(f_ " [%s]")
(Schema.get
schema
env
name)
- with Not_set _ ->
+ with Not_set _ ->
""
in
-
- let args =
- match def.cli with
- | CLINone ->
+
+ let args =
+ match def.cli with
+ | CLINone ->
[]
- | CLIAuto ->
+ | CLIAuto ->
[
arg_concat "--" arg_name,
Arg.String var_set,
@@ -2156,23 +2705,21 @@ module BaseEnv = struct
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
- "");
- ]
+ let dflt =
+ if default_value = " [true]" then
+ s_ " [default: enabled]"
+ else
+ s_ " [default: disabled]"
+ in
+ [
+ arg_concat "--enable-" arg_name,
+ Arg.Unit (fun () -> var_set "true"),
+ Printf.sprintf (f_ " %s%s") hlp dflt;
+
+ arg_concat "--disable-" arg_name,
+ Arg.Unit (fun () -> var_set "false"),
+ Printf.sprintf (f_ " %s%s") hlp dflt
+ ]
| CLIUser lst ->
lst
in
@@ -2181,264 +2728,26 @@ module BaseEnv = struct
schema)
end
-module BaseExec = struct
-# 21 "/build/buildd/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 "/build/buildd/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 "/build/buildd/oasis-0.2.0/src/base/BaseArgExt.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.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'"))
+ (failwithf (f_ "Don't know what to do with arguments: '%s'"))
(s_ "configure options:")
- with
+ with
| Arg.Help txt ->
print_endline txt;
exit 0
@@ -2448,106 +2757,106 @@ module BaseArgExt = struct
end
module BaseCheck = struct
-# 21 "/build/buildd/oasis-0.2.0/src/base/BaseCheck.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.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))
-
+ prg
+ (fun () ->
+ let alternate =
+ List.fold_left
+ (fun res e ->
+ match res with
+ | Some _ ->
+ res
+ | None ->
+ try
+ Some (OASISFileUtil.which ~ctxt:!BaseContext.default e)
+ with Not_found ->
+ None)
+ None
+ prg_lst
+ in
+ match alternate with
+ | Some prg -> prg
+ | None -> raise Not_found)
+
let prog prg =
prog_best prg [prg]
-
- let prog_opt prg =
+
+ let prog_opt prg =
prog_best prg [prg^".opt"; prg]
-
- let ocamlfind =
+
+ let ocamlfind =
prog "ocamlfind"
-
- let version
- var_prefix
+
+ let version
+ var_prefix
cmp
- fversion
- () =
+ fversion
+ () =
(* Really compare version provided *)
- let var =
+ let var =
var_prefix^"_version_"^(OASISVersion.varname_of_comparator cmp)
in
- var_redefine
- ~hide:true
+ 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))
+ (fun () ->
+ let version_str =
+ match fversion () with
+ | "[Distributed with OCaml]" ->
+ begin
+ try
+ (var_get "ocaml_version")
+ with Not_found ->
+ warning
+ (f_ "Variable ocaml_version not defined, fallback \
+ to default");
+ Sys.ocaml_version
+ end
+ | res ->
+ res
+ in
+ let version =
+ OASISVersion.version_of_string version_str
+ in
+ if OASISVersion.comparator_apply version cmp then
+ version_str
+ else
+ failwithf
+ (f_ "Cannot satisfy version constraint on %s: %s (version: %s)")
+ var_prefix
+ (OASISVersion.string_of_comparator cmp)
+ version_str)
()
-
+
let package_version pkg =
- BaseExec.run_read_one_line
+ OASISExec.run_read_one_line ~ctxt:!BaseContext.default
(ocamlfind ())
["query"; "-format"; "%v"; pkg]
-
+
let package ?version_comparator pkg () =
let var =
- OASISUtils.varname_concat
- "pkg_"
+ OASISUtils.varname_concat
+ "pkg_"
(OASISUtils.varname_of_string pkg)
in
- let findlib_dir pkg =
- let dir =
- BaseExec.run_read_one_line
+ let findlib_dir pkg =
+ let dir =
+ OASISExec.run_read_one_line ~ctxt:!BaseContext.default
(ocamlfind ())
["query"; "-format"; "%d"; pkg]
in
if Sys.file_exists dir && Sys.is_directory dir then
dir
else
- failwithf2
+ failwithf
(f_ "When looking for findlib package %s, \
directory %s return doesn't exist")
pkg dir
@@ -2555,62 +2864,62 @@ module BaseCheck = struct
let vl =
var_redefine
var
- (lazy (findlib_dir pkg))
+ (fun () -> findlib_dir pkg)
()
in
(
- match version_comparator with
+ match version_comparator with
| Some ver_cmp ->
ignore
- (version
+ (version
var
ver_cmp
(fun _ -> package_version pkg)
())
- | None ->
+ | None ->
()
);
vl
end
module BaseOCamlcConfig = struct
-# 21 "/build/buildd/oasis-0.2.0/src/base/BaseOCamlcConfig.ml"
-
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseOCamlcConfig.ml" *)
+
+
open BaseEnv
open OASISUtils
open OASISGettext
-
+
module SMap = Map.Make(String)
-
- let ocamlc =
+
+ let ocamlc =
BaseCheck.prog_opt "ocamlc"
-
+
let ocamlc_config_map =
- (* Map name to value for ocamlc -config output
- (name ^": "^value)
+ (* Map name to value for ocamlc -config output
+ (name ^": "^value)
*)
- let rec split_field mp lst =
- match lst with
+ 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
+ if pos_semicolon > 1 then
(
let name =
- String.sub line 0 pos_semicolon
+ 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)
+ String.sub
+ line
+ (pos_semicolon + 2)
(linelen - pos_semicolon - 2)
else
""
@@ -2630,100 +2939,128 @@ module BaseOCamlcConfig = struct
| [] ->
mp
in
-
+
+ let cache =
+ lazy
+ (var_protect
+ (Marshal.to_string
+ (split_field
+ SMap.empty
+ (OASISExec.run_read_output
+ ~ctxt:!BaseContext.default
+ (ocamlc ()) ["-config"]))
+ []))
+ 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"]))
- [])))
-
+ (fun () ->
+ (* TODO: update if ocamlc change !!! *)
+ Lazy.force cache)
+
let var_define nm =
(* Extract data from ocamlc -config *)
- let avlbl_config_get () =
- Marshal.from_string
+ let avlbl_config_get () =
+ Marshal.from_string
(ocamlc_config_map ())
0
in
- let nm_config =
- match nm with
- | "ocaml_version" -> "version"
- | _ -> nm
+ let chop_version_suffix s =
+ try
+ String.sub s 0 (String.index s '+')
+ with _ ->
+ s
+ in
+
+ let nm_config, value_config =
+ match nm with
+ | "ocaml_version" ->
+ "version", chop_version_suffix
+ | _ -> nm, (fun x -> x)
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 ())))
-
+ nm
+ (fun () ->
+ try
+ let map =
+ avlbl_config_get ()
+ in
+ let value =
+ SMap.find nm_config map
+ in
+ value_config value
+ with Not_found ->
+ failwithf
+ (f_ "Cannot find field '%s' in '%s -config' output")
+ nm
+ (ocamlc ()))
+
end
module BaseStandardVar = struct
-# 21 "/build/buildd/oasis-0.2.0/src/base/BaseStandardVar.ml"
-
-
+(* # 21 "/build/buildd/oasis-0.3.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 =
+ let rpkg =
ref None
-
+
let pkg_get () =
- match !rpkg with
+ match !rpkg with
| Some pkg -> pkg
| None -> failwith (s_ "OASIS Package is not set")
+
+ let var_cond = ref []
+
+ let var_define_cond ~since_version f dflt =
+ let holder = ref (fun () -> dflt) in
+ let since_version =
+ OASISVersion.VGreaterEqual (OASISVersion.version_of_string since_version)
+ in
+ var_cond :=
+ (fun ver ->
+ if OASISVersion.comparator_apply ver since_version then
+ holder := f ()) :: !var_cond;
+ fun () -> !holder ()
+
(**/**)
-
- let pkg_name =
+
+ let pkg_name =
var_define
~short_desc:(fun () -> s_ "Package name")
"pkg_name"
- (lazy (pkg_get ()).name)
-
+ (fun () -> (pkg_get ()).name)
+
let pkg_version =
var_define
~short_desc:(fun () -> s_ "Package version")
"pkg_version"
- (lazy
+ (fun () ->
(OASISVersion.string_of_version (pkg_get ()).version))
-
- let c = BaseOCamlcConfig.var_define
-
+
+ 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"
@@ -2736,222 +3073,312 @@ module BaseStandardVar = struct
let ext_dll = c "ext_dll"
let default_executable_name = c "default_executable_name"
let systhread_supported = c "systhread_supported"
-
-
+
+ let flexlink =
+ BaseCheck.prog "flexlink"
+
+ let flexdll_version =
+ var_define
+ ~short_desc:(fun () -> "FlexDLL version (Win32)")
+ "flexdll_version"
+ (fun () ->
+ let lst =
+ OASISExec.run_read_output ~ctxt:!BaseContext.default
+ (flexlink ()) ["-help"]
+ in
+ match lst with
+ | line :: _ ->
+ Scanf.sscanf line "FlexDLL version %s" (fun ver -> ver)
+ | [] ->
+ raise Not_found)
+
(**/**)
- let p name hlp dflt =
+ let p name hlp dflt =
var_define
- ~short_desc:hlp
- ~cli:CLIAuto
- ~arg_help:"dir"
- name
- dflt
-
- let (/) a b =
+ ~short_desc:hlp
+ ~cli:CLIAuto
+ ~arg_help:"dir"
+ name
+ dflt
+
+ let (/) a b =
if os_type () = Sys.os_type then
- Filename.concat a b
+ Filename.concat a b
else if os_type () = "Unix" then
- BaseFilePath.Unix.concat a b
+ OASISUnixPath.concat a b
else
- OASISUtils.failwithf1
- (f_ "Cannot handle os_type %s filename concat")
+ OASISUtils.failwithf (f_ "Cannot handle os_type %s filename concat")
(os_type ())
(**/**)
-
- let prefix =
+
+ 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 =
+ (fun () ->
+ 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")
-
+ (fun () -> "$prefix")
+
let bindir =
p "bindir"
(fun () -> s_ "User executables")
- (lazy ("$exec_prefix"/"bin"))
-
+ (fun () -> "$exec_prefix"/"bin")
+
let sbindir =
p "sbindir"
(fun () -> s_ "System admin executables")
- (lazy ("$exec_prefix"/"sbin"))
-
+ (fun () -> "$exec_prefix"/"sbin")
+
let libexecdir =
p "libexecdir"
(fun () -> s_ "Program executables")
- (lazy ("$exec_prefix"/"libexec"))
-
+ (fun () -> "$exec_prefix"/"libexec")
+
let sysconfdir =
p "sysconfdir"
(fun () -> s_ "Read-only single-machine data")
- (lazy ("$prefix"/"etc"))
-
+ (fun () -> "$prefix"/"etc")
+
let sharedstatedir =
p "sharedstatedir"
(fun () -> s_ "Modifiable architecture-independent data")
- (lazy ("$prefix"/"com"))
-
+ (fun () -> "$prefix"/"com")
+
let localstatedir =
p "localstatedir"
(fun () -> s_ "Modifiable single-machine data")
- (lazy ("$prefix"/"var"))
-
+ (fun () -> "$prefix"/"var")
+
let libdir =
p "libdir"
(fun () -> s_ "Object code libraries")
- (lazy ("$exec_prefix"/"lib"))
-
+ (fun () -> "$exec_prefix"/"lib")
+
let datarootdir =
p "datarootdir"
(fun () -> s_ "Read-only arch-independent data root")
- (lazy ("$prefix"/"share"))
-
+ (fun () -> "$prefix"/"share")
+
let datadir =
p "datadir"
(fun () -> s_ "Read-only architecture-independent data")
- (lazy ("$datarootdir"))
-
+ (fun () -> "$datarootdir")
+
let infodir =
p "infodir"
(fun () -> s_ "Info documentation")
- (lazy ("$datarootdir"/"info"))
-
+ (fun () -> "$datarootdir"/"info")
+
let localedir =
p "localedir"
(fun () -> s_ "Locale-dependent data")
- (lazy ("$datarootdir"/"locale"))
-
+ (fun () -> "$datarootdir"/"locale")
+
let mandir =
p "mandir"
(fun () -> s_ "Man documentation")
- (lazy ("$datarootdir"/"man"))
-
+ (fun () -> "$datarootdir"/"man")
+
let docdir =
p "docdir"
(fun () -> s_ "Documentation root")
- (lazy ("$datarootdir"/"doc"/"$pkg_name"))
-
+ (fun () -> "$datarootdir"/"doc"/"$pkg_name")
+
let htmldir =
p "htmldir"
(fun () -> s_ "HTML documentation")
- (lazy ("$docdir"))
-
+ (fun () -> "$docdir")
+
let dvidir =
p "dvidir"
(fun () -> s_ "DVI documentation")
- (lazy ("$docdir"))
-
+ (fun () -> "$docdir")
+
let pdfdir =
p "pdfdir"
(fun () -> s_ "PDF documentation")
- (lazy ("$docdir"))
-
+ (fun () -> "$docdir")
+
let psdir =
p "psdir"
(fun () -> s_ "PS documentation")
- (lazy ("$docdir"))
-
+ (fun () -> "$docdir")
+
let destdir =
p "destdir"
(fun () -> s_ "Prepend a path when installing package")
- (lazy
- (raise
- (PropList.Not_set
- ("destdir",
- Some (s_ "undefined by construct")))))
-
+ (fun () ->
+ raise
+ (PropList.Not_set
+ ("destdir",
+ Some (s_ "undefined by construct"))))
+
let findlib_version =
var_define
"findlib_version"
- (lazy
- (BaseCheck.package_version "findlib"))
-
+ (fun () ->
+ 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"))
-
+ (fun () ->
+ 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"
- | _ -> ""
- ))
-
+ (fun () ->
+ 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"))
-
+ (fun () ->
+ 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"))
-
+ (fun () ->
+ match os_type () with
+ | "Win32" -> "rd"
+ | _ -> "rm -rf")
+
let debug =
var_define
- ~short_desc:(fun () -> s_ "Compile with ocaml debug flag on.")
+ ~short_desc:(fun () -> s_ "Turn ocaml debug flag on")
+ ~cli:CLIEnable
"debug"
- (lazy "true")
-
+ (fun () -> "true")
+
let profile =
var_define
- ~short_desc:(fun () -> s_ "Compile with ocaml profile flag on.")
+ ~short_desc:(fun () -> s_ "Turn ocaml profile flag on")
+ ~cli:CLIEnable
"profile"
- (lazy "false")
-
- let init pkg =
- rpkg := Some pkg
-
+ (fun () -> "false")
+
+ let tests =
+ var_define_cond ~since_version:"0.3"
+ (fun () ->
+ var_define
+ ~short_desc:(fun () ->
+ s_ "Compile tests executable and library and run them")
+ ~cli:CLIEnable
+ "tests"
+ (fun () -> "false"))
+ "true"
+
+ let docs =
+ var_define_cond ~since_version:"0.3"
+ (fun () ->
+ var_define
+ ~short_desc:(fun () -> s_ "Create documentations")
+ ~cli:CLIEnable
+ "docs"
+ (fun () -> "true"))
+ "true"
+
+ let native_dynlink =
+ var_define
+ ~short_desc:(fun () -> s_ "Compiler support generation of .cmxs.")
+ ~cli:CLINone
+ "native_dynlink"
+ (fun () ->
+ let res =
+ let ocaml_lt_312 () =
+ OASISVersion.comparator_apply
+ (OASISVersion.version_of_string (ocaml_version ()))
+ (OASISVersion.VLesser
+ (OASISVersion.version_of_string "3.12.0"))
+ in
+ let flexdll_lt_030 () =
+ OASISVersion.comparator_apply
+ (OASISVersion.version_of_string (flexdll_version ()))
+ (OASISVersion.VLesser
+ (OASISVersion.version_of_string "0.30"))
+ in
+ let has_native_dynlink =
+ let ocamlfind = ocamlfind () in
+ try
+ let fn =
+ OASISExec.run_read_one_line
+ ~ctxt:!BaseContext.default
+ ocamlfind
+ ["query"; "-predicates"; "native"; "dynlink";
+ "-format"; "%d/%a"]
+ in
+ Sys.file_exists fn
+ with _ ->
+ false
+ in
+ if not has_native_dynlink then
+ false
+ else if ocaml_lt_312 () then
+ false
+ else if (os_type () = "Win32" || os_type () = "Cygwin")
+ && flexdll_lt_030 () then
+ begin
+ BaseMessage.warning
+ (f_ ".cmxs generation disabled because FlexDLL needs to be \
+ at least 0.30. Please upgrade FlexDLL from %s to 0.30.")
+ (flexdll_version ());
+ false
+ end
+ else
+ true
+ in
+ string_of_bool res)
+
+ let init pkg =
+ rpkg := Some pkg;
+ List.iter (fun f -> f pkg.oasis_version) !var_cond
+
end
module BaseFileAB = struct
-# 21 "/build/buildd/oasis-0.2.0/src/base/BaseFileAB.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseFileAB.ml" *)
+
open BaseEnv
open OASISGettext
open BaseMessage
-
+
let to_filename fn =
let fn =
- BaseFilePath.of_unix fn
+ OASISHostPath.of_unix fn
in
if not (Filename.check_suffix fn ".ab") then
- warning
+ warning
(f_ "File '%s' doesn't have '.ab' extension")
fn;
Filename.chop_extension fn
-
+
let replace fn_lst =
let buff =
Buffer.create 13
@@ -2959,7 +3386,7 @@ module BaseFileAB = struct
List.iter
(fun fn ->
let fn =
- BaseFilePath.of_unix fn
+ OASISHostPath.of_unix fn
in
let chn_in =
open_in fn
@@ -2984,42 +3411,42 @@ module BaseFileAB = struct
end
module BaseLog = struct
-# 21 "/build/buildd/oasis-0.2.0/src/base/BaseLog.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseLog.ml" *)
+
open OASISUtils
-
+
let default_filename =
- Filename.concat
+ Filename.concat
(Filename.dirname BaseEnv.default_filename)
"setup.log"
-
+
module SetTupleString =
Set.Make
- (struct
+ (struct
type t = string * string
- let compare (s11, s12) (s21, s22) =
- match String.compare s11 s21 with
+ let compare (s11, s12) (s21, s22) =
+ match String.compare s11 s21 with
| 0 -> String.compare s12 s22
| n -> n
end)
-
- let load () =
+
+ let load () =
if Sys.file_exists default_filename then
begin
- let chn =
+ let chn =
open_in default_filename
in
- let scbuf =
+ 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 =
+ let acc =
+ try
+ Scanf.bscanf scbuf "%S %S\n"
+ (fun e d ->
+ let t =
e, d
in
if SetTupleString.mem t st then
@@ -3028,9 +3455,9 @@ module BaseLog = struct
SetTupleString.add t st,
t :: lst)
with Scanf.Scan_failure _ ->
- failwith
+ failwith
(Scanf.bscanf scbuf
- "%l"
+ "%l"
(fun line ->
Printf.sprintf
"Malformed log file '%s' at line %d"
@@ -3051,18 +3478,18 @@ module BaseLog = struct
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 =
+ let lst =
load ()
in
let chn_out =
@@ -3071,7 +3498,7 @@ module BaseLog = struct
let write_something =
ref false
in
- List.iter
+ List.iter
(fun (e, d) ->
if e <> event || d <> data then
begin
@@ -3083,19 +3510,19 @@ module BaseLog = struct
if not !write_something then
Sys.remove default_filename
end
-
+
let filter events =
let st_events =
List.fold_left
- (fun st e ->
+ (fun st e ->
SetString.add e st)
SetString.empty
events
in
- List.filter
+ List.filter
(fun (e, _) -> SetString.mem e st_events)
(load ())
-
+
let exists event data =
List.exists
(fun v -> (event, data) = v)
@@ -3103,47 +3530,47 @@ module BaseLog = struct
end
module BaseBuilt = struct
-# 21 "/build/buildd/oasis-0.2.0/src/base/BaseBuilt.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.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
+ (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 =
+
+ let register t nm lst =
BaseLog.register
(to_log_event_done t nm)
"true";
List.iter
(fun alt ->
- let registered =
+ let registered =
List.fold_left
(fun registered fn ->
- if Sys.file_exists fn then
+ if OASISFileUtil.file_exists_case fn then
begin
- BaseLog.register
+ BaseLog.register
(to_log_event_file t nm)
(if Filename.is_relative fn then
Filename.concat (Sys.getcwd ()) fn
- else
+ else
fn);
true
end
@@ -3157,31 +3584,31 @@ module BaseBuilt = struct
(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;
+ (BaseLog.filter
+ [to_log_event_file t nm;
to_log_event_done t nm])
-
- let fold t nm f acc =
- List.fold_left
+
+ let fold t nm f acc =
+ List.fold_left
(fun acc (_, fn) ->
- if Sys.file_exists fn then
+ if OASISFileUtil.file_exists_case fn then
begin
f acc fn
end
else
begin
- warning
+ warning
(f_ "File '%s' has been marked as built \
for %s but doesn't exist")
fn
(Printf.sprintf
- (match t with
- | BExec | BExecLib ->
+ (match t with
+ | BExec | BExecLib ->
(f_ "executable %s")
| BLib ->
(f_ "library %s")
@@ -3193,29 +3620,29 @@ module BaseBuilt = struct
acc
(BaseLog.filter
[to_log_event_file t nm])
-
+
let is_built t nm =
List.fold_left
(fun is_built (_, d) ->
- (try
+ (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
+
+ 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
+ (fun () ->
+ bool_of_string
(is_native ()))
ext_dll
ext_program
in
- let evs =
+ let evs =
(BExec, cs.cs_name, [[ffn unix_exec_is]])
::
(match unix_dll_opt with
@@ -3227,18 +3654,18 @@ module BaseBuilt = struct
evs,
unix_exec_is,
unix_dll_opt
-
- let of_library ffn (cs, bs, lib) =
- let unix_lst =
+
+ let of_library ffn (cs, bs, lib) =
+ let unix_lst =
OASISLibrary.generated_unix_files
~ctxt:!BaseContext.default
+ ~source_file_exists:(fun fn ->
+ OASISFileUtil.file_exists_case (OASISHostPath.of_unix fn))
+ ~is_native:(bool_of_string (is_native ()))
+ ~has_native_dynlink:(bool_of_string (native_dynlink ()))
+ ~ext_lib:(ext_lib ())
+ ~ext_dll:(ext_dll ())
(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,
@@ -3246,45 +3673,45 @@ module BaseBuilt = struct
List.map (List.map ffn) unix_lst]
in
evs, unix_lst
-
+
end
module BaseCustom = struct
-# 21 "/build/buildd/oasis-0.2.0/src/base/BaseCustom.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseCustom.ml" *)
+
open BaseEnv
open BaseMessage
open OASISTypes
open OASISGettext
-
+
let run cmd args extra_args =
- BaseExec.run
+ OASISExec.run ~ctxt:!BaseContext.default ~quote:false
(var_expand cmd)
- (List.map
+ (List.map
var_expand
(args @ (Array.to_list extra_args)))
-
+
let hook ?(failsafe=false) cstm f e =
- let optional_command lst =
+ let optional_command lst =
let printer =
- function
+ function
| Some (cmd, args) -> String.concat " " (cmd :: args)
| None -> s_ "No command"
in
- match
- var_choose
+ match
+ var_choose
~name:(s_ "Pre/Post Command")
- ~printer
- lst with
+ ~printer
+ lst with
| Some (cmd, args) ->
begin
- try
+ try
run cmd args [||]
with e when failsafe ->
- warning
+ warning
(f_ "Command '%s' fail with error: %s")
(String.concat " " (cmd :: args))
- (match e with
+ (match e with
| Failure msg -> msg
| e -> Printexc.to_string e)
end
@@ -3300,75 +3727,78 @@ module BaseCustom = struct
end
module BaseDynVar = struct
-# 21 "/build/buildd/oasis-0.2.0/src/base/BaseDynVar.ml"
-
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseDynVar.ml" *)
+
+
open OASISTypes
open OASISGettext
open BaseEnv
open BaseBuilt
-
+
let init pkg =
- List.iter
+ (* TODO: disambiguate exec vs other variable by adding exec_VARNAME. *)
+ (* TODO: provide compile option for library libary_byte_args_VARNAME... *)
+ List.iter
(function
| Executable (cs, bs, exec) ->
- 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))))))
-
+ if var_choose bs.bs_build then
+ var_ignore
+ (var_redefine
+ (* We don't save this variable *)
+ ~dump:false
+ ~short_desc:(fun () ->
+ Printf.sprintf
+ (f_ "Filename of executable '%s'")
+ cs.cs_name)
+ (OASISUtils.varname_of_string cs.cs_name)
+ (fun () ->
+ let fn_opt =
+ fold
+ BExec cs.cs_name
+ (fun _ fn -> Some fn)
+ None
+ in
+ match fn_opt with
+ | Some fn -> fn
+ | None ->
+ raise
+ (PropList.Not_set
+ (cs.cs_name,
+ Some (Printf.sprintf
+ (f_ "Executable '%s' not yet built.")
+ cs.cs_name)))))
+
| Library _ | Flag _ | Test _ | SrcRepo _ | Doc _ ->
())
pkg.sections
end
module BaseTest = struct
-# 21 "/build/buildd/oasis-0.2.0/src/base/BaseTest.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.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
+ if var_choose
~name:(Printf.sprintf
(f_ "test %s run")
cs.cs_name)
~printer:string_of_bool
test.test_run then
begin
- let () =
+ let () =
info (f_ "Running test '%s'") cs.cs_name
in
- let back_cwd =
- match test.test_working_directory with
- | Some dir ->
- let cwd =
+ let back_cwd =
+ match test.test_working_directory with
+ | Some dir ->
+ let cwd =
Sys.getcwd ()
in
let chdir d =
@@ -3377,16 +3807,16 @@ module BaseTest = struct
in
chdir dir;
fun () -> chdir cwd
-
- | None ->
+
+ | None ->
fun () -> ()
in
- try
+ try
let failure_percent =
- BaseCustom.hook
+ BaseCustom.hook
test.test_custom
(test_plugin pkg (cs, test))
- extra_args
+ extra_args
in
back_cwd ();
(failure_percent +. failure, n + 1)
@@ -3414,7 +3844,7 @@ module BaseTest = struct
else
failed /. (float_of_int n)
in
- let msg =
+ let msg =
Printf.sprintf
(f_ "Tests had a %.2f%% failure rate")
(100. *. failure_percent)
@@ -3422,23 +3852,31 @@ module BaseTest = struct
if failure_percent > 0.0 then
failwith msg
else
- info "%s" msg
+ info "%s" msg;
+
+ (* Possible explanation why the tests where not run. *)
+ if OASISVersion.version_0_3_or_after pkg.oasis_version &&
+ not (bool_of_string (BaseStandardVar.tests ())) &&
+ lst <> [] then
+ BaseMessage.warning
+ "Tests are turned off, consider enabling with \
+ 'ocaml setup.ml -configure --enable-tests'"
end
module BaseDoc = struct
-# 21 "/build/buildd/oasis-0.2.0/src/base/BaseDoc.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.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")
+
+ 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
@@ -3450,129 +3888,156 @@ module BaseDoc = struct
extra_args
end
in
- List.iter
- one_doc
- lst
+ List.iter one_doc lst;
+
+ if OASISVersion.version_0_3_or_after pkg.oasis_version &&
+ not (bool_of_string (BaseStandardVar.docs ())) &&
+ lst <> [] then
+ BaseMessage.warning
+ "Docs are turned off, consider enabling with \
+ 'ocaml setup.ml -configure --enable-docs'"
end
module BaseSetup = struct
-# 21 "/build/buildd/oasis-0.2.0/src/base/BaseSetup.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseSetup.ml" *)
+
open BaseEnv
open BaseMessage
open OASISTypes
open OASISSection
open OASISGettext
open OASISUtils
-
- type std_args_fun =
+
+ type std_args_fun =
package -> string array -> unit
-
- type ('a, 'b) section_args_fun =
+
+ 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;
- }
-
+ configure: std_args_fun;
+ build: std_args_fun;
+ doc: ((doc, unit) section_args_fun) list;
+ test: ((test, float) section_args_fun) list;
+ install: std_args_fun;
+ uninstall: std_args_fun;
+ clean: std_args_fun list;
+ clean_doc: (doc, unit) section_args_fun list;
+ clean_test: (test, unit) section_args_fun list;
+ distclean: std_args_fun list;
+ distclean_doc: (doc, unit) section_args_fun list;
+ distclean_test: (test, unit) section_args_fun list;
+ package: package;
+ oasis_fn: string option;
+ oasis_version: string;
+ oasis_digest: Digest.t option;
+ oasis_exec: string option;
+ oasis_setup_args: string list;
+ setup_update: bool;
+ }
+
(* Associate a plugin function with data from package *)
let join_plugin_sections filter_map lst =
List.rev
(List.fold_left
(fun acc sct ->
- match filter_map sct with
+ 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
+ try
List.assoc nm lst
with Not_found ->
- failwithf3
+ failwithf
(f_ "Cannot find plugin %s matching section %s for %s action")
plugin
nm
action
-
- let configure t args =
+
+ let configure t args =
(* Run configure *)
- BaseCustom.hook
+ BaseCustom.hook
t.package.conf_custom
- (t.configure t.package)
- args;
-
+ (fun () ->
+ (* Reload if preconf has changed it *)
+ begin
+ try
+ unload ();
+ load ();
+ with _ ->
+ ()
+ end;
+
+ (* Run plugin's configure *)
+ t.configure t.package args;
+
+ (* Dump to allow postconf to change it *)
+ dump ())
+ ();
+
(* Reload environment *)
unload ();
load ();
-
+
+ (* Save environment *)
+ print ();
+
(* 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"
+ (function
+ | Doc (cs, e) ->
+ Some
+ (lookup_plugin_section
+ "documentation"
(s_ "build")
- cs.cs_name
+ cs.cs_name
t.doc,
cs,
e)
- | _ ->
+ | _ ->
None)
t.package.sections)
t.package
args
-
- let test t args =
- BaseTest.test
+
+ let test t args =
+ BaseTest.test
(join_plugin_sections
- (function
- | Test (cs, e) ->
- Some
+ (function
+ | Test (cs, e) ->
+ Some
(lookup_plugin_section
"test"
(s_ "run")
- cs.cs_name
+ cs.cs_name
t.test,
cs,
e)
- | _ ->
+ | _ ->
None)
t.package.sections)
t.package
args
-
+
let all t args =
- let rno_doc =
+ let rno_doc =
ref false
in
let rno_test =
@@ -3580,30 +4045,30 @@ module BaseSetup = struct
in
Arg.parse_argv
~current:(ref 0)
- (Array.of_list
- ((Sys.executable_name^" all") ::
+ (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'"))
+ (failwithf (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";
@@ -3613,7 +4078,7 @@ module BaseSetup = struct
begin
info "Skipping doc step"
end;
-
+
if not !rno_test then
begin
info "Running test step";
@@ -3623,36 +4088,36 @@ module BaseSetup = struct
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 clean, distclean =
let failsafe f a =
- try
+ try
f a
with e ->
- warning
+ warning
(f_ "Action fail with error: %s")
- (match e with
+ (match e with
| Failure msg -> msg
| e -> Printexc.to_string e)
in
-
- let generic_clean t cstm mains docs tests args =
+
+ let generic_clean t cstm mains docs tests args =
BaseCustom.hook
~failsafe:true
cstm
@@ -3662,7 +4127,7 @@ module BaseSetup = struct
(function
| Test (cs, test) ->
let f =
- try
+ try
List.assoc cs.cs_name tests
with Not_found ->
fun _ _ _ -> ()
@@ -3673,43 +4138,52 @@ module BaseSetup = struct
| Doc (cs, doc) ->
let f =
try
- List.assoc cs.cs_name docs
+ List.assoc cs.cs_name docs
with Not_found ->
fun _ _ _ -> ()
in
- failsafe
+ failsafe
(f t.package (cs, doc))
args
- | Library _
+ | Library _
| Executable _
- | Flag _
+ | Flag _
| SrcRepo _ ->
())
t.package.sections;
(* Clean whole package *)
List.iter
- (fun f ->
+ (fun f ->
failsafe
(f t.package)
args)
mains)
()
in
-
+
let clean t args =
- generic_clean
- t
+ generic_clean
+ t
t.package.clean_custom
- t.clean
- t.clean_doc
- t.clean_test
+ t.clean
+ t.clean_doc
+ t.clean_test
args
in
-
+
let distclean t args =
(* Call clean *)
clean t args;
-
+
+ (* Call distclean code *)
+ generic_clean
+ t
+ t.package.distclean_custom
+ t.distclean
+ t.distclean_doc
+ t.distclean_test
+ args;
+
(* Remove generated file *)
List.iter
(fun fn ->
@@ -3718,251 +4192,324 @@ module BaseSetup = struct
info (f_ "Remove '%s'") fn;
Sys.remove fn
end)
- (BaseEnv.default_filename
- ::
+ (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
+ (List.rev_map BaseFileAB.to_filename t.package.files_ab))
+ in
+
+ clean, distclean
+
+ let version t _ =
+ print_endline t.oasis_version
+
+ let update_setup_ml, no_update_setup_ml_cli =
+ let b = ref true in
+ b,
+ ("-no-update-setup-ml",
+ Arg.Clear b,
+ s_ " Don't try to update setup.ml, even if _oasis has changed.")
+
+ let update_setup_ml t =
+ let oasis_fn =
+ match t.oasis_fn with
+ | Some fn -> fn
+ | None -> "_oasis"
+ in
+ let oasis_exec =
+ match t.oasis_exec with
+ | Some fn -> fn
+ | None -> "oasis"
+ in
+ let ocaml =
+ Sys.executable_name
+ in
+ let setup_ml, args =
+ match Array.to_list Sys.argv with
+ | setup_ml :: args ->
+ setup_ml, args
+ | [] ->
+ failwith
+ (s_ "Expecting non-empty command line arguments.")
+ in
+ let ocaml, setup_ml =
+ if Sys.executable_name = Sys.argv.(0) then
+ (* We are not running in standard mode, probably the script
+ * is precompiled.
+ *)
+ "ocaml", "setup.ml"
+ else
+ ocaml, setup_ml
+ in
+ let no_update_setup_ml_cli, _, _ = no_update_setup_ml_cli in
+ let do_update () =
+ let oasis_exec_version =
+ OASISExec.run_read_one_line
+ ~ctxt:!BaseContext.default
+ ~f_exit_code:
+ (function
+ | 0 ->
+ ()
+ | 1 ->
+ failwithf
+ (f_ "Executable '%s' is probably an old version \
+ of oasis (< 0.3.0), please update to version \
+ v%s.")
+ oasis_exec t.oasis_version
+ | 127 ->
+ failwithf
+ (f_ "Cannot find executable '%s', please install \
+ oasis v%s.")
+ oasis_exec t.oasis_version
+ | n ->
+ failwithf
+ (f_ "Command '%s version' exited with code %d.")
+ oasis_exec n)
+ oasis_exec ["version"]
+ in
+ if OASISVersion.comparator_apply
+ (OASISVersion.version_of_string oasis_exec_version)
+ (OASISVersion.VGreaterEqual
+ (OASISVersion.version_of_string t.oasis_version)) then
+ begin
+ (* We have a version >= for the executable oasis, proceed with
+ * update.
+ *)
+ (* TODO: delegate this check to 'oasis setup'. *)
+ if Sys.os_type = "Win32" then
+ failwithf
+ (f_ "It is not possible to update the running script \
+ setup.ml on Windows. Please update setup.ml by \
+ running '%s'.")
+ (String.concat " " (oasis_exec :: "setup" :: t.oasis_setup_args))
+ else
+ begin
+ OASISExec.run
+ ~ctxt:!BaseContext.default
+ ~f_exit_code:
+ (function
+ | 0 ->
+ ()
+ | n ->
+ failwithf
+ (f_ "Unable to update setup.ml using '%s', \
+ please fix the problem and retry.")
+ oasis_exec)
+ oasis_exec ("setup" :: t.oasis_setup_args);
+ OASISExec.run ~ctxt:!BaseContext.default ocaml (setup_ml :: args)
+ end
+ end
+ else
+ failwithf
+ (f_ "The version of '%s' (v%s) doesn't match the version of \
+ oasis used to generate the %s file. Please install at \
+ least oasis v%s.")
+ oasis_exec oasis_exec_version setup_ml t.oasis_version
in
-
- clean, distclean
-
- let version t _ =
- print_endline t.version
-
- let setup t =
+
+ if !update_setup_ml then
+ begin
+ try
+ match t.oasis_digest with
+ | Some dgst ->
+ if Sys.file_exists oasis_fn && dgst <> Digest.file "_oasis" then
+ begin
+ do_update ();
+ true
+ end
+ else
+ false
+ | None ->
+ false
+ with e ->
+ error
+ (f_ "Error when updating setup.ml. If you want to avoid this error, \
+ you can bypass the update of %s by running '%s %s %s %s'")
+ setup_ml ocaml setup_ml no_update_setup_ml_cli
+ (String.concat " " args);
+ raise e
+ end
+ else
+ false
+
+ let setup t =
let catch_exn =
ref true
in
try
let act_ref =
- ref (fun _ ->
- failwithf2
+ ref (fun _ ->
+ failwithf
(f_ "No action defined, run '%s %s -help'")
Sys.executable_name
Sys.argv.(0))
-
+
in
let extra_args_ref =
ref []
in
- let allow_empty_env_ref =
+ 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 () ->
+
+ Arg.Unit
+ (fun () ->
allow_empty_env_ref := allow_empty_env;
act_ref := act);
]
in
-
- Arg.parse
+
+ 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'"))
+ ]
+ @
+ (if t.setup_update then
+ [no_update_setup_ml_cli]
+ else
+ [])
+ @ (BaseContext.args ())))
+ (failwithf (f_ "Don't know what to do with '%s'"))
(s_ "Setup and run build process current package\n");
-
+
(* Build initial environment *)
load ~allow_empty:!allow_empty_env_ref ();
-
+
(** Initialize flags *)
List.iter
(function
- | Flag (cs, {flag_description = hlp;
+ | Flag (cs, {flag_description = hlp;
flag_default = choices}) ->
begin
- let apply ?short_desc () =
+ 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))))
+ (fun () ->
+ string_of_bool
+ (var_choose
+ ~name:(Printf.sprintf
+ (f_ "default value of flag %s")
+ cs.cs_name)
+ ~printer:string_of_bool
+ choices)))
in
- match hlp with
+ 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))
-
+
+ if t.setup_update && update_setup_ml t then
+ ()
+ else
+ !act_ref t (Array.of_list (List.rev !extra_args_ref))
+
with e when !catch_exn ->
- error "%s" (string_of_exception e);
+ error "%s" (Printexc.to_string e);
exit 1
-
-end
-module BaseDev = struct
-# 21 "/build/buildd/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
+# 4480 "setup.ml"
module InternalConfigurePlugin = struct
-# 21 "/build/buildd/oasis-0.2.0/src/plugins/internal/InternalConfigurePlugin.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.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 var_ignore_eval var =
let _s : string =
var ()
- in
+ in
()
in
-
- let errors =
+
+ let errors =
ref SetString.empty
in
-
+
let buff =
Buffer.create 13
in
-
+
let add_errors fmt =
Printf.kbprintf
(fun b ->
@@ -3971,18 +4518,18 @@ module InternalConfigurePlugin = struct
buff
fmt
in
-
+
let warn_exception e =
- warning "%s" (string_of_exception e)
+ warning "%s" (Printexc.to_string e)
in
-
+
(* Check tools *)
let check_tools lst =
- List.iter
+ List.iter
(function
- | ExternalTool tool ->
+ | ExternalTool tool ->
begin
- try
+ try
var_ignore_eval (BaseCheck.prog tool)
with e ->
warn_exception e;
@@ -3992,8 +4539,8 @@ module InternalConfigurePlugin = struct
(* Check that matching tool is built *)
List.iter
(function
- | Executable ({cs_name = nm2},
- {bs_build = build},
+ | Executable ({cs_name = nm2},
+ {bs_build = build},
_) when nm1 = nm2 ->
if not (var_choose build) then
add_errors
@@ -4005,13 +4552,13 @@ module InternalConfigurePlugin = struct
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
+ try
var_ignore_eval BaseStandardVar.ocamlopt
with e ->
warn_exception e;
@@ -4019,16 +4566,16 @@ module InternalConfigurePlugin = struct
(f_ "Section %s requires native compilation")
(OASISSection.string_of_section sct)
end;
-
+
(* Check tools *)
check_tools bs.bs_build_tools;
-
+
(* Check depends *)
- List.iter
+ List.iter
(function
| FindlibPackage (findlib_pkg, version_comparator) ->
begin
- try
+ try
var_ignore_eval
(BaseCheck.package ?version_comparator findlib_pkg)
with e ->
@@ -4049,7 +4596,7 @@ module InternalConfigurePlugin = struct
List.iter
(function
| Library ({cs_name = nm2},
- {bs_build = build},
+ {bs_build = build},
_) when nm1 = nm2 ->
if not (var_choose build) then
add_errors
@@ -4062,24 +4609,24 @@ module InternalConfigurePlugin = struct
bs.bs_build_depends
end
in
-
+
(* Parse command line *)
BaseArgExt.parse argv (BaseEnv.args ());
-
+
(* OCaml version *)
begin
- match pkg.ocaml_version with
+ match pkg.ocaml_version with
| Some ver_cmp ->
begin
- try
+ try
var_ignore_eval
- (BaseCheck.version
- "ocaml"
- ver_cmp
+ (BaseCheck.version
+ "ocaml"
+ ver_cmp
BaseStandardVar.ocaml_version)
with e ->
warn_exception e;
- add_errors
+ add_errors
(f_ "OCaml version %s doesn't match version constraint %s")
(BaseStandardVar.ocaml_version ())
(OASISVersion.string_of_comparator ver_cmp)
@@ -4087,21 +4634,21 @@ module InternalConfigurePlugin = struct
| None ->
()
end;
-
+
(* Findlib version *)
begin
- match pkg.findlib_version with
+ match pkg.findlib_version with
| Some ver_cmp ->
begin
- try
+ try
var_ignore_eval
- (BaseCheck.version
- "findlib"
- ver_cmp
+ (BaseCheck.version
+ "findlib"
+ ver_cmp
BaseStandardVar.findlib_version)
with e ->
warn_exception e;
- add_errors
+ add_errors
(f_ "Findlib version %s doesn't match version constraint %s")
(BaseStandardVar.findlib_version ())
(OASISVersion.string_of_comparator ver_cmp)
@@ -4109,7 +4656,18 @@ module InternalConfigurePlugin = struct
| None ->
()
end;
-
+
+ (* FlexDLL *)
+ if BaseStandardVar.os_type () = "Win32" ||
+ BaseStandardVar.os_type () = "Cygwin" then
+ begin
+ try
+ var_ignore_eval BaseStandardVar.flexlink
+ with e ->
+ warn_exception e;
+ add_errors (f_ "Cannot find 'flexlink'")
+ end;
+
(* Check build depends *)
List.iter
(function
@@ -4125,35 +4683,50 @@ module InternalConfigurePlugin = struct
| _ ->
())
pkg.sections;
-
- (* Save and print environment *)
- if SetString.empty = !errors then
- begin
- dump ();
- print ()
- end
- else
+
+ (* Check if we need native dynlink (presence of libraries that compile to
+ * native)
+ *)
+ begin
+ let has_cmxa =
+ List.exists
+ (function
+ | Library (_, bs, _) ->
+ var_choose bs.bs_build &&
+ (bs.bs_compiled_object = Native ||
+ (bs.bs_compiled_object = Best &&
+ bool_of_string (BaseStandardVar.is_native ())))
+ | _ ->
+ false)
+ pkg.sections
+ in
+ if has_cmxa then
+ var_ignore_eval BaseStandardVar.native_dynlink
+ end;
+
+ (* Check errors *)
+ if SetString.empty != !errors then
begin
List.iter
(fun e -> error "%s" e)
(SetString.elements !errors);
- failwithf1
- (fn_
+ failwithf
+ (fn_
"%d configuration error"
"%d configuration errors"
(SetString.cardinal !errors))
(SetString.cardinal !errors)
end
-
+
end
module InternalInstallPlugin = struct
-# 21 "/build/buildd/oasis-0.2.0/src/plugins/internal/InternalInstallPlugin.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/internal/InternalInstallPlugin.ml" *)
+
(** Install using internal scheme
@author Sylvain Le Gall
*)
-
+
open BaseEnv
open BaseStandardVar
open BaseMessage
@@ -4161,31 +4734,96 @@ module InternalInstallPlugin = struct
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 =
+
+ let install_file_ev =
"install-file"
-
+
let install_dir_ev =
"install-dir"
-
+
let install_findlib_ev =
"install-findlib"
-
+
+ let win32_max_command_line_length = 8000
+
+ let split_install_command ocamlfind findlib_name meta files =
+ if Sys.os_type = "Win32" then
+ (* Arguments for the first command: *)
+ let first_args = ["install"; findlib_name; meta] in
+ (* Arguments for remaining commands: *)
+ let other_args = ["install"; findlib_name; "-add"] in
+ (* Extract as much files as possible from [files], [len] is
+ the current command line length: *)
+ let rec get_files len acc files =
+ match files with
+ | [] ->
+ (List.rev acc, [])
+ | file :: rest ->
+ let len = len + 1 + String.length file in
+ if len > win32_max_command_line_length then
+ (List.rev acc, files)
+ else
+ get_files len (file :: acc) rest
+ in
+ (* Split the command into several commands. *)
+ let rec split args files =
+ match files with
+ | [] ->
+ []
+ | _ ->
+ (* Length of "ocamlfind install <lib> [META|-add]" *)
+ let len =
+ List.fold_left
+ (fun len arg ->
+ len + 1 (* for the space *) + String.length arg)
+ (String.length ocamlfind)
+ args
+ in
+ match get_files len [] files with
+ | ([], _) ->
+ failwith (s_ "Command line too long.")
+ | (firsts, others) ->
+ let cmd = args @ firsts in
+ (* Use -add for remaining commands: *)
+ let () =
+ let findlib_ge_132 =
+ OASISVersion.comparator_apply
+ (OASISVersion.version_of_string
+ (BaseStandardVar.findlib_version ()))
+ (OASISVersion.VGreaterEqual
+ (OASISVersion.version_of_string "1.3.2"))
+ in
+ if not findlib_ge_132 then
+ failwithf
+ (f_ "Installing the library %s require to use the flag \
+ '-add' of ocamlfind because the command line is too \
+ long. This flag is only available for findlib 1.3.2. \
+ Please upgrade findlib from %s to 1.3.2")
+ findlib_name (BaseStandardVar.findlib_version ())
+ in
+ let cmds = split other_args others in
+ cmd :: cmds
+ in
+ (* The first command does not use -add: *)
+ split first_args files
+ else
+ ["install" :: findlib_name :: meta :: files]
+
let install pkg argv =
-
+
let in_destdir =
- try
+ try
let destdir =
- destdir ()
+ destdir ()
in
(* Practically speaking destdir is prepended
* at the beginning of the target filename
@@ -4194,82 +4832,88 @@ module InternalInstallPlugin = struct
with PropList.Not_set _ ->
fun fn -> fn
in
-
- let install_file src_file envdir =
- let tgt_dir =
+
+ let install_file ?tgt_fn src_file envdir =
+ let tgt_dir =
in_destdir (envdir ())
in
let tgt_file =
- Filename.concat
+ Filename.concat
tgt_dir
- (Filename.basename src_file)
+ (match tgt_fn with
+ | Some fn ->
+ fn
+ | None ->
+ Filename.basename src_file)
in
(* Create target directory if needed *)
- BaseFileUtil.mkdir_parent
+ OASISFileUtil.mkdir_parent
+ ~ctxt:!BaseContext.default
(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;
+ OASISFileUtil.cp ~ctxt:!BaseContext.default 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)
+ let tgtdir =
+ OASISHostPath.of_unix (var_expand tgtdir)
in
List.iter
(fun (src, tgt_opt) ->
- let real_srcs =
- BaseFileUtil.glob
+ let real_srcs =
+ OASISFileUtil.glob
+ ~ctxt:!BaseContext.default
(Filename.concat srcdir src)
in
if real_srcs = [] then
- failwithf1
+ failwithf
(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 ->
+ List.iter
+ (fun fn ->
+ install_file
+ fn
+ (fun () ->
+ match tgt_opt with
+ | Some s ->
+ OASISHostPath.of_unix (var_expand s)
+ | None ->
tgtdir))
real_srcs)
lst
- in
-
+ in
+
(** Install all libraries *)
let install_libs pkg =
-
- let files_of_library (f_data, acc) data_lib =
+
+ 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 &&
+ if var_choose bs.bs_install &&
BaseBuilt.is_built BaseBuilt.BLib cs.cs_name then
begin
- let acc =
+ let acc =
(* Start with acc + lib_extra *)
List.rev_append lib_extra acc
in
- let acc =
+ let acc =
(* Add uncompiled header from the source tree *)
- let path =
- BaseFilePath.of_unix bs.bs_path
+ let path =
+ OASISHostPath.of_unix bs.bs_path
in
List.fold_left
(fun acc modul ->
- try
+ try
List.find
- Sys.file_exists
+ OASISFileUtil.file_exists_case
(List.map
(Filename.concat path)
[modul^".mli";
@@ -4281,7 +4925,7 @@ module InternalInstallPlugin = struct
:: acc
with Not_found ->
begin
- warning
+ warning
(f_ "Cannot find source header for module %s \
in library %s")
modul cs.cs_name;
@@ -4290,27 +4934,27 @@ module InternalInstallPlugin = struct
acc
lib.lib_modules
in
-
- let acc =
+
+ let acc =
(* Get generated files *)
- BaseBuilt.fold
- BaseBuilt.BLib
+ 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
+ (Filename.concat
(datarootdir ())
pkg.name);
f_data ()
in
-
+
(f_data, acc)
end
else
@@ -4318,13 +4962,13 @@ module InternalInstallPlugin = struct
(f_data, acc)
end
in
-
+
(* Install one group of library *)
- let install_group_lib grp =
+ 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
+ let data_and_files, children =
+ match grp with
| Container (_, children) ->
data_and_files, children
| Package (_, cs, bs, lib, children) ->
@@ -4335,24 +4979,24 @@ module InternalInstallPlugin = struct
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
+ if files = [] then
begin
warning
(f_ "Nothing to install for findlib library '%s'")
@@ -4360,42 +5004,80 @@ module InternalInstallPlugin = struct
end
else
begin
- let meta =
+ let meta =
(* Search META file *)
- let (_, bs, _) =
+ let (_, bs, _) =
root_lib
in
- let res =
+ let res =
Filename.concat bs.bs_path "META"
in
- if not (Sys.file_exists res) then
- failwithf2
+ if not (OASISFileUtil.file_exists_case res) then
+ failwithf
(f_ "Cannot find file '%s' for findlib library %s")
res
findlib_name;
res
in
- info
+ let files =
+ (* Make filename shorter to avoid hitting command max line length
+ * too early, esp. on Windows.
+ *)
+ let remove_prefix p n =
+ let plen = String.length p in
+ let nlen = String.length n in
+ if plen <= nlen && String.sub n 0 plen = p then
+ begin
+ let fn_sep =
+ if Sys.os_type = "Win32" then
+ '\\'
+ else
+ '/'
+ in
+ let cutpoint = plen +
+ (if plen < nlen && n.[plen] = fn_sep then
+ 1
+ else
+ 0)
+ in
+ String.sub n cutpoint (nlen - cutpoint)
+ end
+ else
+ n
+ in
+ List.map (remove_prefix (Sys.getcwd ())) files
+ in
+ info
(f_ "Installing findlib library '%s'")
findlib_name;
- BaseExec.run
- (ocamlfind ())
- ("install" :: findlib_name :: meta :: files);
- BaseLog.register install_findlib_ev findlib_name
+ let ocamlfind = ocamlfind () in
+ let commands =
+ split_install_command
+ ocamlfind
+ findlib_name
+ meta
+ files
+ in
+ List.iter
+ (OASISExec.run ~ctxt:!BaseContext.default ocamlfind)
+ commands;
+ BaseLog.register install_findlib_ev findlib_name
end;
-
+
(* Install data files *)
f_data ();
-
+
in
-
+
+ let group_libs, _, _ =
+ findlib_mapping pkg
+ in
+
(* We install libraries in groups *)
- List.iter
- install_group_lib
- (group_libs pkg)
+ List.iter install_group_lib group_libs
in
-
- let install_execs pkg =
+
+ let install_execs pkg =
let install_exec data_exec =
let (cs, bs, exec) =
!exec_hook data_exec
@@ -4404,7 +5086,7 @@ module InternalInstallPlugin = struct
BaseBuilt.is_built BaseBuilt.BExec cs.cs_name then
begin
let exec_libdir () =
- Filename.concat
+ Filename.concat
(libdir ())
pkg.name
in
@@ -4413,6 +5095,7 @@ module InternalInstallPlugin = struct
cs.cs_name
(fun () fn ->
install_file
+ ~tgt_fn:(cs.cs_name ^ ext_program ())
fn
bindir)
();
@@ -4427,7 +5110,7 @@ module InternalInstallPlugin = struct
install_data
bs.bs_path
bs.bs_data_files
- (Filename.concat
+ (Filename.concat
(datarootdir ())
pkg.name)
end
@@ -4440,8 +5123,8 @@ module InternalInstallPlugin = struct
())
pkg.sections
in
-
- let install_docs pkg =
+
+ let install_docs pkg =
let install_doc data =
let (cs, doc) =
!doc_hook data
@@ -4450,14 +5133,14 @@ module InternalInstallPlugin = struct
BaseBuilt.is_built BaseBuilt.BDoc cs.cs_name then
begin
let tgt_dir =
- BaseFilePath.of_unix (var_expand doc.doc_install_dir)
+ OASISHostPath.of_unix (var_expand doc.doc_install_dir)
in
BaseBuilt.fold
BaseBuilt.BDoc
cs.cs_name
(fun () fn ->
- install_file
- fn
+ install_file
+ fn
(fun () -> tgt_dir))
();
install_data
@@ -4474,18 +5157,18 @@ module InternalInstallPlugin = struct
())
pkg.sections
in
-
+
install_libs pkg;
install_execs pkg;
install_docs pkg
-
+
(* Uninstall already installed data *)
let uninstall _ argv =
- List.iter
+ List.iter
(fun (ev, data) ->
if ev = install_file_ev then
begin
- if Sys.file_exists data then
+ if OASISFileUtil.file_exists_case data then
begin
info
(f_ "Removing file '%s'")
@@ -4498,7 +5181,7 @@ module InternalInstallPlugin = struct
(f_ "File '%s' doesn't exist anymore")
data
end
- end
+ end
else if ev = install_dir_ev then
begin
if Sys.file_exists data && Sys.is_directory data then
@@ -4508,20 +5191,20 @@ module InternalInstallPlugin = struct
info
(f_ "Removing directory '%s'")
data;
- BaseFileUtil.rmdir data
+ OASISFileUtil.rmdir ~ctxt:!BaseContext.default data
end
else
begin
- warning
+ warning
(f_ "Directory '%s' is not empty (%s)")
data
- (String.concat
- ", "
- (Array.to_list
+ (String.concat
+ ", "
+ (Array.to_list
(Sys.readdir data)))
end
end
- else
+ else
begin
warning
(f_ "Directory '%s' doesn't exist anymore")
@@ -4531,78 +5214,80 @@ module InternalInstallPlugin = struct
else if ev = install_findlib_ev then
begin
info (f_ "Removing findlib library '%s'") data;
- BaseExec.run (ocamlfind ()) ["remove"; data]
+ OASISExec.run ~ctxt:!BaseContext.default
+ (ocamlfind ()) ["remove"; data]
end
else
- failwithf1 (f_ "Unknown log event '%s'") ev;
+ failwithf (f_ "Unknown log event '%s'") ev;
BaseLog.unregister ev data)
(* We process event in reverse order *)
- (List.rev
- (BaseLog.filter
- [install_file_ev;
+ (List.rev
+ (BaseLog.filter
+ [install_file_ev;
install_dir_ev;
install_findlib_ev;]))
-
+
end
+# 5233 "setup.ml"
module OCamlbuildCommon = struct
-# 21 "/build/buildd/oasis-0.2.0/src/plugins/ocamlbuild/OCamlbuildCommon.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.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 "")
-
+ (fun () -> "")
+
(** Fix special arguments depending on environment *)
let fix_args args extra_argv =
List.flatten
[
if (os_type ()) = "Win32" then
[
- "-classic-display";
- "-no-log";
+ "-classic-display";
+ "-no-log";
"-no-links";
- "-install-lib-dir";
+ "-install-lib-dir";
(Filename.concat (standard_library ()) "ocamlbuild")
- ]
+ ]
else
[];
-
+
if not (bool_of_string (is_native ())) || (os_type ()) = "Win32" then
[
- "-byte-plugin"
+ "-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 ());
-
+
+ OASISString.nsplit (ocamlbuildflags ()) ' ';
+
Array.to_list extra_argv;
]
-
+
(** Run 'ocamlbuild -clean' if not already done *)
let run_clean extra_argv =
let extra_cli =
@@ -4611,26 +5296,28 @@ module OCamlbuildCommon = struct
(* 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);
+ OASISExec.run ~ctxt:!BaseContext.default
+ (ocamlbuild ()) (fix_args ["-clean"] extra_argv);
BaseLog.register ocamlbuild_clean_ev extra_cli;
- at_exit
+ at_exit
(fun () ->
- try
+ 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);
+ OASISExec.run ~ctxt:!BaseContext.default
+ (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 =
@@ -4639,20 +5326,20 @@ module OCamlbuildCommon = struct
search_args dir tl
| _ :: tl ->
search_args dir tl
- | [] ->
+ | [] ->
dir
in
search_args "_build" (fix_args [] extra_argv)
-
+
end
module OCamlbuildPlugin = struct
-# 21 "/build/buildd/oasis-0.2.0/src/plugins/ocamlbuild/OCamlbuildPlugin.ml"
-
- (** Build using ocamlbuild
+(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/ocamlbuild/OCamlbuildPlugin.ml" *)
+
+ (** Build using ocamlbuild
@author Sylvain Le Gall
*)
-
+
open OASISTypes
open OASISGettext
open OASISUtils
@@ -4660,107 +5347,100 @@ module OCamlbuildPlugin = struct
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)
+ 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_build_dir (OASISHostPath.of_unix fn)
in
-
+
let cond_targets =
List.fold_left
(fun acc ->
- function
+ function
| Library (cs, bs, lib) when var_choose bs.bs_build ->
begin
let evs, unix_files =
- BaseBuilt.of_library
+ 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
+ (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)
+ List.flatten
+ (List.filter
+ (fun l -> l <> [])
+ (List.map
+ (List.filter
+ (fun fn ->
+ ends_with ".cma" fn
+ || ends_with ".cmxs" fn
+ || ends_with ".cmxa" fn
+ || ends_with (ext_lib ()) fn
+ || ends_with (ext_dll ()) fn))
+ unix_files))
in
-
- match tgts with
- | hd :: tl ->
- (evs, Std hd)
- ::
- (List.map (fun tgts -> [], Std tgts) tl)
- @
- acc
+
+ match tgts with
+ | _ :: _ ->
+ (evs, tgts) :: acc
| [] ->
- failwithf2
- (f_ "No possible ocamlbuild targets \
- in generated files %s for library %s")
- (String.concat (s_ ", " ) (List.map (String.concat (s_ ", ")) tgts))
+ failwithf
+ (f_ "No possible ocamlbuild targets for library %s")
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
+ 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
+ let unix_tgt =
+ (OASISUnixPath.concat
bs.bs_path
- (BaseFilePath.Unix.chop_extension
+ (OASISUnixPath.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))
+ let evs =
+ (* Fix evs, we want to use the unix_tgt, without copying *)
+ List.map
+ (function
+ | BaseBuilt.BExec, nm, lst when nm = cs.cs_name ->
+ BaseBuilt.BExec, nm, [[in_build_dir_of_unix unix_tgt]]
+ | ev ->
+ ev)
+ evs
+ in
+ evs, [unix_tgt]
in
-
+
(* Add executable *)
let acc =
match bs.bs_compiled_object with
@@ -4774,107 +5454,44 @@ module OCamlbuildPlugin = struct
in
acc
end
-
- | Library _ | Executable _ | Test _
+
+ | 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) =
+ let check_and_register (bt, bnm, lst) =
List.iter
(fun fns ->
- if not (List.exists Sys.file_exists fns) then
- failwithf1
+ if not (List.exists OASISFileUtil.file_exists_case fns) then
+ failwithf
(f_ "No one of expected built files %s exists")
(String.concat (s_ ", ") (List.map (Printf.sprintf "'%s'") fns)))
lst;
- (BaseBuilt.register bt bnm lst)
+ (BaseBuilt.register bt bnm lst)
in
-
- (* Run a list of target + post process *)
- let run_ocamlbuild rtargets =
+
+ let cond_targets =
+ (* Run the hook *)
+ !cond_targets_hook cond_targets
+ in
+
+ (* Run a list of target... *)
run_ocamlbuild
- (List.rev_map snd rtargets)
+ (List.flatten
+ (List.map snd cond_targets))
argv;
+ (* ... and register events *)
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 =
+ (List.flatten (List.map fst cond_targets))
+
+
+ let clean pkg extra_args =
run_clean extra_args;
List.iter
(function
@@ -4886,27 +5503,27 @@ module OCamlbuildPlugin = struct
| _ ->
())
pkg.sections
-
+
end
module OCamlbuildDocPlugin = struct
-# 21 "/build/buildd/oasis-0.2.0/src/plugins/ocamlbuild/OCamlbuildDocPlugin.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.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
+ OASISUnixPath.make
[
path;
cs.cs_name^".docdir";
@@ -4914,10 +5531,10 @@ module OCamlbuildDocPlugin = struct
]
in
let tgt_dir =
- BaseFilePath.make
+ OASISHostPath.make
[
build_dir argv;
- BaseFilePath.of_unix path;
+ OASISHostPath.of_unix path;
cs.cs_name^".docdir";
]
in
@@ -4927,39 +5544,40 @@ module OCamlbuildDocPlugin = struct
BaseBuilt.register
BaseBuilt.BDoc
cs.cs_name
- [BaseFileUtil.glob
+ [OASISFileUtil.glob ~ctxt:!BaseContext.default
(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
+# 5558 "setup.ml"
module CustomPlugin = struct
-# 21 "/build/buildd/oasis-0.2.0/src/plugins/custom/CustomPlugin.ml"
-
+(* # 21 "/build/buildd/oasis-0.3.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
@@ -4967,21 +5585,21 @@ module CustomPlugin = struct
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 =
@@ -4994,7 +5612,7 @@ module CustomPlugin = struct
begin
let evs, _ =
BaseBuilt.of_library
- BaseFilePath.of_unix
+ OASISHostPath.of_unix
(cs, bs, lib)
in
evs
@@ -5003,7 +5621,7 @@ module CustomPlugin = struct
begin
let evs, _, _ =
BaseBuilt.of_executable
- BaseFilePath.of_unix
+ OASISHostPath.of_unix
(cs, bs, exec)
in
evs
@@ -5015,7 +5633,7 @@ module CustomPlugin = struct
(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
@@ -5031,11 +5649,11 @@ module CustomPlugin = struct
| _ ->
())
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 =
@@ -5048,31 +5666,32 @@ module CustomPlugin = struct
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
+# 5694 "setup.ml"
open OASISTypes;;
let setup_t =
@@ -5128,11 +5747,12 @@ let setup_t =
version = "1.2";
license =
OASISLicense.DEP5License
- {
- OASISLicense.license = "LGPL";
- exceptions = [];
- version = OASISLicense.Version "2.1";
- };
+ (OASISLicense.DEP5Unit
+ {
+ OASISLicense.license = "LGPL";
+ excption = None;
+ version = OASISLicense.Version "2.1";
+ });
license_file = None;
copyrights = [];
maintainers = [];
@@ -5141,20 +5761,23 @@ let setup_t =
synopsis = "Lustre compiler C and Java backends";
description = None;
categories = [];
- conf_type = (`Configure, "internal", Some "0.2");
+ conf_type = (`Configure, "internal", Some "0.3");
conf_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
post_command = [(OASISExpr.EBool true, None)];
};
- build_type = (`Build, "ocamlbuild", Some "0.2");
+ build_type = (`Build, "ocamlbuild", Some "0.3");
build_custom =
{
pre_command =
- [(OASISExpr.EBool true, Some (("./svn_version.sh", [])))];
+ [
+ (OASISExpr.EBool true,
+ Some (("./svn_version.sh", ["$(prefix)"])))
+ ];
post_command = [(OASISExpr.EBool true, None)];
};
- install_type = (`Install, "internal", Some "0.2");
+ install_type = (`Install, "internal", Some "0.3");
install_custom =
{
pre_command = [(OASISExpr.EBool true, None)];
@@ -5165,10 +5788,14 @@ let setup_t =
(("mkdir",
[
"-p";
- "$(prefix)/include;";
+ "$(prefix)/include/lustrec;";
+ "cp";
+ "-rf";
+ "include/*.[ch]";
+ "$(prefix)/include/lustrec;";
"cp";
"-rf";
- "include";
+ "include/*.java";
"$(prefix)/include/lustrec"
])))
];
@@ -5246,10 +5873,16 @@ let setup_t =
schema_data = PropList.Data.create ();
plugin_data = [];
};
- version = "0.2.0";
+ oasis_fn = Some "_oasis";
+ oasis_version = "0.3.0";
+ oasis_digest = Some "^\201\165\144\189\n\251D\168\165\229o\014u\145\241";
+ oasis_exec = None;
+ oasis_setup_args = [];
+ setup_update = false;
};;
let setup () = BaseSetup.setup setup_t;;
+# 5887 "setup.ml"
(* OASIS_STOP *)
let () = setup ();;
diff --git a/src/c_backend.ml b/src/c_backend.ml
index 7496d308..c67382d1 100644
--- a/src/c_backend.ml
+++ b/src/c_backend.ml
@@ -547,6 +547,9 @@ let print_prototype fmt decl =
| _ -> () (* We don't do anything here *)
*)
+let print_import_standard fmt =
+ fprintf fmt "#include \"%s/include/lustrec/arrow.h\"@.@." Version.prefix
+
let print_prototype fmt decl =
match decl.top_decl_desc with
| Open m -> fprintf fmt "#include \"%s.h\"@," m
@@ -562,12 +565,16 @@ let pp_registers_struct fmt m =
()
let print_machine_struct fmt m =
- (* Define struct *)
- fprintf fmt "@[%a {@[%a%a%t@]};@]@."
- pp_machine_memtype_name m.mname.node_id
- pp_registers_struct m
- (Utils.fprintf_list ~sep:"; " pp_c_decl_instance_var) m.minstances
- (Utils.pp_final_char_if_non_empty "; " m.minstances)
+ if m.mname.node_id != arrow_id
+ then (
+ (* We don't print arrow function *)
+ (* Define struct *)
+ fprintf fmt "@[%a {@[%a%a%t@]};@]@."
+ pp_machine_memtype_name m.mname.node_id
+ pp_registers_struct m
+ (Utils.fprintf_list ~sep:"; " pp_c_decl_instance_var) m.minstances
+ (Utils.pp_final_char_if_non_empty "; " m.minstances)
+ )
(*
let pp_static_array_instance fmt m (v, m) =
@@ -631,24 +638,22 @@ let print_static_alloc_macro fmt m =
pp_machine_static_link_name m.mname.node_id
let print_machine_decl fmt m =
- (* Static allocation *)
- if !Options.static_mem then (
- fprintf fmt "%a@.%a@.%a@."
- print_static_declare_macro m
- print_static_link_macro m
- print_static_alloc_macro m;
- )
- else (
+ if m.mname.node_id <> arrow_id
+ then (
+ (* We don't print arrow function *)
+ (* Static allocation *)
+ if !Options.static_mem
+ then (
+ fprintf fmt "%a@.%a@.%a@."
+ print_static_declare_macro m
+ print_static_link_macro m
+ print_static_alloc_macro m
+ )
+ else (
(* Dynamic allocation *)
- fprintf fmt "extern %a;@.@."
- print_alloc_prototype (m.mname.node_id, m.mstatic);
- );
- if m.mname.node_id = arrow_id then (
- (* Arrow will be defined by a #define macro because of polymorphism *)
- fprintf fmt "#define _arrow_step(x,y,output,self) ((self)->_reg._first?((self)->_reg._first=0,(*output = x)):(*output = y))@.@.";
- fprintf fmt "#define _arrow_reset(self) {(self)->_reg._first = 1;}@.@."
- )
- else (
+ fprintf fmt "extern %a;@.@."
+ print_alloc_prototype (m.mname.node_id, m.mstatic)
+ );
let self = mk_self m in
fprintf fmt "extern %a;@.@."
(print_reset_prototype self) (m.mname.node_id, m.mstatic);
@@ -736,14 +741,16 @@ let print_step_code fmt m self =
(fun fmt -> fprintf fmt "return;")
let print_machine fmt m =
+ if m.mname.node_id <> arrow_id
+ then (
+ (* We don't print arrow function *)
(* Alloc function, only if non static mode *)
- if (not !Options.static_mem) then
- (
- fprintf fmt "@[<v 2>%a {@,%a@]@,}@.@."
- print_alloc_prototype (m.mname.node_id, m.mstatic)
- print_alloc_code m;
- );
- if m.mname.node_id = arrow_id then () else ( (* We don't print arrow function *)
+ if (not !Options.static_mem) then
+ (
+ fprintf fmt "@[<v 2>%a {@,%a@]@,}@.@."
+ print_alloc_prototype (m.mname.node_id, m.mstatic)
+ print_alloc_code m;
+ );
let self = mk_self m in
(* Reset function *)
fprintf fmt "@[<v 2>%a {@,%a%treturn;@]@,}@.@."
@@ -835,31 +842,31 @@ let print_main_fun machines m fmt =
fprintf fmt "@]@ }@."
let print_main_header fmt =
- fprintf fmt "#include <stdio.h>@.#include <unistd.h>@.#include \"io_frontend.h\"@."
+ fprintf fmt "#include <stdio.h>@.#include <unistd.h>@.#include \"%s/include/lustrec/io_frontend.h\"@." Version.prefix
-let rec pp_c_type_decl cpt var fmt tdecl =
+let rec pp_c_type_decl filename cpt var fmt tdecl =
match tdecl with
| Tydec_any -> assert false
| Tydec_int -> fprintf fmt "int %s" var
| Tydec_real -> fprintf fmt "double %s" var
| Tydec_float -> fprintf fmt "float %s" var
| Tydec_bool -> fprintf fmt "_Bool %s" var
- | Tydec_clock ty -> pp_c_type_decl cpt var fmt ty
+ | Tydec_clock ty -> pp_c_type_decl filename cpt var fmt ty
| Tydec_const c -> fprintf fmt "%s %s" c var
- | Tydec_array (d, ty) -> fprintf fmt "%a[%a]" (pp_c_type_decl cpt var) ty pp_c_dimension d
+ | Tydec_array (d, ty) -> fprintf fmt "%a[%a]" (pp_c_type_decl filename cpt var) ty pp_c_dimension d
| Tydec_enum tl ->
begin
incr cpt;
- fprintf fmt "enum _enum_%d { %a } %s" !cpt (Utils.fprintf_list ~sep:", " pp_print_string) tl var
+ fprintf fmt "enum _enum_%s_%d { %a } %s" filename !cpt (Utils.fprintf_list ~sep:", " pp_print_string) tl var
end
-let print_type_definitions fmt =
+let print_type_definitions fmt filename =
let cpt_type = ref 0 in
Hashtbl.iter (fun typ def ->
match typ with
| Tydec_const var ->
fprintf fmt "typedef %a;@.@."
- (pp_c_type_decl cpt_type var) def
+ (pp_c_type_decl filename cpt_type var) def
| _ -> ()) type_table
let print_makefile basename nodename dependencies fmt =
@@ -898,9 +905,14 @@ let translate_to_c header_fmt source_fmt makefile_fmt spec_fmt_opt basename prog
print_version header_fmt;
fprintf header_fmt "#ifndef _%s@.#define _%s@." baseNAME baseNAME;
pp_print_newline header_fmt ();
+ fprintf header_fmt "/* Imports standard library */@.";
+ (* imports standard library definitions (arrow) *)
+ print_import_standard header_fmt;
+ pp_print_newline header_fmt ();
fprintf header_fmt "/* Types definitions */@.";
(* Print the type definitions from the type table *)
- print_type_definitions header_fmt;
+ print_type_definitions header_fmt basename;
+ pp_print_newline header_fmt ();
(* Print the global constant declarations. *)
fprintf header_fmt "/* Global constant (declarations, definitions are in C file) */@.";
List.iter (fun c -> print_const_decl header_fmt c) (get_consts prog);
diff --git a/svn_version.sh b/svn_version.sh
index 097d053c..47f1e440 100755
--- a/svn_version.sh
+++ b/svn_version.sh
@@ -3,10 +3,16 @@
version=`svn info | awk -v ver="UNKNOWN" -F ":" '/R?vision/ { ver=$2 } END { print ver }' | tr -d " "`
filename=version.ml
+prefix=$1
-echo "Generating version number in file \"${filename}\" ..."
+echo "Generating version information in file \"${filename}\" ..."
echo "" > src/${filename}
echo "(* Version file generated by Oasis *)" >> src/${filename}
echo "" >> src/${filename}
echo "let number = \"${version}\"" >> src/${filename}
+echo "version number: ${version}"
+echo "" >> src/${filename}
+echo "let prefix = \"${prefix}\"" >> src/${filename}
+echo "installation path prefix: ${prefix}"
+echo "... done"
\ No newline at end of file
--
GitLab