Mercurial > hg > sv-dependency-builds
comparison src/fftw-3.3.8/genfft/littlesimp.ml @ 167:bd3cc4d1df30
Add FFTW 3.3.8 source, and a Linux build
author | Chris Cannam <cannam@all-day-breakfast.com> |
---|---|
date | Tue, 19 Nov 2019 14:52:55 +0000 |
parents | |
children |
comparison
equal
deleted
inserted
replaced
166:cbd6d7e562c7 | 167:bd3cc4d1df30 |
---|---|
1 (* | |
2 * Copyright (c) 1997-1999 Massachusetts Institute of Technology | |
3 * Copyright (c) 2003, 2007-14 Matteo Frigo | |
4 * Copyright (c) 2003, 2007-14 Massachusetts Institute of Technology | |
5 * | |
6 * This program is free software; you can redistribute it and/or modify | |
7 * it under the terms of the GNU General Public License as published by | |
8 * the Free Software Foundation; either version 2 of the License, or | |
9 * (at your option) any later version. | |
10 * | |
11 * This program is distributed in the hope that it will be useful, | |
12 * but WITHOUT ANY WARRANTY; without even the implied warranty of | |
13 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
14 * GNU General Public License for more details. | |
15 * | |
16 * You should have received a copy of the GNU General Public License | |
17 * along with this program; if not, write to the Free Software | |
18 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA | |
19 * | |
20 *) | |
21 | |
22 (* | |
23 * The LittleSimplifier module implements a subset of the simplifications | |
24 * of the AlgSimp module. These simplifications can be executed | |
25 * quickly here, while they would take a long time using the heavy | |
26 * machinery of AlgSimp. | |
27 * | |
28 * For example, 0 * x is simplified to 0 tout court by the LittleSimplifier. | |
29 * On the other hand, AlgSimp would first simplify x, generating lots | |
30 * of common subexpressions, storing them in a table etc, just to | |
31 * discard all the work later. Similarly, the LittleSimplifier | |
32 * reduces the constant FFT in Rader's algorithm to a constant sequence. | |
33 *) | |
34 | |
35 open Expr | |
36 | |
37 let rec makeNum = function | |
38 | n -> Num n | |
39 | |
40 and makeUminus = function | |
41 | Uminus a -> a | |
42 | Num a -> makeNum (Number.negate a) | |
43 | a -> Uminus a | |
44 | |
45 and makeTimes = function | |
46 | (Num a, Num b) -> makeNum (Number.mul a b) | |
47 | (Num a, Times (Num b, c)) -> makeTimes (makeNum (Number.mul a b), c) | |
48 | (Num a, b) when Number.is_zero a -> makeNum (Number.zero) | |
49 | (Num a, b) when Number.is_one a -> b | |
50 | (Num a, b) when Number.is_mone a -> makeUminus b | |
51 | (Num a, Uminus b) -> Times (makeUminus (Num a), b) | |
52 | (a, (Num b as b')) -> makeTimes (b', a) | |
53 | (a, b) -> Times (a, b) | |
54 | |
55 and makePlus l = | |
56 let rec reduceSum x = match x with | |
57 [] -> [] | |
58 | [Num a] -> if Number.is_zero a then [] else x | |
59 | (Num a) :: (Num b) :: c -> | |
60 reduceSum ((makeNum (Number.add a b)) :: c) | |
61 | ((Num _) as a') :: b :: c -> b :: reduceSum (a' :: c) | |
62 | a :: s -> a :: reduceSum s | |
63 | |
64 in match reduceSum l with | |
65 [] -> makeNum (Number.zero) | |
66 | [a] -> a | |
67 | [a; b] when a == b -> makeTimes (Num Number.two, a) | |
68 | [Times (Num a, b); Times (Num c, d)] when b == d -> | |
69 makeTimes (makePlus [Num a; Num c], b) | |
70 | a -> Plus a | |
71 |