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