diff --git a/Debug/SimpleReflect.hs b/Debug/SimpleReflect.hs --- a/Debug/SimpleReflect.hs +++ b/Debug/SimpleReflect.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Debug.SimpleReflect --- Copyright : (c) 2008 Twan van Laarhoven +-- Copyright : (c) 2008-2014 Twan van Laarhoven -- License : BSD-style -- -- Maintainer : twanvl@gmail.com diff --git a/Debug/SimpleReflect/Expr.hs b/Debug/SimpleReflect/Expr.hs --- a/Debug/SimpleReflect/Expr.hs +++ b/Debug/SimpleReflect/Expr.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Debug.SimpleReflect.Expr --- Copyright : (c) 2008 Twan van Laarhoven +-- Copyright : (c) 2008-2014 Twan van Laarhoven -- License : BSD-style -- -- Maintainer : twanvl@gmail.com @@ -63,26 +63,33 @@ -- | An infix operator with the given associativity, precedence and name op :: Associativity -> Int -> String -> Expr -> Expr -> Expr -op fix prec op a b = emptyExpr { showExpr = showFun } +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 op + . 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 @@ -124,7 +131,7 @@ -- | Show all reduction steps when evaluating an expression. reduction :: Expr -> [Expr] -reduction e = e : unfoldr (\e -> do e' <- reduced e; return (e',e')) e +reduction e0 = e0 : unfoldr (\e -> do e' <- reduced e; return (e',e')) e0 ------------------------------------------------------------------------------ -- Numeric classes @@ -154,10 +161,10 @@ , doubleExpr = Just $ fromInteger i } instance Real Expr where - toRational expr = case (doubleExpr expr, intExpr expr) of + toRational someExpr = case (doubleExpr someExpr, intExpr someExpr) of (Just d,_) -> toRational d (_,Just i) -> toRational i - _ -> error "not a number" + _ -> error $ "not a rational number: " ++ show someExpr instance Integral Expr where quotRem a b = (quot a b, rem a b) @@ -166,15 +173,16 @@ 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 expr = case intExpr expr of + toInteger someExpr = case intExpr someExpr of Just i -> i - _ -> error "not a number" + _ -> 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 @@ -215,4 +223,5 @@ instance Monoid Expr where mempty = var "mempty" mappend = withReduce2 $ op InfixR 6 " <> " + mconcat = fun "mconcat" diff --git a/Debug/SimpleReflect/Vars.hs b/Debug/SimpleReflect/Vars.hs --- a/Debug/SimpleReflect/Vars.hs +++ b/Debug/SimpleReflect/Vars.hs @@ -1,7 +1,7 @@ ----------------------------------------------------------------------------- -- | -- Module : Debug.SimpleReflect.Vars --- Copyright : (c) 2008 Twan van Laarhoven +-- Copyright : (c) 2008-2014 Twan van Laarhoven -- License : BSD-style -- -- Maintainer : twanvl@gmail.com @@ -20,6 +20,8 @@ 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 @@ -30,7 +32,7 @@ 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']] + = [var [letter] | letter <- ['a'..'e']++['i'..'z']] f,f',f'',g,h :: FromExpr a => a f = fun "f" @@ -38,3 +40,27 @@ 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 ⊕ + + diff --git a/simple-reflect.cabal b/simple-reflect.cabal --- a/simple-reflect.cabal +++ b/simple-reflect.cabal @@ -1,29 +1,29 @@ -name: simple-reflect -version: 0.3.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 -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 +name: 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