Project

General

Profile

Download (13.3 KB) Statistics
| Branch: | Tag: | Revision:
1 a2d97a3e ploc
(********************************************************************)
2
(*                                                                  *)
3
(*  The LustreC compiler toolset   /  The LustreC Development Team  *)
4
(*  Copyright 2012 -    --   ONERA - CNRS - INPT                    *)
5
(*                                                                  *)
6
(*  LustreC is free software, distributed WITHOUT ANY WARRANTY      *)
7
(*  under the terms of the GNU Lesser General Public License        *)
8
(*  version 2.1.                                                    *)
9
(*                                                                  *)
10
(********************************************************************)
11
12 22fe1c93 ploc
open Graph
13
14 ca7ff3f7 Lélio Brun
type rat = int * int
15
16 22fe1c93 ploc
type ident = string
17 ca7ff3f7 Lélio Brun
18 22fe1c93 ploc
type tag = int
19 ca7ff3f7 Lélio Brun
20 22fe1c93 ploc
type longident = (string * tag) list
21
22 ca7ff3f7 Lélio Brun
exception TransposeError of int * int
23 b616fe7a xthirioux
24 22fe1c93 ploc
(** General utility functions. *)
25
let create_hashtable size init =
26
  let tbl = Hashtbl.create size in
27
  List.iter (fun (key, data) -> Hashtbl.add tbl key data) init;
28
  tbl
29
30 ca7ff3f7 Lélio Brun
module IdentModule = struct
31
  (* Node module *)
32 22fe1c93 ploc
  type t = ident
33 ca7ff3f7 Lélio Brun
34 22fe1c93 ploc
  let compare = compare
35 ca7ff3f7 Lélio Brun
36 22fe1c93 ploc
  let hash n = Hashtbl.hash n
37 ca7ff3f7 Lélio Brun
38 22fe1c93 ploc
  let equal n1 n2 = n1 = n2
39
end
40
41 75c459f4 Lélio Brun
module IMap = struct
42 ca7ff3f7 Lélio Brun
  include Map.Make (IdentModule)
43
44 75c459f4 Lélio Brun
  let union_l m1 m2 =
45 ca7ff3f7 Lélio Brun
    merge
46
      (fun _ o1 o2 ->
47
        match o1, o2 with
48
        | None, None ->
49
          None
50
        | Some _, _ ->
51
          o1
52
        | _, Some _ ->
53
          o2)
54
      m1 m2
55 75c459f4 Lélio Brun
end
56
57 ca7ff3f7 Lélio Brun
module ISet = Set.Make (IdentModule)
58 a703ed0c ploc
module IdentDepGraph = Imperative.Digraph.ConcreteBidirectional (IdentModule)
59 ca7ff3f7 Lélio Brun
module TopologicalDepGraph = Topological.Make (IdentDepGraph)
60
module ComponentsDepGraph = Components.Make (IdentDepGraph)
61
62 365d1b07 ploc
(*module DotGraph = Graphviz.Dot (IdentDepGraph)*)
63
module Bfs = Traverse.Bfs (IdentDepGraph)
64
65 04a63d25 xthirioux
exception DeSome
66 ca7ff3f7 Lélio Brun
67 04a63d25 xthirioux
let desome x = match x with Some x -> x | None -> raise DeSome
68 e2380d4d ploc
69 ca7ff3f7 Lélio Brun
let option_map f o = match o with None -> None | Some e -> Some (f e)
70 22fe1c93 ploc
71 ca7ff3f7 Lélio Brun
let add_cons x l = if List.mem x l then l else x :: l
72 45c13277 xthirioux
73 bb2ca5f4 xthirioux
let rec remove_duplicates l =
74 ca7ff3f7 Lélio Brun
  match l with [] -> [] | t :: q -> add_cons t (remove_duplicates q)
75 bb2ca5f4 xthirioux
76 22fe1c93 ploc
let position pred l =
77
  let rec pos p l =
78
    match l with
79 ca7ff3f7 Lélio Brun
    | [] ->
80
      assert false
81
    | t :: q ->
82
      if pred t then p else pos (p + 1) q
83
  in
84
  pos 0 l
