simple-reflect (empty) → 0.1
raw patch · 6 files changed
+338/−0 lines, 6 filesdep +basesetup-changed
Dependencies added: base
Files
- Debug/SimpleReflect.hs +36/−0
- Debug/SimpleReflect/Expr.hs +207/−0
- Debug/SimpleReflect/Vars.hs +40/−0
- LICENSE +27/−0
- Setup.hs +6/−0
- simple-reflect.cabal +22/−0
+ Debug/SimpleReflect.hs view
@@ -0,0 +1,36 @@+-----------------------------------------------------------------------------+-- |+-- Module : Debug.SimpleReflect+-- Copyright : (c) 2008 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
+ Debug/SimpleReflect/Expr.hs view
@@ -0,0 +1,207 @@+-----------------------------------------------------------------------------+-- |+-- Module : Debug.SimpleReflect.Expr+-- Copyright : (c) 2008 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+ -- * Evaluating+ , expr, reduce, reduction+ ) where++import Data.List+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 }++data Fixity = L | R deriving Eq++-- | A operator as expression+op :: Fixity -> Int -> String -> Expr -> Expr -> Expr+op fix prec op a b = emptyExpr { showExpr = showFun }+ where showFun p = showParen (p > prec)+ $ showExpr a (if fix == L then prec else prec + 1)+ . showString op+ . showExpr b (if fix == R then prec else prec + 1)++------------------------------------------------------------------------------+-- Adding numeric results+------------------------------------------------------------------------------++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 r a = let rr = r a in+ rr { reduced = withReduce r <$> reduced a+ <|> fromInteger <$> intExpr rr+ <|> fromDouble <$> doubleExpr rr+ }+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 L 10 " " f (lift a)++-- | A generic 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 e = e : unfoldr (\e -> do e' <- reduced e; return (e',e')) e++------------------------------------------------------------------------------+-- 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 L 6 " + " `iOp2` (+) `dOp2` (+)+ (-) = withReduce2 $ op L 6 " - " `iOp2` (-) `dOp2` (-)+ (*) = withReduce2 $ op L 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 expr = case (doubleExpr expr, intExpr expr) of+ (Just d,_) -> toRational d+ (_,Just i) -> toRational i+ _ -> error "not a number"++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 L 7 " `quot` " `iOp2` quot+ rem = withReduce2 $ op L 7 " `rem` " `iOp2` rem+ div = withReduce2 $ op L 7 " `div` " `iOp2` div+ mod = withReduce2 $ op L 7 " `mod` " `iOp2` mod+ toInteger expr = case intExpr expr of+ Just i -> i+ _ -> error "not a number"++instance Fractional Expr where+ (/) = withReduce2 $ op L 7 " / " `dOp2` (/)+ recip = withReduce $ fun "recip" `dOp` recip+ fromRational r = fromDouble (fromRational r)++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 R 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"
+ Debug/SimpleReflect/Vars.hs view
@@ -0,0 +1,40 @@+-----------------------------------------------------------------------------+-- |+-- Module : Debug.SimpleReflect.Vars+-- Copyright : (c) 2008 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+ ) 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 [x] | x <- ['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"
+ LICENSE view
@@ -0,0 +1,27 @@+Copyright (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.
+ Setup.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Distribution.Simple++main :: IO ()+main = defaultMain
+ simple-reflect.cabal view
@@ -0,0 +1,22 @@+name: simple-reflect+version: 0.1+homepage: http://twan.home.fmf.nl/blog/haskell/simple-reflection-of-expressions.details+license: BSD3+license-file: LICENSE+author: Twan van Laarhoven+maintainer: twanvl@gmail.com+category: Debug+cabal-version: >= 1.2+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.+build-depends: base+exposed-modules:+ Debug.SimpleReflect+ Debug.SimpleReflect.Expr+ Debug.SimpleReflect.Vars