Project

General

Profile

Revision 53206908

View differences:

Makefile.in
3 3
prefix=@prefix@
4 4
exec_prefix=@exec_prefix@
5 5
bindir=@bindir@
6
datadir = ${prefix}/share
6
datarootdir = ${prefix}/share
7 7
includedir = ${prefix}/include
8 8

  
9
LUSI_LIBS=include/math.lusi include/conv.lusi
9
LUSI_LIBS=include/math.lusi include/conv.lusi include/mpfr_lustre.lusi
10

  
10 11
LOCAL_BINDIR=bin
11 12
LOCAL_DOCDIR=doc/manual
12 13

  
13 14
lustrec:
14 15
	@echo Compiling binary lustrec
15
	@$(OCAMLBUILD) -cflags -I,@OCAMLGRAPH_PATH@ -lflag @OCAMLGRAPH_PATH@/graph.cmxa -I src -I src/backends/C src/main_lustre_compiler.native
16
	@mkdir -p $(LOCAL_BINDIR)
17
	@mv _build/src/main_lustre_compiler.native $(LOCAL_BINDIR)/lustrec
16
	@make -C src lustrec
18 17

  
19 18
doc:
20 19
	@echo Generating doc
21
	@$(OCAMLBUILD) lustrec.docdir/index.html
22
	@rm -rf $(LOCAL_DOCDIR)
23
	@cp -rf _build/lustrec.docdir $(LOCAL_DOCDIR)
20
	@make -C src doc
24 21

  
25 22
dot: doc
26
	$(OCAMLBUILD) lustrec.docdir/lustrec.dot
27
	dot -T ps -o lustrec.dot _build/lustrec.docdir/lustrec.dot
28
	mv _build/lustrec.docdir/lustrec.dot $(LOCAL_DOCDIR)
23
	@make -C src dot
29 24

  
30 25
clean:
31
	$(OCAMLBUILD) -clean
26
	@make -C src clean
27
	@rm -f  $(LUSI_LIBS:%.lusi=%.lusic) $(LUSI_LIBS:%.lusi=%.h)
