simple-reflect-0.3.2/0000755000000000000000000000000012323234407012615 5ustar0000000000000000simple-reflect-0.3.2/LICENSE0000644000000000000000000000270412323234407013625 0ustar0000000000000000Copyright (c) Twan van Laarhoven 2008. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. 2. 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. 3. Neither the name of the author nor the names of his contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE REGENTS 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 AUTHORS 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. simple-reflect-0.3.2/simple-reflect.cabal0000644000000000000000000000211712323234407016515 0ustar0000000000000000name: simple-reflect version: 0.3.2 homepage: http://twanvl.nl/blog/haskell/simple-reflection-of-expressions license: BSD3 license-file: LICENSE author: Twan van Laarhoven maintainer: twanvl@gmail.com bug-reports: https://github.com/twanvl/simple-reflect/issues category: Debug cabal-version: >= 1.6 build-type: Simple synopsis: Simple reflection of expressions containing variables description: This package allows simple reflection of expressions containing variables. Reflection here means that a Haskell expression is turned into a string. The primary aim of this package is teaching and understanding; there are no options for manipulating the reflected expressions beyond showing them. source-repository head type: git location: http://github.com/twanvl/simple-reflect.git Library build-depends: base >= 2 && < 5 exposed-modules: Debug.SimpleReflect Debug.SimpleReflect.Expr Debug.SimpleReflect.Vars simple-reflect-0.3.2/Setup.hs0000644000000000000000000000012712323234407014251 0ustar0000000000000000module Main (main) where import Distribution.Simple main :: IO () main = defaultMain simple-reflect-0.3.2/Debug/0000755000000000000000000000000012323234407013643 5ustar0000000000000000simple-reflect-0.3.2/Debug/SimpleReflect.hs0000644000000000000000000000164412323234407016742 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Debug.SimpleReflect -- Copyright : (c) 2008-2014 Twan van Laarhoven -- License : BSD-style -- -- Maintainer : twanvl@gmail.com -- Stability : experimental -- Portability : portable -- -- Simple reflection of haskell expressions containing variables. -- -- Some examples: -- -- > > sum [1..5] :: Expr -- > 0 + 1 + 2 + 3 + 4 + 5 -- -- > > foldr1 f [a,b,c] -- > f a (f b c) -- -- > > take 5 (iterate f x) -- > [x,f x,f (f x),f (f (f x)),f (f (f (f x)))] -- -- > > mapM_ print $ reduction (1+2*(3+4)) -- > 1 + 2 * (3 + 4) -- > 1 + 2 * 7 -- > 1 + 14 -- > 15 ----------------------------------------------------------------------------- module Debug.SimpleReflect ( module Debug.SimpleReflect.Expr , module Debug.SimpleReflect.Vars ) where import Debug.SimpleReflect.Expr import Debug.SimpleReflect.Vars simple-reflect-0.3.2/Debug/SimpleReflect/0000755000000000000000000000000012323234407016401 5ustar0000000000000000simple-reflect-0.3.2/Debug/SimpleReflect/Vars.hs0000644000000000000000000000350112323234407017647 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Debug.SimpleReflect.Vars -- Copyright : (c) 2008-2014 Twan van Laarhoven -- License : BSD-style -- -- Maintainer : twanvl@gmail.com -- Stability : experimental -- Portability : portable -- -- Single letter variable names. -- -- All names have type @Expr@, except for @f@, @g@ and @h@, which are generic functions. -- This means that @show (f x :: Expr) == \"f x\"@, but that @show (a x :: Expr)@ gives a type error. -- On the other hand, the type of @g@ in @show (f g)@ is ambiguous. -- ----------------------------------------------------------------------------- module Debug.SimpleReflect.Vars ( -- * Variables a,b,c,d,e,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z -- * Functions , f,f',f'',g,h -- * Operators , (⊗), (⊕), (@@) ) where import Debug.SimpleReflect.Expr ------------------------------------------------------------------------------ -- Variables! ------------------------------------------------------------------------------ a,b,c,d,e,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z :: Expr [a,b,c,d,e,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z] = [var [letter] | letter <- ['a'..'e']++['i'..'z']] f,f',f'',g,h :: FromExpr a => a f = fun "f" f' = fun "f'" f'' = fun "f''" g = fun "g" h = fun "h" ------------------------------------------------------------------------------ -- Operators ------------------------------------------------------------------------------ -- | A non-associative infix 9 operator (@@) :: Expr -> Expr -> Expr (@@) = op Infix 9 " @@ " infix 9 @@ -- | A non-associative infix 7 operator (⊗) :: Expr -> Expr -> Expr (⊗) = op Infix 7 " ⊗ " infix 7 ⊗ -- | A non-associative infix 6 operator (⊕) :: Expr -> Expr -> Expr (⊕) = op Infix 6 " ⊕ " infix 6 ⊕ simple-reflect-0.3.2/Debug/SimpleReflect/Expr.hs0000644000000000000000000002163512323234407017662 0ustar0000000000000000----------------------------------------------------------------------------- -- | -- Module : Debug.SimpleReflect.Expr -- Copyright : (c) 2008-2014 Twan van Laarhoven -- License : BSD-style -- -- Maintainer : twanvl@gmail.com -- Stability : experimental -- Portability : portable -- -- Simple reflection of haskell expressions containing variables. -- ----------------------------------------------------------------------------- module Debug.SimpleReflect.Expr ( -- * Construction Expr , FromExpr(..) , var, fun, Associativity(..), op -- * Evaluating , expr, reduce, reduction ) where import Data.List import Data.Monoid import Control.Applicative ------------------------------------------------------------------------------ -- Data type ------------------------------------------------------------------------------ -- | A reflected expression data Expr = Expr { showExpr :: Int -> ShowS -- ^ Show with the given precedence level , intExpr :: Maybe Integer -- ^ Integer value? , doubleExpr :: Maybe Double -- ^ Floating value? , reduced :: Maybe Expr -- ^ Next reduction step } instance Show Expr where showsPrec p r = showExpr r p -- | Default expression emptyExpr :: Expr emptyExpr = Expr { showExpr = \_ -> showString "" , intExpr = Nothing , doubleExpr = Nothing , reduced = Nothing } ------------------------------------------------------------------------------ -- Lifting and combining expressions ------------------------------------------------------------------------------ -- | A variable with the given name var :: String -> Expr var s = emptyExpr { showExpr = \_ -> showString s } lift :: Show a => a -> Expr lift x = emptyExpr { showExpr = \p -> showsPrec p x } -- | This data type specifies the associativity of operators: left, right or none. data Associativity = InfixL | Infix | InfixR deriving Eq -- | An infix operator with the given associativity, precedence and name op :: Associativity -> Int -> String -> Expr -> Expr -> Expr op fix prec opName a b = emptyExpr { showExpr = showFun } where showFun p = showParen (p > prec) $ showExpr a (if fix == InfixL then prec else prec + 1) . showString opName . showExpr b (if fix == InfixR then prec else prec + 1) ------------------------------------------------------------------------------ -- Adding numeric results ------------------------------------------------------------------------------ iOp :: (Expr -> Expr) -> (Integer -> Integer) -> Expr -> Expr iOp2 :: (Expr -> Expr -> Expr) -> (Integer -> Integer -> Integer) -> Expr -> Expr -> Expr dOp :: (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr dOp2 :: (Expr -> Expr -> Expr) -> (Double -> Double -> Double) -> Expr -> Expr -> Expr iOp r f a = (r a ) { intExpr = f <$> intExpr a } iOp2 r f a b = (r a b) { intExpr = f <$> intExpr a <*> intExpr b } dOp r f a = (r a ) { doubleExpr = f <$> doubleExpr a } dOp2 r f a b = (r a b) { doubleExpr = f <$> doubleExpr a <*> doubleExpr b } withReduce :: (Expr -> Expr) -> (Expr -> Expr) withReduce r a = let rr = r a in rr { reduced = withReduce r <$> reduced a <|> fromInteger <$> intExpr rr <|> fromDouble <$> doubleExpr rr } withReduce2 :: (Expr -> Expr -> Expr) -> (Expr -> Expr -> Expr) withReduce2 r a b = let rr = r a b in rr { reduced = (\a' -> withReduce2 r a' b) <$> reduced a <|> (\b' -> withReduce2 r a b') <$> reduced b <|> fromInteger <$> intExpr rr <|> fromDouble <$> doubleExpr rr } ------------------------------------------------------------------------------ -- Function types ------------------------------------------------------------------------------ -- | Conversion from @Expr@ to other types class FromExpr a where fromExpr :: Expr -> a instance FromExpr Expr where fromExpr = id instance (Show a, FromExpr b) => FromExpr (a -> b) where fromExpr f a = fromExpr $ op InfixL 10 " " f (lift a) -- | A generic, overloaded, function variable fun :: FromExpr a => String -> a fun = fromExpr . var ------------------------------------------------------------------------------ -- Forcing conversion & evaluation ------------------------------------------------------------------------------ -- | Force something to be an expression. expr :: Expr -> Expr expr = id -- | Reduce (evaluate) an expression once. -- -- For example @reduce (1 + 2 + 3 + 4) == 3 + 3 + 4@ reduce :: Expr -> Expr reduce e = maybe e id (reduced e) -- | Show all reduction steps when evaluating an expression. reduction :: Expr -> [Expr] reduction e0 = e0 : unfoldr (\e -> do e' <- reduced e; return (e',e')) e0 ------------------------------------------------------------------------------ -- Numeric classes ------------------------------------------------------------------------------ instance Eq Expr where Expr{ intExpr = Just a } == Expr{ intExpr = Just b } = a == b Expr{ doubleExpr = Just a } == Expr{ doubleExpr = Just b } = a == b a == b = show a == show b instance Ord Expr where compare Expr{ intExpr = Just a } Expr{ intExpr = Just b } = compare a b compare Expr{ doubleExpr = Just a } Expr{ doubleExpr = Just b } = compare a b compare a b = compare (show a) (show b) min = fun "min" `iOp2` min `dOp2` min max = fun "max" `iOp2` max `dOp2` max instance Num Expr where (+) = withReduce2 $ op InfixL 6 " + " `iOp2` (+) `dOp2` (+) (-) = withReduce2 $ op InfixL 6 " - " `iOp2` (-) `dOp2` (-) (*) = withReduce2 $ op InfixL 7 " * " `iOp2` (*) `dOp2` (*) negate = withReduce $ fun "negate" `iOp` negate `dOp` negate abs = withReduce $ fun "abs" `iOp` abs `dOp` abs signum = withReduce $ fun "signum" `iOp` signum `dOp` signum fromInteger i = (lift i) { intExpr = Just i , doubleExpr = Just $ fromInteger i } instance Real Expr where toRational someExpr = case (doubleExpr someExpr, intExpr someExpr) of (Just d,_) -> toRational d (_,Just i) -> toRational i _ -> error $ "not a rational number: " ++ show someExpr instance Integral Expr where quotRem a b = (quot a b, rem a b) divMod a b = (div a b, mod a b) quot = withReduce2 $ op InfixL 7 " `quot` " `iOp2` quot rem = withReduce2 $ op InfixL 7 " `rem` " `iOp2` rem div = withReduce2 $ op InfixL 7 " `div` " `iOp2` div mod = withReduce2 $ op InfixL 7 " `mod` " `iOp2` mod toInteger someExpr = case intExpr someExpr of Just i -> i _ -> error $ "not an integer: " ++ show someExpr instance Fractional Expr where (/) = withReduce2 $ op InfixL 7 " / " `dOp2` (/) recip = withReduce $ fun "recip" `dOp` recip fromRational r = fromDouble (fromRational r) fromDouble :: Double -> Expr fromDouble d = (lift d) { doubleExpr = Just d } instance Floating Expr where pi = (var "pi") { doubleExpr = Just pi } exp = withReduce $ fun "exp" `dOp` exp sqrt = withReduce $ fun "sqrt" `dOp` sqrt log = withReduce $ fun "log" `dOp` log (**) = withReduce2 $ op InfixR 8 "**" `dOp2` (**) sin = withReduce $ fun "sin" `dOp` sin cos = withReduce $ fun "cos" `dOp` cos sinh = withReduce $ fun "sinh" `dOp` sinh cosh = withReduce $ fun "cosh" `dOp` cosh asin = withReduce $ fun "asin" `dOp` asin acos = withReduce $ fun "acos" `dOp` acos atan = withReduce $ fun "atan" `dOp` atan asinh = withReduce $ fun "asinh" `dOp` asinh acosh = withReduce $ fun "acosh" `dOp` acosh atanh = withReduce $ fun "atanh" `dOp` atanh instance Enum Expr where succ = withReduce $ fun "succ" `iOp` succ `dOp` succ pred = withReduce $ fun "pred" `iOp` pred `dOp` pred toEnum = fun "toEnum" fromEnum = fromEnum . toInteger enumFrom a = map fromInteger $ enumFrom (toInteger a) enumFromThen a b = map fromInteger $ enumFromThen (toInteger a) (toInteger b) enumFromTo a c = map fromInteger $ enumFromTo (toInteger a) (toInteger c) enumFromThenTo a b c = map fromInteger $ enumFromThenTo (toInteger a) (toInteger b) (toInteger c) instance Bounded Expr where minBound = var "minBound" maxBound = var "maxBound" ------------------------------------------------------------------------------ -- Other classes ------------------------------------------------------------------------------ instance Monoid Expr where mempty = var "mempty" mappend = withReduce2 $ op InfixR 6 " <> " mconcat = fun "mconcat"