uniplate 1.6.1 → 1.6.2

raw patch · 3 files changed

+40/−7 lines, 3 files

Files

• Data/Generics/Uniplate/Data.hs +17/−0
• Data/Generics/Uniplate/Internal/Data.hs +22/−6
• uniplate.cabal +1/−1

@@ -14,6 +14,23 @@     For faster performance (5x faster, but requires writing instances) switch to     "Data.Generics.Uniplate.Direct". If you get instance conflicts     when using both @Data@ and @Direct@, switch to "Data.Generics.Uniplate.DataOnly".++    The instances are faster than GHC because they precompute a table of useful information,+    then use this information when performing the traversals. Sometimes it is not possible+    to compute the table, in which case this library will perform about the same speed as+    SYB.++    Setting the environment variable @$UNIPLATE_VERBOSE@ has the following effects:++  * @-1@ - raise a program error every time construction of the table fails++  * @0@ (or unset) - never print any messages or raise any errors++  * @1@ - give a message every time a table is computed++  * @2@ - give a message when table computation fails++    The @$UNIPLATE_VERBOSE@ environment variable must be set before the first call to uniplate. -} module Data.Generics.Uniplate.Data(     module Data.Generics.Uniplate.Operations,

@@ -14,6 +14,8 @@ import Data.List import Data.IORef import Control.Exception+import Control.Monad+import System.Environment(getEnv) import qualified Data.IntMap as IntMap; import Data.IntMap(IntMap)  @@ -41,7 +43,12 @@  #endif +{-# NOINLINE uniplateVerbose #-}+uniplateVerbose :: Int -- 0 = quiet, 1 = errors only, 2 = everything+uniplateVerbose = unsafePerformIO $ do+    fmap read (getEnv "UNIPLATE_VERBOSE") `Control.Exception.catch` \(_ :: SomeException) -> return 0 + --------------------------------------------------------------------- -- HIT TEST @@ -84,13 +91,18 @@     case lookup2 kfrom kto follow of         Just ans -> return ans         Nothing -> do-            res <- Control.Exception.catch (return $! Just $! insertHitMap from hit) (\(_ :: SomeException) -> return Nothing)+            res <- Control.Exception.try (return $! insertHitMap from hit)             (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 ()+                Left _ -> (hit, Nothing)+                Right hit -> (hit, Just $ follower kfrom kto hit) +            let msg =+                    "# Uniplate lookup on (" ++ show (typeOf vfrom) ++ "), from (" ++ show kfrom ++ "), to (" ++ show kto ++ "): " +++                    either (\(msg::SomeException) -> "FAILURE (" ++ show msg ++ ")") (const "Success") res++            when (uniplateVerbose + maybe 1 (const 0) fol >= 2) $ putStrLn msg+            when (uniplateVerbose < 0 && isNothing fol) $ error msg+             atomicModifyIORef cache $ \(Cache _ follow) -> (Cache hit (insert2 kfrom kto fol follow), ())             return fol @@ -164,7 +176,11 @@ sybChildren :: Data a => a -> [DataBox] sybChildren x     | isAlgType dtyp = concatMap f ctrs-    | isNorepType dtyp = error "sybChildren on NorepType"+    | isNorepType dtyp = []+        -- Extensive discussions with Lennart and Roman decided that if something returns NorepType, it really wants to be atomic+        -- so we should let it be, and pretend it has no children.+        -- The most common types which say this are Data.Set/Data.Map, and we think that's a bug in their Data instances.+        -- error $ "Data.Generics.Uniplate.Data: sybChildren on data type which returns NorepType, " ++ show (typeOf x) ++ ", " ++ show dtyp     | otherwise = []     where         f ctr = gmapQ dataBox (asTypeOf (fromConstr ctr) x)

@@ -1,7 +1,7 @@ cabal-version:      >= 1.6 build-type:         Simple name:               uniplate-version:            1.6.1+version:            1.6.2 author:             Neil Mitchell <ndmitchell@gmail.com> maintainer:         Neil Mitchell <ndmitchell@gmail.com> copyright:          Neil Mitchell 2006-2011