    {-# LANGUAGE CPP, Rank2Types, MagicHash, UnboxedTuples, ExistentialQuantification, ScopedTypeVariables #-}
    {-# OPTIONS_GHC -Wno-orphans #-}

    {- |
        Internal module, do not import or use.
    -}

    module Data.Generics.Uniplate.Internal.Data where

    import Data.Generics.Str
    import Data.Generics.Uniplate.Internal.Utils
    import Data.Data
    import Data.Generics
    import Data.Maybe
    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)

    ---------------------------------------------------------------------
    -- GHC 7.2 and above (using fingerprint)

    import qualified Data.HashMap.Strict as Map
    import qualified Data.HashSet as Set
    type TypeSet = Set.HashSet TypeKey
    type TypeMap = Map.HashMap TypeKey

    type TypeKey = TypeRep

    typeKey :: Typeable a => a -> TypeKey
    typeKey :: forall a. Typeable a => a -> TypeKey
    typeKey = a -> TypeKey
    forall a. Typeable a => a -> TypeKey
    typeOf

    ! :: HashMap k a -> k -> a
    (!) HashMap k a
    mp k
    k = a -> k -> HashMap k a -> a
    forall {k} {a}. Hashable k => a -> k -> HashMap k a -> a
    map_findWithDefault ([Char] -> a
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "Could not find element") k
    k HashMap k a
    mp
    map_findWithDefault :: a -> k -> HashMap k a -> a
    map_findWithDefault a
    d k
    k HashMap k a
    mp = a -> Maybe a -> a
    forall a. a -> Maybe a -> a
    fromMaybe a
    d (Maybe a -> a) -> Maybe a -> a
    forall a b. (a -> b) -> a -> b
    $ k -> HashMap k a -> Maybe a
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    Map.lookup k
    k HashMap k a
    mp -- in 0.2.3.0 lookupDefault is strict in the default :(
    map_fromAscList :: [(TypeKey, v)] -> HashMap TypeKey v
    map_fromAscList = [(TypeKey, v)] -> HashMap TypeKey v
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    Map.fromList
    map_keysSet :: HashMap TypeKey v -> TypeSet
    map_keysSet = [TypeKey] -> TypeSet
    forall a. (Eq a, Hashable a) => [a] -> HashSet a
    Set.fromList ([TypeKey] -> TypeSet)
    -> (HashMap TypeKey v -> [TypeKey]) -> HashMap TypeKey v -> TypeSet
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HashMap TypeKey v -> [TypeKey]
    forall k v. HashMap k v -> [k]
    Map.keys
    map_member :: k -> HashMap k a -> Bool
    map_member k
    x HashMap k a
    xs = Maybe a -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe a -> Bool) -> Maybe a -> Bool
    forall a b. (a -> b) -> a -> b
    $ k -> HashMap k a -> Maybe a
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    Map.lookup k
    x HashMap k a
    xs
    set_partition :: (a -> Bool) -> HashSet a -> (HashSet a, HashSet a)
    set_partition a -> Bool
    f HashSet a
    x = ((a -> Bool) -> HashSet a -> HashSet a
    forall a. (a -> Bool) -> HashSet a -> HashSet a
    Set.filter a -> Bool
    f HashSet a
    x, (a -> Bool) -> HashSet a -> HashSet a
    forall a. (a -> Bool) -> HashSet a -> HashSet a
    Set.filter (Bool -> Bool
    not (Bool -> Bool) -> (a -> Bool) -> a -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Bool
    f) HashSet a
    x)
    set_toAscList :: HashSet a -> [a]
    set_toAscList = HashSet a -> [a]
    forall a. HashSet a -> [a]
    Set.toList
    set_unions :: [TypeSet] -> TypeSet
    set_unions = (TypeSet -> TypeSet -> TypeSet) -> TypeSet -> [TypeSet] -> TypeSet
    forall a b. (a -> b -> b) -> b -> [a] -> b
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr TypeSet -> TypeSet -> TypeSet
    forall a. Eq a => HashSet a -> HashSet a -> HashSet a
    Set.union TypeSet
    forall a. HashSet a
    Set.empty

    {-# NOINLINE uniplateVerbose #-}
    uniplateVerbose :: Int -- -1 = error if failed, 0 = quiet, 1 = print errors only, 2 = print everything
    uniplateVerbose :: Int
    uniplateVerbose = IO Int -> Int
    forall a. IO a -> a
    unsafePerformIO (IO Int -> Int) -> IO Int -> Int
    forall a b. (a -> b) -> a -> b
    $ do
        ([Char] -> Int) -> IO [Char] -> IO Int
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Char] -> Int
    forall a. Read a => [Char] -> a
    read ([Char] -> IO [Char]
    getEnv [Char]
    "UNIPLATE_VERBOSE") IO Int -> (SomeException -> IO Int) -> IO Int
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `Control.Exception.catch` \(SomeException
    _ :: SomeException) -> Int -> IO Int
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    0

    ---------------------------------------------------------------------
    -- HIT TEST

    data Answer a = Hit {forall a. Answer a -> a
    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!

    data Oracle to = Oracle {forall to. Oracle to -> forall on. Typeable on => on -> Answer to
    fromOracle :: forall on . Typeable on => on -> Answer to}

    {-# INLINE hitTest #-}
    hitTest :: (Data from, Data to) => from -> to -> Oracle to
    hitTest :: forall from to. (Data from, Data to) => from -> to -> Oracle to
    hitTest from
    from to
    to =
        let kto :: TypeKey
    kto = to -> TypeKey
    forall a. Typeable a => a -> TypeKey
    typeKey to
    to
        in case DataBox -> TypeKey -> Maybe Follower
    readCacheFollower (from -> DataBox
    forall a. Data a => a -> DataBox
    dataBox from
    from) TypeKey
    kto of
               Maybe Follower
    Nothing -> (forall on. Typeable on => on -> Answer to) -> Oracle to
    forall to. (forall on. Typeable on => on -> Answer to) -> Oracle to
    Oracle ((forall on. Typeable on => on -> Answer to) -> Oracle to)
    -> (forall on. Typeable on => on -> Answer to) -> Oracle to
    forall a b. (a -> b) -> a -> b
    $ \on
    on -> if on -> TypeKey
    forall a. Typeable a => a -> TypeKey
    typeKey on
    on TypeKey -> Follower
    forall a. Eq a => a -> a -> Bool
    == TypeKey
    kto then to -> Answer to
    forall a. a -> Answer a
    Hit (to -> Answer to) -> to -> Answer to
    forall a b. (a -> b) -> a -> b
    $ on -> to
    forall a b. a -> b
    unsafeCoerce on
    on else Answer to
    forall a. Answer a
    Follow
               Just Follower
    test -> (forall on. Typeable on => on -> Answer to) -> Oracle to
    forall to. (forall on. Typeable on => on -> Answer to) -> Oracle to
    Oracle ((forall on. Typeable on => on -> Answer to) -> Oracle to)
    -> (forall on. Typeable on => on -> Answer to) -> Oracle to
    forall a b. (a -> b) -> a -> b
    $ \on
    on -> let kon :: TypeKey
    kon = on -> TypeKey
    forall a. Typeable a => a -> TypeKey
    typeKey on
    on in
                       if TypeKey
    kon TypeKey -> Follower
    forall a. Eq a => a -> a -> Bool
    == TypeKey
    kto then to -> Answer to
    forall a. a -> Answer a
    Hit (to -> Answer to) -> to -> Answer to
    forall a b. (a -> b) -> a -> b
    $ on -> to
    forall a b. a -> b
    unsafeCoerce on
    on
                       else if Follower
    test TypeKey
    kon then Answer to
    forall a. Answer a
    Follow
                       else Answer to
    forall a. Answer a
    Miss

    ---------------------------------------------------------------------
    -- CACHE
    -- Store and compute the Follower and HitMap

    data Cache = Cache HitMap (TypeMap2 (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 :: IORef Cache
    cache = IO (IORef Cache) -> IORef Cache
    forall a. IO a -> a
    unsafePerformIO (IO (IORef Cache) -> IORef Cache)
    -> IO (IORef Cache) -> IORef Cache
    forall a b. (a -> b) -> a -> b
    $ Cache -> IO (IORef Cache)
    forall a. a -> IO (IORef a)
    newIORef (Cache -> IO (IORef Cache)) -> Cache -> IO (IORef Cache)
    forall a b. (a -> b) -> a -> b
    $ HashMap TypeKey TypeSet -> TypeMap2 (Maybe Follower) -> Cache
    Cache HashMap TypeKey TypeSet
    emptyHitMap TypeMap2 (Maybe Follower)
    forall k v. HashMap k v
    Map.empty

    readCacheFollower :: DataBox -> TypeKey -> Maybe Follower
    readCacheFollower :: DataBox -> TypeKey -> Maybe Follower
    readCacheFollower from :: DataBox
    from@(DataBox TypeKey
    kfrom a
    vfrom) TypeKey
    kto = IO (Maybe Follower) -> Maybe Follower
    forall a. IO a -> a
    inlinePerformIO (IO (Maybe Follower) -> Maybe Follower)
    -> IO (Maybe Follower) -> Maybe Follower
    forall a b. (a -> b) -> a -> b
    $ do
        Cache HashMap TypeKey TypeSet
    hit TypeMap2 (Maybe Follower)
    follow <- IORef Cache -> IO Cache
    forall a. IORef a -> IO a
    readIORef IORef Cache
    cache
        case TypeKey
    -> TypeKey -> TypeMap2 (Maybe Follower) -> Maybe (Maybe Follower)
    forall a. TypeKey -> TypeKey -> TypeMap2 a -> Maybe a
    lookup2 TypeKey
    kfrom TypeKey
    kto TypeMap2 (Maybe Follower)
    follow of
            Just Maybe Follower
    ans -> Maybe Follower -> IO (Maybe Follower)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Follower
    ans
            Maybe (Maybe Follower)
    Nothing -> do
                Either SomeException (HashMap TypeKey TypeSet)
    res <- IO (HashMap TypeKey TypeSet)
    -> IO (Either SomeException (HashMap TypeKey TypeSet))
    forall e a. Exception e => IO a -> IO (Either e a)
    Control.Exception.try (HashMap TypeKey TypeSet -> IO (HashMap TypeKey TypeSet)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HashMap TypeKey TypeSet -> IO (HashMap TypeKey TypeSet))
    -> HashMap TypeKey TypeSet -> IO (HashMap TypeKey TypeSet)
    forall a b. (a -> b) -> a -> b
    $! DataBox -> HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet
    insertHitMap DataBox
    from HashMap TypeKey TypeSet
    hit)
                (HashMap TypeKey TypeSet
    hit,Maybe Follower
    fol) <- (HashMap TypeKey TypeSet, Maybe Follower)
    -> IO (HashMap TypeKey TypeSet, Maybe Follower)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((HashMap TypeKey TypeSet, Maybe Follower)
     -> IO (HashMap TypeKey TypeSet, Maybe Follower))
    -> (HashMap TypeKey TypeSet, Maybe Follower)
    -> IO (HashMap TypeKey TypeSet, Maybe Follower)
    forall a b. (a -> b) -> a -> b
    $ case Either SomeException (HashMap TypeKey TypeSet)
    res of
                    Left SomeException
    _ -> (HashMap TypeKey TypeSet
    hit, Maybe Follower
    forall a. Maybe a
    Nothing)
                    Right HashMap TypeKey TypeSet
    hit -> (HashMap TypeKey TypeSet
    hit, Follower -> Maybe Follower
    forall a. a -> Maybe a
    Just (Follower -> Maybe Follower) -> Follower -> Maybe Follower
    forall a b. (a -> b) -> a -> b
    $ TypeKey -> TypeKey -> HashMap TypeKey TypeSet -> Follower
    follower TypeKey
    kfrom TypeKey
    kto HashMap TypeKey TypeSet
    hit)

                let msg :: [Char]
    msg =
                        [Char]
    "# Uniplate lookup on (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ TypeKey -> [Char]
    forall a. Show a => a -> [Char]
    show (a -> TypeKey
    forall a. Typeable a => a -> TypeKey
    typeOf a
    vfrom) [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "), from (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ TypeKey -> [Char]
    forall a. Show a => a -> [Char]
    show TypeKey
    kfrom [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "), to (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ TypeKey -> [Char]
    forall a. Show a => a -> [Char]
    show TypeKey
    kto [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    "): " [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++
                        (SomeException -> [Char])
    -> (HashMap TypeKey TypeSet -> [Char])
    -> Either SomeException (HashMap TypeKey TypeSet)
    -> [Char]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (\(SomeException
    msg::SomeException) -> [Char]
    "FAILURE (" [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ SomeException -> [Char]
    forall a. Show a => a -> [Char]
    show SomeException
    msg [Char] -> [Char] -> [Char]
    forall a. [a] -> [a] -> [a]
    ++ [Char]
    ")") ([Char] -> HashMap TypeKey TypeSet -> [Char]
    forall a b. a -> b -> a
    const [Char]
    "Success") Either SomeException (HashMap TypeKey TypeSet)
    res

                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    uniplateVerbose Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int -> (Follower -> Int) -> Maybe Follower -> Int
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe Int
    1 (Int -> Follower -> Int
    forall a b. a -> b -> a
    const Int
    0) Maybe Follower
    fol Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    2) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    putStrLn [Char]
    msg
                Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (Int
    uniplateVerbose Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    0 Bool -> Bool -> Bool
    && Maybe Follower -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe Follower
    fol) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> IO ()
    forall a. HasCallStack => [Char] -> a
    error [Char]
    msg

                IORef Cache -> (Cache -> (Cache, ())) -> IO ()
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef Cache
    cache ((Cache -> (Cache, ())) -> IO ())
    -> (Cache -> (Cache, ())) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Cache HashMap TypeKey TypeSet
    _ TypeMap2 (Maybe Follower)
    follow) -> (HashMap TypeKey TypeSet -> TypeMap2 (Maybe Follower) -> Cache
    Cache HashMap TypeKey TypeSet
    hit (TypeKey
    -> TypeKey
    -> Maybe Follower
    -> TypeMap2 (Maybe Follower)
    -> TypeMap2 (Maybe Follower)
    forall a. TypeKey -> TypeKey -> a -> TypeMap2 a -> TypeMap2 a
    insert2 TypeKey
    kfrom TypeKey
    kto Maybe Follower
    fol TypeMap2 (Maybe Follower)
    follow), ())
                Maybe Follower -> IO (Maybe Follower)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Follower
    fol

    -- from which values, what can you reach
    readCacheHitMap :: DataBox -> Maybe HitMap
    readCacheHitMap :: DataBox -> Maybe (HashMap TypeKey TypeSet)
    readCacheHitMap from :: DataBox
    from@(DataBox TypeKey
    kfrom a
    vfrom) = IO (Maybe (HashMap TypeKey TypeSet))
    -> Maybe (HashMap TypeKey TypeSet)
    forall a. IO a -> a
    inlinePerformIO (IO (Maybe (HashMap TypeKey TypeSet))
     -> Maybe (HashMap TypeKey TypeSet))
    -> IO (Maybe (HashMap TypeKey TypeSet))
    -> Maybe (HashMap TypeKey TypeSet)
    forall a b. (a -> b) -> a -> b
    $ do
        Cache HashMap TypeKey TypeSet
    hit TypeMap2 (Maybe Follower)
    _ <- IORef Cache -> IO Cache
    forall a. IORef a -> IO a
    readIORef IORef Cache
    cache
        case TypeKey -> HashMap TypeKey TypeSet -> Maybe TypeSet
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    Map.lookup TypeKey
    kfrom HashMap TypeKey TypeSet
    hit of
            Just TypeSet
    _ -> Maybe (HashMap TypeKey TypeSet)
    -> IO (Maybe (HashMap TypeKey TypeSet))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (HashMap TypeKey TypeSet)
     -> IO (Maybe (HashMap TypeKey TypeSet)))
    -> Maybe (HashMap TypeKey TypeSet)
    -> IO (Maybe (HashMap TypeKey TypeSet))
    forall a b. (a -> b) -> a -> b
    $ HashMap TypeKey TypeSet -> Maybe (HashMap TypeKey TypeSet)
    forall a. a -> Maybe a
    Just HashMap TypeKey TypeSet
    hit
            Maybe TypeSet
    Nothing -> do
                Maybe (HashMap TypeKey TypeSet)
    res <- IO (Maybe (HashMap TypeKey TypeSet))
    -> (SomeException -> IO (Maybe (HashMap TypeKey TypeSet)))
    -> IO (Maybe (HashMap TypeKey TypeSet))
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    Control.Exception.catch (Maybe (HashMap TypeKey TypeSet)
    -> IO (Maybe (HashMap TypeKey TypeSet))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (HashMap TypeKey TypeSet)
     -> IO (Maybe (HashMap TypeKey TypeSet)))
    -> Maybe (HashMap TypeKey TypeSet)
    -> IO (Maybe (HashMap TypeKey TypeSet))
    forall a b. (a -> b) -> a -> b
    $! HashMap TypeKey TypeSet -> Maybe (HashMap TypeKey TypeSet)
    forall a. a -> Maybe a
    Just (HashMap TypeKey TypeSet -> Maybe (HashMap TypeKey TypeSet))
    -> HashMap TypeKey TypeSet -> Maybe (HashMap TypeKey TypeSet)
    forall a b. (a -> b) -> a -> b
    $! DataBox -> HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet
    insertHitMap DataBox
    from HashMap TypeKey TypeSet
    hit) (\(SomeException
    _ :: SomeException) -> Maybe (HashMap TypeKey TypeSet)
    -> IO (Maybe (HashMap TypeKey TypeSet))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (HashMap TypeKey TypeSet)
    forall a. Maybe a
    Nothing)
                case Maybe (HashMap TypeKey TypeSet)
    res of
                    Maybe (HashMap TypeKey TypeSet)
    Nothing -> Maybe (HashMap TypeKey TypeSet)
    -> IO (Maybe (HashMap TypeKey TypeSet))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (HashMap TypeKey TypeSet)
    forall a. Maybe a
    Nothing
                    Just HashMap TypeKey TypeSet
    hit -> do
                        IORef Cache -> (Cache -> (Cache, ())) -> IO ()
    forall a b. IORef a -> (a -> (a, b)) -> IO b
    atomicModifyIORef IORef Cache
    cache ((Cache -> (Cache, ())) -> IO ())
    -> (Cache -> (Cache, ())) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \(Cache HashMap TypeKey TypeSet
    _ TypeMap2 (Maybe Follower)
    follow) -> (HashMap TypeKey TypeSet -> TypeMap2 (Maybe Follower) -> Cache
    Cache HashMap TypeKey TypeSet
    hit TypeMap2 (Maybe Follower)
    follow, ())
                        Maybe (HashMap TypeKey TypeSet)
    -> IO (Maybe (HashMap TypeKey TypeSet))
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (HashMap TypeKey TypeSet)
     -> IO (Maybe (HashMap TypeKey TypeSet)))
    -> Maybe (HashMap TypeKey TypeSet)
    -> IO (Maybe (HashMap TypeKey TypeSet))
    forall a b. (a -> b) -> a -> b
    $ HashMap TypeKey TypeSet -> Maybe (HashMap TypeKey TypeSet)
    forall a. a -> Maybe a
    Just HashMap TypeKey TypeSet
    hit

    ---------------------------------------------------------------------
    -- TYPEMAP2/INTMAP2

    type TypeMap2 a = TypeMap (TypeMap a)

    lookup2 :: TypeKey -> TypeKey -> TypeMap2 a -> Maybe a
    lookup2 :: forall a. TypeKey -> TypeKey -> TypeMap2 a -> Maybe a
    lookup2 TypeKey
    x TypeKey
    y TypeMap2 a
    mp = TypeKey -> TypeMap2 a -> Maybe (TypeMap a)
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    Map.lookup TypeKey
    x TypeMap2 a
    mp Maybe (TypeMap a) -> (TypeMap a -> Maybe a) -> Maybe a
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= TypeKey -> TypeMap a -> Maybe a
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    Map.lookup TypeKey
    y

    insert2 :: TypeKey -> TypeKey -> a -> TypeMap2 a -> TypeMap2 a
    insert2 :: forall a. TypeKey -> TypeKey -> a -> TypeMap2 a -> TypeMap2 a
    insert2 TypeKey
    x TypeKey
    y a
    v TypeMap2 a
    mp = (TypeMap a -> TypeMap a -> TypeMap a)
    -> TypeKey -> TypeMap a -> TypeMap2 a -> TypeMap2 a
    forall k v.
    (Eq k, Hashable k) =>
    (v -> v -> v) -> k -> v -> HashMap k v -> HashMap k v
    Map.insertWith ((TypeMap a -> TypeMap a) -> TypeMap a -> TypeMap a -> TypeMap a
    forall a b. a -> b -> a
    const ((TypeMap a -> TypeMap a) -> TypeMap a -> TypeMap a -> TypeMap a)
    -> (TypeMap a -> TypeMap a) -> TypeMap a -> TypeMap a -> TypeMap a
    forall a b. (a -> b) -> a -> b
    $ TypeKey -> a -> TypeMap a -> TypeMap a
    forall k v.
    (Eq k, Hashable k) =>
    k -> v -> HashMap k v -> HashMap k v
    Map.insert TypeKey
    y a
    v) TypeKey
    x (TypeKey -> a -> TypeMap a
    forall k v. Hashable k => k -> v -> HashMap k v
    Map.singleton TypeKey
    y a
    v) TypeMap2 a
    mp

    type IntMap2 a = IntMap (IntMap a)

    intLookup2 :: Int -> Int -> IntMap2 a -> Maybe a
    intLookup2 :: forall a. Int -> Int -> IntMap2 a -> Maybe a
    intLookup2 Int
    x Int
    y IntMap2 a
    mp = Int -> IntMap2 a -> Maybe (IntMap a)
    forall a. Int -> IntMap a -> Maybe a
    IntMap.lookup Int
    x IntMap2 a
    mp Maybe (IntMap a) -> (IntMap a -> Maybe a) -> Maybe a
    forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Int -> IntMap a -> Maybe a
    forall a. Int -> IntMap a -> Maybe a
    IntMap.lookup Int
    y

    intInsert2 :: Int -> Int -> a -> IntMap2 a -> IntMap2 a
    intInsert2 :: forall a. Int -> Int -> a -> IntMap2 a -> IntMap2 a
    intInsert2 Int
    x Int
    y a
    v IntMap2 a
    mp = (IntMap a -> IntMap a -> IntMap a)
    -> Int -> IntMap a -> IntMap2 a -> IntMap2 a
    forall a. (a -> a -> a) -> Int -> a -> IntMap a -> IntMap a
    IntMap.insertWith ((IntMap a -> IntMap a) -> IntMap a -> IntMap a -> IntMap a
    forall a b. a -> b -> a
    const ((IntMap a -> IntMap a) -> IntMap a -> IntMap a -> IntMap a)
    -> (IntMap a -> IntMap a) -> IntMap a -> IntMap a -> IntMap a
    forall a b. (a -> b) -> a -> b
    $ Int -> a -> IntMap a -> IntMap a
    forall a. Int -> a -> IntMap a -> IntMap a
    IntMap.insert Int
    y a
    v) Int
    x (Int -> a -> IntMap a
    forall a. Int -> a -> IntMap a
    IntMap.singleton Int
    y a
    v) IntMap2 a
    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 :: TypeKey -> TypeKey -> HashMap TypeKey TypeSet -> Follower
    follower TypeKey
    from TypeKey
    to HashMap TypeKey TypeSet
    mp
        | TypeSet -> Bool
    forall a. HashSet a -> Bool
    Set.null TypeSet
    hit = Bool -> Follower
    forall a b. a -> b -> a
    const Bool
    False
        | TypeSet -> Bool
    forall a. HashSet a -> Bool
    Set.null TypeSet
    miss = Bool -> Follower
    forall a b. a -> b -> a
    const Bool
    True
        | TypeSet -> Int
    forall a. HashSet a -> Int
    Set.size TypeSet
    hit Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < TypeSet -> Int
    forall a. HashSet a -> Int
    Set.size TypeSet
    miss = \TypeKey
    k -> TypeKey
    k TypeKey -> TypeSet -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    `Set.member` TypeSet
    hit
        | Bool
    otherwise = \TypeKey
    k -> Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ TypeKey
    k TypeKey -> TypeSet -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    `Set.member` TypeSet
    miss
        where
            (TypeSet
    hit,TypeSet
    miss) = Follower -> TypeSet -> (TypeSet, TypeSet)
    forall {a}. (a -> Bool) -> HashSet a -> (HashSet a, HashSet a)
    set_partition (\TypeKey
    x -> TypeKey
    to TypeKey -> TypeSet -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    `Set.member` TypeKey -> TypeSet
    grab TypeKey
    x) (TypeKey -> TypeSet -> TypeSet
    forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
    Set.insert TypeKey
    from (TypeSet -> TypeSet) -> TypeSet -> TypeSet
    forall a b. (a -> b) -> a -> b
    $ TypeKey -> TypeSet
    grab TypeKey
    from)
            grab :: TypeKey -> TypeSet
    grab TypeKey
    x = TypeSet -> TypeKey -> HashMap TypeKey TypeSet -> TypeSet
    forall {k} {a}. Hashable k => a -> k -> HashMap k a -> a
    map_findWithDefault ([Char] -> TypeSet
    forall a. HasCallStack => [Char] -> a
    error [Char]
    "couldn't grab in follower") TypeKey
    x HashMap TypeKey TypeSet
    mp

    ---------------------------------------------------------------------
    -- DATA/TYPEABLE OPERATIONS

    -- | An existential box representing a type which supports SYB
    -- operations.
    data DataBox = forall a . (Data a) => DataBox {DataBox -> TypeKey
    dataBoxKey :: TypeKey, ()
    dataBoxVal :: a}

    dataBox :: Data a => a -> DataBox
    dataBox :: forall a. Data a => a -> DataBox
    dataBox a
    x = TypeKey -> a -> DataBox
    forall a. Data a => TypeKey -> a -> DataBox
    DataBox (a -> TypeKey
    forall a. Typeable a => a -> TypeKey
    typeKey a
    x) a
    x

    -- NOTE: This function is partial, but all exceptions are caught later on
    sybChildren :: Data a => a -> [DataBox]
    sybChildren :: forall a. Data a => a -> [DataBox]
    sybChildren a
    x
        | DataType -> Bool
    isAlgType DataType
    dtyp = (Constr -> [DataBox]) -> [Constr] -> [DataBox]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap Constr -> [DataBox]
    f [Constr]
    ctrs
        | DataType -> Bool
    isNorepType DataType
    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
        | Bool
    otherwise = []
        where
            f :: Constr -> [DataBox]
    f Constr
    ctr = (forall a. Data a => a -> DataBox) -> a -> [DataBox]
    forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
    forall u. (forall d. Data d => d -> u) -> a -> [u]
    gmapQ d -> DataBox
    forall a. Data a => a -> DataBox
    dataBox (a -> a -> a
    forall a. a -> a -> a
    asTypeOf (Constr -> a
    forall a. Data a => Constr -> a
    fromConstr Constr
    ctr) a
    x)
            ctrs :: [Constr]
    ctrs = DataType -> [Constr]
    dataTypeConstrs DataType
    dtyp
            dtyp :: DataType
    dtyp = a -> DataType
    forall a. Data a => a -> DataType
    dataTypeOf a
    x

    ---------------------------------------------------------------------
    -- HITMAP
    -- What is the transitive closure of a type key

    type HitMap = TypeMap TypeSet

    emptyHitMap :: HitMap
    emptyHitMap :: HashMap TypeKey TypeSet
    emptyHitMap = [(TypeKey, TypeSet)] -> HashMap TypeKey TypeSet
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    Map.fromList
            [(TypeKey
    tRational, TypeKey -> TypeSet
    forall a. Hashable a => a -> HashSet a
    Set.singleton TypeKey
    tInteger)
            ,(TypeKey
    tInteger, TypeSet
    forall a. HashSet a
    Set.empty)]
        where tRational :: TypeKey
    tRational = Rational -> TypeKey
    forall a. Typeable a => a -> TypeKey
    typeKey (Rational
    forall a. HasCallStack => a
    undefined :: Rational)
              tInteger :: TypeKey
    tInteger = Integer -> TypeKey
    forall a. Typeable a => a -> TypeKey
    typeKey (Integer
    0 :: Integer)

    insertHitMap :: DataBox -> HitMap -> HitMap
    insertHitMap :: DataBox -> HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet
    insertHitMap DataBox
    box HashMap TypeKey TypeSet
    hit = (HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet)
    -> HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet
    forall a. Eq a => (a -> a) -> a -> a
    fixEq HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet
    trans (DataBox -> HashMap TypeKey TypeSet
    populate DataBox
    box) HashMap TypeKey TypeSet
    -> HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet
    forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
    `Map.union` HashMap TypeKey TypeSet
    hit
        where
            -- create a fresh box with all the necessary children that aren't in hit
            populate :: DataBox -> HitMap
            populate :: DataBox -> HashMap TypeKey TypeSet
    populate DataBox
    x = DataBox -> HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet
    f DataBox
    x HashMap TypeKey TypeSet
    forall k v. HashMap k v
    Map.empty
                where
                    f :: DataBox -> HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet
    f (DataBox TypeKey
    key a
    val) HashMap TypeKey TypeSet
    mp
                        | TypeKey
    key TypeKey -> HashMap TypeKey TypeSet -> Bool
    forall {k} {a}. Hashable k => k -> HashMap k a -> Bool
    `map_member` HashMap TypeKey TypeSet
    hit Bool -> Bool -> Bool
    || TypeKey
    key TypeKey -> HashMap TypeKey TypeSet -> Bool
    forall {k} {a}. Hashable k => k -> HashMap k a -> Bool
    `map_member` HashMap TypeKey TypeSet
    mp = HashMap TypeKey TypeSet
    mp
                        | Bool
    otherwise = [DataBox] -> HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet
    fs [DataBox]
    cs (HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet)
    -> HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet
    forall a b. (a -> b) -> a -> b
    $ TypeKey
    -> TypeSet -> HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet
    forall k v.
    (Eq k, Hashable k) =>
    k -> v -> HashMap k v -> HashMap k v
    Map.insert TypeKey
    key ([TypeKey] -> TypeSet
    forall a. (Eq a, Hashable a) => [a] -> HashSet a
    Set.fromList ([TypeKey] -> TypeSet) -> [TypeKey] -> TypeSet
    forall a b. (a -> b) -> a -> b
    $ (DataBox -> TypeKey) -> [DataBox] -> [TypeKey]
    forall a b. (a -> b) -> [a] -> [b]
    map DataBox -> TypeKey
    dataBoxKey [DataBox]
    cs) HashMap TypeKey TypeSet
    mp
                            where cs :: [DataBox]
    cs = a -> [DataBox]
    forall a. Data a => a -> [DataBox]
    sybChildren a
    val

                    fs :: [DataBox] -> HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet
    fs [] HashMap TypeKey TypeSet
    mp = HashMap TypeKey TypeSet
    mp
                    fs (DataBox
    x:[DataBox]
    xs) HashMap TypeKey TypeSet
    mp = [DataBox] -> HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet
    fs [DataBox]
    xs (DataBox -> HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet
    f DataBox
    x HashMap TypeKey TypeSet
    mp)

            -- update every one to be the transitive closure
            trans :: HitMap -> HitMap
            trans :: HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet
    trans HashMap TypeKey TypeSet
    mp = (TypeSet -> TypeSet)
    -> HashMap TypeKey TypeSet -> HashMap TypeKey TypeSet
    forall v1 v2 k. (v1 -> v2) -> HashMap k v1 -> HashMap k v2
    Map.map TypeSet -> TypeSet
    f HashMap TypeKey TypeSet
    mp
                where
                    f :: TypeSet -> TypeSet
    f TypeSet
    x = [TypeSet] -> TypeSet
    set_unions ([TypeSet] -> TypeSet) -> [TypeSet] -> TypeSet
    forall a b. (a -> b) -> a -> b
    $ TypeSet
    x TypeSet -> [TypeSet] -> [TypeSet]
    forall a. a -> [a] -> [a]
    : (TypeKey -> TypeSet) -> [TypeKey] -> [TypeSet]
    forall a b. (a -> b) -> [a] -> [b]
    map TypeKey -> TypeSet
    g (TypeSet -> [TypeKey]
    forall a. HashSet a -> [a]
    Set.toList TypeSet
    x)
                    g :: TypeKey -> TypeSet
    g TypeKey
    x = TypeSet -> TypeKey -> HashMap TypeKey TypeSet -> TypeSet
    forall {k} {a}. Hashable k => a -> k -> HashMap k a -> a
    map_findWithDefault (HashMap TypeKey TypeSet
    hit HashMap TypeKey TypeSet -> TypeKey -> TypeSet
    forall {k} {a}. Hashable k => HashMap k a -> k -> a
    ! TypeKey
    x) TypeKey
    x HashMap TypeKey TypeSet
    mp

    fixEq :: Eq a => (a -> a) -> a -> a
    fixEq :: forall a. Eq a => (a -> a) -> a -> a
    fixEq a -> a
    f a
    x = if a
    x a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    == a
    x2 then a
    x2 else (a -> a) -> a -> a
    forall a. Eq a => (a -> a) -> a -> a
    fixEq a -> a
    f a
    x2
        where x2 :: a
    x2 = a -> a
    f a
    x

    ---------------------------------------------------------------------
    -- INSTANCE FUNCTIONS

    newtype C x a = C {forall x a. C x a -> CC x a
    fromC :: CC x a}

    type CC x a = (Str x, Str x -> a)

    biplateData :: (Data on, Data with) => (forall a . Typeable a => a -> Answer with) -> on -> CC with on
    biplateData :: forall on with.
    (Data on, Data with) =>
    (forall a. Typeable a => a -> Answer with) -> on -> CC with on
    biplateData forall a. Typeable a => a -> Answer with
    oracle on
    x = case on -> Answer with
    forall a. Typeable a => a -> Answer with
    oracle on
    x of
        Hit with
    y -> (with -> Str with
    forall a. a -> Str a
    One with
    y, \(One with
    x) -> with -> on
    forall a b. a -> b
    unsafeCoerce with
    x)
        Answer with
    Follow -> (forall a. Typeable a => a -> Answer with) -> on -> CC with on
    forall on with.
    (Data on, Data with) =>
    (forall a. Typeable a => a -> Answer with) -> on -> CC with on
    uniplateData a -> Answer with
    forall a. Typeable a => a -> Answer with
    oracle on
    x
        Answer with
    Miss -> (Str with
    forall a. Str a
    Zero, \Str with
    _ -> on
    x)

    uniplateData :: forall on with . (Data on, Data with) => (forall a . Typeable a => a -> Answer with) -> on -> CC with on
    uniplateData :: forall on with.
    (Data on, Data with) =>
    (forall a. Typeable a => a -> Answer with) -> on -> CC with on
    uniplateData forall a. Typeable a => a -> Answer with
    oracle on
    item = C with on -> CC with on
    forall x a. C x a -> CC x a
    fromC (C with on -> CC with on) -> C with on -> CC with on
    forall a b. (a -> b) -> a -> b
    $ (forall d b. Data d => C with (d -> b) -> d -> C with b)
    -> (forall g. g -> C with g) -> on -> C with on
    forall a (c :: * -> *).
    Data a =>
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> on -> c on
    gfoldl C with (d -> b) -> d -> C with b
    forall d b. Data d => C with (d -> b) -> d -> C with b
    combine g -> C with g
    forall g. g -> C with g
    create on
    item
        where
            combine :: Data a => C with (a -> b) -> a -> C with b
            combine :: forall d b. Data d => C with (d -> b) -> d -> C with b
    combine (C (Str with
    c,Str with -> a -> b
    g)) a
    x = case (forall a. Typeable a => a -> Answer with) -> a -> CC with a
    forall on with.
    (Data on, Data with) =>
    (forall a. Typeable a => a -> Answer with) -> on -> CC with on
    biplateData a -> Answer with
    forall a. Typeable a => a -> Answer with
    oracle a
    x of
                                      (Str with
    c2, Str with -> a
    g2) -> CC with b -> C with b
    forall x a. CC x a -> C x a
    C (Str with -> Str with -> Str with
    forall a. Str a -> Str a -> Str a
    Two Str with
    c Str with
    c2, \(Two Str with
    c' Str with
    c2') -> Str with -> a -> b
    g Str with
    c' (Str with -> a
    g2 Str with
    c2'))

            create :: g -> C with g
            create :: forall g. g -> C with g
    create g
    x = CC with g -> C with g
    forall x a. CC x a -> C x a
    C (Str with
    forall a. Str a
    Zero, \Str with
    _ -> g
    x)

    descendData :: Data on => (forall a . Typeable a => a -> Answer on) -> (on -> on) -> on -> on
    descendData :: forall on.
    Data on =>
    (forall a. Typeable a => a -> Answer on) -> (on -> on) -> on -> on
    descendData forall a. Typeable a => a -> Answer on
    oracle on -> on
    op = (forall b. Data b => b -> b) -> on -> on
    forall a. Data a => (forall b. Data b => b -> b) -> a -> a
    gmapT ((forall a. Typeable a => a -> Answer on) -> (on -> on) -> b -> b
    forall on with.
    (Data on, Data with) =>
    (forall a. Typeable a => a -> Answer with)
    -> (with -> with) -> on -> on
    descendBiData a -> Answer on
    forall a. Typeable a => a -> Answer on
    oracle on -> on
    op)

    descendBiData :: (Data on, Data with) => (forall a . Typeable a => a -> Answer with) -> (with -> with) -> on -> on
    descendBiData :: forall on with.
    (Data on, Data with) =>
    (forall a. Typeable a => a -> Answer with)
    -> (with -> with) -> on -> on
    descendBiData forall a. Typeable a => a -> Answer with
    oracle with -> with
    op on
    x = case on -> Answer with
    forall a. Typeable a => a -> Answer with
    oracle on
    x of
        Hit with
    y -> with -> on
    forall a b. a -> b
    unsafeCoerce (with -> on) -> with -> on
    forall a b. (a -> b) -> a -> b
    $ with -> with
    op with
    y
        Answer with
    Follow -> (forall b. Data b => b -> b) -> on -> on
    forall a. Data a => (forall b. Data b => b -> b) -> a -> a
    gmapT ((forall a. Typeable a => a -> Answer with)
    -> (with -> with) -> b -> b
    forall on with.
    (Data on, Data with) =>
    (forall a. Typeable a => a -> Answer with)
    -> (with -> with) -> on -> on
    descendBiData a -> Answer with
    forall a. Typeable a => a -> Answer with
    oracle with -> with
    op) on
    x
        Answer with
    Miss -> on
    x

    descendDataM :: (Data on, Applicative m) => (forall a . Typeable a => a -> Answer on) -> (on -> m on) -> on -> m on
    descendDataM :: forall on (m :: * -> *).
    (Data on, Applicative m) =>
    (forall a. Typeable a => a -> Answer on)
    -> (on -> m on) -> on -> m on
    descendDataM forall a. Typeable a => a -> Answer on
    oracle on -> m on
    op = (forall d. Data d => d -> m d) -> on -> m on
    forall (m :: * -> *) a.
    (Data a, Applicative m) =>
    (forall d. Data d => d -> m d) -> a -> m a
    gmapA ((forall a. Typeable a => a -> Answer on)
    -> (on -> m on) -> d -> m d
    forall on with (m :: * -> *).
    (Data on, Data with, Applicative m) =>
    (forall a. Typeable a => a -> Answer with)
    -> (with -> m with) -> on -> m on
    descendBiDataM a -> Answer on
    forall a. Typeable a => a -> Answer on
    oracle on -> m on
    op)

    descendBiDataM :: (Data on, Data with, Applicative m) => (forall a . Typeable a => a -> Answer with) -> (with -> m with) -> on -> m on
    descendBiDataM :: forall on with (m :: * -> *).
    (Data on, Data with, Applicative m) =>
    (forall a. Typeable a => a -> Answer with)
    -> (with -> m with) -> on -> m on
    descendBiDataM forall a. Typeable a => a -> Answer with
    oracle with -> m with
    op on
    x = case on -> Answer with
    forall a. Typeable a => a -> Answer with
    oracle on
    x of
        Hit with
    y -> m with -> m on
    forall a b. a -> b
    unsafeCoerce (m with -> m on) -> m with -> m on
    forall a b. (a -> b) -> a -> b
    $ with -> m with
    op with
    y
        Answer with
    Follow -> (forall d. Data d => d -> m d) -> on -> m on
    forall (m :: * -> *) a.
    (Data a, Applicative m) =>
    (forall d. Data d => d -> m d) -> a -> m a
    gmapA ((forall a. Typeable a => a -> Answer with)
    -> (with -> m with) -> d -> m d
    forall on with (m :: * -> *).
    (Data on, Data with, Applicative m) =>
    (forall a. Typeable a => a -> Answer with)
    -> (with -> m with) -> on -> m on
    descendBiDataM a -> Answer with
    forall a. Typeable a => a -> Answer with
    oracle with -> m with
    op) on
    x
        Answer with
    Miss -> on -> m on
    forall a. a -> m a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure on
    x

    gmapA :: forall m a. (Data a, Applicative m) => (forall d. Data d => d -> m d) -> a -> m a
    gmapA :: forall (m :: * -> *) a.
    (Data a, Applicative m) =>
    (forall d. Data d => d -> m d) -> a -> m a
    gmapA forall d. Data d => d -> m d
    f = (forall d b. Data d => m (d -> b) -> d -> m b)
    -> (forall g. g -> m g) -> a -> m a
    forall a (c :: * -> *).
    Data a =>
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a
    forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a
    gfoldl m (d -> b) -> d -> m b
    forall d b. Data d => m (d -> b) -> d -> m b
    k g -> m g
    forall g. g -> m g
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure
        where k :: Data d => m (d -> b) -> d -> m b
              k :: forall d b. Data d => m (d -> b) -> d -> m b
    k m (d -> b)
    c d
    x = m (d -> b)
    c m (d -> b) -> m d -> m b
    forall a b. m (a -> b) -> m a -> m b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> d -> m d
    forall d. Data d => d -> m d
    f d
    x

    ---------------------------------------------------------------------
    -- FUSION

    data Transformer = forall a . Data a => Transformer TypeKey (a -> a)

    -- | Wrap up a @(a -> a)@ transformation function, to use with 'transformBis'
    transformer :: Data a => (a -> a) -> Transformer
    transformer :: forall a. Data a => (a -> a) -> Transformer
    transformer = (a -> a) -> Transformer
    forall a. Data a => (a -> a) -> Transformer
    transformer_

    -- Don't export directly, as don't want Haddock to see the forall
    transformer_ :: forall a . Data a => (a -> a) -> Transformer
    transformer_ :: forall a. Data a => (a -> a) -> Transformer
    transformer_ = TypeKey -> (a -> a) -> Transformer
    forall a. Data a => TypeKey -> (a -> a) -> Transformer
    Transformer (a -> TypeKey
    forall a. Typeable a => a -> TypeKey
    typeKey (a
    forall a. HasCallStack => a
    undefined :: a))

    -- | Apply a sequence of transformations in order. This function obeys the equivalence:
    --
    -- > transformBis [[transformer f],[transformer g],...] == transformBi f . transformBi g . ...
    --
    --   Each item of type @[Transformer]@ is applied in turn, right to left. Within each
    --   @[Transformer]@, the individual @Transformer@ values may be interleaved.
    --
    --   The implementation will attempt to perform fusion, and avoid walking any part of the
    --   data structure more than necessary. To further improve performance, you may wish to
    --   partially apply the first argument, which will calculate information about the relationship
    --   between the transformations.
    transformBis :: forall a . Data a => [[Transformer]] -> a -> a
    transformBis :: forall a. Data a => [[Transformer]] -> a -> a
    transformBis = [[Transformer]] -> a -> a
    forall a. Data a => [[Transformer]] -> a -> a
    transformBis_

    transformBis_ :: forall a . Data a => [[Transformer]] -> a -> a

    -- basic algorithm:
    -- as you go down, given transformBis [fN..f1]
    --   if x is not in the set reachable by fN..f1, return x
    --   if x is in the reachable set, gmap (transformBis [fN..f1]) x
    --   if x is one of fN..f1, pick the lowest fi then
    --      transformBis [fN..f(i+1)] $ fi $ gmap (transformBis [fi..f1]) x

    transformBis_ :: forall a. Data a => [[Transformer]] -> a -> a
    transformBis_ [[Transformer]]
    ts | Maybe (HashMap TypeKey TypeSet) -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe (HashMap TypeKey TypeSet)
    hitBoxM = TypeMap (Maybe Transformer) -> a -> a
    forall b. Data b => TypeMap (Maybe Transformer) -> b -> b
    op (Int -> Int -> TypeMap (Maybe Transformer)
    sliceMe Int
    1 Int
    n)
        where
            on :: DataBox
    on = a -> DataBox
    forall a. Data a => a -> DataBox
    dataBox (a
    forall a. HasCallStack => a
    undefined :: a)
            hitBoxM :: Maybe (HashMap TypeKey TypeSet)
    hitBoxM = DataBox -> Maybe (HashMap TypeKey TypeSet)
    readCacheHitMap DataBox
    on
            hitBox :: HashMap TypeKey TypeSet
    hitBox = Maybe (HashMap TypeKey TypeSet) -> HashMap TypeKey TypeSet
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe (HashMap TypeKey TypeSet)
    hitBoxM
            univ :: [TypeKey]
    univ = TypeSet -> [TypeKey]
    forall a. HashSet a -> [a]
    set_toAscList (TypeSet -> [TypeKey]) -> TypeSet -> [TypeKey]
    forall a b. (a -> b) -> a -> b
    $ TypeKey -> TypeSet -> TypeSet
    forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
    Set.insert (DataBox -> TypeKey
    dataBoxKey DataBox
    on) (TypeSet -> TypeSet) -> TypeSet -> TypeSet
    forall a b. (a -> b) -> a -> b
    $ HashMap TypeKey TypeSet
    hitBox HashMap TypeKey TypeSet -> TypeKey -> TypeSet
    forall {k} {a}. Hashable k => HashMap k a -> k -> a
    ! DataBox -> TypeKey
    dataBoxKey DataBox
    on
            n :: Int
    n = [[Transformer]] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [[Transformer]]
    ts

            -- (a,b), where a < b, and both in range 1..n
            sliceMe :: Int -> Int -> TypeMap (Maybe Transformer)
    sliceMe Int
    i Int
    j = TypeMap (Maybe Transformer)
    -> Maybe (TypeMap (Maybe Transformer))
    -> TypeMap (Maybe Transformer)
    forall a. a -> Maybe a -> a
    fromMaybe TypeMap (Maybe Transformer)
    forall k v. HashMap k v
    Map.empty (Maybe (TypeMap (Maybe Transformer))
     -> TypeMap (Maybe Transformer))
    -> Maybe (TypeMap (Maybe Transformer))
    -> TypeMap (Maybe Transformer)
    forall a b. (a -> b) -> a -> b
    $ Int
    -> Int
    -> IntMap2 (TypeMap (Maybe Transformer))
    -> Maybe (TypeMap (Maybe Transformer))
    forall a. Int -> Int -> IntMap2 a -> Maybe a
    intLookup2 Int
    i Int
    j IntMap2 (TypeMap (Maybe Transformer))
    slices
            slices :: IntMap2 (TypeMap (Maybe Transformer))
            slices :: IntMap2 (TypeMap (Maybe Transformer))
    slices = [(Int, IntMap (TypeMap (Maybe Transformer)))]
    -> IntMap2 (TypeMap (Maybe Transformer))
    forall a. [(Int, a)] -> IntMap a
    IntMap.fromAscList
                [ (Int
    i, [(Int, TypeMap (Maybe Transformer))]
    -> IntMap (TypeMap (Maybe Transformer))
    forall a. [(Int, a)] -> IntMap a
    IntMap.fromAscList [(Int
    j, Int -> Int -> [[Transformer]] -> TypeMap (Maybe Transformer)
    slice Int
    i Int
    j [[Transformer]]
    ts) | (Int
    j,[[Transformer]]
    ts) <- [Int] -> [[[Transformer]]] -> [(Int, [[Transformer]])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    i..Int
    n] ([[[Transformer]]] -> [[[Transformer]]]
    forall a. HasCallStack => [a] -> [a]
    tail ([[[Transformer]]] -> [[[Transformer]]])
    -> [[[Transformer]]] -> [[[Transformer]]]
    forall a b. (a -> b) -> a -> b
    $ [[Transformer]] -> [[[Transformer]]]
    forall a. [a] -> [[a]]
    inits [[Transformer]]
    ts)])
                | (Int
    i,[[Transformer]]
    ts) <- [Int] -> [[[Transformer]]] -> [(Int, [[Transformer]])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    1..Int
    n] ([[Transformer]] -> [[[Transformer]]]
    forall a. [a] -> [[a]]
    tails ([[Transformer]] -> [[[Transformer]]])
    -> [[Transformer]] -> [[[Transformer]]]
    forall a b. (a -> b) -> a -> b
    $ [[Transformer]] -> [[Transformer]]
    forall a. [a] -> [a]
    reverse [[Transformer]]
    ts)]

            slice :: Int -> Int -> [[Transformer]] -> TypeMap (Maybe Transformer)
            slice :: Int -> Int -> [[Transformer]] -> TypeMap (Maybe Transformer)
    slice Int
    from Int
    to [[Transformer]]
    tts = TypeMap (Maybe Transformer)
    self
                where
                    self :: TypeMap (Maybe Transformer)
    self = TypeMap (Maybe Transformer)
    -> [(Int, [Transformer])] -> TypeMap (Maybe Transformer)
    f TypeMap (Maybe Transformer)
    forall k v. HashMap k v
    Map.empty ([Int] -> [[Transformer]] -> [(Int, [Transformer])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    from..] [[Transformer]]
    tts) -- FIXME: flattening out here gives different results...
                    f :: TypeMap (Maybe Transformer)
    -> [(Int, [Transformer])] -> TypeMap (Maybe Transformer)
    f TypeMap (Maybe Transformer)
    a ((Int
    i,[Transformer TypeKey
    tk a -> a
    tr]):[(Int, [Transformer])]
    ts)
                        | TypeKey
    tk TypeKey -> TypeMap (Maybe Transformer) -> Bool
    forall {k} {a}. Hashable k => k -> HashMap k a -> Bool
    `map_member` TypeMap (Maybe Transformer)
    a = TypeMap (Maybe Transformer)
    -> [(Int, [Transformer])] -> TypeMap (Maybe Transformer)
    f TypeMap (Maybe Transformer)
    a [(Int, [Transformer])]
    ts
                        | Bool
    otherwise = TypeMap (Maybe Transformer)
    -> [(Int, [Transformer])] -> TypeMap (Maybe Transformer)
    f (TypeKey
    -> Maybe Transformer
    -> TypeMap (Maybe Transformer)
    -> TypeMap (Maybe Transformer)
    forall k v.
    (Eq k, Hashable k) =>
    k -> v -> HashMap k v -> HashMap k v
    Map.insert TypeKey
    tk Maybe Transformer
    t TypeMap (Maybe Transformer)
    a) [(Int, [Transformer])]
    ts
                        where
                            t :: Maybe Transformer
    t = Transformer -> Maybe Transformer
    forall a. a -> Maybe a
    Just (Transformer -> Maybe Transformer)
    -> Transformer -> Maybe Transformer
    forall a b. (a -> b) -> a -> b
    $ TypeKey -> (a -> a) -> Transformer
    forall a. Data a => TypeKey -> (a -> a) -> Transformer
    Transformer TypeKey
    tk ((a -> a) -> Transformer) -> (a -> a) -> Transformer
    forall a b. (a -> b) -> a -> b
    $ TypeMap (Maybe Transformer) -> a -> a
    forall b. Data b => TypeMap (Maybe Transformer) -> b -> b
    op (Int -> Int -> TypeMap (Maybe Transformer)
    sliceMe (Int
    iInt -> Int -> Int
    forall a. Num a => a -> a -> a
    +Int
    1) Int
    to) (a -> a) -> (a -> a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> a
    tr (a -> a) -> (a -> a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (forall b. Data b => b -> b) -> a -> a
    forall a. Data a => (forall b. Data b => b -> b) -> a -> a
    gmapT (TypeMap (Maybe Transformer) -> b -> b
    forall b. Data b => TypeMap (Maybe Transformer) -> b -> b
    op (TypeMap (Maybe Transformer) -> b -> b)
    -> TypeMap (Maybe Transformer) -> b -> b
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> TypeMap (Maybe Transformer)
    sliceMe Int
    from Int
    i)

                    f TypeMap (Maybe Transformer)
    a [] = TypeMap (Maybe Transformer)
    a TypeMap (Maybe Transformer)
    -> TypeMap (Maybe Transformer) -> TypeMap (Maybe Transformer)
    forall k v. Eq k => HashMap k v -> HashMap k v -> HashMap k v
    `Map.union` [(TypeKey, Maybe Transformer)] -> TypeMap (Maybe Transformer)
    forall {v}. [(TypeKey, v)] -> HashMap TypeKey v
    map_fromAscList ((TypeKey -> Maybe (TypeKey, Maybe Transformer))
    -> [TypeKey] -> [(TypeKey, Maybe Transformer)]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (TypeSet -> TypeKey -> Maybe (TypeKey, Maybe Transformer)
    forall {a}. TypeSet -> TypeKey -> Maybe (TypeKey, Maybe a)
    g (TypeSet -> TypeKey -> Maybe (TypeKey, Maybe Transformer))
    -> TypeSet -> TypeKey -> Maybe (TypeKey, Maybe Transformer)
    forall a b. (a -> b) -> a -> b
    $ TypeMap (Maybe Transformer) -> TypeSet
    forall {v}. HashMap TypeKey v -> TypeSet
    map_keysSet TypeMap (Maybe Transformer)
    a) [TypeKey]
    univ)

                    g :: TypeSet -> TypeKey -> Maybe (TypeKey, Maybe a)
    g TypeSet
    a TypeKey
    t = if Bool
    b then Maybe (TypeKey, Maybe a)
    forall a. Maybe a
    Nothing else (TypeKey, Maybe a) -> Maybe (TypeKey, Maybe a)
    forall a. a -> Maybe a
    Just (TypeKey
    t, Maybe a
    forall a. Maybe a
    Nothing)
                        where b :: Bool
    b = TypeSet -> Bool
    forall a. HashSet a -> Bool
    Set.null (TypeSet -> Bool) -> TypeSet -> Bool
    forall a b. (a -> b) -> a -> b
    $ TypeSet
    a TypeSet -> TypeSet -> TypeSet
    forall a. Eq a => HashSet a -> HashSet a -> HashSet a
    `Set.intersection` (HashMap TypeKey TypeSet
    hitBox HashMap TypeKey TypeSet -> TypeKey -> TypeSet
    forall {k} {a}. Hashable k => HashMap k a -> k -> a
    ! TypeKey
    t)

            op :: forall b . Data b => TypeMap (Maybe Transformer) -> b -> b
            op :: forall b. Data b => TypeMap (Maybe Transformer) -> b -> b
    op TypeMap (Maybe Transformer)
    slice = case TypeKey -> TypeMap (Maybe Transformer) -> Maybe (Maybe Transformer)
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    Map.lookup (b -> TypeKey
    forall a. Typeable a => a -> TypeKey
    typeKey (b
    forall a. HasCallStack => a
    undefined :: b)) TypeMap (Maybe Transformer)
    slice of
                Maybe (Maybe Transformer)
    Nothing -> b -> b
    forall a. a -> a
    id
                Just Maybe Transformer
    Nothing -> (forall b. Data b => b -> b) -> b -> b
    forall a. Data a => (forall b. Data b => b -> b) -> a -> a
    gmapT (TypeMap (Maybe Transformer) -> b -> b
    forall b. Data b => TypeMap (Maybe Transformer) -> b -> b
    op TypeMap (Maybe Transformer)
    slice)
                Just (Just (Transformer TypeKey
    _ a -> a
    t)) -> a -> b
    forall a b. a -> b
    unsafeCoerce (a -> b) -> (b -> a) -> b -> b
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> a
    t (a -> a) -> (b -> a) -> b -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . b -> a
    forall a b. a -> b
    unsafeCoerce

    transformBis_ [] = a -> a
    forall a. a -> a
    id
    transformBis_ ([]:[[Transformer]]
    xs) = [[Transformer]] -> a -> a
    forall a. Data a => [[Transformer]] -> a -> a
    transformBis_ [[Transformer]]
    xs
    transformBis_ ((Transformer TypeKey
    _ a -> a
    t:[Transformer]
    x):[[Transformer]]
    xs) = (forall b. Data b => b -> b) -> forall b. Data b => b -> b
    everywhere ((a -> a) -> a -> a
    forall a b. (Typeable a, Typeable b) => (b -> b) -> a -> a
    mkT a -> a
    t) (a -> a) -> (a -> a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [[Transformer]] -> a -> a
    forall a. Data a => [[Transformer]] -> a -> a
    transformBis_ ([Transformer]
    x[Transformer] -> [[Transformer]] -> [[Transformer]]
    forall a. a -> [a] -> [a]
    :[[Transformer]]
    xs)