← Back to branch summary

~ubuntu-branches/ubuntu/maverick/blender/maverick

« back to all changes in this revision

Viewing changes to extern/fftw/genfft-k7/util.ml

  • Committer: Bazaar Package Importer
  • Author(s): Khashayar Naderehvandi, Khashayar Naderehvandi, Alessio Treglia
  • Date: 2009-01-22 16:53:59 UTC
  • mfrom: (14.1.1 experimental)
  • Revision ID: james.westby@ubuntu.com-20090122165359-v0996tn7fbit64ni
Tags: 2.48a+dfsg-1ubuntu1
https://launchpad.net/bugs/320045
[ Khashayar Naderehvandi ]
* Merge from debian experimental (LP: #320045), Ubuntu remaining changes:
  - Add patch correcting header file locations.
  - Add libvorbis-dev and libgsm1-dev to Build-Depends.
  - Use avcodec_decode_audio2() in source/blender/src/hddaudio.c

[ Alessio Treglia ]
* Add missing previous changelog entries.

Show diffs side-by-side

added added

removed removed

Lines of Context:
extern/fftw/genfft-k7/util.ml
 
1
(*
 
2
 * Copyright (c) 1997-1999 Massachusetts Institute of Technology
 
3
 * Copyright (c) 2000-2001 Stefan Kral
 
4
 *
 
5
 * This program is free software; you can redistribute it and/or modify
 
6
 * it under the terms of the GNU General Public License as published by
 
7
 * the Free Software Foundation; either version 2 of the License, or
 
8
 * (at your option) any later version.
 
9
 *
 
10
 * This program is distributed in the hope that it will be useful,
 
11
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 
12
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 
13
 * GNU General Public License for more details.
 
14
 *
 
15
 * You should have received a copy of the GNU General Public License
 
16
 * along with this program; if not, write to the Free Software
 
17
 * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
 
18
 *
 
19
 *)
 
20
 
 
21
(* various utility functions *)
 
22
open List
 
23
open Unix 
 
24
 
 
25
(*****************************************
 
26
 * Integer operations
 
27
 *****************************************)
 
28
(* fint the inverse of n modulo m *)
 
29
let invmod n m =
 
30
    let rec loop i =
 
31
        if ((i * n) mod m == 1) then i
 
32
        else loop (i + 1)
 
33
    in
 
34
        loop 1
 
35
 
 
36
(* Yooklid's algorithm *)
 
37
let rec gcd n m =
 
38
    if (n > m)
 
39
      then gcd m n
 
40
    else
 
41
      let r = m mod n
 
42
      in
 
43
          if (r == 0) then n
 
44
          else gcd r n
 
45
 
 
46
(* reduce the fraction m/n to lowest terms, modulo factors of n/n *)
 
47
let lowest_terms n m =
 
48
    if (m mod n == 0) then
 
49
      (1,0)
 
50
    else
 
51
      let nn = (abs n) in let mm = m * (n / nn)
 
52
      in let mpos = 
 
53
          if (mm > 0) then (mm mod nn)
 
54
          else (mm + (1 + (abs mm) / nn) * nn) mod nn
 
55
      and d = gcd nn (abs mm)
 
56
      in (nn / d, mpos / d)
 
57
 
 
58
(* find a generator for the multiplicative group mod p
 
59
   (where p must be prime for a generator to exist!!) *)
 
60
 
 
61
exception No_Generator
 
62
 
 
63
let find_generator p =
 
64
    let rec period x prod =
 
65
        if (prod == 1) then 1
 
66
        else 1 + (period x (prod * x mod p))
 
67
    in let rec findgen x =
 
68
        if (x == 0) then raise No_Generator
 
69
        else if ((period x x) == (p - 1)) then x
 
70
        else findgen ((x + 1) mod p)
 
71
    in findgen 1
 
72
 
 
73
(* raise x to a power n modulo p (requires n > 0) (in principle,
 
74
   negative powers would be fine, provided that x and p are relatively
 
75
   prime...we don't need this functionality, though) *)
 
76
 
 
77
exception Negative_Power
 
78
 
 
79
let rec pow_mod x n p =
 
80
    if (n == 0) then 1
 
81
    else if (n < 0) then raise Negative_Power
 
82
    else if (n mod 2 == 0) then pow_mod (x * x mod p) (n / 2) p
 
83
    else x * (pow_mod x (n - 1) p) mod p
 
84
 
 
85
(******************************************
 
86
 * auxiliary functions 
 
87
 ******************************************)
 
88
let rec forall id combiner a b f =
 
89
    if (a >= b) then id
 
90
    else combiner (f a) (forall id combiner (a + 1) b f)
 
91
 
 
92
let sum_list l = fold_right (+) l 0
 
93
let max_list l = fold_right (max) l (-999999)
 
94
let min_list l = fold_right (min) l 999999
 
95
let count pred = fold_left (fun a elem -> if (pred elem) then 1 + a else a) 0
 
96
 
 
97
let remove elem = filter ((!=) elem)
 
98
let cons a b = a::b
 
99
 
 
100
let null = function [] -> true | _ -> false
 
101
 
 
102
(* functional composition *)
 
103
let (@@) f g x = f (g x)
 
104
 
 
105
(* Hmm... CAML won't allow second-order polymorphism.  Oh well.. *)
 
106
(* let forall_flat = forall (@);; *)
 
107
let rec forall_flat a b f = 
 
108
    if (a >= b) then []
 
109
    else (f a) @ (forall_flat (a + 1) b f)
 
110
 
 
111
let identity x = x
 
112
 
 
113
let find_elem p xs = try Some (List.find p xs) with Not_found -> None
 
114
 
 
115
(* find x, x >= a, such that (p x) is true *)
 
116
let rec suchthat a pred =
 
117
  if (pred a) then a else suchthat (a + 1) pred
 
118
 
 
119
 
 
120
let selectFirst p xs =
 
121
  let rec selectFirst' = function
 
122
    | [] -> raise Not_found
 
123
    | x::xs when p x -> (x,xs) 
 
124
    | x::xs -> let (x',xs') = selectFirst' xs in (x',x::xs')
 
125
  in try Some(selectFirst' xs) with Not_found -> None
 
126
 
 
127
(* used for inserting an element into a sorted list *)
 
128
let insertList stop el xs = 
 
129
  let rec insert' = function
 
130
    | [] -> [el]
 
131
    | x::xs as xxs -> if stop el x then el::xxs else x::(insert' xs)
 
132
  in insert' xs
 
133
 
 
134
(* used for inserting an element into a sorted list *)
 
135
let insert_list p el xs = 
 
136
  let rec insert' = function
 
137
    | [] -> [el]
 
138
    | x::xs as xxs -> if p el x < 0 then el::xxs else x::(insert' xs)
 
139
  in insert' xs
 
140
 
 
141
let zip xs = 
 
142
  let rec zip' ls rs = function
 
143
    | []    -> (ls,rs)
 
144
    | x::xs -> zip' (x::rs) ls xs
 
145
  in zip' [] [] xs
 
146
 
 
147
let rec intertwine xs zs = match (xs,zs) with
 
148
  | ([],zs) -> zs
 
149
  | (x::xs,zs) -> x::(intertwine zs xs)
 
150
 
 
151
  
 
152
let (@.) (a,b) (c,d) = (a@c,b@d)
 
153
 
 
154
let listAssoc key assoclist =
 
155
  try Some (List.assoc key assoclist) with Not_found -> None
 
156
 
 
157
let identity x = x
 
158
 
 
159
let listToString toString separator =
 
160
  let rec listToString_internal = function
 
161
    | [] -> ""
 
162
    | [x] -> toString x
 
163
    | x::xs -> (toString x) ^ separator ^ (listToString_internal xs) in
 
164
  listToString_internal
 
165
 
 
166
let stringlistToString = listToString identity
 
167
 
 
168
let intToString = string_of_int
 
169
let floatToString = string_of_float
 
170
 
 
171
let same_length xs zs = 
 
172
  let rec same_length_internal = function
 
173
    | [],[]  -> true
 
174
    | [], _  -> false
 
175
    | _, []  -> false
 
176
    | _::xs,_::zs -> same_length_internal (xs,zs) 
 
177
  in same_length_internal (xs,zs)
 
178
 
 
179
let optionIsSome = function None -> false | Some _ -> true
 
180
let optionIsNone = function None -> true  | Some _ -> false
 
181
let optionToValue' exn = function None -> raise exn | Some x -> x
 
182
let optionToValue v = optionToValue' (Failure "optionToValue") v
 
183
let optionToList = function None -> [] | Some a -> [a]
 
184
 
 
185
let optionToListAndConcat xs = function
 
186
  | None   -> xs
 
187
  | Some x -> x::xs
 
188
 
 
189
let option_to_boolvaluepair oldvalue = function
 
190
  | None          -> (false, oldvalue)
 
191
  | Some newvalue -> (true,  newvalue)
 
192
 
 
193
let minimize f xs =
 
194
  let rec minimize' z z' = function
 
195
    | []    -> Some z
 
196
    | x::xs -> 
 
197
        let x' = f x in
 
198
          if x' < z' then minimize' x x' xs else minimize' z z' xs
 
199
  in match xs with
 
200
    | []    -> None
 
201
    | [x]   -> Some x
 
202
    | x::xs -> minimize' x (f x) xs
 
203
 
 
204
let list_removefirst p =
 
205
  let rec remove_internal = function
 
206
    | [] -> []
 
207
    | x::xs -> if p x then xs else x::(remove_internal xs)
 
208
  in remove_internal
 
209
 
 
210
let cons a b = a::b
 
211
 
 
212
let mapOption f = function
 
213
  | Some x -> Some (f x)
 
214
  | None   -> None
 
215
 
 
216
(*
 
217
use return/identity for that
 
218
let get1of1 x = x
 
219
*)
 
220
 
 
221
(*
 
222
use Pervasives.fst and Pervasives.snd for that
 
223
let get1of2 (x,_) = x
 
224
let get2of2 (_,x) = x
 
225
*)
 
226
 
 
227
let get1of3 (x,_,_) = x
 
228
let get2of3 (_,x,_) = x
 
229
let get3of3 (_,_,x) = x
 
230
 
 
231
let get1of4 (x,_,_,_) = x
 
232
let get2of4 (_,x,_,_) = x
 
233
let get3of4 (_,_,x,_) = x
 
234
let get4of4 (_,_,_,x) = x
 
235
 
 
236
let get1of5 (x,_,_,_,_) = x
 
237
let get2of5 (_,x,_,_,_) = x
 
238
let get3of5 (_,_,x,_,_) = x
 
239
let get4of5 (_,_,_,x,_) = x
 
240
let get5of5 (_,_,_,_,x) = x
 
241
 
 
242
let get1of6 (x,_,_,_,_,_) = x
 
243
let get2of6 (_,x,_,_,_,_) = x
 
244
let get3of6 (_,_,x,_,_,_) = x
 
245
let get4of6 (_,_,_,x,_,_) = x
 
246
let get5of6 (_,_,_,_,x,_) = x
 
247
let get6of6 (_,_,_,_,_,x) = x
 
248
 
 
249
let repl1of2 x (_,a) = (x,a)
 
250
let repl2of2 x (a,_) = (a,x)
 
251
 
 
252
let repl1of3 x (_,a,b) = (x,a,b)
 
253
let repl2of3 x (a,_,b) = (a,x,b)
 
254
let repl3of3 x (a,b,_) = (a,b,x)
 
255
 
 
256
let repl1of4 x (_,a,b,c) = (x,a,b,c)
 
257
let repl2of4 x (a,_,b,c) = (a,x,b,c)
 
258
let repl3of4 x (a,b,_,c) = (a,b,x,c)
 
259
let repl4of4 x (a,b,c,_) = (a,b,c,x)
 
260
 
 
261
let repl1of5 x (_,a,b,c,d) = (x,a,b,c,d)
 
262
let repl2of5 x (a,_,b,c,d) = (a,x,b,c,d)
 
263
let repl3of5 x (a,b,_,c,d) = (a,b,x,c,d)
 
264
let repl4of5 x (a,b,c,_,d) = (a,b,c,x,d)
 
265
let repl5of5 x (a,b,c,d,_) = (a,b,c,d,x)
 
266
 
 
267
let repl1of6 x (_,a,b,c,d,e) = (x,a,b,c,d,e)
 
268
let repl2of6 x (a,_,b,c,d,e) = (a,x,b,c,d,e)
 
269
let repl3of6 x (a,b,_,c,d,e) = (a,b,x,c,d,e)
 
270
let repl4of6 x (a,b,c,_,d,e) = (a,b,c,x,d,e)
 
271
let repl5of6 x (a,b,c,d,_,e) = (a,b,c,d,x,e)
 
272
let repl6of6 x (a,b,c,d,e,_) = (a,b,c,d,e,x)
 
273
 
 
274
 
 
275
let rec fixpoint f a = match f a with
 
276
  | (false, b) -> b
 
277
  | (true, b') -> fixpoint f b'
 
278
 
 
279
let return x = x
 
280
 
 
281
let diff a b = filter (fun x -> not (List.mem x b)) a
 
282
 
 
283
let addelem a set = if not (List.mem a set) then a :: set else set
 
284
 
 
285
let union l =
 
286
  let f x = addelem x   (* let is source of polymorphism *)
 
287
  in List.fold_right f l
 
288
 
 
289
let uniq l =
 
290
  List.fold_right (fun a b -> if List.mem a b then b else a :: b) l []
 
291
 
 
292
let msb x =
 
293
  let rec msb_internal msb0 = function
 
294
    | 0 -> msb0
 
295
    | n -> msb_internal (msb0+1) (n lsr 1) in
 
296
  msb_internal (-1) x
 
297
 
 
298
let lists_overlap xs zs = List.exists (fun i -> List.mem i xs) zs
 
299
 
 
300
let toNil _  = []
 
301
let toNone _ = None
 
302
let toZero _ = 0
 
303
 
 
304
 
 
305
(* print an information message *)
 
306
let info string =
 
307
  if !Magic.verbose then begin
 
308
    let now = Unix.times () 
 
309
    and pid = Unix.getpid () in
 
310
    prerr_string ((string_of_int pid) ^ ": " ^
 
311
                  "at t = " ^  (string_of_float now.tms_utime) ^ " : ");
 
312
    prerr_string (string ^ "\n");
 
313
    flush Pervasives.stderr;
 
314
  end
 
315
 
 
316
let debugOutputString str = 
 
317
  if !Magic.do_debug_output then Printf.printf "/* %s */\n" str else ()
 
318
 
 
319
let rec list_last = function
 
320
  | [] -> failwith "list_last"
 
321
  | [x] -> x
 
322
  | x::xs -> list_last xs
 
323
 
 
324
(*
 
325
 * freeze a function, i.e., compute it only once on demand, and
 
326
 * cache it into an array.
 
327
 *)
 
328
let array n f =
 
329
  let a = Array.init n (fun i -> lazy (f i))
 
330
  in fun i -> Lazy.force a.(i)
 
331
 
 
332
(* iota n produces the list [0; 1; ...; n - 1] *)
 
333
let iota n = forall [] cons 0 n identity
 
334
 
 
335
(* interval a b produces the list [a; 1; ...; b - 1] *)
 
336
let interval a b = List.map ((+) a) (iota (b - a))