diff --git a/Data/Generics/Biplate.hs b/Data/Generics/Biplate.hs --- a/Data/Generics/Biplate.hs +++ b/Data/Generics/Biplate.hs @@ -1,4 +1,3 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} {-# LANGUAGE MultiParamTypeClasses #-} {- | @@ -26,7 +25,6 @@ ) where import Data.Generics.UniplateStrOn -import Data.Generics.Str -- * The Class diff --git a/Data/Generics/PlateData.hs b/Data/Generics/PlateData.hs --- a/Data/Generics/PlateData.hs +++ b/Data/Generics/PlateData.hs @@ -12,12 +12,9 @@ import Data.Generics.Biplate import Data.Generics.PlateInternal -import Data.Generics.Str import Data.Generics -import Data.Maybe import Data.List import qualified Data.IntSet as IntSet -import Control.Monad.State import Data.Ratio diff --git a/Data/Generics/PlateDirect.hs b/Data/Generics/PlateDirect.hs --- a/Data/Generics/PlateDirect.hs +++ b/Data/Generics/PlateDirect.hs @@ -44,9 +44,6 @@ ) where import Data.Generics.Biplate -import Data.Generics.PlateInternal -import Data.Generics.Str -import Data.Maybe type Type from to = (Str to, Str to -> from) diff --git a/Data/Generics/PlateInternal.hs b/Data/Generics/PlateInternal.hs --- a/Data/Generics/PlateInternal.hs +++ b/Data/Generics/PlateInternal.hs @@ -1,5 +1,4 @@ -{-# OPTIONS_GHC -fglasgow-exts #-} -{-# LANGUAGE CPP, Rank2Types #-} +{-# LANGUAGE CPP, Rank2Types, MagicHash, UnboxedTuples #-} {- | Internal module, do not import or use. @@ -19,7 +18,11 @@ -} import GHC.Exts(unsafeCoerce#, build, realWorld#) +#if __GLASGOW_HASKELL__ < 612 import GHC.IOBase(IO(IO)) +#else +import GHC.IO(IO(IO)) +#endif {-# INLINE unsafeCast #-} -- | @unsafeCoerce@, but for all compilers. In future this can be obtained from diff --git a/Data/Generics/PlateTypeable.hs b/Data/Generics/PlateTypeable.hs --- a/Data/Generics/PlateTypeable.hs +++ b/Data/Generics/PlateTypeable.hs @@ -31,9 +31,7 @@ import Data.Generics.Biplate import Data.Generics.PlateInternal -import Data.Generics.Str import Data.Typeable -import Data.Maybe instance (Typeable a, Typeable b, Uniplate b, PlateAll a b) => Biplate a b where diff --git a/Data/Generics/Str.hs b/Data/Generics/Str.hs --- a/Data/Generics/Str.hs +++ b/Data/Generics/Str.hs @@ -18,6 +18,11 @@ data Str a = Zero | One a | Two (Str a) (Str a) deriving Show +instance Eq a => Eq (Str a) where + Zero == Zero = True + One x == One y = x == y + Two x1 x2 == Two y1 y2 = x1 == y1 && x2 == y2 + _ == _ = False instance Functor Str where fmap f Zero = Zero diff --git a/Data/Generics/Uniplate.hs b/Data/Generics/Uniplate.hs --- a/Data/Generics/Uniplate.hs +++ b/Data/Generics/Uniplate.hs @@ -18,7 +18,6 @@ where import Control.Monad -import Data.List(inits,tails) import Data.Generics.PlateInternal diff --git a/Data/Generics/Uniplate/Data.hs b/Data/Generics/Uniplate/Data.hs --- a/Data/Generics/Uniplate/Data.hs +++ b/Data/Generics/Uniplate/Data.hs @@ -16,7 +16,8 @@ when using both @Data@ and @Direct@, switch to "Data.Generics.Uniplate.DataOnly". -} module Data.Generics.Uniplate.Data( - module Data.Generics.Uniplate.Operations + module Data.Generics.Uniplate.Operations, + transformBis, Transformer, transformer ) where import Data.Generics.Uniplate.Operations diff --git a/Data/Generics/Uniplate/DataOnly.hs b/Data/Generics/Uniplate/DataOnly.hs --- a/Data/Generics/Uniplate/DataOnly.hs +++ b/Data/Generics/Uniplate/DataOnly.hs @@ -10,7 +10,8 @@ the same project and they are conflicting. -} module Data.Generics.Uniplate.DataOnly( - module Data.Generics.Uniplate.Internal.DataOnlyOperations + module Data.Generics.Uniplate.Internal.DataOnlyOperations, + transformBis, Transformer, transformer ) where import Data.Generics.Uniplate.Internal.DataOnlyOperations diff --git a/Data/Generics/Uniplate/Internal/Data.hs b/Data/Generics/Uniplate/Internal/Data.hs --- a/Data/Generics/Uniplate/Internal/Data.hs +++ b/Data/Generics/Uniplate/Internal/Data.hs @@ -9,6 +9,7 @@ import Data.Generics.Str import Data.Generics.Uniplate.Internal.Utils import Data.Data +import Data.Generics import Data.Maybe import Data.List import qualified Data.IntSet as IntSet @@ -153,7 +154,7 @@ hitTest from to = let kto = typeKey to - in case readCache (dataBox from) kto of + in case readCacheFollower (dataBox from) kto of Nothing -> Oracle $ \on -> if typeKey on == kto then Hit $ unsafeCoerce on else Follow Just test -> Oracle $ \on -> let kon = typeKey on in if kon == kto then Hit $ unsafeCoerce on @@ -175,8 +176,8 @@ cache = unsafePerformIO $ newIORef $ Cache emptyHitMap IntMap.empty -readCache :: DataBox -> TypeKey -> Maybe Follower -readCache from@(DataBox kfrom vfrom) kto = inlinePerformIO $ do +readCacheFollower :: DataBox -> TypeKey -> Maybe Follower +readCacheFollower from@(DataBox kfrom vfrom) kto = inlinePerformIO $ do Cache hit follow <- readIORef cache case lookup2 kfrom kto follow of Just ans -> return ans @@ -192,6 +193,21 @@ return fol +-- from which values, what can you reach +readCacheHitMap :: DataBox -> Maybe HitMap +readCacheHitMap from@(DataBox kfrom vfrom) = inlinePerformIO $ do + Cache hit _ <- readIORef cache + case IntMap.lookup kfrom hit of + Just _ -> return $ Just hit + Nothing -> do + res <- Control.Exception.catch (return $! Just $! insertHitMap from hit) (\(_ :: SomeException) -> return Nothing) + case res of + Nothing -> return Nothing + Just hit -> do + atomicModifyIORef cache $ \(Cache _ follow) -> (Cache hit follow, ()) + return $ Just hit + + --------------------------------------------------------------------- -- INTMAP2 @@ -297,6 +313,9 @@ #endif +--------------------------------------------------------------------- +-- INSTANCE FUNCTIONS + newtype C x a = C {fromC :: CC x a} type CC x a = (Str x, Str x -> a) @@ -328,3 +347,90 @@ Hit y -> unsafeCoerce $ op y Follow -> gmapT (descendBiData oracle op) x Miss -> x + + +--------------------------------------------------------------------- +-- FUSION + +data Transformer = forall a . Data a => Transformer TypeKey (a -> a) + + +-- | Wrap up a @(a -> a)@ transformation function, to use with 'transformBis' +transformer :: Data a => (a -> a) -> Transformer +transformer = transformer_ + + +-- Don't export directly, as don't want Haddock to see the forall +transformer_ :: forall a . Data a => (a -> a) -> Transformer +transformer_ = Transformer (typeKey (undefined :: a)) + + +-- | Apply a sequence of transformations in order. This function obeys the equivalence: +-- +-- > transformBis [[transformer f],[transformer g],...] == transformBi f . transformBi g . ... +-- +-- Each item of type @[Transformer]@ is applied in turn, right to left. Within each +-- @[Transformer]@, the individual @Transformer@ values may be interleaved. +-- +-- The implementation will attempt to perform fusion, and avoid walking any part of the +-- data structure more than necessary. To further improve performance, you may wish to +-- partially apply the first argument, which will calculate information about the relationship +-- between the transformations. +transformBis :: forall a . Data a => [[Transformer]] -> a -> a +transformBis = transformBis_ + + +transformBis_ :: forall a . Data a => [[Transformer]] -> a -> a + + +#if __GLASGOW_HASKELL__ >= 606 + +-- basic algorithm: +-- as you go down, given transformBis [fN..f1] +-- if x is not in the set reachable by fN..f1, return x +-- if x is in the reachable set, gmap (transformBis [fN..f1]) x +-- if x is one of fN..f1, pick the lowest fi then +-- transformBis [fN..f(i+1)] $ fi $ gmap (transformBis [fi..f1]) x + +transformBis_ ts | isJust hitBoxM = op (sliceMe 1 n) + where + on = dataBox (undefined :: a) + hitBoxM = readCacheHitMap on + hitBox = fromJust hitBoxM + univ = IntSet.toAscList $ IntSet.insert (dataBoxKey on) $ hitBox IntMap.! dataBoxKey on + n = length ts + + -- (a,b), where a < b, and both in range 1..n + sliceMe i j = fromMaybe IntMap.empty $ lookup2 i j slices + slices :: IntMap2 (IntMap (Maybe Transformer)) + slices = IntMap.fromAscList + [ (i, IntMap.fromAscList [(j, slice i j ts) | (j,ts) <- zip [i..n] (tail $ inits ts)]) + | (i,ts) <- zip [1..n] (tails $ reverse ts)] + + slice :: Int -> Int -> [[Transformer]] -> IntMap (Maybe Transformer) + slice from to tts = self + where + self = f IntMap.empty (zip [from..] tts) -- FIXME: flattening out here gives different results... + f a ((i,[Transformer tk tr]):ts) + | tk `IntMap.member` a = f a ts + | otherwise = f (IntMap.insert tk t a) ts + where + t = Just $ Transformer tk $ op (sliceMe (i+1) to) . tr . gmapT (op $ sliceMe from i) + + f a [] = a `IntMap.union` IntMap.fromAscList (mapMaybe (g $ IntMap.keysSet a) $ univ) + + g a t = if b then Nothing else Just (t, Nothing) + where b = IntSet.null $ a `IntSet.intersection` (hitBox IntMap.! t) + + op :: forall b . Data b => IntMap (Maybe Transformer) -> b -> b + op slice = case IntMap.lookup (typeKey (undefined :: b)) slice of + Nothing -> id + Just Nothing -> gmapT (op slice) + Just (Just (Transformer _ t)) -> unsafeCoerce . t . unsafeCoerce + +#endif + + +transformBis_ [] = id +transformBis_ ([]:xs) = transformBis_ xs +transformBis_ ((Transformer _ t:x):xs) = everywhere (mkT t) . transformBis_ (x:xs) diff --git a/Data/Generics/Uniplate/Internal/OperationsInc.hs b/Data/Generics/Uniplate/Internal/OperationsInc.hs --- a/Data/Generics/Uniplate/Internal/OperationsInc.hs +++ b/Data/Generics/Uniplate/Internal/OperationsInc.hs @@ -7,7 +7,8 @@ -- * The Classes --- | The standard Uniplate class, all operations require this. +-- | The standard Uniplate class, all operations require this. All definitions must +-- define 'uniplate', while 'descend' and 'descendM' are optional. class Uniplate on where -- | The underlying method in the class. -- Taking a value, the function should return all the immediate children @@ -30,7 +31,14 @@ -- | Perform a transformation on all the immediate children, then combine them back. -- This operation allows additional information to be passed downwards, and can be - -- used to provide a top-down transformation. + -- used to provide a top-down transformation. This function can be defined explicitly, + -- or can be provided by automatically in terms of 'uniplate'. + -- + -- For example, on the sample type, we could write: + -- + -- > descend f (Val i ) = Val i + -- > descend f (Neg a ) = Neg (f a) + -- > descend f (Add a b) = Add (f a) (f b) descend :: (on -> on) -> on -> on descend f x = generate $ fmap f current where (current, generate) = uniplate x @@ -42,15 +50,21 @@ -- | Children are defined as the top-most items of type to --- /starting at the root/. +-- /starting at the root/. All instances must define 'biplate', while +-- 'descendBi' and 'descendBiM' are optional. class Uniplate to => Biplate from to where -- | Return all the top most children of type @to@ within @from@. -- - -- If @from == to@ then this function should return the root as the single - -- child. + -- If @from == to@ then this function should return the root as the single + -- child. biplate :: from -> (Str to, Str to -> from) + -- | Like 'descend' but with more general types. If @from == to@ then this + -- function /does not/ descend. Therefore, when writing definitions it is + -- highly unlikely that this function should be used in the recursive case. + -- A common pattern is to first match the types using 'descendBi', then continue + -- the recursion with 'descend'. descendBi :: (to -> to) -> from -> from descendBi f x = generate $ fmap f current where (current, generate) = biplate x @@ -137,8 +151,8 @@ -- | Return all the contexts and holes. -- --- > propUniverse x = universe x == map fst (contexts x) --- > propId x = all (== x) [b a | (a,b) <- contexts x] +-- > universe x == map fst (contexts x) +-- > all (== x) [b a | (a,b) <- contexts x] contexts :: Uniplate on => on -> [(on, on -> on)] contexts x = (x,id) : f (holes x) where @@ -149,8 +163,8 @@ -- | The one depth version of 'contexts' -- --- > propChildren x = children x == map fst (holes x) --- > propId x = all (== x) [b a | (a,b) <- holes x] +-- > children x == map fst (holes x) +-- > all (== x) [b a | (a,b) <- holes x] holes :: Uniplate on => on -> [(on, on -> on)] holes x = uncurry f (uniplate x) where f Zero _ = [] diff --git a/Data/Generics/Uniplate/Internal/Utils.hs b/Data/Generics/Uniplate/Internal/Utils.hs --- a/Data/Generics/Uniplate/Internal/Utils.hs +++ b/Data/Generics/Uniplate/Internal/Utils.hs @@ -13,7 +13,11 @@ #ifdef __GLASGOW_HASKELL__ import GHC.Exts(build, realWorld#) +#if __GLASGOW_HASKELL__ < 612 import GHC.IOBase(IO(IO)) +#else +import GHC.IO(IO(IO)) +#endif #endif diff --git a/Data/Generics/Uniplate/Zipper.hs b/Data/Generics/Uniplate/Zipper.hs new file mode 100644 --- /dev/null +++ b/Data/Generics/Uniplate/Zipper.hs @@ -0,0 +1,157 @@ +{-| +A zipper is a structure for walking a value and manipulating it in constant time. + +This module was inspired by the paper: +/Michael D. Adams. Scrap Your Zippers: A Generic Zipper for Heterogeneous Types, Workshop on Generic Programming 2010/. +-} + + +module Data.Generics.Uniplate.Zipper( + -- * Create a zipper and get back the value + Zipper, zipper, zipperBi, fromZipper, + -- * Navigate within a zipper + left, right, up, down, + -- * Manipulate the zipper hole + hole, replaceHole + ) where + +import Data.Generics.Uniplate.Operations +import Data.Generics.Str +import Control.Monad +import Data.Maybe + + +-- | Create a zipper, focused on the top-left value. +zipper :: Uniplate to => to -> Zipper to to +zipper = fromJust . toZipper (\x -> (One x, \(One x) -> x)) + + +-- | Create a zipper with a different focus type from the outer type. Will return +-- @Nothing@ if there are no instances of the focus type within the original value. +zipperBi :: Biplate from to => from -> Maybe (Zipper from to) +zipperBi = toZipper biplate + + +-- | Zipper structure, whose root type is the first type argument, and whose +-- focus type is the second type argument. +data Zipper from to = Zipper + {reform :: Str to -> from + ,zipp :: ZipN to + } + +rezipp f (Zipper a b) = fmap (Zipper a) $ f b + +instance (Eq from, Eq to) => Eq (Zipper from to) where + a == b = fromZipper a == fromZipper b && zipp a == zipp b + + +toZipper :: Uniplate to => (from -> (Str to, Str to -> from)) -> from -> Maybe (Zipper from to) +toZipper biplate x = fmap (Zipper gen) $ zipN cs + where (cs,gen) = biplate x + + +-- | From a zipper take the whole structure, including any modifications. +fromZipper :: Zipper from to -> from +fromZipper x = reform x $ top1 $ topN $ zipp x + + +-- | Move one step left from the current position. +left :: Zipper from to -> Maybe (Zipper from to) +left = rezipp leftN + +-- | Move one step right from the current position. +right :: Zipper from to -> Maybe (Zipper from to) +right = rezipp rightN + +-- | Move one step down from the current position. +down :: Uniplate to => Zipper from to -> Maybe (Zipper from to) +down = rezipp downN + +-- | Move one step up from the current position. +up :: Zipper from to -> Maybe (Zipper from to) +up = rezipp upN + + +-- | Retrieve the current focus of the zipper.. +hole :: Zipper from to -> to +hole = holeN . zipp + + +-- | Replace the value currently at the focus of the zipper. +replaceHole :: to -> Zipper from to -> Zipper from to +replaceHole x z = z{zipp=replaceN x (zipp z)} + + +--------------------------------------------------------------------- +-- N LEVEL ZIPPER ON Str + +data ZipN x = ZipN [Str x -> Zip1 x] (Zip1 x) + +instance Eq x => Eq (ZipN x) where + x@(ZipN _ xx) == y@(ZipN _ yy) = xx == yy && upN x == upN y + +zipN :: Str x -> Maybe (ZipN x) +zipN x = fmap (ZipN []) $ zip1 x + +leftN (ZipN p x) = fmap (ZipN p) $ left1 x +rightN (ZipN p x) = fmap (ZipN p) $ right1 x +holeN (ZipN _ x) = hole1 x +replaceN v (ZipN p x) = ZipN p $ replace1 x v + +upN (ZipN [] x) = Nothing +upN (ZipN (p:ps) x) = Just $ ZipN ps $ p $ top1 x + +topN (ZipN [] x) = x +topN x = topN $ fromJust $ upN x + +downN :: Uniplate x => ZipN x -> Maybe (ZipN x) +downN (ZipN ps x) = fmap (ZipN $ replace1 x . gen : ps) $ zip1 cs + where (cs,gen) = uniplate $ hole1 x + + +--------------------------------------------------------------------- +-- 1 LEVEL ZIPPER ON Str + +data Diff1 a = TwoLeft (Str a) | TwoRight (Str a) deriving Eq + +undiff1 r (TwoLeft l) = Two l r +undiff1 l (TwoRight r) = Two l r + +-- Warning: this definition of Eq may look too strong (Str Left/Right is not relevant) +-- but you don't know what the uniplate.gen function will do +data Zip1 a = Zip1 [Diff1 a] a deriving Eq + +zip1 :: Str x -> Maybe (Zip1 x) +zip1 = insert1 True [] + +insert1 :: Bool -> [Diff1 a] -> Str a -> Maybe (Zip1 a) +insert1 leftmost c Zero = Nothing +insert1 leftmost c (One x) = Just $ Zip1 c x +insert1 leftmost c (Two l r) = if leftmost then ll `mplus` rr else rr `mplus` ll + where ll = insert1 leftmost (TwoRight r:c) l + rr = insert1 leftmost (TwoLeft l:c) r + +left1, right1 :: Zip1 a -> Maybe (Zip1 a) +left1 = move1 True +right1 = move1 False + +move1 :: Bool -> Zip1 a -> Maybe (Zip1 a) +move1 leftward (Zip1 p x) = f p $ One x + where + f p x = msum $ + [insert1 False (TwoRight x:ps) l | TwoLeft l:ps <- [p], leftward] ++ + [insert1 True (TwoLeft x:ps) r | TwoRight r:ps <- [p], not leftward] ++ + [f ps (x `undiff1` p) | p:ps <- [p]] + +top1 :: Zip1 a -> Str a +top1 (Zip1 p x) = f p (One x) + where f :: [Diff1 a] -> Str a -> Str a + f [] x = x + f (p:ps) x = f ps (x `undiff1` p) + +hole1 :: Zip1 a -> a +hole1 (Zip1 _ x) = x + +-- this way round so the a can be disguarded quickly +replace1 :: Zip1 a -> a -> Zip1 a +replace1 (Zip1 p _) = Zip1 p diff --git a/Data/Generics/UniplateOn.hs b/Data/Generics/UniplateOn.hs --- a/Data/Generics/UniplateOn.hs +++ b/Data/Generics/UniplateOn.hs @@ -21,7 +21,6 @@ import Data.Generics.Uniplate import Control.Monad(liftM) -import Data.List(inits,tails) -- * Types diff --git a/Data/Generics/UniplateStr.hs b/Data/Generics/UniplateStr.hs --- a/Data/Generics/UniplateStr.hs +++ b/Data/Generics/UniplateStr.hs @@ -19,8 +19,6 @@ ) where import Control.Monad hiding (mapM) -import Data.List(inits,tails) -import Control.Monad.State hiding (mapM) import Data.Traversable import Prelude hiding (mapM) diff --git a/Data/Generics/UniplateStrOn.hs b/Data/Generics/UniplateStrOn.hs --- a/Data/Generics/UniplateStrOn.hs +++ b/Data/Generics/UniplateStrOn.hs @@ -17,7 +17,6 @@ ) where import Control.Monad(liftM) -import Data.List(inits,tails) import Data.Traversable import Prelude hiding (mapM) diff --git a/uniplate.cabal b/uniplate.cabal --- a/uniplate.cabal +++ b/uniplate.cabal @@ -1,7 +1,7 @@ Cabal-Version: >= 1.2 Build-Type: Simple Name: uniplate -Version: 1.5.1 +Version: 1.6 Copyright: 2006-10, Neil Mitchell Maintainer: ndmitchell@gmail.com Homepage: http://community.haskell.org/~ndm/uniplate/ @@ -30,6 +30,8 @@ . In addition, some users may want to make use of the following modules: . + * "Data.Generics.Uniplate.Zipper" - a zipper built on top of Uniplate instances. + . * "Data.Generics.SYB" - users transitioning from the Scrap Your Boilerplate library. . * "Data.Generics.Compos" - users transitioning from the Compos library. @@ -46,19 +48,20 @@ Library if flag(ghc_6_10) - build-depends: base >=4 && <5, mtl, containers, syb + build-depends: base >=4 && <5, containers, syb else - build-depends: base >=3 && <4, mtl, containers + build-depends: base >=3 && <4, containers Exposed-modules: Data.Generics.Str Data.Generics.Compos Data.Generics.SYB - Data.Generics.Uniplate.Operations - Data.Generics.Uniplate.Direct - Data.Generics.Uniplate.Typeable Data.Generics.Uniplate.Data Data.Generics.Uniplate.DataOnly + Data.Generics.Uniplate.Direct + Data.Generics.Uniplate.Operations + Data.Generics.Uniplate.Typeable + Data.Generics.Uniplate.Zipper -- DEPRECATED Data.Generics.Uniplate diff --git a/uniplate.htm b/uniplate.htm --- a/uniplate.htm +++ b/uniplate.htm @@ -118,26 +118,29 @@
  • {-# LANGUAGE DerivingDataTypeable #-}, this pragma turns on language support for the deriving line.

    • - This definition makes use of the Scrap Your Boilerplate (SYB) based Uniplate implementation. The SYB implementation is compatible with the other implementations, but is slower (between 2 and 8 times) and requires some modest compiler extensions (implemented in GHC for many years). The alternative definition scheme is described towards the end of this document, in "Making Uniplate Faster". I recommend using the SYB implementation to start with, as it requires least setup. + This definition makes use of the Scrap Your Boilerplate (SYB) based Uniplate implementation. The SYB implementation is compatible with the other implementations, but is slower (between 2 and 8 times) and requires some modest compiler extensions (implemented in GHC for many years). The alternative definition scheme is described towards the end of this document, in "Making Uniplate Faster". I recommend using the SYB implementation to start with, as it requires least work to use.

    +

    + The Uniplate library defines two classes, Uniplate and Biplate, along with a number of functions. After importing Data.Generics.Uniplate.Data all types which have Data instances automatically have the necessary Uniplate instances. In the following subsections we introduce the Uniplate functions, along with examples of using them. The two most commonly used functions are universe (used for queries) and transform (used for transformations). +

    -

    Checking for division by zero

    +

    Finding the constant values

     universe :: Uniplate on => on -> [on]

    - If an expression is divided by zero, this causes a runtime error in our language. As part of the compiler, it's nice to give the user a warning message about this. This can be done with the following test: + When manipulating our little language it may be useful to know which constants have been used. This can be done with the following code: 

    -hasDivZero :: Expr -> Bool
-hasDivZero x = not $ null [() | Div _ (Val 0) <- universe x]
+constants :: Expr -> [Int]
+constants x = nub [y | Val y <- universe x]

    - Here the only Uniplate method being used is universe. Given a tree, universe returns all the root of the tree, and all it's subtrees at all levels. This can be used to quickly flatten a tree structure into a list, for quick analysis via list comprehensions, as is done above. For each division by zero found, any value is created in the list comprehension, and then this is checked to see if anything did match. Returning the count of divide by zero errors is trivial, simply use length instead of not $ null. Extra context could perhaps be given by printing some of the value that is being divided by zero, to help narrow down the error. + Here the only Uniplate method being used is universe, which when given a tree returns all the root of the tree, and all it's subtrees at all levels. This can be used to quickly flatten a tree structure into a list, for quick analysis via list comprehensions, as is done above.

    - Exercise: Write a function to find all literals that occur in an expression, together with their count. + Exercise: Write a function to test if an expression performs a division by the literal zero.

    Basic optimisation

    @@ -155,7 +158,7 @@ f x = x

    - Here the Uniplate method being used is transform. This applies the given function to all the children of an expression, before applying it to the parent. This can be thought of as bottom-up traversal of the data structure. The optimise code merely pattern matches on the negation of a literal, and replaces it with the literal. + Here the Uniplate method being used is transform, which applies the given function to all the children of an expression, before applying it to the parent. This function can be thought of as bottom-up traversal of the data structure. The optimise code merely pattern matches on the negation of a literal, and replaces it with the literal.

    Now lets add another optimisation into the same pass, just before the f x = x line insert: @@ -164,7 +167,7 @@ f (Add x y) | x == y = Mul x (Val 2)

    - This takes an addition where two terms are equal and changes it into a multiplication, causing the nested expression to be executed only once. This shows that normal Haskell applies, the Uniplate lets you write code as before. + This takes an addition where two terms are equal and changes it into a multiplication, causing the nested expression to be executed only once.

    Exercise: Extend the optimisation to so that adding x to Mul x (Val 2) produces a multiplication by 3. @@ -184,7 +187,7 @@ depth = para (\_ cs -> 1 + maximum (0:cs))

    - This function performs a paramorphism (a bit like a fold) over the data structure. The function simply says that for each iteration, add one to the previous depth. An evaluator for this expression language can also be modelled as a para, see inside the example directory to see an implementation. + This function performs a paramorphism (a bit like a fold) over the data structure. The function simply says that for each iteration, add one to the previous depth.

    Exercise: Write a function that counts the maximum depth of addition only. @@ -235,14 +238,59 @@ Exercise: Replace one multiplication with addition, if there are no multiplications return the original expression.

    +

    Fixed point optimisation

    -

    Using Biplate

    +
    +rewrite :: Uniplate on => (on -> Maybe on) -> on -> on
+
    +

    + When slotting many transformations together, often one optimisation will enable another. For example, the the optimisation to reduce. +

    +

    Descend

    +

    + Do something different in the odd and even cases. Particularly useful if you have free variables and are passing state downwards. +

    + +

    Monadic Variants

    + +
    +descendM :: Monad m => (on -> m on) -> on -> m on                         -- descend
+transformM :: (Monad m, Uniplate on) => (on -> m on) -> on -> m on        -- transform
+rewriteM :: (Monad m, Uniplate on) => (on -> m (Maybe on)) -> on -> m on  -- rewrite
+
    + +

    + All the transformations have both monadic and non-monadic versions. +

    + +

    Single Depth Varaints

    + +
    +children :: Uniplate on => on -> [on]           -- universe
+descend :: (on -> on) -> on -> on               -- transform
+holes :: Uniplate on => on -> [(on, on -> on)]  -- contexts
+
    + +

    + Lot's of functions which operate over the entire tree also operate over just one level. Usually you want to use the multiple level version, but when needing more explicit control the others are handy. +

    + +

    Evaluation

    + +

    + Don't use Uniplate! The reasons are that there is little boilerplate, you have to handle every case separately. For example in our language we can write: +

    + + +

    Using Biplate

    + +

    All the operations defined in Uniplate have a corresponding Biplate instance. Typically the operations are just the same as Uniplate, with Bi on the end. 

    -universeBi:: Biplate on with => on -> [with]
+universeBi :: Biplate on with => on -> [with]
 transformBi :: Biplate on with => (with -> with) -> on -> on
 transformBiM :: (Monad m, Biplate on with) => (with -> m with) -> on -> m on
    @@ -254,7 +302,11 @@ children (Add (Val 1) (Val 2)) == [Val 1, Val 2] -

    Making Uniplate Faster

    +

    + For example, you should never hvae descendBi in an inner recursive loop. +

    + +

    Making Uniplate Faster

    To make Uniplate faster import Data.Generics.Uniplate.Direct, and provide Uniplate instances by generating them with the Derive tool.