annotate src/fftw-3.3.8/genfft/littlesimp.ml @ 169:223a55898ab9 tip default

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