uniplate 1.6.8 → 1.6.9
raw patch · 11 files changed
+52/−128 lines, 11 files
Files
- Data/Generics/PlateData.hs +3/−3
- Data/Generics/PlateInternal.hs +0/−81
- Data/Generics/PlateTypeable.hs +2/−2
- Data/Generics/Str.hs +27/−3
- Data/Generics/Uniplate.hs +1/−1
- Data/Generics/Uniplate/Internal/DataOnlyOperations.hs +1/−1
- Data/Generics/Uniplate/Internal/OperationsInc.hs +14/−32
- Data/Generics/Uniplate/Operations.hs +1/−1
- Data/Generics/UniplateStr.hs +1/−1
- Data/Generics/UniplateStrOn.hs +1/−1
- uniplate.cabal +1/−2
Data/Generics/PlateData.hs view
@@ -13,7 +13,7 @@ ) where import Data.Generics.Biplate-import Data.Generics.PlateInternal+import Data.Generics.Uniplate.Internal.Utils import Data.Generics #if !(__GLASGOW_HASKELL__ < 606 || __GLASGOW_HASKELL__ >= 702)@@ -57,7 +57,7 @@ typeInt x = inlinePerformIO $ typeRepKey x query :: Typeable a => a -> Answer find- query a = if tifind == tia then Hit (unsafeCast a)+ query a = if tifind == tia then Hit (unsafeCoerce a) else if tia `IntSet.member` timatch then Follow else Miss where tia = typeInt $ typeOf a @@ -124,7 +124,7 @@ collect_generate_self oracle x = res where res = case oracle x of- Hit y -> (One y, \(One x) -> unsafeCast x)+ Hit y -> (One y, \(One x) -> unsafeCoerce x) Follow -> collect_generate oracle x Miss -> (Zero, \_ -> x)
− Data/Generics/PlateInternal.hs
@@ -1,81 +0,0 @@-{-# LANGUAGE CPP, Rank2Types, MagicHash, UnboxedTuples #-}--{- |- 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#)-#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--- @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
@@ -32,7 +32,7 @@ ) where import Data.Generics.Biplate-import Data.Generics.PlateInternal+import Data.Generics.Uniplate.Internal.Utils import Data.Typeable @@ -53,7 +53,7 @@ where res = case asTypeOf (cast x) (Just $ strType $ fst res) of Nothing -> plateAll x- Just y -> (One y, \(One y) -> unsafeCast y)+ Just y -> (One y, \(One y) -> unsafeCoerce y) -- | This class represents going from the container type to the target.
Data/Generics/Str.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE BangPatterns #-} {- | This module provides the 'Str' data type, which is used by the underlying 'uniplate' and 'biplate' methods. It should not@@ -6,13 +7,15 @@ module Data.Generics.Str where -import Data.Generics.PlateInternal+import Data.Generics.Uniplate.Internal.Utils -import Data.Traversable-import Data.Foldable import Control.Applicative+import Control.Monad+import Data.Foldable import Data.Monoid+import Data.Traversable + -- * The Data Type data Str a = Zero | One a | Two (Str a) (Str a)@@ -24,10 +27,31 @@ Two x1 x2 == Two y1 y2 = x1 == y1 && x2 == y2 _ == _ = False ++{-# INLINE strMap #-}+strMap :: (a -> b) -> Str a -> Str b+strMap f x = g SPEC x+ where+ g !spec Zero = Zero+ g !spec (One x) = One $ f x+ g !spec (Two x y) = Two (g spec x) (g spec y)++++{-# INLINE strMapM #-}+strMapM :: Monad m => (a -> m b) -> Str a -> m (Str b)+strMapM f x = g SPEC x+ where+ g !spec Zero = return Zero+ g !spec (One x) = liftM One $ f x+ g !spec (Two x y) = liftM2 Two (g spec x) (g spec y)++ instance Functor Str where fmap f Zero = Zero fmap f (One x) = One (f x) fmap f (Two x y) = Two (fmap f x) (fmap f y)+ instance Foldable Str where
Data/Generics/Uniplate.hs view
@@ -18,7 +18,7 @@ where import Control.Monad-import Data.Generics.PlateInternal+import Data.Generics.Uniplate.Internal.Utils -- * The Class
Data/Generics/Uniplate/Internal/DataOnlyOperations.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, MultiParamTypeClasses, BangPatterns #-}+{-# LANGUAGE CPP, MultiParamTypeClasses #-} module Data.Generics.Uniplate.Internal.DataOnlyOperations where
Data/Generics/Uniplate/Internal/OperationsInc.hs view
@@ -1,6 +1,4 @@-import Control.Monad(liftM,liftM2)-import Data.Traversable-import Prelude hiding (mapM)+import Control.Monad import Data.Generics.Str import Data.Generics.Uniplate.Internal.Utils @@ -42,21 +40,13 @@ {-# INLINE descend #-} descend :: (on -> on) -> on -> on descend f x = case uniplate x of- (current, generate) -> generate $ g current- where- g Zero = Zero- g (One x) = One $ f x- g (Two x y) = Two (g x) (g y)+ (current, generate) -> generate $ strMap f current -- | Monadic variant of 'descend' {-# INLINE descendM #-} descendM :: Monad m => (on -> m on) -> on -> m on descendM f x = case uniplate x of- (current, generate) -> liftM generate $ g SPEC current- where- g !spec Zero = return Zero- g !spec (One x) = liftM One $ f x- g !spec (Two x y) = liftM2 Two (g spec x) (g spec y)+ (current, generate) -> liftM generate $ strMapM f current @@ -79,20 +69,12 @@ {-# INLINE descendBi #-} descendBi :: (to -> to) -> from -> from descendBi f x = case biplate x of- (current, generate) -> generate $ g current- where- g Zero = Zero- g (One x) = One $ f x- g (Two x y) = Two (g x) (g y)-+ (current, generate) -> generate $ strMap f current + {-# INLINE descendBiM #-} descendBiM :: Monad m => (to -> m to) -> from -> m from descendBiM f x = case biplate x of- (current, generate) -> liftM generate $ g SPEC current- where- g !spec Zero = return Zero- g !spec (One x) = liftM One $ f x- g !spec (Two x y) = liftM2 Two (g spec x) (g spec y)+ (current, generate) -> liftM generate $ strMapM f current -- * Single Type Operations@@ -229,24 +211,24 @@ {-# INLINE transformBi #-} transformBi :: Biplate from to => (to -> to) -> from -> from-transformBi f x = generate $ fmap (transform f) current- where (current, generate) = biplate x+transformBi f x = case biplate x of+ (current, generate) -> generate $ strMap (transform f) current {-# INLINE transformBiM #-} transformBiM :: (Monad m, Biplate from to) => (to -> m to) -> from -> m from-transformBiM f x = liftM generate $ mapM (transformM f) current- where (current, generate) = biplate x+transformBiM f x = case biplate x of+ (current, generate) -> liftM generate $ strMapM (transformM f) current rewriteBi :: Biplate from to => (to -> Maybe to) -> from -> from-rewriteBi f x = generate $ fmap (rewrite f) current- where (current, generate) = biplate x+rewriteBi f x = case biplate x of+ (current, generate) -> generate $ strMap (rewrite f) current rewriteBiM :: (Monad m, Biplate from to) => (to -> m (Maybe to)) -> from -> m from-rewriteBiM f x = liftM generate $ mapM (rewriteM f) current- where (current, generate) = biplate x+rewriteBiM f x = case biplate x of+ (current, generate) -> liftM generate $ strMapM (rewriteM f) current -- ** Others
Data/Generics/Uniplate/Operations.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, MultiParamTypeClasses, BangPatterns #-}+{-# LANGUAGE CPP, MultiParamTypeClasses #-} {- | Definitions of 'Uniplate' and 'Biplate' classes, along with all the standard operations.
Data/Generics/UniplateStr.hs view
@@ -24,7 +24,7 @@ import Data.Traversable import Prelude hiding (mapM) -import Data.Generics.PlateInternal+import Data.Generics.Uniplate.Internal.Utils import Data.Generics.Str
Data/Generics/UniplateStrOn.hs view
@@ -22,7 +22,7 @@ import Data.Traversable import Prelude hiding (mapM) -import Data.Generics.PlateInternal+import Data.Generics.Uniplate.Internal.Utils import Data.Generics.Str import Data.Generics.UniplateStr
uniplate.cabal view
@@ -1,7 +1,7 @@ cabal-version: >= 1.6 build-type: Simple name: uniplate-version: 1.6.8+version: 1.6.9 author: Neil Mitchell <ndmitchell@gmail.com> maintainer: Neil Mitchell <ndmitchell@gmail.com> copyright: Neil Mitchell 2006-2012@@ -87,7 +87,6 @@ Data.Generics.PlateData other-modules:- Data.Generics.PlateInternal Data.Generics.Uniplate.Internal.Data Data.Generics.Uniplate.Internal.DataOnlyOperations Data.Generics.Uniplate.Internal.Utils