85 22fe1c93 ploc
86 1df55e58 Lélio Brun
(* TODO: Lélio: why n+1? cf former def below *)
87
(* if n < 0 then [] else x :: duplicate x (n - 1) *)
88 ca7ff3f7 Lélio Brun
let duplicate x n = List.init (n + 1) (fun _ -> x)
89 22fe1c93 ploc
90 1df55e58 Lélio Brun
let enumerate n = List.init n (fun i -> i)
91 22fe1c93 ploc
92 ca7ff3f7 Lélio Brun
let rec repeat n f x = if n <= 0 then x else repeat (n - 1) f (f x)
93 22fe1c93 ploc
94 b616fe7a xthirioux
let transpose_list ll =
95
  let rec transpose ll =
96
    match ll with
97 ca7ff3f7 Lélio Brun
    | [] ->
98
      []
99
    | [ l ] ->
100
      List.map (fun el -> [ el ]) l
101
    | l :: q ->
102
      List.map2 (fun el eq -> el :: eq) l (transpose q)
103
  in
104
  match ll with
105
  | [] ->
106
    []
107
  | l :: q ->
108
    let length_l = List.length l in
109
    List.iter
110
      (fun l' ->
111
        let length_l' = List.length l' in
112
        if length_l <> length_l' then
113
          raise (TransposeError (length_l, length_l')))
114
      q;
115 1df55e58 Lélio Brun
    transpose ll
116 22fe1c93 ploc
117
let rec filter_upto p n l =
118 ca7ff3f7 Lélio Brun
  if n = 0 then []
119
  else
120
    match l with
121
    | [] ->
122
      []
123
    | t :: q ->
124
      if p t then t :: filter_upto p (n - 1) q else filter_upto p n q
125 22fe1c93 ploc
126
(* Warning: bad complexity *)
127
let list_of_imap imap =
128 ca7ff3f7 Lélio Brun
  IMap.fold (fun i v (il, vl) -> i :: il, v :: vl) imap ([], [])
129 22fe1c93 ploc
130
(** [gcd a b] returns the greatest common divisor of [a] and [b]. *)
131 ca7ff3f7 Lélio Brun
let rec gcd a b = if b = 0 then a else gcd b (a mod b)
132 22fe1c93 ploc
133
(** [lcm a b] returns the least common multiple of [a] and [b]. *)
134 ca7ff3f7 Lélio Brun
let lcm a b = if a = 0 && b = 0 then 0 else a * b / gcd a b
135
136
(** [sum_rat (a,b) (a',b')] returns the sum of rationals [(a,b)] and [(a',b')] *)
137
let sum_rat (a, b) (a', b') =
138
  if a = 0 && b = 0 then a', b'
139
  else if a' = 0 && b' = 0 then a, b
140 22fe1c93 ploc
  else
141
    let lcm_bb' = lcm b b' in
142 ca7ff3f7 Lélio Brun
    (a * lcm_bb' / b) + (a' * lcm_bb' / b'), lcm_bb'
143 22fe1c93 ploc
144 ca7ff3f7 Lélio Brun
let simplify_rat (a, b) =
145 22fe1c93 ploc
  let gcd = gcd a b in
146 ca7ff3f7 Lélio Brun
  if gcd = 0 then a, b else a / gcd, b / gcd
147 22fe1c93 ploc
148 ca7ff3f7 Lélio Brun
let max_rat (a, b) (a', b') =
149
  let ratio_ab = float_of_int a /. float_of_int b in
150
  let ratio_ab' = float_of_int a' /. float_of_int b' in
151
  if ratio_ab > ratio_ab' then a, b else a', b'
152
153
(** [list_union l1 l2] returns the union of list [l1] and [l2]. The result
154
    contains no duplicates. *)
155 22fe1c93 ploc
let list_union l1 l2 =
156
  let rec aux l acc =
157
    match l with
158 ca7ff3f7 Lélio Brun
    | [] ->
159
      acc
160
    | x :: tl ->
161
      if List.mem x acc then aux tl acc else aux tl (x :: acc)
162 22fe1c93 ploc
  in
163
  let l1' = aux l1 [] in
164
  aux l2 l1'
165
166
(** [hashtbl_add h1 h2] adds all the bindings in [h2] to [h1]. If the
167
    intersection is not empty, it replaces the former binding *)
168
let hashtbl_add h1 h2 =
169
  Hashtbl.iter (fun key value -> Hashtbl.replace h1 key value) h2
170
171
let hashtbl_iterlast h f1 f2 =
172
  let l = Hashtbl.length h in
173 ca7ff3f7 Lélio Brun
  ignore
174
    (Hashtbl.fold
175
       (fun k v cpt ->
176
         if cpt = l then (
177
           f2 k v;
178
           cpt + 1)
179
         else (
180
           f1 k v;
181
           cpt + 1))
182
       h 1)
183
184
(** Match types variables to 'a, 'b, ..., for pretty-printing. Type variables
185
    are identified by integers. *)
186
let tnames = ref ([] : (int * string) list)
187
188 22fe1c93 ploc
let tname_counter = ref 0
189 ca7ff3f7 Lélio Brun
190 22fe1c93 ploc
(* Same for carriers *)
191 ca7ff3f7 Lélio Brun
let crnames = ref ([] : (int * string) list)
192
193 22fe1c93 ploc
let crname_counter = ref 0
194 ca7ff3f7 Lélio Brun
195 22fe1c93 ploc
(* Same for dimension *)
196 ca7ff3f7 Lélio Brun
let dnames = ref ([] : (int * string) list)
197
198 22fe1c93 ploc
let dname_counter = ref 0
199 ca7ff3f7 Lélio Brun
200 22fe1c93 ploc
(* Same for delays *)
201 ca7ff3f7 Lélio Brun
let inames = ref ([] : (int * string) list)
202
203 22fe1c93 ploc
let iname_counter = ref 0
204
205
let reset_names () =
206 1df55e58 Lélio Brun
  tnames := [];
207
  tname_counter := 0;
208
  crnames := [];
209
  crname_counter := 0;
210
  dnames := [];
211
  dname_counter := 0;
212
  inames := [];
213
  iname_counter := 0
214 22fe1c93 ploc
215
(* From OCaml compiler *)
216
let new_tname () =
217
  let tname =
218 ca7ff3f7 Lélio Brun
    if !tname_counter < 26 then String.make 1 (Char.chr (97 + !tname_counter))
219
    else
220
      String.make 1 (Char.chr (97 + (!tname_counter mod 26)))
221
      ^ string_of_int (!tname_counter / 26)
222
  in
223 22fe1c93 ploc
  incr tname_counter;
224
  tname
225
226
let new_crname () =
227
  incr crname_counter;
228 ca7ff3f7 Lélio Brun
  Format.sprintf "c%i" (!crname_counter - 1)
229 22fe1c93 ploc
230
let name_of_type id =
231 ca7ff3f7 Lélio Brun
  try List.assoc id !tnames
232
  with Not_found ->
233 22fe1c93 ploc
    let name = new_tname () in
234
    tnames := (id, name) :: !tnames;
235
    name
236
237
let name_of_carrier id =
238
  let pp_id =
239 ca7ff3f7 Lélio Brun
    try List.assoc id !crnames
240
    with Not_found ->
241 22fe1c93 ploc
      let name = new_crname () in
242 ca7ff3f7 Lélio Brun
      crnames := (id, name) :: !crnames;
243 22fe1c93 ploc
      name
244
  in
245
  pp_id
246
247
let new_dname () =
248
  incr dname_counter;
249 ca7ff3f7 Lélio Brun
  Format.sprintf "d%i" (!dname_counter - 1)
250 22fe1c93 ploc
251
let name_of_dimension id =
252 ca7ff3f7 Lélio Brun
  try List.assoc id !dnames
253
  with Not_found ->
254 22fe1c93 ploc
    let name = new_dname () in
255
    dnames := (id, name) :: !dnames;
256
    name
257
258
let new_iname () =
259
  incr iname_counter;
260 ca7ff3f7 Lélio Brun
  Format.sprintf "t%i" (!iname_counter - 1)
261 22fe1c93 ploc
262
let name_of_delay id =
263 ca7ff3f7 Lélio Brun
  try List.assoc id !inames
264
  with Not_found ->
265 22fe1c93 ploc
    let name = new_iname () in
266
    inames := (id, name) :: !inames;
267
    name
268
269
open Format
270
271 ca7ff3f7 Lélio Brun
let print_rat fmt (a, b) =
272
  if b = 1 then Format.fprintf fmt "%i" a
273
  else if b < 0 then Format.fprintf fmt "%i/%i" (-a) (-b)
274
  else Format.fprintf fmt "%i/%i" a b
275 22fe1c93 ploc
276
(* Generic pretty printing *)
277
278 ca7ff3f7 Lélio Brun
let pp_final_char_if_non_empty c l fmt =
279
  match l with [] -> () | _ -> Format.fprintf fmt "%(%)" c
280 90cc3b8e Lélio Brun
281 ca7ff3f7 Lélio Brun
let pp_newline_if_non_empty l fmt =
282
  match l with [] -> () | _ -> Format.fprintf fmt "@,"
283 22fe1c93 ploc
284 90cc3b8e Lélio Brun
module Format = struct
285
  include Format
286
  open Format
287
288
  let with_out_file file f =
289
    let oc = open_out file in
290
    let fmt = formatter_of_out_channel oc in
291
    f fmt;
292
    close_out oc
293
294
  let pp_print_nothing _fmt _ = ()
295
296
  let pp_print_cutcut fmt () = fprintf fmt "@,@,"
297
298
  let pp_print_endcut s fmt () = fprintf fmt "%s@," s
299
300
  let pp_print_opar fmt () = pp_print_string fmt "("
301 ca7ff3f7 Lélio Brun
302 90cc3b8e Lélio Brun
  let pp_print_cpar fmt () = pp_print_string fmt ")"
303 ca7ff3f7 Lélio Brun
304 6d1693b9 Lélio Brun
  let pp_print_obracket fmt () = pp_print_string fmt "["
305 ca7ff3f7 Lélio Brun
306 6d1693b9 Lélio Brun
  let pp_print_cbracket fmt () = pp_print_string fmt "]"
307 ca7ff3f7 Lélio Brun
308 90cc3b8e Lélio Brun
  let pp_print_obrace fmt () = pp_print_string fmt "{"
309 ca7ff3f7 Lélio Brun
310 90cc3b8e Lélio Brun
  let pp_print_cbrace fmt () = pp_print_string fmt "}"
311 ca7ff3f7 Lélio Brun
312 15c3e4e7 Lélio Brun
  let pp_print_opar' fmt () = pp_print_string fmt "( "
313 ca7ff3f7 Lélio Brun
314 15c3e4e7 Lélio Brun
  let pp_print_cpar' fmt () = pp_print_string fmt " )"
315 ca7ff3f7 Lélio Brun
316 15c3e4e7 Lélio Brun
  let pp_print_obrace' fmt () = pp_print_string fmt "{ "
317 ca7ff3f7 Lélio Brun
318 15c3e4e7 Lélio Brun
  let pp_print_cbrace' fmt () = pp_print_string fmt " }"
319 90cc3b8e Lélio Brun
320
  let pp_print_comma fmt () = fprintf fmt ",@ "
321 ca7ff3f7 Lélio Brun
322 90cc3b8e Lélio Brun
  let pp_print_semicolon fmt () = fprintf fmt ";@ "
323 ca7ff3f7 Lélio Brun
324 90cc3b8e Lélio Brun
  let pp_print_comma' fmt () = fprintf fmt ","
325 ca7ff3f7 Lélio Brun
326 90cc3b8e Lélio Brun
  let pp_print_semicolon' fmt () = fprintf fmt ";"
327
328
  let pp_open_vbox0 fmt () = pp_open_vbox fmt 0
329
330 ca7ff3f7 Lélio Brun
  let pp_print_list ?(pp_prologue = pp_print_nothing)
331
      ?(pp_epilogue = pp_print_nothing) ?(pp_op = pp_print_nothing)
332
      ?(pp_cl = pp_print_nothing)
333
      ?(pp_open_box = fun fmt () -> pp_open_box fmt 0)
334
      ?(pp_eol = pp_print_nothing) ?(pp_nil = pp_print_nothing) ?pp_sep pp_v fmt
335
      l =
336 90cc3b8e Lélio Brun
    fprintf fmt "%a%a%a%a%a@]%a%a"
337 ca7ff3f7 Lélio Brun
      (fun fmt l -> if l <> [] then pp_prologue fmt ())
338
      l pp_op () pp_open_box ()
339 c226a3ba Lélio Brun
      (fun fmt () ->
340 ca7ff3f7 Lélio Brun
        if l = [] then pp_nil fmt () else pp_print_list ?pp_sep pp_v fmt l)
341
      ()
342
      (fun fmt l -> if l <> [] then pp_eol fmt ())
343
      l pp_cl ()
344
      (fun fmt l -> if l <> [] then pp_epilogue fmt ())
345
      l
346 90cc3b8e Lélio Brun
347 6d1693b9 Lélio Brun
  let pp_comma_list = pp_print_list ~pp_sep:pp_print_comma
348
349 ca7ff3f7 Lélio Brun
  let pp_print_list_i ?pp_prologue ?pp_epilogue ?pp_op ?pp_cl ?pp_open_box
350
      ?pp_eol ?pp_sep pp_v =
351 90cc3b8e Lélio Brun
    let i = ref 0 in
352 ca7ff3f7 Lélio Brun
    pp_print_list ?pp_prologue ?pp_epilogue ?pp_op ?pp_cl ?pp_open_box ?pp_eol
353
      ?pp_sep (fun fmt x ->
354
        pp_v fmt !i x;
355
        incr i)
356
357
  let pp_print_list2 ?pp_prologue ?pp_epilogue ?pp_op ?pp_cl ?pp_open_box
358
      ?pp_eol ?pp_sep pp_v fmt (l1, l2) =
359
    pp_print_list ?pp_prologue ?pp_epilogue ?pp_op ?pp_cl ?pp_open_box ?pp_eol
360
      ?pp_sep pp_v fmt (List.combine l1 l2)
361
362
  let pp_print_list_i2 ?pp_prologue ?pp_epilogue ?pp_op ?pp_cl ?pp_open_box
363
      ?pp_eol ?pp_sep pp_v fmt (l1, l2) =
364
    pp_print_list_i ?pp_prologue ?pp_epilogue ?pp_op ?pp_cl ?pp_open_box ?pp_eol
365
      ?pp_sep
366
      (fun fmt i (x1, x2) -> pp_v fmt i x1 x2)
367
      fmt (List.combine l1 l2)
368
369
  let pp_print_parenthesized ?(pp_sep = pp_print_comma) =
370
    pp_print_list ~pp_op:pp_print_opar ~pp_cl:pp_print_cpar ~pp_sep
371
372
  let pp_print_bracketed ?(pp_sep = pp_print_comma) =
373
    pp_print_list ~pp_op:pp_print_obracket ~pp_cl:pp_print_cbracket ~pp_sep
374
375
  let pp_print_braced ?(pp_sep = pp_print_comma) =
376
    pp_print_list ~pp_op:pp_print_obrace ~pp_cl:pp_print_cbrace ~pp_sep
377
378
  let pp_print_braced' ?(pp_sep = pp_print_comma) =
379
    pp_print_list ~pp_op:pp_print_obrace' ~pp_cl:pp_print_cbrace' ~pp_sep
380 90cc3b8e Lélio Brun
end
381
382 ca7ff3f7 Lélio Brun
let fprintf_list ?(eol : ('a, formatter, unit) format = "") ~sep f fmt l =
383 1df55e58 Lélio Brun
  Format.(pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt "%(%)" sep) f fmt l);
384
  if l <> [] then Format.fprintf fmt "%(%)" eol
385
386 22fe1c93 ploc
let pp_list l pp_fun beg_str end_str sep_str =
387 ca7ff3f7 Lélio Brun
  if beg_str = "\n" then print_newline () else print_string beg_str;
388 22fe1c93 ploc
  let rec pp_l l =
389
    match l with
390 ca7ff3f7 Lélio Brun
    | [] ->
391
      ()
392
    | [ hd ] ->
393
      pp_fun hd
394
    | hd :: tl ->
395
      pp_fun hd;
396
      if sep_str = "\n" then print_newline () else print_string sep_str;
397
      pp_l tl
398 22fe1c93 ploc
  in
399
  pp_l l;
400 ca7ff3f7 Lélio Brun
  if end_str = "\n" then print_newline () else print_string end_str
401 22fe1c93 ploc
402
let pp_array a pp_fun beg_str end_str sep_str =
403 ca7ff3f7 Lélio Brun
  if beg_str = "\n" then print_newline () else print_string beg_str;
404 22fe1c93 ploc
  let n = Array.length a in
405 ca7ff3f7 Lélio Brun
  if n > 0 then (
406
    Array.iter
407
      (fun x ->
408
        pp_fun x;
409
        print_string sep_str)
410
      (Array.sub a 0 (n - 1));
411
    pp_fun a.(n - 1));
412
  if end_str = "\n" then print_newline () else print_string end_str
413 22fe1c93 ploc
414 8a183477 xthirioux
let pp_iset fmt t =
415 7ee5f69e Lélio Brun
  Format.fprintf fmt "@[<hv 0>@[<hv 2>{";
416
  ISet.iter (fun s -> Format.fprintf fmt "@ %s" s) t;
417
  Format.fprintf fmt "@]@ }@]"
418
419 ca7ff3f7 Lélio Brun
let pp_imap ?(comment = "") pp_val fmt m =
420 7ee5f69e Lélio Brun
  Format.fprintf fmt "@[<hv 0>@[<hv 2>{ %s" comment;
421
  IMap.iter (fun key v -> Format.fprintf fmt "@ %s -> %a" key pp_val v) m;
422
  Format.fprintf fmt "@]@ }@]"
423
424 22fe1c93 ploc
let pp_hashtbl t pp_fun beg_str end_str sep_str =
425 ca7ff3f7 Lélio Brun
  if beg_str = "\n" then print_newline () else print_string beg_str;
426 22fe1c93 ploc
  let pp_fun1 k v =
427
    pp_fun k v;
428 ca7ff3f7 Lélio Brun
    if sep_str = "\n" then print_newline () else print_string sep_str
429 22fe1c93 ploc
  in
430
  hashtbl_iterlast t pp_fun1 pp_fun;
431 ca7ff3f7 Lélio Brun
  if end_str = "\n" then print_newline () else print_string end_str
432 22fe1c93 ploc
433
let pp_longident lid =
434
  let pp_fun (nid, tag) =
435
    print_string nid;
436
    print_string "(";
437
    print_int tag;
438
    print_string ")"
439
  in
440 ca7ff3f7 Lélio Brun
  pp_list lid pp_fun "" "." "."
441 22fe1c93 ploc
442 5c1184ad ploc
let pp_date fmt tm =
443 1df55e58 Lélio Brun
  let open Unix in
444 ca7ff3f7 Lélio Brun
  Format.fprintf fmt "%i/%i/%i, %02i:%02i:%02i" (tm.tm_year + 1900) tm.tm_mon
445
    tm.tm_mday tm.tm_hour tm.tm_min tm.tm_sec
446 22fe1c93 ploc
447
(* Used for uid in variables *)
448
449 1df55e58 Lélio Brun
let get_new_id =
450
  let var_id_cpt = ref 0 in
451 ca7ff3f7 Lélio Brun
  fun () ->
452
    incr var_id_cpt;
453
    !var_id_cpt
454 22fe1c93 ploc
455 1df55e58 Lélio Brun
let new_tag =
456
  let last_tag = ref (-1) in
457 ca7ff3f7 Lélio Brun
  fun () ->
458
    incr last_tag;
459
    !last_tag
460 22fe1c93 ploc
461 1df55e58 Lélio Brun
module List = struct
462 ca7ff3f7 Lélio Brun
  include List
463
464 6fa45cb6 ploc
  let iteri2 f l1 l2 =
465
    if List.length l1 <> List.length l2 then
466
      raise (Invalid_argument "iteri2: lists have different lengths")
467
    else
468
      let rec run idx l1 l2 =
469 1df55e58 Lélio Brun
        match l1, l2 with
470 ca7ff3f7 Lélio Brun
        | [], [] ->
471
          ()
472
        | hd1 :: tl1, hd2 :: tl2 ->
473 1df55e58 Lélio Brun
          f idx hd1 hd2;
474 ca7ff3f7 Lélio Brun
          run (idx + 1) tl1 tl2
475
        | _ ->
476
          assert false
477 6fa45cb6 ploc
      in
478
      run 0 l1 l2
479 57d61d67 ploc
480
  let rec extract l fst last =
481 ca7ff3f7 Lélio Brun
    if last < fst then assert false
482
    else
483 57d61d67 ploc
      match l, fst with
484 ca7ff3f7 Lélio Brun
      | hd :: tl, 0 ->
485
        if last = 0 then [] else hd :: extract tl 0 (last - 1)
486
      | _ :: tl, _ ->
487
        extract tl (fst - 1) (last - 1)
488
      | [], 0 ->
489
        if last = 0 then [] else assert false (* List too short *)
490
      | _ ->
491
        assert false
492 6fa45cb6 ploc
end
493
494 57d61d67 ploc
let get_date () =
495 ca7ff3f7 Lélio Brun
  let tm = Unix.localtime (Unix.time ()) in
496 57d61d67 ploc
  let fmt = Format.str_formatter in
497 7d77632f ploc
  pp_date fmt tm;
498 57d61d67 ploc
  Format.flush_str_formatter ()
499
500 1df55e58 Lélio Brun
(* Local Variables: *)
501
(* compile-command:"make -C .." *)
502
(* End: *)