Revision 04e26a3f
Added by Xavier Thirioux almost 9 years ago
_oasis | ||
---|---|---|
6 | 6 |
License: LGPL-2.1 |
7 | 7 |
Plugins: DevFiles (0.2) |
8 | 8 |
# , Custom (0.2) |
9 |
PreBuildCommand: ./svn_version.sh |
|
10 |
PostInstallCommand: mkdir -p $(prefix)/include; cp -rf include $(prefix)/include/lustrec
|
|
9 |
PreBuildCommand: ./svn_version.sh $(prefix)
|
|
10 |
PostInstallCommand: mkdir -p $(prefix)/include/lustrec; cp -rf include/*.[ch] $(prefix)/include/lustrec; cp -rf include/*.java $(prefix)/include/lustrec
|
|
11 | 11 |
|
12 | 12 |
Executable lustrec |
13 | 13 |
Path: src |
_tags | ||
---|---|---|
1 | 1 |
# OASIS_START |
2 |
# DO NOT EDIT (digest: 54aa7498411485980381101fb69226dd) |
|
2 |
# DO NOT EDIT (digest: 98bcbc21d29d2f6266238c1025fff223) |
|
3 |
# Ignore VCS directories, you can use the same kind of rule outside |
|
4 |
# OASIS_START/STOP if you want to exclude directories that contains |
|
5 |
# useless stuff for the build process |
|
6 |
<**/.svn>: -traverse |
|
7 |
<**/.svn>: not_hygienic |
|
8 |
".bzr": -traverse |
|
9 |
".bzr": not_hygienic |
|
10 |
".hg": -traverse |
|
11 |
".hg": not_hygienic |
|
12 |
".git": -traverse |
|
13 |
".git": not_hygienic |
|
14 |
"_darcs": -traverse |
|
15 |
"_darcs": not_hygienic |
|
3 | 16 |
# Executable lustrec |
4 |
"src/main_lustre_compiler.native": pkg_unix |
|
5 |
"src/main_lustre_compiler.native": pkg_str |
|
6 | 17 |
"src/main_lustre_compiler.native": pkg_ocamlgraph |
7 |
<src/*.ml{,i}>: pkg_unix
|
|
8 |
<src/*.ml{,i}>: pkg_str
|
|
18 |
"src/main_lustre_compiler.native": pkg_str
|
|
19 |
"src/main_lustre_compiler.native": pkg_unix
|
|
9 | 20 |
<src/*.ml{,i}>: pkg_ocamlgraph |
21 |
<src/*.ml{,i}>: pkg_str |
|
22 |
<src/*.ml{,i}>: pkg_unix |
|
10 | 23 |
# OASIS_STOP |
configure | ||
---|---|---|
1 | 1 |
#!/bin/sh |
2 | 2 |
|
3 | 3 |
# OASIS_START |
4 |
# DO NOT EDIT (digest: ed33e59fe00e48bc31edf413bbc8b8d6)
|
|
4 |
# DO NOT EDIT (digest: 425187ed8bfdbdd207fd76392dd243a7)
|
|
5 | 5 |
set -e |
6 | 6 |
|
7 |
ocaml setup.ml -configure $* |
|
7 |
FST=true |
|
8 |
for i in "$@"; do |
|
9 |
if $FST; then |
|
10 |
set -- |
|
11 |
FST=false |
|
12 |
fi |
|
13 |
|
|
14 |
case $i in |
|
15 |
--*=*) |
|
16 |
ARG=${i%%=*} |
|
17 |
VAL=${i##*=} |
|
18 |
set -- "$@" "$ARG" "$VAL" |
|
19 |
;; |
|
20 |
*) |
|
21 |
set -- "$@" "$i" |
|
22 |
;; |
|
23 |
esac |
|
24 |
done |
|
25 |
|
|
26 |
ocaml setup.ml -configure "$@" |
|
8 | 27 |
# OASIS_STOP |
include/arrow.c | ||
---|---|---|
1 |
#include <stdlib.h> |
|
2 |
#include <assert.h> |
|
3 |
#include "arrow.h" |
|
4 |
|
|
5 |
struct _arrow_mem *arrow_alloc() { |
|
6 |
struct _arrow_mem *_alloc; |
|
7 |
_alloc = (struct _arrow_mem *) malloc(sizeof(struct _arrow_mem *)); |
|
8 |
assert (_alloc); |
|
9 |
return _alloc; |
|
10 |
} |
include/arrow.h | ||
---|---|---|
1 |
|
|
2 |
#ifndef _ARROW |
|
3 |
#define _ARROW |
|
4 |
|
|
5 |
struct _arrow_mem {struct _arrow_reg {_Bool _first; } _reg; }; |
|
6 |
|
|
7 |
extern struct _arrow_mem *arrow_alloc (); |
|
8 |
|
|
9 |
#define _arrow_DECLARE(inst)\ |
|
10 |
struct _arrow_mem inst; |
|
11 |
|
|
12 |
#define _arrow_LINK(inst) do {\ |
|
13 |
;\ |
|
14 |
} while (0) |
|
15 |
|
|
16 |
#define _arrow_step(x,y,output,self) ((self)->_reg._first?((self)->_reg._first=0,(*output = x)):(*output = y)) |
|
17 |
|
|
18 |
#define _arrow_reset(self) {(self)->_reg._first = 1;} |
|
19 |
|
|
20 |
#endif |
myocamlbuild.ml | ||
---|---|---|
1 | 1 |
(* OASIS_START *) |
2 |
(* DO NOT EDIT (digest: 7eabc0106cad87d67c960d9a2ff80b28) *)
|
|
2 |
(* DO NOT EDIT (digest: 00359f2e15a7ed8f31f1d7ce086345f9) *)
|
|
3 | 3 |
module OASISGettext = struct |
4 |
# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISGettext.ml"
|
|
5 |
|
|
6 |
let ns_ str =
|
|
4 |
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISGettext.ml" *)
|
|
5 |
|
|
6 |
let ns_ str = |
|
7 | 7 |
str |
8 |
|
|
9 |
let s_ str =
|
|
8 |
|
|
9 |
let s_ str = |
|
10 | 10 |
str |
11 |
|
|
11 |
|
|
12 | 12 |
let f_ (str : ('a, 'b, 'c, 'd) format4) = |
13 | 13 |
str |
14 |
|
|
14 |
|
|
15 | 15 |
let fn_ fmt1 fmt2 n = |
16 | 16 |
if n = 1 then |
17 | 17 |
fmt1^^"" |
18 | 18 |
else |
19 | 19 |
fmt2^^"" |
20 |
|
|
21 |
let init =
|
|
20 |
|
|
21 |
let init = |
|
22 | 22 |
[] |
23 |
|
|
23 |
|
|
24 | 24 |
end |
25 | 25 |
|
26 | 26 |
module OASISExpr = struct |
27 |
# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISExpr.ml"
|
|
28 |
|
|
29 |
|
|
30 |
|
|
27 |
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISExpr.ml" *)
|
|
28 |
|
|
29 |
|
|
30 |
|
|
31 | 31 |
open OASISGettext |
32 |
|
|
32 |
|
|
33 | 33 |
type test = string |
34 |
|
|
34 |
|
|
35 | 35 |
type flag = string |
36 |
|
|
36 |
|
|
37 | 37 |
type t = |
38 | 38 |
| EBool of bool |
39 | 39 |
| ENot of t |
... | ... | |
42 | 42 |
| EFlag of flag |
43 | 43 |
| ETest of test * string |
44 | 44 |
|
45 |
|
|
45 |
|
|
46 | 46 |
type 'a choices = (t * 'a) list |
47 |
|
|
47 |
|
|
48 | 48 |
let eval var_get t = |
49 |
let rec eval' =
|
|
49 |
let rec eval' = |
|
50 | 50 |
function |
51 | 51 |
| EBool b -> |
52 | 52 |
b |
53 |
|
|
54 |
| ENot e ->
|
|
53 |
|
|
54 |
| ENot e -> |
|
55 | 55 |
not (eval' e) |
56 |
|
|
56 |
|
|
57 | 57 |
| EAnd (e1, e2) -> |
58 | 58 |
(eval' e1) && (eval' e2) |
59 |
|
|
60 |
| EOr (e1, e2) ->
|
|
59 |
|
|
60 |
| EOr (e1, e2) -> |
|
61 | 61 |
(eval' e1) || (eval' e2) |
62 |
|
|
62 |
|
|
63 | 63 |
| EFlag nm -> |
64 | 64 |
let v = |
65 | 65 |
var_get nm |
66 | 66 |
in |
67 | 67 |
assert(v = "true" || v = "false"); |
68 | 68 |
(v = "true") |
69 |
|
|
69 |
|
|
70 | 70 |
| ETest (nm, vl) -> |
71 | 71 |
let v = |
72 | 72 |
var_get nm |
... | ... | |
74 | 74 |
(v = vl) |
75 | 75 |
in |
76 | 76 |
eval' t |
77 |
|
|
77 |
|
|
78 | 78 |
let choose ?printer ?name var_get lst = |
79 |
let rec choose_aux =
|
|
79 |
let rec choose_aux = |
|
80 | 80 |
function |
81 | 81 |
| (cond, vl) :: tl -> |
82 |
if eval var_get cond then
|
|
83 |
vl
|
|
82 |
if eval var_get cond then |
|
83 |
vl |
|
84 | 84 |
else |
85 | 85 |
choose_aux tl |
86 | 86 |
| [] -> |
87 |
let str_lst =
|
|
87 |
let str_lst = |
|
88 | 88 |
if lst = [] then |
89 | 89 |
s_ "<empty>" |
90 | 90 |
else |
91 |
String.concat
|
|
91 |
String.concat |
|
92 | 92 |
(s_ ", ") |
93 | 93 |
(List.map |
94 | 94 |
(fun (cond, vl) -> |
... | ... | |
97 | 97 |
| None -> s_ "<no printer>") |
98 | 98 |
lst) |
99 | 99 |
in |
100 |
match name with
|
|
100 |
match name with |
|
101 | 101 |
| Some nm -> |
102 | 102 |
failwith |
103 |
(Printf.sprintf
|
|
103 |
(Printf.sprintf |
|
104 | 104 |
(f_ "No result for the choice list '%s': %s") |
105 | 105 |
nm str_lst) |
106 | 106 |
| None -> |
... | ... | |
110 | 110 |
str_lst) |
111 | 111 |
in |
112 | 112 |
choose_aux (List.rev lst) |
113 |
|
|
113 |
|
|
114 | 114 |
end |
115 | 115 |
|
116 | 116 |
|
117 |
# 117 "myocamlbuild.ml" |
|
117 | 118 |
module BaseEnvLight = struct |
118 |
# 21 "/build/buildd/oasis-0.2.0/src/base/BaseEnvLight.ml"
|
|
119 |
|
|
119 |
(* # 21 "/build/buildd/oasis-0.3.0/src/base/BaseEnvLight.ml" *)
|
|
120 |
|
|
120 | 121 |
module MapString = Map.Make(String) |
121 |
|
|
122 |
|
|
122 | 123 |
type t = string MapString.t |
123 |
|
|
124 |
|
|
124 | 125 |
let default_filename = |
125 |
Filename.concat
|
|
126 |
Filename.concat |
|
126 | 127 |
(Sys.getcwd ()) |
127 | 128 |
"setup.data" |
128 |
|
|
129 |
|
|
129 | 130 |
let load ?(allow_empty=false) ?(filename=default_filename) () = |
130 | 131 |
if Sys.file_exists filename then |
131 | 132 |
begin |
... | ... | |
138 | 139 |
let line = |
139 | 140 |
ref 1 |
140 | 141 |
in |
141 |
let st_line =
|
|
142 |
let st_line = |
|
142 | 143 |
Stream.from |
143 | 144 |
(fun _ -> |
144 | 145 |
try |
145 |
match Stream.next st with
|
|
146 |
match Stream.next st with |
|
146 | 147 |
| '\n' -> incr line; Some '\n' |
147 | 148 |
| c -> Some c |
148 | 149 |
with Stream.Failure -> None) |
149 | 150 |
in |
150 |
let lexer =
|
|
151 |
let lexer = |
|
151 | 152 |
Genlex.make_lexer ["="] st_line |
152 | 153 |
in |
153 | 154 |
let rec read_file mp = |
154 |
match Stream.npeek 3 lexer with
|
|
155 |
match Stream.npeek 3 lexer with |
|
155 | 156 |
| [Genlex.Ident nm; Genlex.Kwd "="; Genlex.String value] -> |
156 |
Stream.junk lexer;
|
|
157 |
Stream.junk lexer;
|
|
157 |
Stream.junk lexer; |
|
158 |
Stream.junk lexer; |
|
158 | 159 |
Stream.junk lexer; |
159 | 160 |
read_file (MapString.add nm value mp) |
160 | 161 |
| [] -> |
... | ... | |
177 | 178 |
end |
178 | 179 |
else |
179 | 180 |
begin |
180 |
failwith
|
|
181 |
(Printf.sprintf
|
|
181 |
failwith |
|
182 |
(Printf.sprintf |
|
182 | 183 |
"Unable to load environment, the file '%s' doesn't exist." |
183 | 184 |
filename) |
184 | 185 |
end |
185 |
|
|
186 |
|
|
186 | 187 |
let var_get name env = |
187 | 188 |
let rec var_expand str = |
188 | 189 |
let buff = |
189 | 190 |
Buffer.create ((String.length str) * 2) |
190 | 191 |
in |
191 |
Buffer.add_substitute
|
|
192 |
Buffer.add_substitute |
|
192 | 193 |
buff |
193 |
(fun var ->
|
|
194 |
try
|
|
194 |
(fun var -> |
|
195 |
try |
|
195 | 196 |
var_expand (MapString.find var env) |
196 | 197 |
with Not_found -> |
197 |
failwith
|
|
198 |
(Printf.sprintf
|
|
198 |
failwith |
|
199 |
(Printf.sprintf |
|
199 | 200 |
"No variable %s defined when trying to expand %S." |
200 |
var
|
|
201 |
var |
|
201 | 202 |
str)) |
202 | 203 |
str; |
203 | 204 |
Buffer.contents buff |
204 | 205 |
in |
205 | 206 |
var_expand (MapString.find name env) |
206 |
|
|
207 |
let var_choose lst env =
|
|
207 |
|
|
208 |
let var_choose lst env = |
|
208 | 209 |
OASISExpr.choose |
209 | 210 |
(fun nm -> var_get nm env) |
210 | 211 |
lst |
211 | 212 |
end |
212 | 213 |
|
213 | 214 |
|
215 |
# 215 "myocamlbuild.ml" |
|
214 | 216 |
module MyOCamlbuildFindlib = struct |
215 |
# 21 "/build/buildd/oasis-0.2.0/src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml"
|
|
216 |
|
|
217 |
(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/ocamlbuild/MyOCamlbuildFindlib.ml" *)
|
|
218 |
|
|
217 | 219 |
(** OCamlbuild extension, copied from |
218 | 220 |
* http://brion.inria.fr/gallium/index.php/Using_ocamlfind_with_ocamlbuild |
219 | 221 |
* by N. Pouillard and others |
... | ... | |
223 | 225 |
* Modified by Sylvain Le Gall |
224 | 226 |
*) |
225 | 227 |
open Ocamlbuild_plugin |
226 |
|
|
228 |
|
|
227 | 229 |
(* these functions are not really officially exported *) |
228 | 230 |
let run_and_read = |
229 | 231 |
Ocamlbuild_pack.My_unix.run_and_read |
230 |
|
|
232 |
|
|
231 | 233 |
let blank_sep_strings = |
232 | 234 |
Ocamlbuild_pack.Lexers.blank_sep_strings |
233 |
|
|
235 |
|
|
234 | 236 |
let split s ch = |
235 | 237 |
let x = |
236 | 238 |
ref [] |
... | ... | |
245 | 247 |
try |
246 | 248 |
go s |
247 | 249 |
with Not_found -> !x |
248 |
|
|
250 |
|
|
249 | 251 |
let split_nl s = split s '\n' |
250 |
|
|
252 |
|
|
251 | 253 |
let before_space s = |
252 | 254 |
try |
253 | 255 |
String.before s (String.index s ' ') |
254 | 256 |
with Not_found -> s |
255 |
|
|
257 |
|
|
256 | 258 |
(* this lists all supported packages *) |
257 | 259 |
let find_packages () = |
258 | 260 |
List.map before_space (split_nl & run_and_read "ocamlfind list") |
259 |
|
|
261 |
|
|
260 | 262 |
(* this is supposed to list available syntaxes, but I don't know how to do it. *) |
261 | 263 |
let find_syntaxes () = ["camlp4o"; "camlp4r"] |
262 |
|
|
264 |
|
|
263 | 265 |
(* ocamlfind command *) |
264 | 266 |
let ocamlfind x = S[A"ocamlfind"; x] |
265 |
|
|
267 |
|
|
266 | 268 |
let dispatch = |
267 | 269 |
function |
268 | 270 |
| Before_options -> |
... | ... | |
292 | 294 |
flag ["ocaml"; "infer_interface"; "pkg_"^pkg] & S[A"-package"; A pkg]; |
293 | 295 |
end |
294 | 296 |
(find_packages ()); |
295 |
|
|
297 |
|
|
296 | 298 |
(* Like -package but for extensions syntax. Morover -syntax is useless |
297 | 299 |
* when linking. *) |
298 | 300 |
List.iter begin fun syntax -> |
... | ... | |
301 | 303 |
flag ["ocaml"; "doc"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; |
302 | 304 |
flag ["ocaml"; "infer_interface"; "syntax_"^syntax] & S[A"-syntax"; A syntax]; |
303 | 305 |
end (find_syntaxes ()); |
304 |
|
|
306 |
|
|
305 | 307 |
(* The default "thread" tag is not compatible with ocamlfind. |
306 | 308 |
* Indeed, the default rules add the "threads.cma" or "threads.cmxa" |
307 | 309 |
* options when using this tag. When using the "-linkpkg" option with |
... | ... | |
311 | 313 |
* the "threads" package using the previous plugin. |
312 | 314 |
*) |
313 | 315 |
flag ["ocaml"; "pkg_threads"; "compile"] (S[A "-thread"]); |
316 |
flag ["ocaml"; "pkg_threads"; "doc"] (S[A "-I"; A "+threads"]); |
|
314 | 317 |
flag ["ocaml"; "pkg_threads"; "link"] (S[A "-thread"]); |
315 | 318 |
flag ["ocaml"; "pkg_threads"; "infer_interface"] (S[A "-thread"]) |
316 |
|
|
319 |
|
|
317 | 320 |
| _ -> |
318 | 321 |
() |
319 |
|
|
322 |
|
|
320 | 323 |
end |
321 | 324 |
|
322 | 325 |
module MyOCamlbuildBase = struct |
323 |
# 21 "/build/buildd/oasis-0.2.0/src/plugins/ocamlbuild/MyOCamlbuildBase.ml"
|
|
324 |
|
|
326 |
(* # 21 "/build/buildd/oasis-0.3.0/src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
|
|
327 |
|
|
325 | 328 |
(** Base functions for writing myocamlbuild.ml |
326 | 329 |
@author Sylvain Le Gall |
327 | 330 |
*) |
328 |
|
|
329 |
|
|
330 |
|
|
331 |
|
|
332 |
|
|
333 |
|
|
331 | 334 |
open Ocamlbuild_plugin |
332 |
|
|
335 |
module OC = Ocamlbuild_pack.Ocaml_compiler |
|
336 |
|
|
333 | 337 |
type dir = string |
334 | 338 |
type file = string |
335 | 339 |
type name = string |
336 | 340 |
type tag = string |
337 |
|
|
338 |
# 55 "/build/buildd/oasis-0.2.0/src/plugins/ocamlbuild/MyOCamlbuildBase.ml"
|
|
339 |
|
|
341 |
|
|
342 |
(* # 56 "/build/buildd/oasis-0.3.0/src/plugins/ocamlbuild/MyOCamlbuildBase.ml" *)
|
|
343 |
|
|
340 | 344 |
type t = |
341 | 345 |
{ |
342 | 346 |
lib_ocaml: (name * dir list) list; |
343 | 347 |
lib_c: (name * dir * file list) list; |
344 | 348 |
flags: (tag list * (spec OASISExpr.choices)) list; |
349 |
(* Replace the 'dir: include' from _tags by a precise interdepends in |
|
350 |
* directory. |
|
351 |
*) |
|
352 |
includes: (dir * dir list) list; |
|
345 | 353 |
} |
346 |
|
|
354 |
|
|
347 | 355 |
let env_filename = |
348 | 356 |
Pathname.basename |
349 | 357 |
BaseEnvLight.default_filename |
350 |
|
|
358 |
|
|
351 | 359 |
let dispatch_combine lst = |
352 | 360 |
fun e -> |
353 | 361 |
List.iter |
354 | 362 |
(fun dispatch -> dispatch e) |
355 | 363 |
lst |
356 |
|
|
364 |
|
|
365 |
let tag_libstubs nm = |
|
366 |
"use_lib"^nm^"_stubs" |
|
367 |
|
|
368 |
let nm_libstubs nm = |
|
369 |
nm^"_stubs" |
|
370 |
|
|
357 | 371 |
let dispatch t e = |
358 | 372 |
let env = |
359 | 373 |
BaseEnvLight.load |
... | ... | |
380 | 394 |
Options.ext_lib, "ext_lib"; |
381 | 395 |
Options.ext_dll, "ext_dll"; |
382 | 396 |
] |
383 |
|
|
397 |
|
|
384 | 398 |
| After_rules -> |
385 | 399 |
(* Declare OCaml libraries *) |
386 | 400 |
List.iter |
387 | 401 |
(function |
388 |
| lib, [] ->
|
|
389 |
ocaml_lib lib;
|
|
390 |
| lib, dir :: tl ->
|
|
391 |
ocaml_lib ~dir:dir lib;
|
|
402 |
| nm, [] ->
|
|
403 |
ocaml_lib nm
|
|
404 |
| nm, dir :: tl ->
|
|
405 |
ocaml_lib ~dir:dir (dir^"/"^nm);
|
|
392 | 406 |
List.iter |
393 | 407 |
(fun dir -> |
394 |
flag |
|
395 |
["ocaml"; "use_"^lib; "compile"] |
|
396 |
(S[A"-I"; P dir])) |
|
408 |
List.iter |
|
409 |
(fun str -> |
|
410 |
flag ["ocaml"; "use_"^nm; str] (S[A"-I"; P dir])) |
|
411 |
["compile"; "infer_interface"; "doc"]) |
|
397 | 412 |
tl) |
398 | 413 |
t.lib_ocaml; |
399 |
|
|
414 |
|
|
415 |
(* Declare directories dependencies, replace "include" in _tags. *) |
|
416 |
List.iter |
|
417 |
(fun (dir, include_dirs) -> |
|
418 |
Pathname.define_context dir include_dirs) |
|
419 |
t.includes; |
|
420 |
|
|
400 | 421 |
(* Declare C libraries *) |
401 | 422 |
List.iter |
402 | 423 |
(fun (lib, dir, headers) -> |
403 | 424 |
(* Handle C part of library *) |
404 |
flag ["link"; "library"; "ocaml"; "byte"; "use_lib"^lib] |
|
405 |
(S[A"-dllib"; A("-l"^lib); A"-cclib"; A("-l"^lib)]); |
|
406 |
|
|
407 |
flag ["link"; "library"; "ocaml"; "native"; "use_lib"^lib] |
|
408 |
(S[A"-cclib"; A("-l"^lib)]); |
|
425 |
flag ["link"; "library"; "ocaml"; "byte"; tag_libstubs lib] |
|
426 |
(S[A"-dllib"; A("-l"^(nm_libstubs lib)); A"-cclib"; |
|
427 |
A("-l"^(nm_libstubs lib))]); |
|
428 |
|
|
429 |
flag ["link"; "library"; "ocaml"; "native"; tag_libstubs lib] |
|
430 |
(S[A"-cclib"; A("-l"^(nm_libstubs lib))]); |
|
409 | 431 |
|
410 |
flag ["link"; "program"; "ocaml"; "byte"; "use_lib"^lib]
|
|
411 |
(S[A"-dllib"; A("dll"^lib)]);
|
|
412 |
|
|
432 |
flag ["link"; "program"; "ocaml"; "byte"; tag_libstubs lib]
|
|
433 |
(S[A"-dllib"; A("dll"^(nm_libstubs lib))]);
|
|
434 |
|
|
413 | 435 |
(* When ocaml link something that use the C library, then one |
414 | 436 |
need that file to be up to date. |
415 | 437 |
*) |
416 |
dep ["link"; "ocaml"; "use_lib"^lib] |
|
417 |
[dir/"lib"^lib^"."^(!Options.ext_lib)]; |
|
418 |
|
|
438 |
dep ["link"; "ocaml"; "program"; tag_libstubs lib] |
|
439 |
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; |
|
440 |
|
|
441 |
dep ["compile"; "ocaml"; "program"; tag_libstubs lib] |
|
442 |
[dir/"lib"^(nm_libstubs lib)^"."^(!Options.ext_lib)]; |
|
443 |
|
|
419 | 444 |
(* TODO: be more specific about what depends on headers *) |
420 | 445 |
(* Depends on .h files *) |
421 | 446 |
dep ["compile"; "c"] |
422 | 447 |
headers; |
423 |
|
|
448 |
|
|
424 | 449 |
(* Setup search path for lib *) |
425 | 450 |
flag ["link"; "ocaml"; "use_"^lib] |
426 | 451 |
(S[A"-I"; P(dir)]); |
427 | 452 |
) |
428 | 453 |
t.lib_c; |
429 |
|
|
454 |
|
|
430 | 455 |
(* Add flags *) |
431 | 456 |
List.iter |
432 | 457 |
(fun (tags, cond_specs) -> |
... | ... | |
437 | 462 |
t.flags |
438 | 463 |
| _ -> |
439 | 464 |
() |
440 |
|
|
465 |
|
|
441 | 466 |
let dispatch_default t = |
442 | 467 |
dispatch_combine |
443 | 468 |
[ |
444 | 469 |
dispatch t; |
445 | 470 |
MyOCamlbuildFindlib.dispatch; |
446 | 471 |
] |
447 |
|
|
472 |
|
|
448 | 473 |
end |
449 | 474 |
|
450 | 475 |
|
476 |
# 476 "myocamlbuild.ml" |
|
451 | 477 |
open Ocamlbuild_plugin;; |
452 | 478 |
let package_default = |
453 |
{MyOCamlbuildBase.lib_ocaml = []; lib_c = []; flags = []; } |
|
479 |
{MyOCamlbuildBase.lib_ocaml = []; lib_c = []; flags = []; includes = []; }
|
|
454 | 480 |
;; |
455 | 481 |
|
456 | 482 |
let dispatch_default = MyOCamlbuildBase.dispatch_default package_default;; |
457 | 483 |
|
484 |
# 485 "myocamlbuild.ml" |
|
458 | 485 |
(* OASIS_STOP *) |
459 | 486 |
Ocamlbuild_plugin.dispatch dispatch_default;; |
setup.ml | ||
---|---|---|
1 | 1 |
(* setup.ml generated for the first time by OASIS v0.2.0 *) |
2 | 2 |
|
3 | 3 |
(* OASIS_START *) |
4 |
(* DO NOT EDIT (digest: 6666f62d55895fd4c2e5dbbf8e9d4998) *)
|
|
4 |
(* DO NOT EDIT (digest: 199ddf56e2399fc7ababf7124443bcc9) *)
|
|
5 | 5 |
(* |
6 |
Regenerated by OASIS v0.2.0
|
|
6 |
Regenerated by OASIS v0.3.0
|
|
7 | 7 |
Visit http://oasis.forge.ocamlcore.org for more information and |
8 | 8 |
documentation about functions used in this file. |
9 | 9 |
*) |
10 | 10 |
module OASISGettext = struct |
11 |
# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISGettext.ml"
|
|
12 |
|
|
13 |
let ns_ str =
|
|
11 |
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISGettext.ml" *)
|
|
12 |
|
|
13 |
let ns_ str = |
|
14 | 14 |
str |
15 |
|
|
16 |
let s_ str =
|
|
15 |
|
|
16 |
let s_ str = |
|
17 | 17 |
str |
18 |
|
|
18 |
|
|
19 | 19 |
let f_ (str : ('a, 'b, 'c, 'd) format4) = |
20 | 20 |
str |
21 |
|
|
21 |
|
|
22 | 22 |
let fn_ fmt1 fmt2 n = |
23 | 23 |
if n = 1 then |
24 | 24 |
fmt1^^"" |
25 | 25 |
else |
26 | 26 |
fmt2^^"" |
27 |
|
|
28 |
let init =
|
|
27 |
|
|
28 |
let init = |
|
29 | 29 |
[] |
30 |
|
|
30 |
|
|
31 | 31 |
end |
32 | 32 |
|
33 | 33 |
module OASISContext = struct |
34 |
# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISContext.ml"
|
|
35 |
|
|
36 |
open OASISGettext
|
|
37 |
|
|
34 |
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISContext.ml" *)
|
|
35 |
|
|
36 |
open OASISGettext |
|
37 |
|
|
38 | 38 |
type level = |
39 | 39 |
[ `Debug |
40 |
| `Info
|
|
40 |
| `Info |
|
41 | 41 |
| `Warning |
42 | 42 |
| `Error] |
43 |
|
|
43 |
|
|
44 | 44 |
type t = |
45 | 45 |
{ |
46 |
verbose: bool; |
|
47 |
debug: bool; |
|
48 |
ignore_plugins: bool; |
|
49 |
printf: level -> string -> unit; |
|
46 |
quiet: bool; |
|
47 |
info: bool; |
|
48 |
debug: bool; |
|
49 |
ignore_plugins: bool; |
|
50 |
ignore_unknown_fields: bool; |
|
51 |
printf: level -> string -> unit; |
|
50 | 52 |
} |
51 |
|
|
52 |
let printf lvl str =
|
|
53 |
let beg =
|
|
54 |
match lvl with
|
|
53 |
|
|
54 |
let printf lvl str = |
|
55 |
let beg = |
|
56 |
match lvl with |
|
55 | 57 |
| `Error -> s_ "E: " |
56 | 58 |
| `Warning -> s_ "W: " |
57 | 59 |
| `Info -> s_ "I: " |
58 | 60 |
| `Debug -> s_ "D: " |
59 | 61 |
in |
60 |
match lvl with |
|
61 |
| `Error -> |
|
62 |
prerr_endline (beg^str) |
|
63 |
| _ -> |
|
64 |
print_endline (beg^str) |
|
65 |
|
|
62 |
prerr_endline (beg^str) |
|
63 |
|
|
66 | 64 |
let default = |
67 |
ref
|
|
65 |
ref |
|
68 | 66 |
{ |
69 |
verbose = true; |
|
70 |
debug = false; |
|
71 |
ignore_plugins = false; |
|
72 |
printf = printf; |
|
67 |
quiet = false; |
|
68 |
info = false; |
|
69 |
debug = false; |
|
70 |
ignore_plugins = false; |
|
71 |
ignore_unknown_fields = false; |
|
72 |
printf = printf; |
|
73 | 73 |
} |
74 |
|
|
75 |
let quiet = |
|
76 |
{!default with |
|
77 |
verbose = false; |
|
78 |
debug = false; |
|
79 |
} |
|
80 |
|
|
81 |
|
|
74 |
|
|
75 |
let quiet = |
|
76 |
{!default with quiet = true} |
|
77 |
|
|
78 |
|
|
82 | 79 |
let args () = |
83 | 80 |
["-quiet", |
84 |
Arg.Unit (fun () -> default := {!default with verbose = false}),
|
|
81 |
Arg.Unit (fun () -> default := {!default with quiet = true}),
|
|
85 | 82 |
(s_ " Run quietly"); |
86 |
|
|
83 |
|
|
84 |
"-info", |
|
85 |
Arg.Unit (fun () -> default := {!default with info = true}), |
|
86 |
(s_ " Display information message"); |
|
87 |
|
|
88 |
|
|
87 | 89 |
"-debug", |
88 | 90 |
Arg.Unit (fun () -> default := {!default with debug = true}), |
89 | 91 |
(s_ " Output debug message")] |
90 | 92 |
end |
91 | 93 |
|
94 |
module OASISString = struct |
|
95 |
(* # 1 "/build/buildd/oasis-0.3.0/src/oasis/OASISString.ml" *) |
|
96 |
|
|
97 |
|
|
98 |
|
|
99 |
(** Various string utilities. |
|
100 |
|
|
101 |
Mostly inspired by extlib and batteries ExtString and BatString libraries. |
|
102 |
|
|
103 |
@author Sylvain Le Gall |
|
104 |
*) |
|
105 |
|
|
106 |
let nsplitf str f = |
|
107 |
if str = "" then |
|
108 |
[] |
|
109 |
else |
|
110 |
let buf = Buffer.create 13 in |
|
111 |
let lst = ref [] in |
|
112 |
let push () = |
|
113 |
lst := Buffer.contents buf :: !lst; |
|
114 |
Buffer.clear buf |
|
115 |
in |
|
116 |
let str_len = String.length str in |
|
117 |
for i = 0 to str_len - 1 do |
|
118 |
if f str.[i] then |
|
119 |
push () |
|
120 |
else |
|
121 |
Buffer.add_char buf str.[i] |
|
122 |
done; |
|
123 |
push (); |
|
124 |
List.rev !lst |
|
125 |
|
|
126 |
(** [nsplit c s] Split the string [s] at char [c]. It doesn't include the |
|
127 |
separator. |
|
128 |
*) |
|
129 |
let nsplit str c = |
|
130 |
nsplitf str ((=) c) |
|
131 |
|
|
132 |
let find ~what ?(offset=0) str = |
|
133 |
let what_idx = ref 0 in |
|
134 |
let str_idx = ref offset in |
|
135 |
while !str_idx < String.length str && |
|
136 |
!what_idx < String.length what do |
|
137 |
if str.[!str_idx] = what.[!what_idx] then |
|
138 |
incr what_idx |
|
139 |
else |
|
140 |
what_idx := 0; |
|
141 |
incr str_idx |
|
142 |
done; |
|
143 |
if !what_idx <> String.length what then |
|
144 |
raise Not_found |
|
145 |
else |
|
146 |
!str_idx - !what_idx |
|
147 |
|
|
148 |
let sub_start str len = |
|
149 |
let str_len = String.length str in |
|
150 |
if len >= str_len then |
|
151 |
"" |
|
152 |
else |
|
153 |
String.sub str len (str_len - len) |
|
154 |
|
|
155 |
let sub_end ?(offset=0) str len = |
|
156 |
let str_len = String.length str in |
|
157 |
if len >= str_len then |
|
158 |
"" |
|
159 |
else |
|
160 |
String.sub str 0 (str_len - len) |
|
161 |
|
|
162 |
let starts_with ~what ?(offset=0) str = |
|
163 |
let what_idx = ref 0 in |
|
164 |
let str_idx = ref offset in |
|
165 |
let ok = ref true in |
|
166 |
while !ok && |
|
167 |
!str_idx < String.length str && |
|
168 |
!what_idx < String.length what do |
|
169 |
if str.[!str_idx] = what.[!what_idx] then |
|
170 |
incr what_idx |
|
171 |
else |
|
172 |
ok := false; |
|
173 |
incr str_idx |
|
174 |
done; |
|
175 |
if !what_idx = String.length what then |
|
176 |
true |
|
177 |
else |
|
178 |
false |
|
179 |
|
|
180 |
let strip_starts_with ~what str = |
|
181 |
if starts_with ~what str then |
|
182 |
sub_start str (String.length what) |
|
183 |
else |
|
184 |
raise Not_found |
|
185 |
|
|
186 |
let ends_with ~what ?(offset=0) str = |
|
187 |
let what_idx = ref ((String.length what) - 1) in |
|
188 |
let str_idx = ref ((String.length str) - 1) in |
|
189 |
let ok = ref true in |
|
190 |
while !ok && |
|
191 |
offset <= !str_idx && |
|
192 |
0 <= !what_idx do |
|
193 |
if str.[!str_idx] = what.[!what_idx] then |
|
194 |
decr what_idx |
|
195 |
else |
|
196 |
ok := false; |
|
197 |
decr str_idx |
|
198 |
done; |
|
199 |
if !what_idx = -1 then |
|
200 |
true |
|
201 |
else |
|
202 |
false |
|
203 |
|
|
204 |
let strip_ends_with ~what str = |
|
205 |
if ends_with ~what str then |
|
206 |
sub_end str (String.length what) |
|
207 |
else |
|
208 |
raise Not_found |
|
209 |
|
|
210 |
let replace_chars f s = |
|
211 |
let buf = String.make (String.length s) 'X' in |
|
212 |
for i = 0 to String.length s - 1 do |
|
213 |
buf.[i] <- f s.[i] |
|
214 |
done; |
|
215 |
buf |
|
216 |
|
|
217 |
end |
|
218 |
|
|
92 | 219 |
module OASISUtils = struct |
93 |
# 21 "/build/buildd/oasis-0.2.0/src/oasis/OASISUtils.ml" |
|
94 |
|
|
220 |
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/OASISUtils.ml" *) |
|
221 |
|
|
222 |
open OASISGettext |
|
223 |
|
|
95 | 224 |
module MapString = Map.Make(String) |
96 |
|
|
225 |
|
|
97 | 226 |
let map_string_of_assoc assoc = |
98 | 227 |
List.fold_left |
99 | 228 |
(fun acc (k, v) -> MapString.add k v acc) |
100 | 229 |
MapString.empty |
101 | 230 |
assoc |
102 |
|
|
231 |
|
|
103 | 232 |
module SetString = Set.Make(String) |
104 |
|
|
233 |
|
|
105 | 234 |
let set_string_add_list st lst = |
106 |
List.fold_left
|
|
235 |
List.fold_left |
|
107 | 236 |
(fun acc e -> SetString.add e acc) |
108 | 237 |
st |
109 | 238 |
lst |
110 |
|
|
239 |
|
|
111 | 240 |
let set_string_of_list = |
112 | 241 |
set_string_add_list |
113 | 242 |
SetString.empty |
114 |
|
|
115 |
|
|
116 |
let compare_csl s1 s2 =
|
|
243 |
|
|
244 |
|
|
245 |
let compare_csl s1 s2 = |
|
117 | 246 |
String.compare (String.lowercase s1) (String.lowercase s2) |
118 |
|
|
119 |
module HashStringCsl =
|
|
247 |
|
|
248 |
module HashStringCsl = |
|
120 | 249 |
Hashtbl.Make |
121 | 250 |
(struct |
122 | 251 |
type t = string |
123 |
|
|
124 |
let equal s1 s2 =
|
|
252 |
|
|
253 |
let equal s1 s2 = |
|
125 | 254 |
(String.lowercase s1) = (String.lowercase s2) |
126 |
|
|
255 |
|
|
127 | 256 |
let hash s = |
128 | 257 |
Hashtbl.hash (String.lowercase s) |
129 | 258 |
end) |
130 |
|
|
131 |
let split sep str = |
|
132 |
let str_len = |
|
133 |
String.length str |
|
134 |
in |
|
135 |
let rec split_aux acc pos = |
|
136 |
if pos < str_len then |
|
137 |
( |
|
138 |
let pos_sep = |
|
139 |
try |
|
140 |
String.index_from str pos sep |
|
141 |
with Not_found -> |
|
142 |
str_len |
|
143 |
in |
|
144 |
let part = |
|
145 |
String.sub str pos (pos_sep - pos) |
|
146 |
in |
|
147 |
let acc = |
|
148 |
part :: acc |
|
149 |
in |
|
150 |
if pos_sep >= str_len then |
|
151 |
( |
|
152 |
(* Nothing more in the string *) |
|
153 |
List.rev acc |
|
154 |
) |
|
155 |
else if pos_sep = (str_len - 1) then |
|
156 |
( |
|
157 |
(* String end with a separator *) |
|
158 |
List.rev ("" :: acc) |
|
159 |
) |
|
160 |
else |
|
161 |
( |
|
162 |
split_aux acc (pos_sep + 1) |
|
163 |
) |
|
164 |
) |
|
165 |
else |
|
166 |
( |
|
167 |
List.rev acc |
|
168 |
) |
|
169 |
in |
|
170 |
split_aux [] 0 |
|
171 |
|
|
172 |
|
|
173 |
let varname_of_string ?(hyphen='_') s = |
|
259 |
|
|
260 |
let varname_of_string ?(hyphen='_') s = |
|
174 | 261 |
if String.length s = 0 then |
175 | 262 |
begin |
176 |
invalid_arg "varname_of_string"
|
|
263 |
invalid_arg "varname_of_string" |
|
177 | 264 |
end |
178 | 265 |
else |
179 | 266 |
begin |
180 |
let buff = |
|
181 |
Buffer.create (String.length s) |
|
182 |
in |
|
183 |
(* Start with a _ if digit *) |
|
184 |
if '0' <= s.[0] && s.[0] <= '9' then |
|
185 |
Buffer.add_char buff hyphen; |
|
186 |
|
|
187 |
String.iter |
|
267 |
let buf = |
|
268 |
OASISString.replace_chars |
|
188 | 269 |
(fun c -> |
189 |
if ('a' <= c && c <= 'z')
|
|
190 |
||
|
|
191 |
('A' <= c && c <= 'Z')
|
|
192 |
||
|
|
270 |
if ('a' <= c && c <= 'z') |
|
271 |
|| |
|
272 |
('A' <= c && c <= 'Z') |
|
273 |
|| |
|
193 | 274 |
('0' <= c && c <= '9') then |
194 |
Buffer.add_char buff c
|
|
275 |
c |
|
195 | 276 |
else |
196 |
Buffer.add_char buff hyphen)
|
|
277 |
hyphen) |
|
197 | 278 |
s; |
198 |
|
|
199 |
String.lowercase (Buffer.contents buff) |
|
279 |
in |
|
280 |
let buf = |
|
281 |
(* Start with a _ if digit *) |
|
282 |
if '0' <= s.[0] && s.[0] <= '9' then |
|
283 |
"_"^buf |
|
284 |
else |
|
285 |
buf |
|
286 |
in |
|
287 |
String.lowercase buf |
|
200 | 288 |
end |
201 |
|
|
202 |
let varname_concat ?(hyphen='_') p s = |
|
203 |
let p = |
|
204 |
let p_len = |
|
205 |
String.length p |
|
206 |
in |
|
207 |
if p_len > 0 && p.[p_len - 1] = hyphen then |
|
208 |
String.sub p 0 (p_len - 1) |
|
209 |
else |
|
210 |
p |
|
289 |
|
|
290 |
let varname_concat ?(hyphen='_') p s = |
|
291 |
let what = String.make 1 hyphen in |
|
292 |
let p = |
|
293 |
try |
|
294 |
OASISString.strip_ends_with ~what p |
|
295 |
with Not_found -> |
|
296 |
p |
|
211 | 297 |
in |
212 |
let s = |
|
213 |
let s_len = |
|
214 |
String.length s |
|
215 |
in |
|
216 |
if s_len > 0 && s.[0] = hyphen then |
|
217 |
String.sub s 1 (s_len - 1) |
|
218 |
else |
|
219 |
s |
|
298 |
let s = |
|
299 |
try |
|
300 |
OASISString.strip_starts_with ~what s |
|
301 |
with Not_found -> |
|
302 |
s |
|
220 | 303 |
in |
221 |
Printf.sprintf "%s%c%s" p hyphen s
|
|
222 |
|
|
223 |
|
|
224 |
let is_varname str =
|
|
304 |
p^what^s
|
|
305 |
|
|
306 |
|
|
307 |
let is_varname str = |
|
225 | 308 |
str = varname_of_string str |
226 |
|
|
227 |
let failwithf1 fmt a = |
|
228 |
failwith (Printf.sprintf fmt a) |
|
229 |
|
|
230 |
let failwithf2 fmt a b = |
|
231 |
failwith (Printf.sprintf fmt a b) |
|
232 |
|
|
233 |
let failwithf3 fmt a b c = |
|
234 |
failwith (Printf.sprintf fmt a b c) |
|
235 |
|
|
236 |
let failwithf4 fmt a b c d = |
|
237 |
failwith (Printf.sprintf fmt a b c d) |
|
238 |
|
|
239 |
let failwithf5 fmt a b c d e = |
|
240 |
failwith (Printf.sprintf fmt a b c d e) |
|
241 |
|
|
309 |
|
|
310 |
let failwithf fmt = Printf.ksprintf failwith fmt |
|
311 |
|
|
242 | 312 |
end |
243 | 313 |
|
244 | 314 |
module PropList = struct |
245 |
# 21 "/build/buildd/oasis-0.2.0/src/oasis/PropList.ml"
|
|
246 |
|
|
315 |
(* # 21 "/build/buildd/oasis-0.3.0/src/oasis/PropList.ml" *)
|
|
316 |
|
|
247 | 317 |
open OASISGettext |
248 |
|
|
318 |
|
|
249 | 319 |
type name = string |
250 |
|
|
251 |
exception Not_set of name * string option
|
|
320 |
|
|
321 |
exception Not_set of name * string option |
|
252 | 322 |
exception No_printer of name |
253 | 323 |
exception Unknown_field of name * name |
254 |
|
|
255 |
let string_of_exception = |
|
256 |
function |
|
257 |
| Not_set (nm, Some rsn) -> |
|
258 |
Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn |
|
259 |
| Not_set (nm, None) -> |
|
260 |
Printf.sprintf (f_ "Field '%s' is not set") nm |
|
261 |
| No_printer nm -> |
|
262 |
Printf.sprintf (f_ "No default printer for value %s") nm |
|
263 |
| Unknown_field (nm, schm) -> |
|
264 |
Printf.sprintf (f_ "Field %s is not defined in schema %s") nm schm |
|
265 |
| e -> |
|
266 |
raise e |
|
267 |
|
|
324 |
|
|
325 |
let () = |
|
326 |
Printexc.register_printer |
|
327 |
(function |
|
328 |
| Not_set (nm, Some rsn) -> |
|
329 |
Some |
|
330 |
(Printf.sprintf (f_ "Field '%s' is not set: %s") nm rsn) |
|
331 |
| Not_set (nm, None) -> |
|
332 |
Some |
|
333 |
(Printf.sprintf (f_ "Field '%s' is not set") nm) |
|
334 |
| No_printer nm -> |
|
335 |
Some |
|
336 |
(Printf.sprintf (f_ "No default printer for value %s") nm) |
|
337 |
| Unknown_field (nm, schm) -> |
|
338 |
Some |
|
339 |
(Printf.sprintf (f_ "Field %s is not defined in schema %s") nm schm) |
|
340 |
| _ -> |
|
341 |
None) |
|
342 |
|
|
268 | 343 |
module Data = |
269 | 344 |
struct |
270 |
|
|
271 |
type t =
|
|
345 |
|
|
346 |
type t = |
|
272 | 347 |
(name, unit -> unit) Hashtbl.t |
273 |
|
|
348 |
|
|
274 | 349 |
let create () = |
275 | 350 |
Hashtbl.create 13 |
276 |
|
|
351 |
|
|
277 | 352 |
let clear t = |
278 | 353 |
Hashtbl.clear t |
279 |
|
|
280 |
# 59 "/build/buildd/oasis-0.2.0/src/oasis/PropList.ml"
|
|
354 |
|
|
355 |
(* # 71 "/build/buildd/oasis-0.3.0/src/oasis/PropList.ml" *)
|
|
281 | 356 |
end |
282 |
|
|
283 |
module Schema =
|
|
357 |
|
|
358 |
module Schema = |
|
284 | 359 |
struct |
285 |
|
|
360 |
|
|
286 | 361 |
type ('ctxt, 'extra) value = |
287 | 362 |
{ |
288 | 363 |
get: Data.t -> string; |
... | ... | |
290 | 365 |
help: (unit -> string) option; |
291 | 366 |
extra: 'extra; |
292 | 367 |
} |
293 |
|
|
368 |
|
|
294 | 369 |
type ('ctxt, 'extra) t = |
295 | 370 |
{ |
296 | 371 |
name: name; |
... | ... | |
298 | 373 |
order: name Queue.t; |
299 | 374 |
name_norm: string -> string; |
300 | 375 |
} |
301 |
|
|
302 |
let create ?(case_insensitive=false) nm =
|
|
376 |
|
|
377 |
let create ?(case_insensitive=false) nm = |
|
303 | 378 |
{ |
304 | 379 |
name = nm; |
305 | 380 |
fields = Hashtbl.create 13; |
306 | 381 |
order = Queue.create (); |
307 |
name_norm =
|
|
308 |
(if case_insensitive then
|
|
382 |
name_norm = |
|
383 |
(if case_insensitive then |
|
309 | 384 |
String.lowercase |
310 | 385 |
else |
311 | 386 |
fun s -> s); |
312 | 387 |
} |
313 |
|
|
314 |
let add t nm set get extra help =
|
|
315 |
let key =
|
|
388 |
|
|
389 |
let add t nm set get extra help = |
|
390 |
let key = |
|
316 | 391 |
t.name_norm nm |
317 | 392 |
in |
318 |
|
|
393 |
|
|
319 | 394 |
if Hashtbl.mem t.fields key then |
320 | 395 |
failwith |
321 |
(Printf.sprintf
|
|
396 |
(Printf.sprintf |
|
322 | 397 |
(f_ "Field '%s' is already defined in schema '%s'") |
323 | 398 |
nm t.name); |
324 |
Hashtbl.add
|
|
325 |
t.fields
|
|
326 |
key
|
|
399 |
Hashtbl.add |
|
400 |
t.fields |
|
401 |
key |
|
327 | 402 |
{ |
328 |
set = set;
|
|
329 |
get = get;
|
|
403 |
set = set; |
|
404 |
get = get; |
|
330 | 405 |
help = help; |
331 | 406 |
extra = extra; |
332 | 407 |
}; |
333 |
Queue.add nm t.order
|
|
334 |
|
|
408 |
Queue.add nm t.order |
|
409 |
|
|
335 | 410 |
let mem t nm = |
336 |
Hashtbl.mem t.fields nm
|
|
337 |
|
|
338 |
let find t nm =
|
|
411 |
Hashtbl.mem t.fields nm |
|
412 |
|
|
413 |
let find t nm = |
|
339 | 414 |
try |
340 | 415 |
Hashtbl.find t.fields (t.name_norm nm) |
341 | 416 |
with Not_found -> |
342 | 417 |
raise (Unknown_field (nm, t.name)) |
343 |
|
|
418 |
|
|
344 | 419 |
let get t data nm = |
345 | 420 |
(find t nm).get data |
346 |
|
|
421 |
|
|
347 | 422 |
let set t data nm ?context x = |
348 |
(find t nm).set
|
|
349 |
data
|
|
350 |
?context
|
|
423 |
(find t nm).set |
|
424 |
data |
|
425 |
?context |
|
351 | 426 |
x |
352 |
|
|
427 |
|
|
353 | 428 |
let fold f acc t = |
354 |
Queue.fold
|
|
429 |
Queue.fold |
|
355 | 430 |
(fun acc k -> |
356 | 431 |
let v = |
357 | 432 |
find t k |
358 | 433 |
in |
359 | 434 |
f acc k v.extra v.help) |
360 |
acc
|
|
435 |
acc |
|
361 | 436 |
t.order |
362 |
|
|
437 |
|
|
363 | 438 |
let iter f t = |
364 |
fold
|
|
439 |
fold |
|
365 | 440 |
(fun () -> f) |
366 | 441 |
() |
367 | 442 |
t |
368 |
|
|
369 |
let name t =
|
|
443 |
|
|
444 |
let name t = |
|
370 | 445 |
t.name |
371 | 446 |
end |
372 |
|
|
447 |
|
|
373 | 448 |
module Field = |
374 | 449 |
struct |
375 |
|
|
450 |
|
|
376 | 451 |
type ('ctxt, 'value, 'extra) t = |
377 | 452 |
{ |
378 | 453 |
set: Data.t -> ?context:'ctxt -> 'value -> unit; |
... | ... | |
382 | 457 |
help: (unit -> string) option; |
383 | 458 |
extra: 'extra; |
384 | 459 |
} |
385 |
|
|
386 |
let new_id =
|
|
460 |
|
|
461 |
let new_id = |
|
387 | 462 |
let last_id = |
388 | 463 |
ref 0 |
389 | 464 |
in |
390 | 465 |
fun () -> incr last_id; !last_id |
391 |
|
|
466 |
|
|
392 | 467 |
let create ?schema ?name ?parse ?print ?default ?update ?help extra = |
393 | 468 |
(* Default value container *) |
394 |
let v =
|
|
395 |
ref None
|
|
469 |
let v = |
|
470 |
ref None |
|
396 | 471 |
in |
397 |
|
|
472 |
|
|
398 | 473 |
(* If name is not given, create unique one *) |
399 |
let nm =
|
|
400 |
match name with
|
|
474 |
let nm = |
|
475 |
match name with |
|
401 | 476 |
| Some s -> s |
402 | 477 |
| None -> Printf.sprintf "_anon_%d" (new_id ()) |
403 | 478 |
in |
404 |
|
|
479 |
|
|
405 | 480 |
(* Last chance to get a value: the default *) |
406 |
let default () =
|
|
407 |
match default with
|
|
481 |
let default () = |
|
482 |
match default with |
|
408 | 483 |
| Some d -> d |
409 | 484 |
| None -> raise (Not_set (nm, Some (s_ "no default value"))) |
410 | 485 |
in |
411 |
|
|
486 |
|
|
412 | 487 |
(* Get data *) |
413 | 488 |
let get data = |
414 | 489 |
(* Get value *) |
415 |
try
|
|
490 |
try |
|
416 | 491 |
(Hashtbl.find data nm) (); |
417 |
match !v with
|
|
418 |
| Some x -> x
|
|
492 |
match !v with |
|
493 |
| Some x -> x |
|
419 | 494 |
| None -> default () |
420 | 495 |
with Not_found -> |
421 | 496 |
default () |
422 | 497 |
in |
423 |
|
|
498 |
|
|
424 | 499 |
(* Set data *) |
425 |
let set data ?context x =
|
|
426 |
let x =
|
|
427 |
match update with
|
|
500 |
let set data ?context x = |
|
501 |
let x = |
|
502 |
match update with |
|
428 | 503 |
| Some f -> |
429 | 504 |
begin |
430 |
try
|
|
505 |
try |
|
431 | 506 |
f ?context (get data) x |
432 | 507 |
with Not_set _ -> |
433 | 508 |
x |
... | ... | |
435 | 510 |
| None -> |
436 | 511 |
x |
437 | 512 |
in |
438 |
Hashtbl.replace
|
|
439 |
data
|
|
440 |
nm
|
|
441 |
(fun () -> v := Some x)
|
|
513 |
Hashtbl.replace |
|
514 |
data |
|
515 |
nm |
|
516 |
(fun () -> v := Some x) |
|
442 | 517 |
in |
443 |
|
|
518 |
|
|
444 | 519 |
(* Parse string value, if possible *) |
445 | 520 |
let parse = |
446 |
match parse with
|
|
447 |
| Some f ->
|
|
521 |
match parse with |
|
522 |
| Some f -> |
|
448 | 523 |
f |
449 | 524 |
| None -> |
450 | 525 |
fun ?context s -> |
451 |
failwith
|
|
452 |
(Printf.sprintf
|
|
526 |
failwith |
|
527 |
(Printf.sprintf |
|
453 | 528 |
(f_ "Cannot parse field '%s' when setting value %S") |
454 | 529 |
nm |
455 | 530 |
s) |
456 | 531 |
in |
457 |
|
|
532 |
|
|
458 | 533 |
(* Set data, from string *) |
459 | 534 |
let sets data ?context s = |
460 | 535 |
set ?context data (parse ?context s) |
461 | 536 |
in |
462 |
|
|
537 |
|
|
463 | 538 |
(* Output value as string, if possible *) |
464 | 539 |
let print = |
465 | 540 |
match print with |
... | ... | |
468 | 543 |
| None -> |
469 | 544 |
fun _ -> raise (No_printer nm) |
470 | 545 |
in |
471 |
|
|
546 |
|
|
472 | 547 |
(* Get data, as a string *) |
473 | 548 |
let gets data = |
474 | 549 |
print (get data) |
475 | 550 |
in |
476 |
|
|
477 |
begin
|
|
478 |
match schema with
|
|
551 |
|
|
552 |
begin |
|
553 |
match schema with |
|
479 | 554 |
| Some t -> |
480 | 555 |
Schema.add t nm sets gets extra help |
481 | 556 |
| None -> |
482 | 557 |
() |
483 | 558 |
end; |
484 |
|
|
559 |
|
|
485 | 560 |
{ |
486 | 561 |
set = set; |
487 | 562 |
get = get; |
... | ... | |
490 | 565 |
help = help; |
491 | 566 |
extra = extra; |
492 | 567 |
} |
493 |
|
|
494 |
let fset data t ?context x =
|
|
568 |
|
|
569 |
let fset data t ?context x = |
|
495 | 570 |
t.set data ?context x |
496 |
|
|
571 |
|
|
497 | 572 |
let fget data t = |
498 | 573 |
t.get data |
499 |
|
|
574 |
|
Also available in: Unified diff
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