uniplate 1.4 → 1.5
raw patch · 3 files changed
+163/−9 lines, 3 files
Files
- Data/Generics/Uniplate/Internal/Data.hs +146/−1
- uniplate.cabal +1/−1
- uniplate.htm +16/−7
Data/Generics/Uniplate/Internal/Data.hs view
@@ -40,7 +40,7 @@ hitTest _ _ = Oracle . maybe Follow Hit . cast -#else+#elif 0 hitTest from to =@@ -148,6 +148,151 @@ dtyp = dataTypeOf x typeRational = typeKey (undefined :: Rational)++#else++hitTest from to =+ let kto = typeKey to+ in case readCache (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+ else if test kon then Follow+ else Miss++++---------------------------------------------------------------------+-- CACHE+-- Store and compute the Follower and HitMap++data Cache = Cache HitMap (IntMap2 (Maybe Follower))++-- Indexed by the @from@ type, then the @to@ type+-- Nothing means that we can't perform the trick on the set+{-# NOINLINE cache #-}+cache :: IORef Cache+cache = unsafePerformIO $ newIORef $ Cache emptyHitMap IntMap.empty+++readCache :: DataBox -> TypeKey -> Maybe Follower+readCache from@(DataBox kfrom vfrom) kto = inlinePerformIO $ do+ Cache hit follow <- readIORef cache+ case lookup2 kfrom kto follow of+ Just ans -> return ans+ Nothing -> do+ res <- Control.Exception.catch (return $! Just $! insertHitMap from hit) (\(_ :: SomeException) -> return Nothing)+ (hit,fol) <- return $ case res of+ Nothing -> (hit, Nothing)+ Just hit -> (hit, Just $ follower kfrom kto hit)+ -- -- uncomment these lines to see where type search fails+ -- if isNothing fol then print ("failure",show (typeOf vfrom),kfrom,kto) else return ()++ atomicModifyIORef cache $ \(Cache _ follow) -> (Cache hit (insert2 kfrom kto fol follow), ())+ return fol+++---------------------------------------------------------------------+-- INTMAP2++type IntMap2 a = IntMap (IntMap a)++lookup2 :: Int -> Int -> IntMap (IntMap x) -> Maybe x+lookup2 x y mp = IntMap.lookup x mp >>= IntMap.lookup y++insert2 :: Int -> Int -> x -> IntMap (IntMap x) -> IntMap (IntMap x)+insert2 x y v mp = IntMap.insertWith (const $ IntMap.insert y v) x (IntMap.singleton y v) mp+++---------------------------------------------------------------------+-- FOLLOWER+-- Function to test if you should follow++type Follower = TypeKey -> Bool+++-- HitMap must have addHitMap on the key+follower :: TypeKey -> TypeKey -> HitMap -> Follower+follower from to mp+ | IntSet.null hit = const False+ | IntSet.null miss = const True+ | otherwise = \now -> now `IntSet.member` hit+ where+ (hit,miss) = IntSet.partition (\x -> to `IntSet.member` grab x) (IntSet.insert from $ grab from)+ grab x = IntMap.findWithDefault (error "couldn't grab in follower") x mp+++---------------------------------------------------------------------+-- DATA/TYPEABLE OPERATIONS++type TypeKey = Int++typeKey :: Typeable a => a -> Int+typeKey x = inlinePerformIO $ typeRepKey $ typeOf x+++-- | An existential box representing a type which supports SYB+-- operations.+data DataBox = forall a . (Data a) => DataBox {dataBoxKey :: TypeKey, dataBoxVal :: a}++dataBox :: Data a => a -> DataBox+dataBox x = DataBox (typeKey x) x+++-- NOTE: This function is partial, but all exceptions are caught later on+sybChildren :: Data a => a -> [DataBox]+sybChildren x+ | isAlgType dtyp = concatMap f ctrs+ | isNorepType dtyp = error "sybChildren on NorepType"+ | otherwise = []+ where+ f ctr = gmapQ dataBox (asTypeOf (fromConstr ctr) x)+ ctrs = dataTypeConstrs dtyp+ dtyp = dataTypeOf x+++---------------------------------------------------------------------+-- HITMAP+-- What is the transitive closure of a type key++type HitMap = IntMap IntSet++emptyHitMap :: HitMap+emptyHitMap = IntMap.fromList+ [(tRational, IntSet.singleton tInteger)+ ,(tInteger, IntSet.empty)]+ where tRational = typeKey (undefined :: Rational)+ tInteger = typeKey (0 :: Integer)+++insertHitMap :: DataBox -> HitMap -> HitMap+insertHitMap box hit = fixEq trans (populate box) `IntMap.union` hit+ where+ -- create a fresh box with all the necessary children that aren't in hit+ populate :: DataBox -> HitMap+ populate x = f x IntMap.empty+ where+ f (DataBox key val) mp+ | key `IntMap.member` hit || key `IntMap.member` mp = mp+ | otherwise = fs cs $ IntMap.insert key (IntSet.fromList $ map dataBoxKey cs) mp+ where cs = sybChildren val++ fs [] mp = mp+ fs (x:xs) mp = fs xs (f x mp)+++ -- update every one to be the transitive closure+ trans :: HitMap -> HitMap+ trans mp = IntMap.map f mp+ where+ f x = IntSet.unions $ x : map g (IntSet.toList x)+ g x = IntMap.findWithDefault (hit IntMap.! x) x mp+++fixEq :: Eq a => (a -> a) -> a -> a+fixEq f x = if x == x2 then x2 else fixEq f x2+ where x2 = f x+ #endif
uniplate.cabal view
@@ -1,7 +1,7 @@ Cabal-Version: >= 1.2 Build-Type: Simple Name: uniplate-Version: 1.4+Version: 1.5 Copyright: 2006-10, Neil Mitchell Maintainer: ndmitchell@gmail.com Homepage: http://community.haskell.org/~ndm/uniplate/
uniplate.htm view
@@ -59,11 +59,11 @@ 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, the Uniplate library focuses on a conceptually simpler generic concept. A more complete document on Uniplate was published at the Haskell Workshop 2007, and is available from the <a href="http://community.haskell.org/~ndm/uniplate/">project website</a>, along with a video presentation, and the associated thesis chapter. </p> <p>- Uniplate is a simple, concise and fast generics library. To expand on that sentance:+ Uniplate is a simple, concise and fast generics library. To expand on that sentence: </p> <ol> <li>A generics library is one which allows you to write functions that operate over a data structure without tying down all aspects of the data structure. In particular, when writing an operation, you don't need to give a case for each constructor, and you don't have to state which fields are recursive.</li>- <li>Uniplate is the simplest generics library. Using Uniplate is suitable for all Haskell programmers.</li>+ <li>Uniplate is the simplest generics library. Using Uniplate is within the reach of all Haskell programmers.</li> <li>Uniplate is more concise than any other generics library.</li> <li>Uniplate is fast, not always the absolute fastest, but massively faster than many generics libraries.</li> <li>Uniplate is also less powerful than some other generics libraries, but if it does the job, you should use it.</li>@@ -94,11 +94,12 @@ <h2>Using Uniplate</h2> <p>- These examples revolve around a small arithmetic language, given here:-+ To demonstrate the facilities of Uniplate, we use a simple arithmetic type: </p> <pre>-import Data.Generics.Uniplate.Data+<b>{-# LANGUAGE DerivingDataTypeable #-}</b>+module Expr where+<b>import Data.Generics.Uniplate.Data</b> data Expr = Val Int | Add Expr Expr@@ -106,10 +107,18 @@ | Div Expr Expr | Mul Expr Expr | Neg Expr- deriving (Show, Eq, Data, Typeable)+ deriving (Show, Eq, <b>Data, Typeable</b>) </pre> <p>- To start using Uniplate I recommend you import <tt>Data.Generics.Uniplate.Data</tt> and add <tt>deriving (Data, Typeable)</tt> to all types you wish to operate upon.+ In this definition, the Uniplate specific bits are bolded. The three extra parts are:+</p>+<ul>+<li><tt>import Data.Generics.Uniplate.Data</tt>, this module contains all the Uniplate functions and definitions.</li>+<li><tt>deriving (Data,Typeable)</tt>, this deriving clause automatically adds the necessary instances for Uniplate.</li>+<li><tt>{-# LANGUAGE DerivingDataTypeable #-}</tt>, this pragma turns on language support for the deriving line.</li>+</ul>+<p>+ This definition makes use of the <a href="http://doi.acm.org/10.1145/604174.604179">Scrap Your Boilerplate (SYB) based</a> 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 <a href="http://haskell.org/ghc/">GHC</a> 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. </p> <h3>Checking for division by zero</h3>