module Simp where import Exp import Ops default(Int) add (Const x) (Const y) = Const (x + y) add (Const x) e = add e (Const x) -- || add (Unop Uneg e) e2 = sub e2 e -- changes the order of terms, confusing add e (Unop Uneg e2) = sub e e2 add (Binop Badd e1 e2) e3 = add e1 (add e2 e3) add e (Binop Bmul (k@(Const _)) e2) | e==e2 = mul (add k one) e add (Binop Bmul (k1@(Const _)) e1) (Binop Bmul (k2@(Const _)) e2) | e1==e2 = mul (add k1 k2) e1 add e1 e2 = if e2==zero' then e1 else if e1==e2 then mul two e1 else Binop Badd e1 e2 sub (Const x) (Const y) = Const (x - y) sub e1 (Unop Uneg e2) = add e1 e2 sub e1 e2 = if e2==zero' then e1 else if e1==zero' then Unop Uneg e2 else if e1==e2 then zero' else Binop Bsub e1 e2 mul (Const x) (Const y) = Const (x * y) mul Var Var = pow Var 2 mul Var (Pow Var n) = Pow Var (n+1) mul (Pow Var n) Var = Pow Var (n+1) mul (Pow Var n) (Pow Var m) = Pow Var (n+m) mul e (Const y) = mul (Const y) e mul e1 (Unop Uneg e2) = neg (mul e1 e2) mul (Unop Uneg e1) e2 = neg (mul e1 e2) mul e1 (Binop Bmul e2 e3) = mul (mul e1 e2) e3 -- || mul (k1 @ (Const _)) (Binop Bmul (k2 @ (Const _)) e) = mul (mul k1 k2) e mul e1 e2 = if e1==one then e2 else if e1==zero' then zero' else if e1==minusone then neg e2 else Binop Bmul e1 e2 div' (Const x) (Const y) = Const (x / y) div' e1 (Unop Uneg e2) = neg (div' e1 e2) div' (Unop Uneg e1) e2 = neg (div' e1 e2) div' (Binop Bmul (Const x) e) (Const y) = mul (Const (x/y)) e div' e1 e2 = if e2==one then e1 else Binop Bdiv e1 e2 pow b 0 | b/=zero'= one pow b 1 = b pow b e = if b==one then one else Pow b e neg (Const x) = (Const (0.0 - x)) neg (Unop Uneg e) = e neg e = Unop Uneg e inv e = div' one e zero' = Const 0.0 one = Const 1.0 two = Const 2.0 minusone = neg one ce = Const . fromIntegral