uniplate 1.3 → 1.4

raw patch · 3 files changed

+17/−11 lines, 3 files

Files

• Data/Generics/Uniplate/Internal/Data.hs +15/−8
• Data/Generics/Uniplate/Internal/OperationsInc.hs +0/−1
• uniplate.cabal +2/−2

@@ -77,7 +77,7 @@   hitTestQuery :: DataBox -> TypeKey -> Maybe Cache-hitTestQuery from@(DataBox kfrom _) kto = inlinePerformIO $ do+hitTestQuery from@(DataBox kfrom vfrom) kto = inlinePerformIO $ do     mp <- readIORef hitTestCache     let res = IntMap.lookup kfrom mp >>= IntMap.lookup kto     case res of@@ -85,8 +85,11 @@         Nothing -> do             let res = toCache $ hitTestAdd from kto IntMap.empty             res2 <- Control.Exception.catch (return $! res) (\(_ :: SomeException) -> return Nothing)-            let mp2 = IntMap.adjust (IntMap.insert kto res2) kfrom mp-            writeIORef hitTestCache mp2+            -- -- uncomment these lines to see where type search fails+            -- if isNothing res2 then print ("failure",show (typeOf vfrom),kfrom,kto) else return ()++            atomicModifyIORef hitTestCache $ \mp -> flip (,) () $+                IntMap.insertWith (const $ IntMap.insert kto res2) kfrom (IntMap.singleton kto res2) mp             return res2  @@ -100,7 +103,7 @@     where f x = IntMap.keysSet $ IntMap.filter (== x) res  hitTestAdd :: DataBox -> TypeKey -> IntMap Res -> IntMap Res-hitTestAdd (DataBox kfrom from) kto res = case sybChildren from of+hitTestAdd from@(DataBox kfrom _) kto res = case sybChildren from of     _ | kfrom `IntMap.member` res -> res     Nothing -> IntMap.insert kfrom RBad res @@ -133,14 +136,18 @@  -- return all the possible children of a node -- if you can't do so, just return Nothing-sybChildren :: Data a => a -> Maybe [DataBox]-sybChildren x | isAlgType dtyp = Just $ concatMap f ctrs-              | isNorepType dtyp = Nothing-              | otherwise = Just []+sybChildren :: DataBox -> Maybe [DataBox]+sybChildren (DataBox k x)+    | k == typeRational = Just [dataBox (0 :: Integer)]+    | isAlgType dtyp = Just $ concatMap f ctrs+    | isNorepType dtyp = Nothing+    | otherwise = Just []     where         f ctr = gmapQ dataBox (asTypeOf (fromConstr ctr) x)         ctrs = dataTypeConstrs dtyp         dtyp = dataTypeOf x++typeRational = typeKey (undefined :: Rational)  #endif 

@@ -1,5 +1,4 @@ import Control.Monad(liftM)-import Data.List(inits,tails) import Data.Traversable import Prelude hiding (mapM) import Data.Generics.Str

@@ -1,8 +1,8 @@ Cabal-Version:      >= 1.2 Build-Type:         Simple Name:               uniplate-Version:            1.3-Copyright:          2006-9, Neil Mitchell+Version:            1.4+Copyright:          2006-10, Neil Mitchell Maintainer:         ndmitchell@gmail.com Homepage:           http://community.haskell.org/~ndm/uniplate/ License:            BSD3