packages feed

uniplate (empty) → 1.0

raw patch · 11 files changed

+1230/−0 lines, 11 filesdep +basedep +mtlbuild-type:Customsetup-changed

Dependencies added: base, mtl

Files

+ Data/Generics/Biplate.hs view
@@ -0,0 +1,78 @@+{-# OPTIONS_GHC -fglasgow-exts #-}+{-# LANGUAGE MultiParamTypeClasses #-}++{- |+    Requires multi-parameter type classes, so is no longer Haskell 98. These operations+    are easier to use and construct than the equivalent @Data.Generics.UniplateOn@ methods,+    but perform the same operation.+    +    It is recommended that instead of importing this module, you import one of the following+    modules, to construct instances:+    +    * "Data.Generics.PlateDirect" - does not require overlapping instances, highest performance+    but requires /O(n^2)/ instances in the worst case.+    +    * "Data.Generics.PlateTypeable" - requires the "Data.Typeable" class for all data structures.+    +    * "Data.Generics.PlateData" - requires "Data.Generics" and the 'Data' class, which is only+    available on GHC, but automatically infers instances.+-}++module Data.Generics.Biplate(+    module Data.Generics.UniplateOn,+    module Data.Generics.Biplate+    ) where++import Data.Generics.UniplateOn+++-- * The Class++-- | Children are defined as the top-most items of type to+--   /starting at the root/.+class Uniplate to => Biplate from to where+    biplate :: BiplateType from to+++-- * The Operations++-- ** Queries++universeBi :: Biplate from to => from -> [to]+universeBi = universeOn biplate+++childrenBi :: Biplate from to => from -> [to]+childrenBi = childrenOn biplate+++-- ** Transformations++transformBi :: Biplate from to => (to -> to) -> from -> from+transformBi = transformOn biplate+++transformBiM :: (Monad m, Biplate from to) => (to -> m to) -> from -> m from+transformBiM = transformOnM biplate+++rewriteBi :: Biplate from to => (to -> Maybe to) -> from -> from+rewriteBi = rewriteOn biplate+++rewriteBiM :: (Monad m, Biplate from to) => (to -> m (Maybe to)) -> from -> m from+rewriteBiM = rewriteOnM biplate+++descendBi :: Biplate from to => (to -> to) -> from -> from+descendBi = descendOn biplate+++descendBiM :: (Monad m, Biplate from to) => (to -> m to) -> from -> m from+descendBiM = descendOnM biplate+++-- ** Others++contextsBi:: Biplate from to => from -> [(to, to -> from)]+contextsBi = contextsOn biplate
+ Data/Generics/PlateData.hs view
@@ -0,0 +1,164 @@+{-# OPTIONS_GHC -fglasgow-exts -cpp -fallow-undecidable-instances #-}+{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances, ExistentialQuantification, Rank2Types, CPP #-}+-- OPTIONS_GHC is required only for 6.4.2, not 6.6.1++{- |+    This module exports 'Biplate' instances for everything with 'Data' defined.+    Using GHC the 'Data' instances can be constructed with @deriving Data@.+-}+++module Data.Generics.PlateData(+    module Data.Generics.Biplate+    ) where++import Data.Generics.Biplate+import Data.Generics.PlateInternal+import Data.Generics+import Data.Maybe+import Data.List+import qualified Data.IntSet as IntSet+import Control.Monad.State++++-- | An existential box representing a type which supports SYB+-- operations.+data DataBox = forall a . (Typeable a, Data a) => DataBox a++data Box find = Box {fromBox :: forall a . Typeable a => a -> Answer find}++data Answer a = Hit {fromHit :: a} -- you just hit the element you were after (here is a cast)+              | Follow -- go forward, you will find something+              | Miss -- you failed to sink my battleship!++++containsMatch :: (Data start, Typeable start, Data find, Typeable find) =>+                 start -> find ->+                 Box find++#if __GLASGOW_HASKELL_COMPILER__ < 606+-- GHC 6.4.2 does not export typeRepKey, so we can't do the trick+-- as efficiently, so we just give up and revert to always following++containsMatch start find = Box query+    where+        query a = case cast a of+                       Just y -> Hit y+                       Nothing -> Follow++#else+-- GHC 6.6 does contain typeRepKey, so only follow when appropriate++containsMatch start find = Box query+    where+        typeInt x = inlinePerformIO $ typeRepKey x+    +        query :: Typeable a => a -> Answer find+        query a = if tifind == tia then Hit (unsafeCast a)+                  else if tia `IntSet.member` timatch then Follow else Miss+            where tia = typeInt $ typeOf a+    +        tifind = typeInt tfind+        timatch = IntSet.fromList $ map typeInt tmatch++        tfind = typeOf find+        tmatch = f [tfind] (filter ((/=) tfind . fst) $ containsList start)++        f want have = if null want2 then [] else want2 ++ f want2 no+            where+                want2 = map fst yes+                (yes,no) = partition (not . null . intersect want . snd) have++containsList :: (Data a, Typeable a) => a -> [(TypeRep, [TypeRep])]+containsList x = f [] [DataBox x]+    where+        f done [] = []+        f done (DataBox t:odo)+            | tt `elem` done = f done odo+            | otherwise = (tt,map (\(DataBox a) -> typeOf a) xs) : f (tt:done) (xs++odo)+            where+                tt = typeOf t+                xs = contains t++contains :: (Data a, Typeable a) => a -> [DataBox]+contains x = if isAlgType dtyp then concatMap f ctrs else []+    where+        f ctr = gmapQ DataBox (asTypeOf (fromConstr ctr) x)+        ctrs = dataTypeConstrs dtyp+        dtyp = dataTypeOf x++#endif+++instance (Data a, Typeable a) => Uniplate a where+    uniplate = \x -> fromCC (collect_generate (fromBox answer) x)+        where+            answer :: Box a+            answer = containsMatch (undefined :: a) (undefined :: a)+++instance (Data a, Data b, Uniplate b, Typeable a, Typeable b) => Biplate a b where+    biplate = \x -> fromCC (collect_generate_self (fromBox answer) x)+        where+            answer :: Box b+            answer = containsMatch (undefined :: a) (undefined :: b)+++newtype C x a = C {fromC :: CC x a}++type CC x a = ([x] -> [x], [x] -> (a, [x]))+++fromCC :: CC x a -> ([x], [x] -> a)+fromCC (a, b) = (a [], \i -> fst (b i))+++collect_generate_self :: (Data on, Uniplate with, Typeable on, Typeable with) =>+                         (forall a . Typeable a => a -> Answer with) -> on -> CC with on+collect_generate_self oracle x = res+        where+            res = case oracle x of+                       Hit y -> ((y:), \(x:xs) -> (unsafeCast x, xs))+                       Follow -> collect_generate oracle x+                       Miss -> (id, \res -> (x,res))+++collect_generate :: (Data on, Uniplate with, Typeable on, Typeable with) =>+                    (forall a . Typeable a => a -> Answer with) -> on -> CC with on+collect_generate oracle item = fromC $ gfoldl combine create item+    where+        -- forall a b . Data a => C with (a -> b) -> a -> C with b+        combine (C (c,g)) x = case collect_generate_self oracle x of+                                  (c2, g2) -> C (c . c2, regen g2)+            where+                regen g2 i = case g i of+                            (x2,i2) -> case g2 i2 of+                                (y2,i3) -> (x2 y2, i3)+        +        -- forall g . g -> C with g+        create x = C (id, \res -> (x, res))++++++{-+OLD VERSION USING TWO SEPARATE TRAVERSALS++collect_generate :: (Data on, Uniplate with, Typeable on, Typeable with) => on -> ([with],[with] -> on)+collect_generate item = (collect, generate)+    where+        collect = concat $ gmapQ getChildrenEx item++        generate xs = evalState (gmapM f item) xs+            where+                f x = do+                        ys <- get+                        let (as,bs) = splitAt (length col) ys+                        put bs+                        return $ gen as+                    where+                        (col,gen) = replaceChildrenEx x+-}
+ Data/Generics/PlateDirect.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances #-}++{- |+    This module supplies a method for writing 'Biplate' instances more easily.+    This module requires fewest extensions, highest performance, and most instance+    definitions.+    +    To take an example:+    +    > data Expr = Var Int | Pos Expr String | Neg Expr | Add Expr Expr+    > data Stmt = Seq [Stmt] | Sel [Expr] | Let String Expr+    >+    > instance PlateOne Expr where+    >     plateOne (Var x  ) = plate Var |- x+    >     plateOne (Pos x y) = plate Pos |* x |- y+    >     plateOne (Neg x  ) = plate Neg |* x+    >     plateOne (Add x y) = plate Add |* x |* y+    >+    > instance PlateAll Expr Expr where+    >     plateAll = plateSelf+    >+    > instance PlateOne Stmt where+    >     plateOne (Seq x  ) = plate Seq ||* x+    >     plateOne (Sel x  ) = plate Sel ||+ x+    >     plateOne (Let x y) = plate Let |-  x |- y+    >+    > instance PlateAll Stmt Stmt where+    >     plateAll = plateSelf+    >+    > instance PlateAll Stmt Expr where+    >     plateAll (Seq x  ) = plate Seq ||+ x+    >     plateAll (Sel x  ) = plate Sel ||* x+    >     plateAll (Let x y) = plate Let |-  x |* y+-}+    ++module Data.Generics.PlateDirect(+    module Data.Generics.Biplate,+    -- * The Classes+    PlateAll(..), PlateOne(..),+    -- * The Combinators+    plate, plateSelf,+    (|+), (|-), (|*), (||+), (||*)+    ) where++import Data.Generics.Biplate+import Data.Generics.PlateInternal+import Data.Maybe+++instance (Uniplate b, PlateAll a b) => Biplate a b where+    biplate x = liftType $ plateAll x++instance PlateOne a => Uniplate a where+    uniplate x = liftType $ plateOne x+++type Type from to = ([to] -> [to], [to] -> (from,[to]))+++liftType :: Type from to -> ([to], [to] -> from)+liftType (a,b) = (a [], fst . b)+++-- | This class represents going from the container type to the target.+--+-- If @from == to@ then use 'plateSelf', otherwise use 'plate' and the+-- other combinators.+class PlateAll from to where+    plateAll :: from -> Type from to++-- | This class is for when the target and container are the same type.+class PlateOne to where+    plateOne :: to -> Type to to+++-- | The main combinator used to start the chain.+--+-- The following rule can be used for optimisation:+--+-- > plate Ctor |- x == plate (Ctor x)+plate :: from -> Type from to+plate f = (id, \xs -> (f,xs))+++-- | The field to the right is the target.+(|*) :: Type (to -> from) to -> to -> Type from to+(|*) f item = (collect2,generate2)+    where+        (collectL,generateL) = f+        collect2 = collectL . (item:)+        generate2 xs = case generateL xs of+                        (a,(b:xs)) -> (a b, xs)+++-- | The field to the right may contain the target.+(|+) :: PlateAll item to => Type (item -> from) to -> item -> Type from to+(|+) f item = (collect2,generate2)+    where+        (collectL,generateL) = f+        (collectR,generateR) = plateAll item+        collect2 = collectL . collectR+        generate2 xs = case generateL xs of+                        (a,xs) -> case generateR xs of+                         (b,xs) -> (a b, xs)+++-- | The field to the right /does not/ contain the target.+(|-) :: Type (item -> from) to -> item -> Type from to+(|-) (collect,generate) item = (collect,\xs -> case generate xs of (r,xs) -> (r item, xs))+++-- | The field to the right is a list of the type of the target+(||*) :: Type ([to] -> from) to -> [to] -> Type from to+(||*) f item = (collect2,generate2)+    where+        (collectL,generateL) = f+        collect2 = collectL . (item++)+        generate2 xs = case generateL xs of+                        (a,xs) -> let (x1,x2) = splitAt (length item) xs+                                  in (a x1,x2)+++-- | The field to the right is a list of types which may contain the target+(||+) :: PlateAll item to => Type ([item] -> from) to -> [item] -> Type from to+(||+) f item = (collect2,generate2)+    where+        (collectL,generateL) = f+        (collectR,generateR) = plateListDiff item+        collect2 = collectL . collectR+        generate2 xs = case generateL xs of+                        (a,xs) -> case generateR xs of+                         (b,xs) -> (a b, xs)++        plateListDiff [] = plate []+        plateListDiff (x:xs) = plate (:) |+ x ||+ xs+++-- | Used for 'PlayAll' definitions where both types are the same.+plateSelf :: to -> Type to to+plateSelf x = ((x:), \(x:xs) -> (x,xs))
+ Data/Generics/PlateInternal.hs view
@@ -0,0 +1,78 @@+{-# OPTIONS_GHC -fglasgow-exts #-}+{-# LANGUAGE CPP, Rank2Types #-}++{- |+    Internal module, do not import or use.+-}++module Data.Generics.PlateInternal(+    unsafeCast, inlinePerformIO, builder, concatCont+    ) where+++---------------------------------------------------------------------+-- GHC+{-+#if !__GLASGOW_HASKELL__+{-+#endif+-}++import GHC.Exts(unsafeCoerce#, build, realWorld#)+import GHC.IOBase(IO(IO))++{-# INLINE unsafeCast #-}+-- | @unsafeCoerce@, but for all compilers. In future this can be obtained from+-- @Unsafe.Coerce.unsafeCoerce@, but thats too recent a change.+unsafeCast :: a -> b+unsafeCast = unsafeCoerce#++{-# INLINE builder #-}+-- | GHCs @foldr@\/@build@ system, but on all platforms+builder :: forall a . (forall b . (a -> b -> b) -> b -> b) -> [a]+builder = build++{-# INLINE inlinePerformIO #-}+-- | 'unsafePerformIO', but suitable for inlining. Copied from "Data.ByteString.Base".+inlinePerformIO :: IO a -> a+inlinePerformIO (IO m) = case m realWorld# of (# _, r #) -> r++{-+#if !__GLASGOW_HASKELL__+-}+#endif+-}++++---------------------------------------------------------------------+-- !GHC+{-+#if !__GLASGOW_HASKELL__+-}++import Data.Typeable+import Data.Maybe+import Foreign++unsafeCast :: (Typeable a, Typeable b) => a -> b+unsafeCast = fromJust . cast++inlinePerformIO :: IO a -> a+inlinePerformIO = unsafePerformIO++builder :: ((x -> [x] -> [x]) -> [x] -> [x]) -> [x]+builder f = f (:) []++{-+#endif+-}+++++{-# INLINE concatCont #-}+-- | Perform concatentation of continuations+concatCont :: [a -> a] -> a -> a+concatCont xs rest = foldr ($) rest xs+
+ Data/Generics/PlateTypeable.hs view
@@ -0,0 +1,164 @@+{-# LANGUAGE MultiParamTypeClasses, UndecidableInstances #-}++{- |+    This module supplies a method for writing 'Biplate' instances more easily.+    +    To take an example:+    +    > data Expr = Var Int | Neg Expr | Add Expr Expr+    >+    > instance Typeable Expr where ...+    >+    > instance (Typeable a, Uniplate a) => PlateAll Expr a where+    >   plateAll (Var x  ) = plate Var |- x+    >   plateAll (Neg x  ) = plate Neg |+ x+    >   plateAll (Add x y) = plate Add |+ x |+ y+    >+    > instance Uniplate Expr where+    >   uniplate = uniplateAll+-}++module Data.Generics.PlateTypeable(+    module Data.Generics.Biplate,+    module Data.Typeable,+    -- * The Class+    PlateAll(..), uniplateAll,+    -- * The Combinators+    plate, (|+), (|-)+    ) where++import Data.Generics.Biplate+import Data.Generics.PlateInternal+import Data.Typeable+import Data.Maybe+++instance (Typeable a, Typeable b, Uniplate b, PlateAll a b) => Biplate a b where+    biplate x = liftType $ plateMore x+++-- | This function is used to write a 'Uniplate' instance from a 'PlateAll' one+uniplateAll :: PlateAll a b => a -> ([b],[b] -> a)+uniplateAll a = liftType $ plateAll a++++type Type from to = ([to] -> [to], [to] -> (from,[to]))+++liftType :: Type from to -> ([to], [to] -> from)+liftType (a,b) = (a [], fst . b)+++plateMore :: (Typeable from, Typeable to, PlateAll from to) => from -> Type from to+plateMore x = res+    where+        res = case asTypeOf (cast x) (Just $ head $ fst res []) of+                  Nothing -> plateAll x+                  Just y -> ((y:), \(y:ys) -> (unsafeCast y, ys))+++-- | This class represents going from the container type to the target.+--+-- This class should only be constructed with 'plate', '|+' and '|-'+class PlateAll from to where+    plateAll :: from -> Type from to+++-- | The main combinator used to start the chain.+--+-- The following rule can be used for optimisation:+--+-- > plate Ctor |- x == plate (Ctor x)+plate :: from -> Type from to+plate f = (id, \xs -> (f,xs))+++-- | the field to the right may contain the target.+(|+) :: (Typeable item, Typeable to, PlateAll item to) => Type (item -> from) to -> item -> Type from to+(|+) f item = (collect2,generate2)+    where+        (collectL,generateL) = f+        (collectR,generateR) = plateMore item+        collect2 = collectL . collectR+        generate2 xs = case generateL xs of+                        (a,xs) -> case generateR xs of+                         (b,xs) -> (a b, xs)++-- | The field to the right /does not/ contain the target.+-- This can be used as either an optimisation, or more commonly for excluding+-- primitives such as Int.+(|-) :: Type (item -> from) to -> item -> Type from to+(|-) (collect,generate) item = (collect,\xs -> case generate xs of (r,xs) -> (r item, xs))+++-- * Instances++-- ** Primitive Types++instance PlateAll Int to where plateAll x = plate x+instance Uniplate Int where uniplate = uniplateAll++instance PlateAll Bool to where plateAll x = plate x+instance Uniplate Bool where uniplate = uniplateAll++instance PlateAll Char to where plateAll x = plate x+instance Uniplate Char where uniplate = uniplateAll++instance PlateAll Integer to where plateAll x = plate x+instance Uniplate Integer where uniplate = uniplateAll++instance PlateAll Double to where plateAll x = plate x+instance Uniplate Double where uniplate = uniplateAll++instance PlateAll Float to where plateAll x = plate x+instance Uniplate Float where uniplate = uniplateAll++instance PlateAll () to where plateAll x = plate x+instance Uniplate () where uniplate = uniplateAll++-- ** Container Types++instance (PlateAll from to, Typeable from, Typeable to, Uniplate to) => PlateAll [from] to where+    plateAll []     = plate []+    plateAll (x:xs) = plate (:) |+ x |+ xs++instance (PlateAll from to, Typeable from, Typeable to, Uniplate to) => PlateAll (Maybe from) to where+    plateAll Nothing  = plate Nothing+    plateAll (Just x) = plate Just |+ x++instance (PlateAll a to, Typeable a, PlateAll b to, Typeable b, Typeable to, Uniplate to) =>+         PlateAll (Either a b) to where+    plateAll (Left  x) = plate Left  |+ x+    plateAll (Right x) = plate Right |+ x++instance (PlateAll a to, Typeable a+         ,PlateAll b to, Typeable b+         ,Typeable to, Uniplate to) =>+         PlateAll (a,b) to where+    plateAll (a,b) = plate (,) |+ a |+ b++instance (PlateAll a to, Typeable a+         ,PlateAll b to, Typeable b+         ,PlateAll c to, Typeable c+         ,Typeable to, Uniplate to) =>+         PlateAll (a,b,c) to where+    plateAll (a,b,c) = plate (,,) |+ a |+ b |+ c++instance (PlateAll a to, Typeable a+         ,PlateAll b to, Typeable b+         ,PlateAll c to, Typeable c+         ,PlateAll d to, Typeable d+         ,Typeable to, Uniplate to) =>+         PlateAll (a,b,c,d) to where+    plateAll (a,b,c,d) = plate (,,,) |+ a |+ b |+ c |+ d++instance (PlateAll a to, Typeable a+         ,PlateAll b to, Typeable b+         ,PlateAll c to, Typeable c+         ,PlateAll d to, Typeable d+         ,PlateAll e to, Typeable e+         ,Typeable to, Uniplate to) =>+         PlateAll (a,b,c,d,e) to where+    plateAll (a,b,c,d,e) = plate (,,,,) |+ a |+ b |+ c |+ d |+ e+
+ Data/Generics/Uniplate.hs view
@@ -0,0 +1,136 @@+{- |+This is the main Uniplate module, which defines all the essential operations+in a Haskell 98 compatible manner.++Most functions have an example of a possible use for the function.+To illustate, I have used the @Expr@ type as below:++> data Expr = Val Int+>           | Neg Expr+>           | Add Expr Expr+-}+++module Data.Generics.Uniplate where++import Control.Monad+import Data.List(inits,tails)+import Data.Generics.PlateInternal+++-- * The Class++-- | The type of replacing all the children of a node+--+--   Taking a value, the function should return all the immediate children+--   of the same type, and a function to replace them.+type UniplateType on = on -> ([on], [on] -> on)++-- | The standard Uniplate class, all operations require this+class Uniplate on where+    -- | The underlying method in the class+    --+    -- > uniplate (Add (Val 1) (Neg (Val 2))) = ([Val 1, Neg (Val 2)], \[a,b] -> Add a b)+    -- > uniplate (Val 1)                     = ([]                  , \[]    -> Val 1  )+    uniplate :: UniplateType on+    +-- * The Operations++-- ** Queries++-- | Get all the children of a node, including itself and all children.+--+-- > universe (Add (Val 1) (Neg (Val 2))) =+-- >     [Add (Val 1) (Neg (Val 2)), Val 1, Neg (Val 2), Val 2]+--+-- This method is often combined with a list comprehension, for example:+--+-- > vals x = [Val i | i <- universe x]+universe :: Uniplate on => on -> [on]+universe x = builder (f x)+    where+        f :: Uniplate on => on -> (on -> res -> res) -> res -> res+        f x cons nil = x `cons` concatCont (map (\x -> f x cons) $ children x) nil+++-- | Get the direct children of a node. Usually using 'universe' is more appropriate.+--+-- @children = fst . 'uniplate'@+children :: Uniplate on => on -> [on]+children = fst . uniplate++++-- ** Transformations+++-- | Transform every element in the tree, in a bottom-up manner.+--+-- For example, replacing negative literals with literals:+--+-- > negLits = trasform f+-- >    where f (Neg (Lit i)) = Lit (negate i)+-- >          f x = x+transform :: Uniplate on => (on -> on) -> on -> on+transform f x = f $ generate $ map (transform f) current+    where (current, generate) = uniplate x+++-- | Monadic variant of 'transform'+transformM :: (Monad m, Uniplate on) => (on -> m on) -> on -> m on+transformM f x = mapM (transformM f) current >>= f . generate+    where (current, generate) = uniplate x+++-- | Rewrite by applying a rule everywhere you can. Ensures that the rule cannot+-- be applied anywhere in the result:+--+-- > propRewrite r x = all (isNothing . r) (universe (rewrite r x))+--+-- Usually 'transform' is more appropriate, but 'rewrite' can give better+-- compositionality. Given two single transformations @f@ and @g@, you can+-- construct @f `mplus` g@ which performs both rewrites until a fixed point.+rewrite :: Uniplate on => (on -> Maybe on) -> on -> on+rewrite f = transform g+    where g x = maybe x (rewrite f) (f x)+++-- | Monadic variant of 'rewrite'+rewriteM :: (Monad m, Uniplate on) => (on -> m (Maybe on)) -> on -> m on+rewriteM f = transformM g+    where g x = f x >>= maybe (return x) (rewriteM f)+++-- | 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.+descend :: Uniplate on => (on -> on) -> on -> on+descend f x = generate $ map f current+    where (current, generate) = uniplate x+++-- | Monadic variant of 'descend'    +descendM :: (Monad m, Uniplate on) => (on -> m on) -> on -> m on+descendM f x = liftM generate $ mapM f current+    where (current, generate) = uniplate x++++-- ** Others++-- | Return all the contexts and holes. This operation is only occasionally useful.+--+-- > propUniverse x = universe x == map fst (contexts x)+-- > propId x = all (== x) [b a | (a,b) <- contexts x]+contexts :: Uniplate on => on -> [(on, on -> on)]+contexts x = (x,id) : f current+  where+    (current, generate) = uniplate x+    f xs = [ (y, \i -> generate (pre ++ [context i] ++ post))+           | (pre,b:post) <- zip (inits xs) (tails xs)+           , (y, context) <- contexts b]++-- | Perform a fold on each value+fold :: Uniplate on => (on -> [r] -> r) -> on -> r+fold op x = op x $ map (fold op) $ children x+
+ Data/Generics/UniplateOn.hs view
@@ -0,0 +1,85 @@+{- |+This module retained Haskell 98 compatability, but users who are happy with+multi-parameter type classes should look towards "Data.Generics.Biplate".++The only function missing from "Data.Generics.Uniplate" is 'fold', as it can be+constructed from 'children' and has little meaning in a multi-typed setting.++All operations, apart from 'childrenOn' should perform identically to their non @On@+counterparts.+-}++module Data.Generics.UniplateOn(+    module Data.Generics.Uniplate,+    module Data.Generics.UniplateOn+    ) where++import Data.Generics.Uniplate+import Control.Monad(liftM)+import Data.List(inits,tails)++-- * Types++-- | 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.+type BiplateType from to = from -> ([to], [to] -> from)+++-- * Operations++-- ** Queries++universeOn :: Uniplate to => BiplateType from to -> from -> [to]+universeOn biplate x = concatMap universe $ fst $ biplate x+++-- | Return the children of a type. If @to == from@ then it returns the+-- original element (in constract to 'children'+childrenOn :: Uniplate to => BiplateType from to -> from -> [to]+childrenOn biplate x = fst $ biplate x+++-- ** Transformations++transformOn :: Uniplate to => BiplateType from to -> (to -> to) -> from -> from+transformOn biplate f x = generate $ map (transform f) current+    where (current, generate) = biplate x+++transformOnM :: (Monad m, Uniplate to) => BiplateType from to -> (to -> m to) -> from -> m from+transformOnM biplate f x = liftM generate $ mapM (transformM f) current+    where (current, generate) = biplate x+++rewriteOn :: Uniplate to => BiplateType from to -> (to -> Maybe to) -> from -> from+rewriteOn biplate f x = generate $ map (rewrite f) current+    where (current, generate) = biplate x+++rewriteOnM :: (Monad m, Uniplate to) => BiplateType from to -> (to -> m (Maybe to)) -> from -> m from+rewriteOnM biplate f x = liftM generate $ mapM (rewriteM f) current+    where (current, generate) = biplate x+++descendOn :: Uniplate to => BiplateType from to -> (to -> to) -> from -> from+descendOn biplate f x = generate $ map (descend f) current+    where (current, generate) = biplate x+++descendOnM :: (Monad m, Uniplate to) => BiplateType from to -> (to -> m to) -> from -> m from+descendOnM biplate f x = liftM generate $ mapM (descendM f) current+    where (current, generate) = biplate x+++-- ** Other++contextsOn :: Uniplate to => BiplateType from to -> from -> [(to, to -> from)]+contextsOn biplate x =+        concat [f pre b post | (pre,b:post) <- zip (inits current) (tails current)]+    where+        (current, generate) = biplate x+        +        f pre x post = [(cur, \new -> generate (pre ++ [new] ++ post))+                       | (cur,gen) <- contexts x]
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright Neil Mitchell 2006-2007.+All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are+met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * 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.++    * Neither the name of Neil Mitchell nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS 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 COPYRIGHT+OWNER 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,2 @@+import Distribution.Simple+main = defaultMain
+ uniplate.cabal view
@@ -0,0 +1,26 @@+Name:               uniplate+Version:            1.0+Copyright:          2006-7, Neil Mitchell+Maintainer:         ndmitchell@gmail.com+Homepage:           http://www-users.cs.york.ac.uk/~ndm/uniplate/+Build-Depends:      base, mtl+License:            BSD3+License-File:       LICENSE+Author:             Neil Mitchell+Synopsis:           Uniform type generic traversals.+Description:+    Uniplate is a boilerplate removal library, with similar goals to the+    original Scrap Your Boilerplate work. It requires few extensions to+    Haskell.+Category:           Development+Extensions:         CPP+Extra-Source-Files:+    uniplate.htm+Exposed-modules:+    Data.Generics.Uniplate+    Data.Generics.UniplateOn+    Data.Generics.Biplate+    Data.Generics.PlateDirect+    Data.Generics.PlateTypeable+    Data.Generics.PlateData+    Data.Generics.PlateInternal
+ uniplate.htm view
@@ -0,0 +1,326 @@+<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"+        "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">+<html>+    <head>+        <meta http-equiv="Content-Type" content="text/html;charset=utf-8" />+        <title>Boilerplate Removal with Uniplate</title>+        <style type="text/css">+pre {+    border: 2px solid gray;+    padding: 1px;+    padding-left: 5px;+    margin-left: 10px;+    background-color: #eee;+}++pre.define {+    background-color: #ffb;+    border-color: #cc0;+}++body {+    font-family: sans-serif;+}++h1, h2, h3 {+    font-family: serif;+}++h1 {+    color: rgb(23,54,93);+    border-bottom: 1px solid rgb(79,129,189);+    padding-bottom: 2px;+    font-variant: small-caps;+    text-align: center;+}++a {+    color: rgb(54,95,145);+}++h2 {+    color: rgb(54,95,145);+}++h3 {+    color: rgb(79,129,189);+}+        </style>+    </head>+    <body>++<h1>Boilerplate Removal with Uniplate</h1>++<p style="text-align:right;margin-bottom:25px;">+    by <a href="http://www.cs.york.ac.uk/~ndm/">Neil Mitchell</a>+</p>++<p style="margin-left:10%;margin-right:10%;margin-bottom:25px;text-align:justify;">+    Generic transformations and queries are often referred to as boilerplate code - they remain relatively similar as the action performed by the code changes, and can often outnumber the actual intent of the code in terms of lines. While other generic traversal schemes have shown how powerful new features can be added to compilers, and how the type system can be manipulated into accepting these operations, this document focuses on a conceptually simpler generic concept. The <i>Uniplate</i> class is introduced, which abstracts over common traversals and queries in a simple manner. A more complete document on the Uniplate class will be available from the <a href="http://www-users.cs.york.ac.uk/~ndm/uniplate/">project website</a> shortly.+</p>+<p>+    There have been several attempts at generic traversal/query methods in Haskell. One initial paper was <a href="http://doi.acm.org/10.1145/604174.604179">"Scrap your boilerplate: a practical design pattern for generic programming"</a> (<a href="http://www.cs.vu.nl/boilerplate/tldi03.pdf">free copy</a>) - which I will refer to as SYB. Another mechanism is <a href="http://doi.acm.org/10.1145/1159803.1159834">"A Pattern for Almost Compositional Functions"</a> (<a href="http://www.cs.chalmers.se/~bringert/publ/composOp/composOp.pdf">free copy</a>) - which I refer to as Compos (after the name of their class). A detailed comparison is given in the Uniplate paper (to be submitted).+</p>+<p>+    The principle advantage of the Uniplate class over these two papers is that it requires no type system extensions, compared to rank-2 types for SYB and GADT's for Compos. The simplicity of the types required means that the user is free to concentrate on the operations within the class, without requiring thought as to the type trickery required. The Uniplate pattern has been implemented in <a href="http://haskell.org/haskellwiki/Yhc">Yhc</a> for the Core data type, and in <a href="http://www-users.cs.york.ac.uk/~ndm/catch/">Catch</a> on several data types within the program.+</p>+<p>+    This document proceeds as follows:+</p>+<ol>+    <li>The motivation and use cases for Uniplate</li>+    <li>How to use the Uniplate class</li>+    <li>Extensions to Biplate</li>+</ol>+<p>+    The libraries is available through <a href="http://hackage.haskell.org/cgi-bin/hackage-scripts/package/uniplate-1.0">Hackage</a> or darcs:+</p>+<pre>+darcs get --partial <a href="http://www.cs.york.ac.uk/fp/darcs/uniplate">http://www.cs.york.ac.uk/fp/darcs/uniplate</a>+</pre>+<p>+    If you only wish to read a small fraction of this document, can I suggest you pay particular attention to <tt>transform</tt> and <tt>universe</tt> - these are by far the most common traversal patterns.+</p>++<h3>Acknowledgements</h3>++<p>+    Thanks to Bj&ouml;rn Bringert for feedback on an earlier version of this document, Eric Mertens for various ideas and code snippets, and to Matt Naylor and Tom Shackell for helpful discussions.+</p>+++<h2>Motivation and Use Cases</h2>++<p>+    The idea behind the Uniplate class is that there exists a data structure, usually with a reasonable number of constructors, which is often transformed or analysed. The usual example of this would be a compiler, which has at its core an expression type. This can be seen as a form of generic programming.+</p>+<p>+    The Uniplate class has the following goals:+</p>+<ul>+    <li>Adding a new constructor should require very few changes</li>+    <li>Traversals should have a minimal amount of boiler plate</li>+    <li>The obvious code should "just work"</li>+    <li>Haskell 98, where possible</li>+    <li>Writing new types of traverals is easy</li>+    <li>The default traversals cover most cases</li>+</ul>+<p>+    The ideas behind the Uniplate class have been used extensively, in both the Yhc compiler and the Catch tool. In Catch there are over 100 traversals using the Uniplate class, showing that the Uniplate class gets extensive use.+</p>+++<h2>Using Uniplate</h2>++<p>+    These examples revolve around a small arithmetic language, given here:++</p>+<pre>+import Data.Generics.Uniplate++data Expr = Val Int+          | Add Expr Expr+          | Sub Expr Expr+          | Div Expr Expr+          | Mul Expr Expr+          | Neg Expr+          deriving (Show, Eq)+</pre>+<p>+    Assume that a Uniplate class has already been written; so now <tt>instance Uniplate Expr</tt> is available to us. Some examples are presented, in rough order of increasingly complexity.+</p>++<h3>Checking for division by zero</h3>++<pre class="define">+universe :: Uniplate on => on -> [on]+</pre>+<p>+    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:+</p>+<pre>+hasDivZero :: Expr -> Bool+hasDivZero x = not $ null [() | Div _ (Val 0) <- universe x]+</pre>+<p>+    Here the only Uniplate method being used is <tt>universe</tt>. Given a tree, <tt>universe</tt> 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 <tt>length</tt> instead of <tt>not $ null</tt>.  Extra context could perhaps be given by printing some of the value that is being divided by zero, to help narrow down the error.+</p>+<p>+    <i>Exercise:</i> Write a function to find all literals that occur in an expression, together with their count.+</p>++<h3>Basic optimisation</h3>++<pre class="define">+transform :: Uniplate on => (on -> on) -> on -> on+</pre>+<p>+    If we are negating a literal value, this computation can be performed in advance, so let's write a function to do this.+</p>+<pre>+optimise :: Expr -> Expr+optimise = transform $ \x -> case x of+    Neg (Val i) -> Val (negate i)+    x -> x+</pre>+<p>+    Here the Uniplate method being used is <tt>transform</tt>. 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.+</p>+<p>+    Now lets add another optimisation into the same pass, just before the <tt>x -> x</tt> line insert:+</p>+<pre>+    Add x y | x == y -> Mul x (Val 2)+</pre>+<p>+    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.+</p>+<p>+    <i>Exercise:</i> Extend the optimisation to so that adding <tt>x</tt> to <tt>Mul x (Val 2)</tt> produces a multiplication by 3.+</p>+++<h3>Depth of an expression</h3>++<pre class="define">+fold :: Uniplate on => (on -> [res] -> res) -> on -> res+</pre>+<p>+    Now lets imagine that programmers in your language are paid by the depth of expression they produce, so lets write a function that computes the maximum depth of an expression.+</p>+<pre>+depth :: Expr -> Int+depth = fold (\_ cs -> 1 + maximum (0:cs))+</pre>+<p>+    This function performs 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 <tt>fold</tt>, see inside the example directory to see an implementation.+</p>+<p>+    <i>Exercise:</i> Write a function that counts the maximum depth of addition only.+</p>++<h3>Renumbering literals</h3>++<pre class="define">+transformM :: (Monad m, Uniplate on) => (on -> m on) -> on -> m on+</pre>+<p>+    The literal values need to be replaced with a sequence of numbers, each unique. This is unlikely for an arithmetic expression, but consider bound variables in lambda calculus and it starts to become a bit more plausible:+</p>+<pre>+uniqueLits :: Expr -> Expr+uniqueLits x = evalState (transformM f x) [0..]+    where+        f (Val i) = do+            y:ys <- get+            put ys+            return (Val y)+        f x = return x+</pre>+<p>+    Here a monadic computation is required, the program needs to keep track of what the next item in the list to use is, and replace the current item. By using the state monad, this can be done easily.+</p>+<p>+    <i>Exercise:</i> Allow each literal to occur only once, when a second occurance is detected, replace that literal with zero.+</p>++<h3>Generating mutants</h3>++<pre class="define">+contexts :: Uniplate on => on -> [(on, on -> on)]+</pre>+<p>+    The person who is inputting the expression thinks they made a mistake, they suspect they got one of the values wrong by plus or minus one. Generate all the expressions they might have written.+</p>+<pre>+mutate :: Expr -> [Expr]+mutate x = concat [[gen $ Val $ i-1, gen $ Val $ i+1]+                  | (Val i, gen) <- contexts x]+</pre>+<p>+   The <tt>transform</tt> function is useful for doing an operation to all nodes in a tree, but sometimes you only want to apply a transformation once. This is less common, but is sometimes required. The idea is that the context provides the information required to recreate the original expression, but with this node altered.+</p>+<p>+    <i>Exercise:</i> Replace one multiplication with addition, if there are no multiplications return the original expression.+</p>++<h3>Reverse notation</h3>++<pre class="define">+uniplate :: Uniplate on => on -> ([on], [on] -> on)+</pre>+<p>+    In general, <tt>universe</tt> and <tt>transform</tt> are used most of the time, and <tt>transformM</tt> is used occasionally. The Uniplate class is built upon the operation <tt>uniplate</tt>, which takes an expression, and returns a pair with the children of that expression, and a function to generate that expression with a new set of children in place. This operation can be directly exploited if required, although should be handled with caution.+</p>+<p>+    Let us make a function that reverses the order of all the inputs, say if the user is working in Right-to-Left mode on their computer:+</p>+<pre>+reverseExpr :: Expr -> Expr+reverseExpr = transform f+    where+        f x = generate $ reverse collect+            where (collect,generate) = uniplate x+</pre>+<p>+    This expression does a standard <tt>transform</tt>, but at each iteration calls <tt>uniplate</tt>, then reverses the children set before regenerating the original expression. This shows the underlying mechanism on which the library is based, and isn't recommended for average users.+</p>+++<h2>Defining a Uniplate instance</h2>++<p>+    As shown in the reversal example (just above), the only method in the Uniplate class is <tt>uniplate</tt>. The Uniplate class is defined as:+</p>+<pre class="define">+class Uniplate on where+    uniplate :: on -> ([on], [on] -> on)+</pre>+<p>+    The idea is that given an item, you want to return all the children, and a function that will replace all the children. An invariant is that the list given to the second function will be the same length as that returned in the first element of the pair. Let's start by constructing the Uniplate instance for the expression type.+</p>+<pre>+instance Uniplate Expr of+    uniplate x =+        case x of+            Add a b -> ([a,b], \[a,b] -> Add a b)+            ...+            Neg a -> ([a], \[a] -> Neg a)+            Val i -> ([], \[] -> Val i)+</pre>+<p>+    A short study of the code should show how this works. The other constructors such as <tt>Mul</tt> follow the same pattern as <tt>Add</tt>. To define a <tt>Uniplate</tt> instance a user should make use of the <a href="http://www-users.cs.york.ac.uk/~ndm/derive/">Data.Derive</a> tool.+</p>+++<h2>Using Biplate</h2>++<p>+    The Biplate class is not standard Haskell, requiring multi-parameter type classes. Where possible try and use the standard Uniplate class. The Biplate class is necessary when working with a data structure that has multiple types within it.+</p>+<pre class="define">+class Uniplate with => Biplate on with where+    biplate :: on -> ([with], [with] -> on)+</pre>+<p>+    The <tt>biplate</tt> method operates much like the <tt>biplate</tt>, except for the different types.  When the types of <tt>on</tt> and <tt>with</tt> are different, <tt>biplate</tt> returns the closest children of the requested type. When the types are the same, this function returns the root element, not it's children.+</p>+<p>+    There are several mechanisms for writing <tt>Biplate</tt> instances, discussed in the Uniplate paper.+</p>++<h3>Using the operations from Biplate</h3>++<p>+    To see various operations being used from the Biplate class, see the Uniplate paper. Typically the operations are just the same as Uniplate, with <tt>Bi</tt> on the end.+</p>+<pre class="define">+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+</pre>+++    </body>+</html>