simple-reflect-0.3.3/0000755000000000000000000000000013252261162012616 5ustar0000000000000000simple-reflect-0.3.3/simple-reflect.cabal0000644000000000000000000000211713252261162016516 0ustar0000000000000000name: simple-reflect version: 0.3.3 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.3/Setup.hs0000644000000000000000000000012713252261162014252 0ustar0000000000000000module Main (main) where import Distribution.Simple main :: IO () main = defaultMain simple-reflect-0.3.3/LICENSE0000644000000000000000000000270413252261162013626 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.3/Debug/0000755000000000000000000000000013252261162013644 5ustar0000000000000000simple-reflect-0.3.3/Debug/SimpleReflect.hs0000644000000000000000000000164413252261162016743 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.3/Debug/SimpleReflect/0000755000000000000000000000000013252261162016402 5ustar0000000000000000simple-reflect-0.3.3/Debug/SimpleReflect/Vars.hs0000644000000000000000000000350113252261162017650 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.3/Debug/SimpleReflect/Expr.hs0000644000000000000000000002223213252261162017655 0ustar0000000000000000{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- 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 #if MIN_VERSION_base(4,9,0) && !(MIN_VERSION_base(4,11,0)) import Data.Semigroup #endif 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 ------------------------------------------------------------------------------ #if MIN_VERSION_base(4,9,0) instance Semigroup Expr where (<>) = withReduce2 $ op InfixR 6 " <> " #endif instance Monoid Expr where mempty = var "mempty" #if !(MIN_VERSION_base(4,11,0)) mappend = withReduce2 $ op InfixR 6 " <> " #endif mconcat = fun "mconcat"