├── .gitignore ├── Debug ├── SimpleReflect.hs └── SimpleReflect │ ├── Expr.hs │ └── Vars.hs ├── LICENSE ├── README.md ├── Setup.hs └── simple-reflect.cabal /.gitignore: -------------------------------------------------------------------------------- 1 | 2 | /dist -------------------------------------------------------------------------------- /Debug/SimpleReflect.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Debug.SimpleReflect 4 | -- Copyright : (c) 2008-2014 Twan van Laarhoven 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : twanvl@gmail.com 8 | -- Stability : experimental 9 | -- Portability : portable 10 | -- 11 | -- Simple reflection of haskell expressions containing variables. 12 | -- 13 | -- Some examples: 14 | -- 15 | -- > > sum [1..5] :: Expr 16 | -- > 0 + 1 + 2 + 3 + 4 + 5 17 | -- 18 | -- > > foldr1 f [a,b,c] 19 | -- > f a (f b c) 20 | -- 21 | -- > > take 5 (iterate f x) 22 | -- > [x,f x,f (f x),f (f (f x)),f (f (f (f x)))] 23 | -- 24 | -- > > mapM_ print $ reduction (1+2*(3+4)) 25 | -- > 1 + 2 * (3 + 4) 26 | -- > 1 + 2 * 7 27 | -- > 1 + 14 28 | -- > 15 29 | ----------------------------------------------------------------------------- 30 | module Debug.SimpleReflect 31 | ( module Debug.SimpleReflect.Expr 32 | , module Debug.SimpleReflect.Vars 33 | ) where 34 | 35 | import Debug.SimpleReflect.Expr 36 | import Debug.SimpleReflect.Vars 37 | -------------------------------------------------------------------------------- /Debug/SimpleReflect/Expr.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | ----------------------------------------------------------------------------- 3 | -- | 4 | -- Module : Debug.SimpleReflect.Expr 5 | -- Copyright : (c) 2008-2014 Twan van Laarhoven 6 | -- License : BSD-style 7 | -- 8 | -- Maintainer : twanvl@gmail.com 9 | -- Stability : experimental 10 | -- Portability : portable 11 | -- 12 | -- Simple reflection of haskell expressions containing variables. 13 | -- 14 | ----------------------------------------------------------------------------- 15 | module Debug.SimpleReflect.Expr 16 | ( -- * Construction 17 | Expr 18 | , FromExpr(..) 19 | , var, fun, Associativity(..), op 20 | -- * Evaluating 21 | , expr, reduce, reduction 22 | ) where 23 | 24 | import Data.List 25 | import Data.Monoid 26 | #if MIN_VERSION_base(4,9,0) && !(MIN_VERSION_base(4,11,0)) 27 | import Data.Semigroup 28 | #endif 29 | import Control.Applicative 30 | 31 | ------------------------------------------------------------------------------ 32 | -- Data type 33 | ------------------------------------------------------------------------------ 34 | 35 | -- | A reflected expression 36 | data Expr = Expr 37 | { showExpr :: Int -> ShowS -- ^ Show with the given precedence level 38 | , intExpr :: Maybe Integer -- ^ Integer value? 39 | , doubleExpr :: Maybe Double -- ^ Floating value? 40 | , reduced :: Maybe Expr -- ^ Next reduction step 41 | } 42 | 43 | instance Show Expr where 44 | showsPrec p r = showExpr r p 45 | 46 | -- | Default expression 47 | emptyExpr :: Expr 48 | emptyExpr = Expr { showExpr = \_ -> showString "" 49 | , intExpr = Nothing 50 | , doubleExpr = Nothing 51 | , reduced = Nothing 52 | } 53 | 54 | ------------------------------------------------------------------------------ 55 | -- Lifting and combining expressions 56 | ------------------------------------------------------------------------------ 57 | 58 | -- | A variable with the given name 59 | var :: String -> Expr 60 | var s = emptyExpr { showExpr = \_ -> showString s } 61 | 62 | lift :: Show a => a -> Expr 63 | lift x = emptyExpr { showExpr = \p -> showsPrec p x } 64 | 65 | -- | This data type specifies the associativity of operators: left, right or none. 66 | data Associativity = InfixL | Infix | InfixR deriving Eq 67 | 68 | -- | An infix operator with the given associativity, precedence and name 69 | op :: Associativity -> Int -> String -> Expr -> Expr -> Expr 70 | op fix prec opName a b = emptyExpr { showExpr = showFun } 71 | where showFun p = showParen (p > prec) 72 | $ showExpr a (if fix == InfixL then prec else prec + 1) 73 | . showString opName 74 | . showExpr b (if fix == InfixR then prec else prec + 1) 75 | 76 | ------------------------------------------------------------------------------ 77 | -- Adding numeric results 78 | ------------------------------------------------------------------------------ 79 | 80 | iOp :: (Expr -> Expr) -> (Integer -> Integer) -> Expr -> Expr 81 | iOp2 :: (Expr -> Expr -> Expr) -> (Integer -> Integer -> Integer) -> Expr -> Expr -> Expr 82 | dOp :: (Expr -> Expr) -> (Double -> Double) -> Expr -> Expr 83 | dOp2 :: (Expr -> Expr -> Expr) -> (Double -> Double -> Double) -> Expr -> Expr -> Expr 84 | 85 | iOp r f a = (r a ) { intExpr = f <$> intExpr a } 86 | iOp2 r f a b = (r a b) { intExpr = f <$> intExpr a <*> intExpr b } 87 | dOp r f a = (r a ) { doubleExpr = f <$> doubleExpr a } 88 | dOp2 r f a b = (r a b) { doubleExpr = f <$> doubleExpr a <*> doubleExpr b } 89 | 90 | withReduce :: (Expr -> Expr) -> (Expr -> Expr) 91 | withReduce r a = let rr = r a in 92 | rr { reduced = withReduce r <$> reduced a 93 | <|> fromInteger <$> intExpr rr 94 | <|> fromDouble <$> doubleExpr rr 95 | } 96 | withReduce2 :: (Expr -> Expr -> Expr) -> (Expr -> Expr -> Expr) 97 | withReduce2 r a b = let rr = r a b in 98 | rr { reduced = (\a' -> withReduce2 r a' b) <$> reduced a 99 | <|> (\b' -> withReduce2 r a b') <$> reduced b 100 | <|> fromInteger <$> intExpr rr 101 | <|> fromDouble <$> doubleExpr rr 102 | } 103 | 104 | ------------------------------------------------------------------------------ 105 | -- Function types 106 | ------------------------------------------------------------------------------ 107 | 108 | -- | Conversion from @Expr@ to other types 109 | class FromExpr a where 110 | fromExpr :: Expr -> a 111 | 112 | instance FromExpr Expr where 113 | fromExpr = id 114 | 115 | instance (Show a, FromExpr b) => FromExpr (a -> b) where 116 | fromExpr f a = fromExpr $ op InfixL 10 " " f (lift a) 117 | 118 | -- | A generic, overloaded, function variable 119 | fun :: FromExpr a => String -> a 120 | fun = fromExpr . var 121 | 122 | ------------------------------------------------------------------------------ 123 | -- Forcing conversion & evaluation 124 | ------------------------------------------------------------------------------ 125 | 126 | -- | Force something to be an expression. 127 | expr :: Expr -> Expr 128 | expr = id 129 | 130 | -- | Reduce (evaluate) an expression once. 131 | -- 132 | -- For example @reduce (1 + 2 + 3 + 4) == 3 + 3 + 4@ 133 | reduce :: Expr -> Expr 134 | reduce e = maybe e id (reduced e) 135 | 136 | -- | Show all reduction steps when evaluating an expression. 137 | reduction :: Expr -> [Expr] 138 | reduction e0 = e0 : unfoldr (\e -> do e' <- reduced e; return (e',e')) e0 139 | 140 | ------------------------------------------------------------------------------ 141 | -- Numeric classes 142 | ------------------------------------------------------------------------------ 143 | 144 | instance Eq Expr where 145 | Expr{ intExpr = Just a } == Expr{ intExpr = Just b } = a == b 146 | Expr{ doubleExpr = Just a } == Expr{ doubleExpr = Just b } = a == b 147 | a == b = show a == show b 148 | 149 | instance Ord Expr where 150 | compare Expr{ intExpr = Just a } Expr{ intExpr = Just b } = compare a b 151 | compare Expr{ doubleExpr = Just a } Expr{ doubleExpr = Just b } = compare a b 152 | compare a b = compare (show a) (show b) 153 | min = fun "min" `iOp2` min `dOp2` min 154 | max = fun "max" `iOp2` max `dOp2` max 155 | 156 | instance Num Expr where 157 | (+) = withReduce2 $ op InfixL 6 " + " `iOp2` (+) `dOp2` (+) 158 | (-) = withReduce2 $ op InfixL 6 " - " `iOp2` (-) `dOp2` (-) 159 | (*) = withReduce2 $ op InfixL 7 " * " `iOp2` (*) `dOp2` (*) 160 | negate = withReduce $ fun "negate" `iOp` negate `dOp` negate 161 | abs = withReduce $ fun "abs" `iOp` abs `dOp` abs 162 | signum = withReduce $ fun "signum" `iOp` signum `dOp` signum 163 | fromInteger i = (lift i) 164 | { intExpr = Just i 165 | , doubleExpr = Just $ fromInteger i } 166 | 167 | instance Real Expr where 168 | toRational someExpr = case (doubleExpr someExpr, intExpr someExpr) of 169 | (Just d,_) -> toRational d 170 | (_,Just i) -> toRational i 171 | _ -> error $ "not a rational number: " ++ show someExpr 172 | 173 | instance Integral Expr where 174 | quotRem a b = (quot a b, rem a b) 175 | divMod a b = (div a b, mod a b) 176 | quot = withReduce2 $ op InfixL 7 " `quot` " `iOp2` quot 177 | rem = withReduce2 $ op InfixL 7 " `rem` " `iOp2` rem 178 | div = withReduce2 $ op InfixL 7 " `div` " `iOp2` div 179 | mod = withReduce2 $ op InfixL 7 " `mod` " `iOp2` mod 180 | toInteger someExpr = case intExpr someExpr of 181 | Just i -> i 182 | _ -> error $ "not an integer: " ++ show someExpr 183 | 184 | instance Fractional Expr where 185 | (/) = withReduce2 $ op InfixL 7 " / " `dOp2` (/) 186 | recip = withReduce $ fun "recip" `dOp` recip 187 | fromRational r = fromDouble (fromRational r) 188 | 189 | fromDouble :: Double -> Expr 190 | fromDouble d = (lift d) { doubleExpr = Just d } 191 | 192 | instance Floating Expr where 193 | pi = (var "pi") { doubleExpr = Just pi } 194 | exp = withReduce $ fun "exp" `dOp` exp 195 | sqrt = withReduce $ fun "sqrt" `dOp` sqrt 196 | log = withReduce $ fun "log" `dOp` log 197 | (**) = withReduce2 $ op InfixR 8 "**" `dOp2` (**) 198 | sin = withReduce $ fun "sin" `dOp` sin 199 | cos = withReduce $ fun "cos" `dOp` cos 200 | sinh = withReduce $ fun "sinh" `dOp` sinh 201 | cosh = withReduce $ fun "cosh" `dOp` cosh 202 | asin = withReduce $ fun "asin" `dOp` asin 203 | acos = withReduce $ fun "acos" `dOp` acos 204 | atan = withReduce $ fun "atan" `dOp` atan 205 | asinh = withReduce $ fun "asinh" `dOp` asinh 206 | acosh = withReduce $ fun "acosh" `dOp` acosh 207 | atanh = withReduce $ fun "atanh" `dOp` atanh 208 | 209 | instance Enum Expr where 210 | succ = withReduce $ fun "succ" `iOp` succ `dOp` succ 211 | pred = withReduce $ fun "pred" `iOp` pred `dOp` pred 212 | toEnum = fun "toEnum" 213 | fromEnum = fromEnum . toInteger 214 | enumFrom a = map fromInteger $ enumFrom (toInteger a) 215 | enumFromThen a b = map fromInteger $ enumFromThen (toInteger a) (toInteger b) 216 | enumFromTo a c = map fromInteger $ enumFromTo (toInteger a) (toInteger c) 217 | enumFromThenTo a b c = map fromInteger $ enumFromThenTo (toInteger a) (toInteger b) (toInteger c) 218 | 219 | instance Bounded Expr where 220 | minBound = var "minBound" 221 | maxBound = var "maxBound" 222 | 223 | ------------------------------------------------------------------------------ 224 | -- Other classes 225 | ------------------------------------------------------------------------------ 226 | 227 | #if MIN_VERSION_base(4,9,0) 228 | instance Semigroup Expr where 229 | (<>) = withReduce2 $ op InfixR 6 " <> " 230 | #endif 231 | 232 | instance Monoid Expr where 233 | mempty = var "mempty" 234 | #if !(MIN_VERSION_base(4,11,0)) 235 | mappend = withReduce2 $ op InfixR 6 " <> " 236 | #endif 237 | mconcat = fun "mconcat" 238 | 239 | -------------------------------------------------------------------------------- /Debug/SimpleReflect/Vars.hs: -------------------------------------------------------------------------------- 1 | ----------------------------------------------------------------------------- 2 | -- | 3 | -- Module : Debug.SimpleReflect.Vars 4 | -- Copyright : (c) 2008-2014 Twan van Laarhoven 5 | -- License : BSD-style 6 | -- 7 | -- Maintainer : twanvl@gmail.com 8 | -- Stability : experimental 9 | -- Portability : portable 10 | -- 11 | -- Single letter variable names. 12 | -- 13 | -- All names have type @Expr@, except for @f@, @g@ and @h@, which are generic functions. 14 | -- This means that @show (f x :: Expr) == \"f x\"@, but that @show (a x :: Expr)@ gives a type error. 15 | -- On the other hand, the type of @g@ in @show (f g)@ is ambiguous. 16 | -- 17 | ----------------------------------------------------------------------------- 18 | module Debug.SimpleReflect.Vars 19 | ( -- * Variables 20 | a,b,c,d,e,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z 21 | -- * Functions 22 | , f,f',f'',g,h 23 | -- * Operators 24 | , (⊗), (⊕), (@@) 25 | ) where 26 | 27 | import Debug.SimpleReflect.Expr 28 | 29 | ------------------------------------------------------------------------------ 30 | -- Variables! 31 | ------------------------------------------------------------------------------ 32 | 33 | a,b,c,d,e,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z :: Expr 34 | [a,b,c,d,e,i,j,k,l,m,n,o,p,q,r,s,t,u,v,w,x,y,z] 35 | = [var [letter] | letter <- ['a'..'e']++['i'..'z']] 36 | 37 | f,f',f'',g,h :: FromExpr a => a 38 | f = fun "f" 39 | f' = fun "f'" 40 | f'' = fun "f''" 41 | g = fun "g" 42 | h = fun "h" 43 | 44 | ------------------------------------------------------------------------------ 45 | -- Operators 46 | ------------------------------------------------------------------------------ 47 | 48 | -- | A non-associative infix 9 operator 49 | (@@) :: Expr -> Expr -> Expr 50 | (@@) = op Infix 9 " @@ " 51 | 52 | infix 9 @@ 53 | 54 | -- | A non-associative infix 7 operator 55 | (⊗) :: Expr -> Expr -> Expr 56 | (⊗) = op Infix 7 " ⊗ " 57 | 58 | infix 7 ⊗ 59 | 60 | -- | A non-associative infix 6 operator 61 | (⊕) :: Expr -> Expr -> Expr 62 | (⊕) = op Infix 6 " ⊕ " 63 | 64 | infix 6 ⊕ 65 | 66 | 67 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) Twan van Laarhoven 2008. 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions 7 | are met: 8 | 1. Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 2. Redistributions in binary form must reproduce the above copyright 11 | notice, this list of conditions and the following disclaimer in the 12 | documentation and/or other materials provided with the distribution. 13 | 3. Neither the name of the author nor the names of his contributors 14 | may be used to endorse or promote products derived from this software 15 | without specific prior written permission. 16 | 17 | THIS SOFTWARE IS PROVIDED BY THE REGENTS AND CONTRIBUTORS ``AS IS'' AND 18 | ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE 19 | IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE 20 | ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHORS OR CONTRIBUTORS BE LIABLE 21 | FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL 22 | DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS 23 | OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) 24 | HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT 25 | LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY 26 | OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF 27 | SUCH DAMAGE. 28 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | See http://twanvl.nl/blog/haskell/simple-reflection-of-expressions for the blog post that introduced this library. 2 | 3 | Version history 4 | ------ 5 | 6 | * 0.3.3: Added `Semigroup` instance 7 | * 0.3.2: Added infix operators to `Debug.SimpleReflect.Vars`, and fixed GHC warnings. 8 | * 0.3.1: Fixed link to this repository. Needed version bump for hackage. 9 | * 0.3: Added `Monoid` instance, link to github repo. 10 | * 0.2: Expose constructor for infix operators 11 | * 0.1: Initial release 12 | 13 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Distribution.Simple 4 | 5 | main :: IO () 6 | main = defaultMain 7 | -------------------------------------------------------------------------------- /simple-reflect.cabal: -------------------------------------------------------------------------------- 1 | name: simple-reflect 2 | version: 0.3.3 3 | homepage: http://twanvl.nl/blog/haskell/simple-reflection-of-expressions 4 | license: BSD3 5 | license-file: LICENSE 6 | author: Twan van Laarhoven 7 | maintainer: twanvl@gmail.com 8 | bug-reports: https://github.com/twanvl/simple-reflect/issues 9 | category: Debug 10 | cabal-version: >= 1.6 11 | build-type: Simple 12 | synopsis: Simple reflection of expressions containing variables 13 | description: 14 | This package allows simple reflection of expressions containing variables. 15 | Reflection here means that a Haskell expression is turned into a string. 16 | 17 | The primary aim of this package is teaching and understanding; 18 | there are no options for manipulating the reflected expressions beyond showing them. 19 | 20 | source-repository head 21 | type: git 22 | location: http://github.com/twanvl/simple-reflect.git 23 | 24 | Library 25 | build-depends: base >= 2 && < 5 26 | exposed-modules: 27 | Debug.SimpleReflect 28 | Debug.SimpleReflect.Expr 29 | Debug.SimpleReflect.Vars 30 | --------------------------------------------------------------------------------