32 28

  
33 29
dist-clean: clean
34
	@rm -f Makefile myocamlbuild.ml config.log config.status configure include/*.lusic include/math.h include/conv.h
35 30

  
36
%.lusic: %.lusi
31
%.lusic: %.lusi 
37 32
	@echo Compiling $<
38
	@$(LOCAL_BINDIR)/lustrec -verbose 0 -d include $< 
33
	@$(LOCAL_BINDIR)/lustrec $(OPTION_LUSIC) -verbose 0 -d include $< 
39 34

  
40
clean-lusic:
41
	@rm -f $(LUSI_LIBS:%.lusi=%.lusic)
35
include/mpfr_lustre.lusic: OPTION_LUSIC=-mpfr 1
42 36

  
43
compile-lusi: $(LUSI_LIBS:%.lusi=%.lusic)
37
compile-lusi: lustrec $(LUSI_LIBS:%.lusi=%.lusic)
44 38

  
45
install: clean-lusic compile-lusi
39
install: compile-lusi
46 40
	mkdir -p ${bindir}
47 41
	install -m 0755 $(LOCAL_BINDIR)/* ${bindir}
48 42
	mkdir -p ${includedir}/lustrec
49 43
	cp include/* ${includedir}/lustrec
50
	mkdir -p ${datadir}
51
	install -m 0655 share/FindLustre.cmake ${datadir}
52 44

  
53 45
.PHONY: compile-lusi doc dot lustrec lustrec.odocl clean install dist-clean
54 46

  
configure.ac
1
define([svnversion], esyscmd([sh -c "svnversion|sed "s/:.*//"|tr -d '\n'"]))dnl
1
dnl define([svnversion], esyscmd([sh -c "svnversion|sed "s/:.*//"|tr -d '\n'"]))
2 2
AC_INIT([lustrec], [1.1-svnversion], [ploc@garoche.net])
3 3

  
4 4

  
......
86 86
# Instanciation
87 87
AC_CONFIG_FILES([Makefile
88 88
		 src/Makefile
89
                 src/myocamlbuild.ml
90 89
		 src/version.ml])
91 90

  
92 91
AC_OUTPUT
setup.ml
1
(* setup.ml generated for the first time by OASIS v0.2.0 *)
2

  
3
(* OASIS_START *)
4
(* DO NOT EDIT (digest: cbef9780a942e499729218b6c22c21f0) *)
5
(*
6
   Regenerated by OASIS v0.3.0
7
   Visit http://oasis.forge.ocamlcore.org for more information and
8
   documentation about functions used in this file.
9
*)
10
module OASISGettext = struct
11
(* # 21 "src/oasis/OASISGettext.ml" *)
12

  
13
  let ns_ str =
14
    str
15

  
16
  let s_ str =
17
    str
18

  
19
  let f_ (str : ('a, 'b, 'c, 'd) format4) =
20
    str
21

  
22
  let fn_ fmt1 fmt2 n =
23
    if n = 1 then
24
      fmt1^^""
25
    else
26
      fmt2^^""
27

  
28
  let init =
29
    []
30

  
31
end
32

  
33
module OASISContext = struct
34
(* # 21 "src/oasis/OASISContext.ml" *)
35

  
36
  open OASISGettext
37

  
38
  type level =
39
    [ `Debug
40
    | `Info
41
    | `Warning
42
    | `Error]
43

  
44
  type t =
45
    {
46
      quiet:                 bool;
47
      info:                  bool;
48
      debug:                 bool;
49
      ignore_plugins:        bool;
50
      ignore_unknown_fields: bool;
51
      printf:                level -> string -> unit;
52
    }
53

  
54
  let printf lvl str =
55
    let beg =
56
      match lvl with
57
        | `Error -> s_ "E: "
58
        | `Warning -> s_ "W: "
59
        | `Info  -> s_ "I: "
60
        | `Debug -> s_ "D: "
61
    in
62
      prerr_endline (beg^str)
63

  
64
  let default =
65
    ref
66
      {
67
        quiet                 = false;
68
        info                  = false;
69
        debug                 = false;
70
        ignore_plugins        = false;
71
        ignore_unknown_fields = false;
72
        printf                = printf;
73
      }
74

  
75
  let quiet =
76
    {!default with quiet = true}
77

  
78

  
79
  let args () =
80
    ["-quiet",
81
     Arg.Unit (fun () -> default := {!default with quiet = true}),
82
     (s_ " Run quietly");
83

  
84
     "-info",
85
     Arg.Unit (fun () -> default := {!default with info = true}),
86
     (s_ " Display information message");
87

  
88

  
89
     "-debug",
90
     Arg.Unit (fun () -> default := {!default with debug = true}),
91
     (s_ " Output debug message")]
92
end
93

  
94
module OASISString = struct
95
(* # 1 "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

  
219
module OASISUtils = struct
220
(* # 21 "src/oasis/OASISUtils.ml" *)
221

  
222
  open OASISGettext
223

  
224
  module MapString = Map.Make(String)
225

  
226
  let map_string_of_assoc assoc =
227
    List.fold_left
228
      (fun acc (k, v) -> MapString.add k v acc)
229
      MapString.empty
230
      assoc
231

  
232
  module SetString = Set.Make(String)
233

  
234
  let set_string_add_list st lst =
235
    List.fold_left
236
      (fun acc e -> SetString.add e acc)
237
      st
238
      lst
239

  
240
  let set_string_of_list =
241
    set_string_add_list
242
      SetString.empty
243

  
244

  
245
  let compare_csl s1 s2 =
246
    String.compare (String.lowercase s1) (String.lowercase s2)
247

  
248
  module HashStringCsl =
249
    Hashtbl.Make
250
      (struct
251
         type t = string
252

  
253
         let equal s1 s2 =
254
             (String.lowercase s1) = (String.lowercase s2)
255

  
256
         let hash s =
257
           Hashtbl.hash (String.lowercase s)
258
       end)
259

  
260
  let varname_of_string ?(hyphen='_') s =
261
    if String.length s = 0 then
262
      begin
263
        invalid_arg "varname_of_string"
264
      end
265
    else
266
      begin
267
        let buf =
268
          OASISString.replace_chars
269
            (fun c ->
270
               if ('a' <= c && c <= 'z')
271
                 ||
272
                  ('A' <= c && c <= 'Z')
273
                 ||
274
                  ('0' <= c && c <= '9') then
275
                 c
276
               else
277
                 hyphen)
278
            s;
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
288
      end
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
297
    in
298
    let s =
299
      try
300
        OASISString.strip_starts_with ~what s
301
      with Not_found ->
302
        s
303
    in
304
      p^what^s
305

  
306

  
307
  let is_varname str =
308
    str = varname_of_string str
309

  
310
  let failwithf fmt = Printf.ksprintf failwith fmt
311

  
312
end
313

  
314
module PropList = struct
315
(* # 21 "src/oasis/PropList.ml" *)
316

  
317
  open OASISGettext
318

  
319
  type name = string
320

  
321
  exception Not_set of name * string option
322
  exception No_printer of name
323
  exception Unknown_field of name * name
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

  
343
  module Data =
344
  struct
345

  
346
    type t =
347
        (name, unit -> unit) Hashtbl.t
348

  
349
    let create () =
350
      Hashtbl.create 13
351

  
352
    let clear t =
353
      Hashtbl.clear t
354

  
355
(* # 71 "src/oasis/PropList.ml" *)
356
  end
357

  
358
  module Schema =
359
  struct
360

  
361
    type ('ctxt, 'extra) value =
362
        {
363
          get:   Data.t -> string;
364
          set:   Data.t -> ?context:'ctxt -> string -> unit;
365
          help:  (unit -> string) option;
366
          extra: 'extra;
367
        }
368

  
369
    type ('ctxt, 'extra) t =
370
        {
371
          name:      name;
372
          fields:    (name, ('ctxt, 'extra) value) Hashtbl.t;
373
          order:     name Queue.t;
374
          name_norm: string -> string;
375
        }
376

  
377
    let create ?(case_insensitive=false) nm =
378
      {
379
        name      = nm;
380
        fields    = Hashtbl.create 13;
381
        order     = Queue.create ();
382
        name_norm =
383
          (if case_insensitive then
384
             String.lowercase
385
           else
386
             fun s -> s);
387
      }
388

  
389
    let add t nm set get extra help =
390
      let key =
391
        t.name_norm nm
392
      in
393

  
394
        if Hashtbl.mem t.fields key then
395
          failwith
396
            (Printf.sprintf
397
               (f_ "Field '%s' is already defined in schema '%s'")
398
               nm t.name);
399
        Hashtbl.add
400
          t.fields
401
          key
402
          {
403
            set   = set;
404
            get   = get;
405
            help  = help;
406
            extra = extra;
407
          };
408
        Queue.add nm t.order
409

  
410
    let mem t nm =
411
      Hashtbl.mem t.fields nm
412

  
413
    let find t nm =
414
      try
415
        Hashtbl.find t.fields (t.name_norm nm)
416
      with Not_found ->
417
        raise (Unknown_field (nm, t.name))
418

  
419
    let get t data nm =
420
      (find t nm).get data
421

  
422
    let set t data nm ?context x =
423
      (find t nm).set
424
        data
425
        ?context
426
        x
427

  
428
    let fold f acc t =
429
      Queue.fold
430
        (fun acc k ->
431
           let v =
432
             find t k
433
           in
434
             f acc k v.extra v.help)
435
        acc
436
        t.order
437

  
438
    let iter f t =
439
      fold
440
        (fun () -> f)
441
        ()
442
        t
443

  
444
    let name t =
445
      t.name
446
  end
447

  
448
  module Field =
449
  struct
450

  
451
    type ('ctxt, 'value, 'extra) t =
452
        {
453
          set:    Data.t -> ?context:'ctxt -> 'value -> unit;
454
          get:    Data.t -> 'value;
455
          sets:   Data.t -> ?context:'ctxt -> string -> unit;
456
          gets:   Data.t -> string;
457
          help:   (unit -> string) option;
458
          extra:  'extra;
459
        }
460

  
461
    let new_id =
462
      let last_id =
463
        ref 0
464
      in
465
        fun () -> incr last_id; !last_id
466

  
467
    let create ?schema ?name ?parse ?print ?default ?update ?help extra =
468
      (* Default value container *)
469
      let v =
470
        ref None
471
      in
472

  
473
      (* If name is not given, create unique one *)
474
      let nm =
475
        match name with
476
          | Some s -> s
477
          | None -> Printf.sprintf "_anon_%d" (new_id ())
478
      in
479

  
480
      (* Last chance to get a value: the default *)
481
      let default () =
482
        match default with
483
          | Some d -> d
484
          | None -> raise (Not_set (nm, Some (s_ "no default value")))
485
      in
486

  
487
      (* Get data *)
488
      let get data =
489
        (* Get value *)
490
        try
491
          (Hashtbl.find data nm) ();
492
          match !v with
493
            | Some x -> x
494
            | None -> default ()
495
        with Not_found ->
496
          default ()
497
      in
498

  
499
      (* Set data *)
500
      let set data ?context x =
501
        let x =
502
          match update with
503
            | Some f ->
504
                begin
505
                  try
506
                    f ?context (get data) x
507
                  with Not_set _ ->
508
                    x
509
                end
510
            | None ->
511
                x
512
        in
513
          Hashtbl.replace
514
            data
515
            nm
516
            (fun () -> v := Some x)
517
      in
518

  
519
      (* Parse string value, if possible *)
520
      let parse =
521
        match parse with
522
          | Some f ->
523
              f
524
          | None ->
525
              fun ?context s ->
526
                failwith
527
                  (Printf.sprintf
528
                     (f_ "Cannot parse field '%s' when setting value %S")
529
                     nm
530
                     s)
531
      in
532

  
533
      (* Set data, from string *)
534
      let sets data ?context s =
535
        set ?context data (parse ?context s)
536
      in
537

  
538
      (* Output value as string, if possible *)
539
      let print =
540
        match print with
541
          | Some f ->
542
              f
543
          | None ->
544
              fun _ -> raise (No_printer nm)
545
      in
546

  
547
      (* Get data, as a string *)
548
      let gets data =
549
        print (get data)
550
      in
551

  
552
        begin
553
          match schema with
554
            | Some t ->
555
                Schema.add t nm sets gets extra help
556
            | None ->
557
                ()
558
        end;
559

  
560
        {
561
          set   = set;
562
          get   = get;
563
          sets  = sets;
564
          gets  = gets;
565
          help  = help;
566
          extra = extra;
567
        }
568

  
569
    let fset data t ?context x =
570
      t.set data ?context x
571

  
572
    let fget data t =
573
      t.get data
574

  
575
    let fsets data t ?context s =
576
      t.sets data ?context s
577

  
578
    let fgets data t =
579
      t.gets data
580

  
581
  end
582

  
583
  module FieldRO =
584
  struct
585

  
586
    let create ?schema ?name ?parse ?print ?default ?update ?help extra =
587
      let fld =
588
        Field.create ?schema ?name ?parse ?print ?default ?update ?help extra
589
      in
590
        fun data -> Field.fget data fld
591

  
592
  end
593
end
594

  
595
module OASISMessage = struct
596
(* # 21 "src/oasis/OASISMessage.ml" *)
597

  
598

  
599
  open OASISGettext
600
  open OASISContext
601

  
602
  let generic_message ~ctxt lvl fmt =
603
    let cond =
604
      if ctxt.quiet then
605
        false
606
      else
607
        match lvl with
608
          | `Debug -> ctxt.debug
609
          | `Info  -> ctxt.info
610
          | _ -> true
611
    in
612
      Printf.ksprintf
613
        (fun str ->
614
           if cond then
615
             begin
616
               ctxt.printf lvl str
617
             end)
618
        fmt
619

  
620
  let debug ~ctxt fmt =
621
    generic_message ~ctxt `Debug fmt
622

  
623
  let info ~ctxt fmt =
624
    generic_message ~ctxt `Info fmt
625

  
626
  let warning ~ctxt fmt =
627
    generic_message ~ctxt `Warning fmt
628

  
629
  let error ~ctxt fmt =
630
    generic_message ~ctxt `Error fmt
631

  
632
end
633

  
634
module OASISVersion = struct
635
(* # 21 "src/oasis/OASISVersion.ml" *)
636

  
637
  open OASISGettext
638

  
639

  
640

  
641
  type s = string
642

  
643
  type t = string 
644

  
645
  type comparator =
646
    | VGreater of t
647
    | VGreaterEqual of t
648
    | VEqual of t
649
    | VLesser of t
650
    | VLesserEqual of t
651
    | VOr of  comparator * comparator
652
    | VAnd of comparator * comparator
653
    
654

  
655
  (* Range of allowed characters *)
656
  let is_digit c =
657
    '0' <= c && c <= '9'
658

  
659
  let is_alpha c =
660
    ('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')
661

  
662
  let is_special =
663
    function
664
      | '.' | '+' | '-' | '~' -> true
665
      | _ -> false
666

  
667
  let rec version_compare v1 v2 =
668
    if v1 <> "" || v2 <> "" then
669
      begin
670
        (* Compare ascii string, using special meaning for version
671
         * related char
672
         *)
673
        let val_ascii c =
674
          if c = '~' then -1
675
          else if is_digit c then 0
676
          else if c = '\000' then 0
677
          else if is_alpha c then Char.code c
678
          else (Char.code c) + 256
679
        in
680

  
681
        let len1 = String.length v1 in
682
        let len2 = String.length v2 in
683

  
684
        let p = ref 0 in
685

  
686
        (** Compare ascii part *)
687
        let compare_vascii () =
688
          let cmp = ref 0 in
689
          while !cmp = 0 &&
690
                !p < len1 && !p < len2 &&
691
                not (is_digit v1.[!p] && is_digit v2.[!p]) do
692
            cmp := (val_ascii v1.[!p]) - (val_ascii v2.[!p]);
693
            incr p
694
          done;
695
          if !cmp = 0 && !p < len1 && !p = len2 then
696
            val_ascii v1.[!p]
697
          else if !cmp = 0 && !p = len1 && !p < len2 then
698
            - (val_ascii v2.[!p])
699
          else
700
            !cmp
701
        in
702

  
703
        (** Compare digit part *)
704
        let compare_digit () =
705
          let extract_int v p =
706
            let start_p = !p in
707
              while !p < String.length v && is_digit v.[!p] do
708
                incr p
709
              done;
710
              let substr = 
711
                String.sub v !p ((String.length v) - !p)
712
              in 
713
              let res = 
714
                match String.sub v start_p (!p - start_p) with 
715
                  | "" -> 0
716
                  | s -> int_of_string s
717
              in
718
                res, substr
719
          in
720
          let i1, tl1 = extract_int v1 (ref !p) in
721
          let i2, tl2 = extract_int v2 (ref !p) in
722
            i1 - i2, tl1, tl2
723
        in
724

  
725
          match compare_vascii () with
726
            | 0 ->
727
                begin
728
                  match compare_digit () with
729
                    | 0, tl1, tl2 ->
730
                        if tl1 <> "" && is_digit tl1.[0] then
731
                          1
732
                        else if tl2 <> "" && is_digit tl2.[0] then
733
                          -1
734
                        else
735
                          version_compare tl1 tl2
736
                    | n, _, _ ->
737
                        n
738
                end
739
            | n ->
740
                n
741
      end
742
    else
743
      begin
744
        0
745
      end
746

  
747

  
748
  let version_of_string str = str
749

  
750
  let string_of_version t = t
751

  
752
  let chop t =
753
    try
754
      let pos =
755
        String.rindex t '.'
756
      in
757
        String.sub t 0 pos
758
    with Not_found ->
759
      t
760

  
761
  let rec comparator_apply v op =
762
    match op with
763
      | VGreater cv ->
764
          (version_compare v cv) > 0
765
      | VGreaterEqual cv ->
766
          (version_compare v cv) >= 0
767
      | VLesser cv ->
768
          (version_compare v cv) < 0
769
      | VLesserEqual cv ->
770
          (version_compare v cv) <= 0
771
      | VEqual cv ->
772
          (version_compare v cv) = 0
773
      | VOr (op1, op2) ->
774
          (comparator_apply v op1) || (comparator_apply v op2)
775
      | VAnd (op1, op2) ->
776
          (comparator_apply v op1) && (comparator_apply v op2)
777

  
778
  let rec string_of_comparator =
779
    function
780
      | VGreater v  -> "> "^(string_of_version v)
781
      | VEqual v    -> "= "^(string_of_version v)
782
      | VLesser v   -> "< "^(string_of_version v)
783
      | VGreaterEqual v -> ">= "^(string_of_version v)
784
      | VLesserEqual v  -> "<= "^(string_of_version v)
785
      | VOr (c1, c2)  ->
786
          (string_of_comparator c1)^" || "^(string_of_comparator c2)
787
      | VAnd (c1, c2) ->
788
          (string_of_comparator c1)^" && "^(string_of_comparator c2)
789

  
790
  let rec varname_of_comparator =
791
    let concat p v =
792
      OASISUtils.varname_concat
793
        p
794
        (OASISUtils.varname_of_string
795
           (string_of_version v))
796
    in
797
      function
798
        | VGreater v -> concat "gt" v
799
        | VLesser v  -> concat "lt" v
800
        | VEqual v   -> concat "eq" v
801
        | VGreaterEqual v -> concat "ge" v
802
        | VLesserEqual v  -> concat "le" v
803
        | VOr (c1, c2) ->
804
            (varname_of_comparator c1)^"_or_"^(varname_of_comparator c2)
805
        | VAnd (c1, c2) ->
806
            (varname_of_comparator c1)^"_and_"^(varname_of_comparator c2)
807

  
808
  let version_0_3_or_after t =
809
    comparator_apply t (VGreaterEqual (string_of_version "0.3"))
810

  
811
end
812

  
813
module OASISLicense = struct
814
(* # 21 "src/oasis/OASISLicense.ml" *)
815

  
816
  (** License for _oasis fields
817
      @author Sylvain Le Gall
818
    *)
819

  
820

  
821

  
822
  type license = string 
823

  
824
  type license_exception = string 
825

  
826
  type license_version =
827
    | Version of OASISVersion.t
828
    | VersionOrLater of OASISVersion.t
829
    | NoVersion
830
    
831

  
832
  type license_dep_5_unit =
833
    {
834
      license:   license;
835
      excption:  license_exception option;
836
      version:   license_version;
837
    }
838
    
839

  
840
  type license_dep_5 =
841
    | DEP5Unit of license_dep_5_unit
842
    | DEP5Or of license_dep_5 list
843
    | DEP5And of license_dep_5 list
844
    
845

  
846
  type t =
847
    | DEP5License of license_dep_5
848
    | OtherLicense of string (* URL *)
849
    
850

  
851
end
852

  
853
module OASISExpr = struct
854
(* # 21 "src/oasis/OASISExpr.ml" *)
855

  
856

  
857

  
858
  open OASISGettext
859

  
860
  type test = string 
861

  
862
  type flag = string 
863

  
864
  type t =
865
    | EBool of bool
866
    | ENot of t
867
    | EAnd of t * t
868
    | EOr of t * t
869
    | EFlag of flag
870
    | ETest of test * string
871
    
872

  
873
  type 'a choices = (t * 'a) list 
874

  
875
  let eval var_get t =
876
    let rec eval' =
877
      function
878
        | EBool b ->
879
            b
880

  
881
        | ENot e ->
882
            not (eval' e)
883

  
884
        | EAnd (e1, e2) ->
885
            (eval' e1) && (eval' e2)
886

  
887
        | EOr (e1, e2) ->
888
            (eval' e1) || (eval' e2)
889

  
890
        | EFlag nm ->
891
            let v =
892
              var_get nm
893
            in
894
              assert(v = "true" || v = "false");
895
              (v = "true")
896

  
897
        | ETest (nm, vl) ->
898
            let v =
899
              var_get nm
900
            in
901
              (v = vl)
902
    in
903
      eval' t
904

  
905
  let choose ?printer ?name var_get lst =
906
    let rec choose_aux =
907
      function
908
        | (cond, vl) :: tl ->
909
            if eval var_get cond then
910
              vl
911
            else
912
              choose_aux tl
913
        | [] ->
914
            let str_lst =
915
              if lst = [] then
916
                s_ "<empty>"
917
              else
918
                String.concat
919
                  (s_ ", ")
920
                  (List.map
921
                     (fun (cond, vl) ->
922
                        match printer with
923
                          | Some p -> p vl
924
                          | None -> s_ "<no printer>")
925
                     lst)
926
            in
927
              match name with
928
                | Some nm ->
929
                    failwith
930
                      (Printf.sprintf
931
                         (f_ "No result for the choice list '%s': %s")
932
                         nm str_lst)
933
                | None ->
934
                    failwith
935
                      (Printf.sprintf
936
                         (f_ "No result for a choice list: %s")
937
                         str_lst)
938
    in
939
      choose_aux (List.rev lst)
940

  
941
end
942

  
943
module OASISTypes = struct
944
(* # 21 "src/oasis/OASISTypes.ml" *)
945

  
946

  
947

  
948

  
949
  type name          = string 
950
  type package_name  = string 
951
  type url           = string 
952
  type unix_dirname  = string 
953
  type unix_filename = string 
954
  type host_dirname  = string 
955
  type host_filename = string 
956
  type prog          = string 
957
  type arg           = string 
958
  type args          = string list 
959
  type command_line  = (prog * arg list) 
960

  
961
  type findlib_name = string 
962
  type findlib_full = string 
963

  
964
  type compiled_object =
965
    | Byte
966
    | Native
967
    | Best
968
    
969

  
970
  type dependency =
971
    | FindlibPackage of findlib_full * OASISVersion.comparator option
972
    | InternalLibrary of name
973
    
974

  
975
  type tool =
976
    | ExternalTool of name
977
    | InternalExecutable of name
978
    
979

  
980
  type vcs =
981
    | Darcs
982
    | Git
983
    | Svn
984
    | Cvs
985
    | Hg
986
    | Bzr
987
    | Arch
988
    | Monotone
989
    | OtherVCS of url
990
    
991

  
992
  type plugin_kind =
993
      [  `Configure
994
       | `Build
995
       | `Doc
996
       | `Test
997
       | `Install
998
       | `Extra
999
      ]
1000

  
1001
  type plugin_data_purpose =
1002
      [  `Configure
1003
       | `Build
1004
       | `Install
1005
       | `Clean
1006
       | `Distclean
1007
       | `Install
1008
       | `Uninstall
1009
       | `Test
1010
       | `Doc
1011
       | `Extra
1012
       | `Other of string
1013
      ]
1014

  
1015
  type 'a plugin = 'a * name * OASISVersion.t option 
1016

  
1017
  type all_plugin = plugin_kind plugin
1018

  
1019
  type plugin_data = (all_plugin * plugin_data_purpose * (unit -> unit)) list
1020

  
1021
(* # 102 "src/oasis/OASISTypes.ml" *)
1022

  
1023
  type 'a conditional = 'a OASISExpr.choices 
1024

  
1025
  type custom =
1026
      {
1027
        pre_command:  (command_line option) conditional;
1028
        post_command: (command_line option) conditional;
1029
      }
1030
      
1031

  
1032
  type common_section =
1033
      {
1034
        cs_name: name;
1035
        cs_data: PropList.Data.t;
1036
        cs_plugin_data: plugin_data;
1037
      }
1038
      
1039

  
1040
  type build_section =
1041
      {
1042
        bs_build:           bool conditional;
1043
        bs_install:         bool conditional;
1044
        bs_path:            unix_dirname;
1045
        bs_compiled_object: compiled_object;
1046
        bs_build_depends:   dependency list;
1047
        bs_build_tools:     tool list;
1048
        bs_c_sources:       unix_filename list;
1049
        bs_data_files:      (unix_filename * unix_filename option) list;
1050
        bs_ccopt:           args conditional;
1051
        bs_cclib:           args conditional;
1052
        bs_dlllib:          args conditional;
1053
        bs_dllpath:         args conditional;
1054
        bs_byteopt:         args conditional;
1055
        bs_nativeopt:       args conditional;
1056
      }
1057
      
1058

  
1059
  type library =
1060
      {
1061
        lib_modules:            string list;
1062
        lib_pack:               bool;
1063
        lib_internal_modules:   string list;
1064
        lib_findlib_parent:     findlib_name option;
1065
        lib_findlib_name:       findlib_name option;
1066
        lib_findlib_containers: findlib_name list;
1067
      } 
1068

  
1069
  type executable =
1070
      {
1071
        exec_custom:          bool;
1072
        exec_main_is:         unix_filename;
1073
      } 
1074

  
1075
  type flag =
1076
      {
1077
        flag_description:  string option;
1078
        flag_default:      bool conditional;
1079
      } 
1080

  
1081
  type source_repository =
1082
      {
1083
        src_repo_type:        vcs;
1084
        src_repo_location:    url;
1085
        src_repo_browser:     url option;
1086
        src_repo_module:      string option;
1087
        src_repo_branch:      string option;
1088
        src_repo_tag:         string option;
1089
        src_repo_subdir:      unix_filename option;
1090
      } 
1091

  
1092
  type test =
1093
      {
1094
        test_type:               [`Test] plugin;
1095
        test_command:            command_line conditional;
1096
        test_custom:             custom;
1097
        test_working_directory:  unix_filename option;
1098
        test_run:                bool conditional;
1099
        test_tools:              tool list;
1100
      } 
1101

  
1102
  type doc_format =
1103
    | HTML of unix_filename
1104
    | DocText
1105
    | PDF
1106
    | PostScript
1107
    | Info of unix_filename
1108
    | DVI
1109
    | OtherDoc
1110
    
1111

  
1112
  type doc =
1113
      {
1114
        doc_type:        [`Doc] plugin;
1115
        doc_custom:      custom;
1116
        doc_build:       bool conditional;
1117
        doc_install:     bool conditional;
1118
        doc_install_dir: unix_filename;
1119
        doc_title:       string;
1120
        doc_authors:     string list;
1121
        doc_abstract:    string option;
1122
        doc_format:      doc_format;
1123
        doc_data_files:  (unix_filename * unix_filename option) list;
1124
        doc_build_tools: tool list;
1125
      } 
1126

  
1127
  type section =
1128
    | Library    of common_section * build_section * library
1129
    | Executable of common_section * build_section * executable
1130
    | Flag       of common_section * flag
1131
    | SrcRepo    of common_section * source_repository
1132
    | Test       of common_section * test
1133
    | Doc        of common_section * doc
1134
    
1135

  
1136
  type section_kind =
1137
      [ `Library | `Executable | `Flag | `SrcRepo | `Test | `Doc ]
1138

  
1139
  type package = 
1140
      {
1141
        oasis_version:    OASISVersion.t;
1142
        ocaml_version:    OASISVersion.comparator option;
1143
        findlib_version:  OASISVersion.comparator option;
1144
        name:             package_name;
1145
        version:          OASISVersion.t;
1146
        license:          OASISLicense.t;
1147
        license_file:     unix_filename option;
1148
        copyrights:       string list;
1149
        maintainers:      string list;
1150
        authors:          string list;
1151
        homepage:         url option;
1152
        synopsis:         string;
1153
        description:      string option;
1154
        categories:       url list;
1155

  
1156
        conf_type:        [`Configure] plugin;
1157
        conf_custom:      custom;
1158

  
1159
        build_type:       [`Build] plugin;
1160
        build_custom:     custom;
1161

  
1162
        install_type:     [`Install] plugin;
1163
        install_custom:   custom;
1164
        uninstall_custom: custom;
1165

  
1166
        clean_custom:     custom;
1167
        distclean_custom: custom;
1168

  
1169
        files_ab:         unix_filename list;
1170
        sections:         section list;
1171
        plugins:          [`Extra] plugin list;
1172
        schema_data:      PropList.Data.t;
1173
        plugin_data:      plugin_data;
1174
      } 
1175

  
1176
end
1177

  
1178
module OASISUnixPath = struct
1179
(* # 21 "src/oasis/OASISUnixPath.ml" *)
1180

  
1181
  type unix_filename = string
1182
  type unix_dirname = string
1183

  
1184
  type host_filename = string
1185
  type host_dirname = string
1186

  
1187
  let current_dir_name = "."
1188

  
1189
  let parent_dir_name = ".."
1190

  
1191
  let is_current_dir fn =
1192
    fn = current_dir_name || fn = ""
1193

  
1194
  let concat f1 f2 =
1195
    if is_current_dir f1 then
1196
      f2
1197
    else
1198
      let f1' =
1199
        try OASISString.strip_ends_with ~what:"/" f1 with Not_found -> f1
1200
      in
1201
        f1'^"/"^f2
1202

  
1203
  let make =
1204
    function
1205
      | hd :: tl ->
1206
          List.fold_left
1207
            (fun f p -> concat f p)
1208
            hd
1209
            tl
1210
      | [] ->
1211
          invalid_arg "OASISUnixPath.make"
1212

  
1213
  let dirname f =
1214
    try
1215
      String.sub f 0 (String.rindex f '/')
1216
    with Not_found ->
1217
      current_dir_name
1218

  
1219
  let basename f =
1220
    try
1221
      let pos_start =
1222
        (String.rindex f '/') + 1
1223
      in
1224
        String.sub f pos_start ((String.length f) - pos_start)
1225
    with Not_found ->
1226
      f
1227

  
1228
  let chop_extension f =
1229
    try
1230
      let last_dot =
1231
        String.rindex f '.'
1232
      in
1233
      let sub =
1234
        String.sub f 0 last_dot
1235
      in
1236
        try
1237
          let last_slash =
1238
            String.rindex f '/'
1239
          in
1240
            if last_slash < last_dot then
1241
              sub
1242
            else
1243
              f
1244
        with Not_found ->
1245
          sub
1246

  
1247
    with Not_found ->
1248
      f
1249

  
1250
  let capitalize_file f =
1251
    let dir = dirname f in
1252
    let base = basename f in
1253
    concat dir (String.capitalize base)
1254

  
1255
  let uncapitalize_file f =
1256
    let dir = dirname f in
1257
    let base = basename f in
1258
    concat dir (String.uncapitalize base)
1259

  
1260
end
1261

  
1262
module OASISHostPath = struct
1263
(* # 21 "src/oasis/OASISHostPath.ml" *)
1264

  
1265

  
1266
  open Filename
1267

  
1268
  module Unix = OASISUnixPath
1269

  
1270
  let make =
1271
    function
1272
      | [] ->
1273
          invalid_arg "OASISHostPath.make"
1274
      | hd :: tl ->
1275
          List.fold_left Filename.concat hd tl
1276

  
1277
  let of_unix ufn =
1278
    if Sys.os_type = "Unix" then
1279
      ufn
1280
    else
1281
      make
1282
        (List.map
1283
           (fun p ->
1284
              if p = Unix.current_dir_name then
1285
                current_dir_name
1286
              else if p = Unix.parent_dir_name then
1287
                parent_dir_name
1288
              else
1289
                p)
1290
           (OASISString.nsplit ufn '/'))
1291

  
1292

  
1293
end
1294

  
1295
module OASISSection = struct
1296
(* # 21 "src/oasis/OASISSection.ml" *)
1297

  
1298
  open OASISTypes
1299

  
1300
  let section_kind_common = 
1301
    function
1302
      | Library (cs, _, _) -> 
1303
          `Library, cs
1304
      | Executable (cs, _, _) ->
1305
          `Executable, cs
1306
      | Flag (cs, _) ->
1307
          `Flag, cs
1308
      | SrcRepo (cs, _) ->
1309
          `SrcRepo, cs
1310
      | Test (cs, _) ->
1311
          `Test, cs
1312
      | Doc (cs, _) ->
1313
          `Doc, cs
1314

  
1315
  let section_common sct =
1316
    snd (section_kind_common sct)
1317

  
1318
  let section_common_set cs =
1319
    function
1320
      | Library (_, bs, lib)     -> Library (cs, bs, lib)
1321
      | Executable (_, bs, exec) -> Executable (cs, bs, exec)
1322
      | Flag (_, flg)            -> Flag (cs, flg)
1323
      | SrcRepo (_, src_repo)    -> SrcRepo (cs, src_repo)
1324
      | Test (_, tst)            -> Test (cs, tst)
1325
      | Doc (_, doc)             -> Doc (cs, doc)
1326

  
1327
  (** Key used to identify section
1328
    *)
1329
  let section_id sct = 
1330
    let k, cs = 
1331
      section_kind_common sct
1332
    in
1333
      k, cs.cs_name
1334

  
1335
  let string_of_section sct =
1336
    let k, nm =
1337
      section_id sct
1338
    in
1339
      (match k with
1340
         | `Library    -> "library" 
1341
         | `Executable -> "executable"
1342
         | `Flag       -> "flag"
1343
         | `SrcRepo    -> "src repository"
1344
         | `Test       -> "test"
1345
         | `Doc        -> "doc")
1346
      ^" "^nm
1347

  
1348
  let section_find id scts =
1349
    List.find
1350
      (fun sct -> id = section_id sct)
1351
      scts
1352

  
1353
  module CSection =
1354
  struct
1355
    type t = section
1356

  
1357
    let id = section_id
1358

  
1359
    let compare t1 t2 = 
1360
      compare (id t1) (id t2)
1361
      
1362
    let equal t1 t2 =
1363
      (id t1) = (id t2)
1364

  
1365
    let hash t =
1366
      Hashtbl.hash (id t)
1367
  end
1368

  
1369
  module MapSection = Map.Make(CSection)
1370
  module SetSection = Set.Make(CSection)
1371

  
1372
end
1373

  
1374
module OASISBuildSection = struct
1375
(* # 21 "src/oasis/OASISBuildSection.ml" *)
1376

  
1377
end
1378

  
1379
module OASISExecutable = struct
1380
(* # 21 "src/oasis/OASISExecutable.ml" *)
1381

  
1382
  open OASISTypes
1383

  
1384
  let unix_exec_is (cs, bs, exec) is_native ext_dll suffix_program = 
1385
    let dir = 
1386
      OASISUnixPath.concat
1387
        bs.bs_path
1388
        (OASISUnixPath.dirname exec.exec_main_is)
1389
    in
1390
    let is_native_exec = 
1391
      match bs.bs_compiled_object with
1392
        | Native -> true
1393
        | Best -> is_native ()
1394
        | Byte -> false
1395
    in
1396

  
1397
      OASISUnixPath.concat
1398
        dir
1399
        (cs.cs_name^(suffix_program ())),
1400

  
1401
      if not is_native_exec && 
... This diff was truncated because it exceeds the maximum size that can be displayed.

Also available in: Unified diff