diff --git a/ConstMath/Pass.hs b/ConstMath/Pass.hs
new file mode 100644
--- /dev/null
+++ b/ConstMath/Pass.hs
@@ -0,0 +1,260 @@
+{-# LANGUAGE PatternGuards #-}
+{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE TupleSections #-}
+
+{-# OPTIONS_GHC -Wall #-}
+module ConstMath.Pass (
+      constMathProgram
+) where
+
+import ConstMath.Types
+
+import Control.Applicative ((<$>))
+import Control.Monad ((<=<))
+import Data.Map (Map)
+import qualified Data.Map as Map
+import Data.Maybe
+
+import GhcPlugins
+
+constMathProgram :: Opts -> [CoreBind] -> CoreM [CoreBind]
+constMathProgram opts binds = do
+    traceMsg opts "\nStarting ConstMath pass"
+    mapM (subBind opts "") binds
+
+subBind :: Opts -> String -> CoreBind -> CoreM CoreBind
+subBind opts tab (NonRec b rhs) = do
+    traceMsg opts $ tab ++ "Non-recursive binding named " ++ showSDoc (ppr b)
+    rhs' <- subExpr opts tab rhs
+    return (NonRec b rhs')
+subBind opts _tab bndr@(Rec pairs) = do
+    _ <- mapM (uncurry $ printRecBind opts) pairs
+    return bndr
+
+printRecBind opts b _e = do
+    traceMsg opts $ "Recursive binding " ++ showSDoc (ppr b)
+
+subExpr :: Opts -> String -> CoreExpr -> CoreM CoreExpr
+
+subExpr opts tab expr@(Type t) = do
+    traceMsg opts $ tab ++ "Type " ++ showSDoc (ppr t)
+    return expr
+
+subExpr opts tab expr@(Coercion _co) = do
+    traceMsg opts $ tab ++ "Coercion"
+    return expr
+
+subExpr opts tab expr@(Lit lit) = do
+    traceMsg opts $ tab ++ "Lit " ++ showSDoc (ppr lit)
+    return expr
+
+subExpr opts tab expr@(Var v) = do
+    traceMsg opts $ tab ++ "Var " ++ showSDoc (ppr v)
+    return expr
+
+subExpr opts tab (App f a) = do
+    traceMsg opts $ tab ++ "App " ++ showSDoc (ppr f)
+    f' <- subExpr opts (tab ++ "< ") f
+    a' <- subExpr opts (tab ++ "> ") a
+    collapse opts (App f' a')
+
+subExpr opts tab (Tick t e) = do
+    traceMsg opts $ tab ++ "Tick"
+    e' <- subExpr opts (tab ++ "  ") e
+    return (Tick t e')
+
+subExpr opts tab (Cast e co) = do
+    traceMsg opts $ tab ++ "Cast"
+    e' <- subExpr opts (tab ++ "  ") e
+    return (Cast e' co)
+
+subExpr opts tab (Lam b e) = do
+    traceMsg opts $ tab ++ "Lam"
+    e' <- subExpr opts (tab ++ "  ") e
+    return (Lam b e')
+
+subExpr opts tab (Let bind e) = do
+    traceMsg opts $ tab ++ "Let"
+    bind' <- subBind opts tab bind
+    e' <- subExpr opts (tab ++ "  ") e
+    return (Let bind' e')
+
+subExpr opts tab (Case scrut bndr ty alts) = do
+    traceMsg opts $ tab ++ "Case"
+    let subAlt (ac,bs,eB) = (ac,bs,) <$> subExpr opts (tab ++ "  ") eB
+    scrut' <- subExpr opts (tab ++ "  ") scrut
+    alts' <- mapM subAlt alts
+    return (Case scrut' bndr ty alts')
+
+----------------------------------------------------------------------
+
+collapse :: Opts -> CoreExpr -> CoreM CoreExpr
+collapse opts expr@(App f1 _)
+  | Just f <- cmSubst <$> findSub f1
+    = f opts expr
+collapse _ expr = return expr
+
+mkUnaryCollapseIEEE :: (forall a. RealFloat a => (a -> a))
+                    -> Opts
+                    -> CoreExpr
+                    -> CoreM CoreExpr
+mkUnaryCollapseIEEE fnE opts expr@(App f1 (App f2 (Lit lit)))
+    | isDHash f2, MachDouble d <- lit = evalUnaryIEEE d mkDoubleLitDouble
+    | isFHash f2, MachFloat d  <- lit = evalUnaryIEEE d mkFloatLitFloat
+    where
+        evalUnaryIEEE d mkLit = do
+            let sub = fnE (fromRational d)
+            maybe (return expr)
+              (return . App f2 . mkLit)
+              =<< maybeIEEE opts (fromJust $ funcName f1) sub
+mkUnaryCollapseIEEE _ _ expr = return expr
+
+mkUnaryCollapseNum :: (forall a . Num a => (a -> a))
+                   -> Opts
+                   -> CoreExpr
+                   -> CoreM CoreExpr
+mkUnaryCollapseNum fnE _opts (App _f1 (App f2 (Lit lit)))
+    | isDHash f2, MachDouble d <- lit =
+        evalUnaryNum fromRational d mkDoubleLitDouble
+    | isFHash f2, MachFloat d  <- lit =
+        evalUnaryNum fromRational d mkFloatLitFloat
+    | isIHash f2, MachInt d    <- lit =
+        evalUnaryNum fromIntegral d mkIntLitInt
+    | isWHash f2, MachWord d   <- lit =
+        evalUnaryNum fromIntegral d mkWordLitWord
+    where
+        evalUnaryNum from d mkLit = do
+            let sub = fnE (from d)
+            return (App f2 (mkLit sub))
+mkUnaryCollapseNum _ _ expr = return expr
+
+mkBinaryCollapse :: (forall a. RealFloat a => (a -> a -> a))
+                 -> Opts
+                 -> CoreExpr
+                 -> CoreM CoreExpr
+mkBinaryCollapse fnE opts expr@(App (App f1 (App f2 (Lit lit1))) (App f3 (Lit lit2)))
+    | isDHash f2 && isDHash f3
+    , MachDouble d1 <- lit1, MachDouble d2 <- lit2 =
+        evalBinaryIEEE d1 d2 mkDoubleLitDouble
+    | isFHash f2 && isFHash f3
+    , MachFloat d1  <- lit1, MachFloat d2  <- lit2 =
+        evalBinaryIEEE d1 d2 mkFloatLitFloat
+    where
+        evalBinaryIEEE d1 d2 mkLit = do
+            let sub = fnE (fromRational d1) (fromRational d2)
+            maybe (return expr) (\x -> return (App f2 (mkLit x)))
+                  =<< maybeIEEE opts (fromJust $ funcName f1) sub
+mkBinaryCollapse _ _ expr = return expr
+
+fromRationalCollapse :: Opts -> CoreExpr -> CoreM CoreExpr
+fromRationalCollapse opts expr@(App f1 (App (App f2 (Lit (LitInteger n _))) (Lit (LitInteger d _))))
+    | Just "ConstMath.Rules.rationalToFloat" <- funcName f1
+    , Just "GHC.Real.:%" <- funcName f2
+      = do
+          let sub = fromRational $ (fromInteger n) / (fromInteger d)
+          maybe (return expr) (\x -> return (mkFloatExpr x)) =<< maybeIEEE opts (fromJust $ funcName f1) sub
+fromRationalCollapse opts expr@(App f1 (App (App f2 (Lit (LitInteger n _))) (Lit (LitInteger d _))))
+    | Just "ConstMath.Rules.rationalToDouble" <- funcName f1
+    , Just "GHC.Real.:%" <- funcName f2
+      = do
+          let sub = fromRational $ (fromInteger n) / (fromInteger d)
+          maybe (return expr) (\x -> return (mkDoubleExpr x)) =<< maybeIEEE opts (fromJust $ funcName f1) sub
+fromRationalCollapse _ expr = return expr
+
+maybeIEEE :: RealFloat a => Opts -> String -> a -> CoreM (Maybe a)
+maybeIEEE opts s d
+    | isNaN d = do
+        err "NaN"
+        return Nothing
+    | isInfinite d = do
+        err "infinite"
+        return Nothing
+    | isDenormalized d = do
+        err "denormalized"
+        return Nothing
+    | isNegativeZero d = do
+        err "negative zero"
+        return Nothing
+    | otherwise = do
+        msg opts $ "Result of replacing " ++ s ++ " is ok"
+        return (Just d)
+    where
+        err v = errorMsgS $ "Skipping replacement of " ++ s ++ " result " ++ v
+
+----------------------------------------------------------------------
+
+data CMSub = CMSub
+    { cmFuncName :: String
+    , cmSubst    :: Opts -> CoreExpr -> CoreM CoreExpr
+    }
+
+unarySubIEEE :: String -> (forall a. RealFloat a => a -> a) -> CMSub
+unarySubIEEE nm fn = CMSub nm (mkUnaryCollapseIEEE fn)
+
+unarySubNum :: String -> (forall a . Num a => (a -> a)) -> CMSub
+unarySubNum nm fn = CMSub nm (mkUnaryCollapseNum fn)
+
+binarySub :: String -> (forall a. RealFloat a => a -> a -> a) -> CMSub
+binarySub nm fn = CMSub nm (mkBinaryCollapse fn)
+
+funcName :: CoreExpr -> Maybe String
+funcName = listToMaybe . words . showSDoc . ppr
+
+isFHash :: CoreExpr -> Bool
+isFHash = maybe False ((==) "GHC.Types.F#") . funcName
+
+isDHash :: CoreExpr -> Bool
+isDHash = maybe False ((==) "GHC.Types.D#") . funcName
+
+isIHash :: CoreExpr -> Bool
+isIHash = maybe False ((==) "GHC.Types.I#") . funcName
+
+isWHash :: CoreExpr -> Bool
+isWHash = maybe False ((==) "GHC.Word.W#") . funcName
+
+findSub :: CoreExpr -> Maybe CMSub
+findSub = flip Map.lookup subFunc <=< funcName
+
+subs :: [CMSub]
+subs =
+    [ unarySubIEEE "GHC.Float.exp"    exp
+    , unarySubIEEE "GHC.Float.log"    log
+    , unarySubIEEE "GHC.Float.sqrt"   sqrt
+    , unarySubIEEE "GHC.Float.sin"    sin
+    , unarySubIEEE "GHC.Float.cos"    cos
+    , unarySubIEEE "GHC.Float.tan"    tan
+    , unarySubIEEE "GHC.Float.asin"   asin
+    , unarySubIEEE "GHC.Float.acos"   acos
+    , unarySubIEEE "GHC.Float.atan"   atan
+    , unarySubIEEE "GHC.Float.sinh"   sinh
+    , unarySubIEEE "GHC.Float.cosh"   cosh
+    , unarySubIEEE "GHC.Float.tanh"   tanh
+    , unarySubIEEE "GHC.Float.asinh"  asinh
+    , unarySubIEEE "GHC.Float.acosh"  acosh
+    , unarySubIEEE "GHC.Float.atanh"  atanh
+    , unarySubNum "GHC.Num.negate"   negate
+    , unarySubNum "GHC.Num.abs"      abs
+    , unarySubNum "GHC.Num.signum"   signum
+    , CMSub    "ConstMath.Rules.rationalToFloat" fromRationalCollapse
+    , CMSub    "ConstMath.Rules.rationalToDouble" fromRationalCollapse
+    ]
+
+subFunc :: Map String CMSub
+subFunc = Map.fromList $ zip (map cmFuncName subs) subs
+
+----------------------------------------------------------------------
+
+msg :: Opts -> String -> CoreM ()
+msg opts s
+    | not (quiet opts) = putMsgS s
+    | otherwise = return ()
+
+vMsg :: Opts -> String -> CoreM ()
+vMsg opts s
+    | verbose opts = putMsgS s
+    | otherwise    = return ()
+
+traceMsg :: Opts -> String -> CoreM ()
+traceMsg opts s
+    | traced opts = putMsgS s
+    | otherwise   = return ()
diff --git a/ConstMath/Plugin.hs b/ConstMath/Plugin.hs
new file mode 100644
--- /dev/null
+++ b/ConstMath/Plugin.hs
@@ -0,0 +1,32 @@
+module ConstMath.Plugin (
+      plugin -- :: Plugin
+) where
+
+import ConstMath.Types
+import ConstMath.Pass (constMathProgram)
+import GhcPlugins
+
+import Data.List (intersperse)
+
+plugin :: Plugin
+plugin = defaultPlugin {
+    installCoreToDos = install
+  }
+
+install :: [CommandLineOption] -> [CoreToDo] -> CoreM [CoreToDo]
+install args todos = do
+    reinitializeGlobals
+    let pass = CoreDoPasses [constMath]
+    return $ intersperse pass todos
+  where constMath = CoreDoPluginPass "Constant Math Elimination"
+            (bindsOnlyPass (constMathProgram (parseOpts args)) )
+
+-- TODO: use a real parser
+parseOpts :: [CommandLineOption] -> Opts
+parseOpts = foldr ($) defaultOpts . map mkArg
+    where
+        mkArg flag
+            | flag `elem` ["-v","--verbose","--verbosity=1"]    = setVerbosity (CmVerbose 1)
+            | flag `elem` ["-v11", "-verbosity=11","--trace"] = setVerbosity Trace
+            | flag `elem` ["-q", "--quiet","--verbosity=0", "-v0"]  = setVerbosity None
+            | otherwise = id
diff --git a/ConstMath/Rules.hs b/ConstMath/Rules.hs
new file mode 100644
--- /dev/null
+++ b/ConstMath/Rules.hs
@@ -0,0 +1,43 @@
+{-# OPTIONS_GHC -Wall -fno-warn-orphans #-}
+{-# OPTIONS_HADDOCK hide #-}
+
+module ConstMath.Rules (
+  rationalToFloat
+, rationalToDouble
+) where
+
+import GHC.Float
+import GHC.Real
+
+rationalToFloat :: Rational -> Float
+rationalToFloat (n:%0)
+    | n == 0        = 0/0
+    | n < 0         = (-1)/0
+    | otherwise     = 1/0
+rationalToFloat (n:%d)
+    | n == 0        = encodeFloat 0 0
+    | n < 0         = -(fromRat'' minEx mantDigs (-n) d)
+    | otherwise     = fromRat'' minEx mantDigs n d
+      where
+        minEx       = fst (floatRange (0::Float))
+        mantDigs    = floatDigits (0 :: Float)
+{-# NOINLINE [1] rationalToFloat #-}
+
+rationalToDouble :: Rational -> Double
+rationalToDouble (n:%0)
+    | n == 0        = 0/0
+    | n < 0         = (-1)/0
+    | otherwise     = 1/0
+rationalToDouble (n:%d)
+    | n == 0        = encodeFloat 0 0
+    | n < 0         = -(fromRat'' minEx mantDigs (-n) d)
+    | otherwise     = fromRat'' minEx mantDigs n d
+      where
+        minEx       = fst (floatRange (0 :: Double))
+        mantDigs    = floatDigits (0 :: Double)
+{-# NOINLINE [1] rationalToDouble #-}
+
+{-# RULES
+"ConstMath/rationalToFloat"  fromRational = rationalToFloat
+"ConstMath/rationalToDouble" fromRational = rationalToDouble
+      #-}
diff --git a/ConstMath/Types.hs b/ConstMath/Types.hs
new file mode 100644
--- /dev/null
+++ b/ConstMath/Types.hs
@@ -0,0 +1,33 @@
+{-# LANGUAGE NamedFieldPuns #-}
+
+{-# OPTIONS_GHC -Wall #-}
+module ConstMath.Types (
+  Opts(..)
+, Verbosity(..)
+, defaultOpts
+, setVerbosity
+, quiet
+, verbose
+, traced
+) where
+
+data Verbosity = None | CmVerbose Int | Trace deriving (Eq, Show, Ord)
+
+data Opts = Opts
+    { cmVerbosity :: Verbosity }
+    deriving (Eq, Show)
+
+setVerbosity :: Verbosity -> Opts -> Opts
+setVerbosity cmVerbosity opts = Opts{cmVerbosity}
+
+defaultOpts :: Opts
+defaultOpts = Opts None
+
+quiet   :: Opts -> Bool
+quiet Opts{cmVerbosity} = cmVerbosity == None
+
+verbose :: Opts -> Bool
+verbose Opts{cmVerbosity} = cmVerbosity > CmVerbose 0
+
+traced :: Opts -> Bool
+traced Opts{cmVerbosity} = cmVerbosity >= Trace
diff --git a/LICENSE b/LICENSE
new file mode 100644
--- /dev/null
+++ b/LICENSE
@@ -0,0 +1,30 @@
+Copyright (c) 2012, Conrad Parker
+
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+    * Redistributions of source code must retain the above copyright
+      notice, this list of conditions and the following disclaimer.
+
+    * Redistributions in binary form must reproduce the above
+      copyright notice, this list of conditions and the following
+      disclaimer in the documentation and/or other materials provided
+      with the distribution.
+
+    * Neither the name of Conrad Parker nor the names of other
+      contributors may be used to endorse or promote products derived
+      from this software without specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/const-math-ghc-plugin.cabal b/const-math-ghc-plugin.cabal
new file mode 100644
--- /dev/null
+++ b/const-math-ghc-plugin.cabal
@@ -0,0 +1,31 @@
+name:                const-math-ghc-plugin
+version:             0.1.0.0
+synopsis:            Compiler plugin for constant math elimination
+description:         
+  This library implements elimination of constant math expressions.
+license:             BSD3
+license-file:        LICENSE
+author:              Conrad Parker, John Lato
+maintainer:          Conrad Parker <conrad@metadecks.org>
+-- copyright:           
+category:            Compiler Plugin
+build-type:          Simple
+cabal-version:       >=1.8
+
+library
+  exposed-modules:     ConstMath.Plugin
+                       ConstMath.Rules
+  other-modules:       ConstMath.Pass
+                       ConstMath.Types
+  build-depends:       base < 5,
+                       containers,
+                       ghc >= 7.4
+
+------------------------------------------------------------------------
+-- Git repo
+--
+source-repository head
+  type: git
+  location: git://github.com/kfish/const-math-ghc-plugin.git
+
+