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

    {- |
        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)

    #if __GLASGOW_HASKELL__ < 606

    ---------------------------------------------------------------------
    -- GHC 6.4 and below

    import qualified Data.Set as Set
    import qualified Data.Map as Map

    type TypeKey = TypeRep
    type TypeSet = Set.Set TypeKey
    type TypeMap = Map.Map TypeKey

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

    #elif __GLASGOW_HASKELL__ < 702

    ---------------------------------------------------------------------
    -- GHC 6.6 to 7.0 (has typeRepKey)

    import qualified Data.IntSet as Set
    import qualified Data.IntMap as Map

    type TypeKey = Int
    type TypeSet = Set.IntSet
    type TypeMap = Map.IntMap

    typeKey :: Typeable a => a -> TypeKey
    typeKey x = inlinePerformIO $ typeRepKey $ typeOf x

    #else

    ---------------------------------------------------------------------
    -- 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 :: a -> TypeKey
    typeKey = a -> TypeKey
    forall a. Typeable a => a -> TypeKey
    typeOf

    #endif

    #if __GLASGOW_HASKELL__ < 702

    ---------------------------------------------------------------------
    -- GHC 7.0 and below (using containers API)

    (!) = (Map.!)
    map_findWithDefault = Map.findWithDefault
    map_fromAscList = Map.fromAscList
    map_keysSet = Map.keysSet
    map_member = Map.member
    set_partition = Set.partition
    set_toAscList = Set.toAscList
    set_unions = Set.unions

    #else

    ---------------------------------------------------------------------
    -- GHC 7.2 and above (using unordered-containers API)

    (!) mp :: HashMap k a
    mp k :: k
    k = a -> k -> HashMap k a -> a
    forall k a. (Eq k, Hashable k) => a -> k -> HashMap k a -> a
    map_findWithDefault ([Char] -> a
    forall a. HasCallStack => [Char] -> a
    error "Could not find element") k
    k HashMap k a
    mp
    map_findWithDefault :: a -> k -> HashMap k a -> a
    map_findWithDefault d :: a
    d k :: k
    k mp :: 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 -> HashSet TypeKey
    map_keysSet = [TypeKey] -> HashSet TypeKey
    forall a. (Eq a, Hashable a) => [a] -> HashSet a
    Set.fromList ([TypeKey] -> HashSet TypeKey)
    -> (HashMap TypeKey v -> [TypeKey])
    -> HashMap TypeKey v
    -> HashSet TypeKey
    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 x :: k
    x xs :: 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 f :: a -> Bool
    f x :: 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 :: [HashSet TypeKey] -> HashSet TypeKey
    set_unions = (HashSet TypeKey -> HashSet TypeKey -> HashSet TypeKey)
    -> HashSet TypeKey -> [HashSet TypeKey] -> HashSet TypeKey
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr HashSet TypeKey -> HashSet TypeKey -> HashSet TypeKey
    forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
    Set.union HashSet TypeKey
    forall a. HashSet a
    Set.empty

    #endif

    {-# 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 (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 "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 (m :: * -> *) a. Monad m => a -> m a
    return 0

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

    data Answer a = Hit {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 {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 :: from -> to -> Oracle to
    hitTest from :: from
    from to :: 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
               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
    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 test :: 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
    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
    $ HitMap -> TypeMap2 (Maybe Follower) -> Cache
    Cache HitMap
    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 kfrom :: TypeKey
    kfrom vfrom :: a
    vfrom) kto :: 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 hit :: HitMap
    hit follow :: 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 ans :: Maybe Follower
    ans -> Maybe Follower -> IO (Maybe Follower)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Follower
    ans
            Nothing -> do
                Either SomeException HitMap
    res <- IO HitMap -> IO (Either SomeException HitMap)
    forall e a. Exception e => IO a -> IO (Either e a)
    Control.Exception.try (HitMap -> IO HitMap
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HitMap -> IO HitMap) -> HitMap -> IO HitMap
    forall a b. (a -> b) -> a -> b
    $! DataBox -> HitMap -> HitMap
    insertHitMap DataBox
    from HitMap
    hit)
                (hit :: HitMap
    hit,fol :: Maybe Follower
    fol) <- (HitMap, Maybe Follower) -> IO (HitMap, Maybe Follower)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((HitMap, Maybe Follower) -> IO (HitMap, Maybe Follower))
    -> (HitMap, Maybe Follower) -> IO (HitMap, Maybe Follower)
    forall a b. (a -> b) -> a -> b
    $ case Either SomeException HitMap
    res of
                    Left _ -> (HitMap
    hit, Maybe Follower
    forall a. Maybe a
    Nothing)
                    Right hit :: HitMap
    hit -> (HitMap
    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 -> HitMap -> Follower
    follower TypeKey
    kfrom TypeKey
    kto HitMap
    hit)

                let msg :: [Char]
    msg =
                        "# 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]
    ++ "), 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]
    ++ "), 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]
    forall a. [a] -> [a] -> [a]
    ++
                        (SomeException -> [Char])
    -> (HitMap -> [Char]) -> Either SomeException HitMap -> [Char]
    forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
    either (\(SomeException
    msg::SomeException) -> "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] -> HitMap -> [Char]
    forall a b. a -> b -> a
    const "Success") Either SomeException HitMap
    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 1 (Int -> Follower -> Int
    forall a b. a -> b -> a
    const 0) Maybe Follower
    fol Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= 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
    < 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 _ follow :: TypeMap2 (Maybe Follower)
    follow) -> (HitMap -> TypeMap2 (Maybe Follower) -> Cache
    Cache HitMap
    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 (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 HitMap
    readCacheHitMap from :: DataBox
    from@(DataBox kfrom :: TypeKey
    kfrom vfrom :: a
    vfrom) = IO (Maybe HitMap) -> Maybe HitMap
    forall a. IO a -> a
    inlinePerformIO (IO (Maybe HitMap) -> Maybe HitMap)
    -> IO (Maybe HitMap) -> Maybe HitMap
    forall a b. (a -> b) -> a -> b
    $ do
        Cache hit :: HitMap
    hit _ <- IORef Cache -> IO Cache
    forall a. IORef a -> IO a
    readIORef IORef Cache
    cache
        case TypeKey -> HitMap -> Maybe (HashSet TypeKey)
    forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
    Map.lookup TypeKey
    kfrom HitMap
    hit of
            Just _ -> Maybe HitMap -> IO (Maybe HitMap)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe HitMap -> IO (Maybe HitMap))
    -> Maybe HitMap -> IO (Maybe HitMap)
    forall a b. (a -> b) -> a -> b
    $ HitMap -> Maybe HitMap
    forall a. a -> Maybe a
    Just HitMap
    hit
            Nothing -> do
                Maybe HitMap
    res <- IO (Maybe HitMap)
    -> (SomeException -> IO (Maybe HitMap)) -> IO (Maybe HitMap)
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    Control.Exception.catch (Maybe HitMap -> IO (Maybe HitMap)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe HitMap -> IO (Maybe HitMap))
    -> Maybe HitMap -> IO (Maybe HitMap)
    forall a b. (a -> b) -> a -> b
    $! HitMap -> Maybe HitMap
    forall a. a -> Maybe a
    Just (HitMap -> Maybe HitMap) -> HitMap -> Maybe HitMap
    forall a b. (a -> b) -> a -> b
    $! DataBox -> HitMap -> HitMap
    insertHitMap DataBox
    from HitMap
    hit) (\(SomeException
    _ :: SomeException) -> Maybe HitMap -> IO (Maybe HitMap)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe HitMap
    forall a. Maybe a
    Nothing)
                case Maybe HitMap
    res of
                    Nothing -> Maybe HitMap -> IO (Maybe HitMap)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe HitMap
    forall a. Maybe a
    Nothing
                    Just hit :: HitMap
    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 _ follow :: TypeMap2 (Maybe Follower)
    follow) -> (HitMap -> TypeMap2 (Maybe Follower) -> Cache
    Cache HitMap
    hit TypeMap2 (Maybe Follower)
    follow, ())
                        Maybe HitMap -> IO (Maybe HitMap)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe HitMap -> IO (Maybe HitMap))
    -> Maybe HitMap -> IO (Maybe HitMap)
    forall a b. (a -> b) -> a -> b
    $ HitMap -> Maybe HitMap
    forall a. a -> Maybe a
    Just HitMap
    hit

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

    type TypeMap2 a = TypeMap (TypeMap a)

    lookup2 :: TypeKey -> TypeKey -> TypeMap2 a -> Maybe a
    lookup2 :: TypeKey -> TypeKey -> TypeMap2 a -> Maybe a
    lookup2 x :: TypeKey
    x y :: TypeKey
    y mp :: 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 (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 :: TypeKey -> TypeKey -> a -> TypeMap2 a -> TypeMap2 a
    insert2 x :: TypeKey
    x y :: TypeKey
    y v :: a
    v mp :: TypeMap2 a
    mp = (HashMap TypeKey a -> HashMap TypeKey a -> HashMap TypeKey a)
    -> TypeKey -> HashMap TypeKey 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 ((HashMap TypeKey a -> HashMap TypeKey a)
    -> HashMap TypeKey a -> HashMap TypeKey a -> HashMap TypeKey a
    forall a b. a -> b -> a
    const ((HashMap TypeKey a -> HashMap TypeKey a)
     -> HashMap TypeKey a -> HashMap TypeKey a -> HashMap TypeKey a)
    -> (HashMap TypeKey a -> HashMap TypeKey a)
    -> HashMap TypeKey a
    -> HashMap TypeKey a
    -> HashMap TypeKey a
    forall a b. (a -> b) -> a -> b
    $ TypeKey -> a -> HashMap TypeKey a -> HashMap TypeKey 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 -> HashMap TypeKey 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 :: Int -> Int -> IntMap2 a -> Maybe a
    intLookup2 x :: Int
    x y :: Int
    y mp :: 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 (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 :: Int -> Int -> a -> IntMap2 a -> IntMap2 a
    intInsert2 x :: Int
    x y :: Int
    y v :: a
    v mp :: 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 -> HitMap -> Follower
    follower from :: TypeKey
    from to :: TypeKey
    to mp :: HitMap
    mp
        | HashSet TypeKey -> Bool
    forall a. HashSet a -> Bool
    Set.null HashSet TypeKey
    hit = Bool -> Follower
    forall a b. a -> b -> a
    const Bool
    False
        | HashSet TypeKey -> Bool
    forall a. HashSet a -> Bool
    Set.null HashSet TypeKey
    miss = Bool -> Follower
    forall a b. a -> b -> a
    const Bool
    True
        | HashSet TypeKey -> Int
    forall a. HashSet a -> Int
    Set.size HashSet TypeKey
    hit Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < HashSet TypeKey -> Int
    forall a. HashSet a -> Int
    Set.size HashSet TypeKey
    miss = \k :: TypeKey
    k -> TypeKey
    k TypeKey -> HashSet TypeKey -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    `Set.member` HashSet TypeKey
    hit
        | Bool
    otherwise = \k :: TypeKey
    k -> Bool -> Bool
    not (Bool -> Bool) -> Bool -> Bool
    forall a b. (a -> b) -> a -> b
    $ TypeKey
    k TypeKey -> HashSet TypeKey -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    `Set.member` HashSet TypeKey
    miss
        where
            (hit :: HashSet TypeKey
    hit,miss :: HashSet TypeKey
    miss) = Follower -> HashSet TypeKey -> (HashSet TypeKey, HashSet TypeKey)
    forall a. (a -> Bool) -> HashSet a -> (HashSet a, HashSet a)
    set_partition (\x :: TypeKey
    x -> TypeKey
    to TypeKey -> HashSet TypeKey -> Bool
    forall a. (Eq a, Hashable a) => a -> HashSet a -> Bool
    `Set.member` TypeKey -> HashSet TypeKey
    grab TypeKey
    x) (TypeKey -> HashSet TypeKey -> HashSet TypeKey
    forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
    Set.insert TypeKey
    from (HashSet TypeKey -> HashSet TypeKey)
    -> HashSet TypeKey -> HashSet TypeKey
    forall a b. (a -> b) -> a -> b
    $ TypeKey -> HashSet TypeKey
    grab TypeKey
    from)
            grab :: TypeKey -> HashSet TypeKey
    grab x :: TypeKey
    x = HashSet TypeKey -> TypeKey -> HitMap -> HashSet TypeKey
    forall k a. (Eq k, Hashable k) => a -> k -> HashMap k a -> a
    map_findWithDefault ([Char] -> HashSet TypeKey
    forall a. HasCallStack => [Char] -> a
    error "couldn't grab in follower") TypeKey
    x HitMap
    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 :: a -> DataBox
    dataBox x :: 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 :: a -> [DataBox]
    sybChildren x :: 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 ctr :: Constr
    ctr = (forall a. Data a => a -> DataBox) -> a -> [DataBox]
    forall a u. Data a => (forall d. Data d => d -> u) -> a -> [u]
    gmapQ 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 :: HitMap
    emptyHitMap = [(TypeKey, HashSet TypeKey)] -> HitMap
    forall k v. (Eq k, Hashable k) => [(k, v)] -> HashMap k v
    Map.fromList
            [(TypeKey
    tRational, TypeKey -> HashSet TypeKey
    forall a. Hashable a => a -> HashSet a
    Set.singleton TypeKey
    tInteger)
            ,(TypeKey
    tInteger, HashSet TypeKey
    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 (0 :: Integer)

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

                    fs :: [DataBox] -> HitMap -> HitMap
    fs [] mp :: HitMap
    mp = HitMap
    mp
                    fs (x :: DataBox
    x:xs :: [DataBox]
    xs) mp :: HitMap
    mp = [DataBox] -> HitMap -> HitMap
    fs [DataBox]
    xs (DataBox -> HitMap -> HitMap
    f DataBox
    x HitMap
    mp)

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

    fixEq :: Eq a => (a -> a) -> a -> a
    fixEq :: (a -> a) -> a -> a
    fixEq f :: a -> a
    f x :: 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 {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 a. Typeable a => a -> Answer with) -> on -> CC with on
    biplateData oracle :: forall a. Typeable a => a -> Answer with
    oracle x :: on
    x = case on -> Answer with
    forall a. Typeable a => a -> Answer with
    oracle on
    x of
        Hit y :: with
    y -> (with -> Str with
    forall a. a -> Str a
    One with
    y, \(One x :: with
    x) -> with -> on
    forall a b. a -> b
    unsafeCoerce with
    x)
        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 forall a. Typeable a => a -> Answer with
    oracle on
    x
        Miss -> (Str with
    forall a. Str a
    Zero, \_ -> on
    x)

    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) -> on -> CC with on
    uniplateData oracle :: forall a. Typeable a => a -> Answer with
    oracle item :: 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
    gfoldl forall d b. Data d => C with (d -> b) -> d -> C with b
    combine forall g. g -> C with g
    create on
    item
        where
            combine :: Data a => C with (a -> b) -> a -> C with b
            combine :: C with (a -> b) -> a -> C with b
    combine (C (c :: Str with
    c,g :: Str with -> a -> b
    g)) x :: 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 forall a. Typeable a => a -> Answer with
    oracle a
    x of
                                      (c2 :: Str with
    c2, g2 :: 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 c' :: Str with
    c' c2' :: Str with
    c2') -> Str with -> a -> b
    g Str with
    c' (Str with -> a
    g2 Str with
    c2'))

            create :: g -> C with g
            create :: g -> C with g
    create x :: 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, \_ -> g
    x)

    descendData :: Data on => (forall a . Typeable a => a -> Answer on) -> (on -> on) -> on -> on
    descendData :: (forall a. Typeable a => a -> Answer on) -> (on -> on) -> on -> on
    descendData oracle :: forall a. Typeable a => a -> Answer on
    oracle op :: 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 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 a. Typeable a => a -> Answer with)
    -> (with -> with) -> on -> on
    descendBiData oracle :: forall a. Typeable a => a -> Answer with
    oracle op :: with -> with
    op x :: on
    x = case on -> Answer with
    forall a. Typeable a => a -> Answer with
    oracle on
    x of
        Hit y :: 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
        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 forall a. Typeable a => a -> Answer with
    oracle with -> with
    op) on
    x
        Miss -> on
    x

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

    descendBiDataM :: (Data on, Data with, Monad m) => (forall a . Typeable a => a -> Answer with) -> (with -> m with) -> on -> m on
    descendBiDataM :: (forall a. Typeable a => a -> Answer with)
    -> (with -> m with) -> on -> m on
    descendBiDataM oracle :: forall a. Typeable a => a -> Answer with
    oracle op :: with -> m with
    op x :: on
    x = case on -> Answer with
    forall a. Typeable a => a -> Answer with
    oracle on
    x of
        Hit y :: 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
        Follow -> (forall d. Data d => d -> m d) -> on -> m on
    forall a (m :: * -> *).
    (Data a, Monad m) =>
    (forall d. Data d => d -> m d) -> a -> m a
    gmapM ((forall a. Typeable a => a -> Answer with)
    -> (with -> m with) -> d -> m d
    forall on with (m :: * -> *).
    (Data on, Data with, Monad 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
        Miss -> on -> m on
    forall (m :: * -> *) a. Monad m => a -> m a
    return on
    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 :: (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_ :: (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 :: [[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_ :: [[Transformer]] -> a -> a
    transformBis_ ts :: [[Transformer]]
    ts | Maybe HitMap -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe HitMap
    hitBoxM = TypeMap (Maybe Transformer) -> a -> a
    forall b. Data b => TypeMap (Maybe Transformer) -> b -> b
    op (Int -> Int -> TypeMap (Maybe Transformer)
    sliceMe 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 HitMap
    hitBoxM = DataBox -> Maybe HitMap
    readCacheHitMap DataBox
    on
            hitBox :: HitMap
    hitBox = Maybe HitMap -> HitMap
    forall a. HasCallStack => Maybe a -> a
    fromJust Maybe HitMap
    hitBoxM
            univ :: [TypeKey]
    univ = HashSet TypeKey -> [TypeKey]
    forall a. HashSet a -> [a]
    set_toAscList (HashSet TypeKey -> [TypeKey]) -> HashSet TypeKey -> [TypeKey]
    forall a b. (a -> b) -> a -> b
    $ TypeKey -> HashSet TypeKey -> HashSet TypeKey
    forall a. (Eq a, Hashable a) => a -> HashSet a -> HashSet a
    Set.insert (DataBox -> TypeKey
    dataBoxKey DataBox
    on) (HashSet TypeKey -> HashSet TypeKey)
    -> HashSet TypeKey -> HashSet TypeKey
    forall a b. (a -> b) -> a -> b
    $ HitMap
    hitBox HitMap -> TypeKey -> HashSet TypeKey
    forall k a. (Eq k, Hashable k) => HashMap k a -> k -> a
    ! DataBox -> TypeKey
    dataBoxKey DataBox
    on
            n :: Int
    n = [[Transformer]] -> 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 i :: Int
    i j :: 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) | (j :: Int
    j,ts :: [[Transformer]]
    ts) <- [Int] -> [[[Transformer]]] -> [(Int, [[Transformer]])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Int
    i..Int
    n] ([[[Transformer]]] -> [[[Transformer]]]
    forall a. [a] -> [a]
    tail ([[[Transformer]]] -> [[[Transformer]]])
    -> [[[Transformer]]] -> [[[Transformer]]]
    forall a b. (a -> b) -> a -> b
    $ [[Transformer]] -> [[[Transformer]]]
    forall a. [a] -> [[a]]
    inits [[Transformer]]
    ts)])
                | (i :: Int
    i,ts :: [[Transformer]]
    ts) <- [Int] -> [[[Transformer]]] -> [(Int, [[Transformer]])]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [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 from :: Int
    from to :: Int
    to tts :: [[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 a :: TypeMap (Maybe Transformer)
    a ((i :: Int
    i,[Transformer tk :: TypeKey
    tk tr :: a -> a
    tr]):ts :: [(Int, [Transformer])]
    ts)
                        | TypeKey
    tk TypeKey -> TypeMap (Maybe Transformer) -> Bool
    forall k a. (Eq k, 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
    +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 a :: TypeMap (Maybe Transformer)
    a [] = TypeMap (Maybe Transformer)
    a TypeMap (Maybe Transformer)
    -> TypeMap (Maybe Transformer) -> TypeMap (Maybe Transformer)
    forall k v.
    (Eq k, Hashable 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 (HashSet TypeKey -> TypeKey -> Maybe (TypeKey, Maybe Transformer)
    forall a. HashSet TypeKey -> TypeKey -> Maybe (TypeKey, Maybe a)
    g (HashSet TypeKey -> TypeKey -> Maybe (TypeKey, Maybe Transformer))
    -> HashSet TypeKey -> TypeKey -> Maybe (TypeKey, Maybe Transformer)
    forall a b. (a -> b) -> a -> b
    $ TypeMap (Maybe Transformer) -> HashSet TypeKey
    forall v. HashMap TypeKey v -> HashSet TypeKey
    map_keysSet TypeMap (Maybe Transformer)
    a) [TypeKey]
    univ)

                    g :: HashSet TypeKey -> TypeKey -> Maybe (TypeKey, Maybe a)
    g a :: HashSet TypeKey
    a t :: 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 = HashSet TypeKey -> Bool
    forall a. HashSet a -> Bool
    Set.null (HashSet TypeKey -> Bool) -> HashSet TypeKey -> Bool
    forall a b. (a -> b) -> a -> b
    $ HashSet TypeKey
    a HashSet TypeKey -> HashSet TypeKey -> HashSet TypeKey
    forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a
    `Set.intersection` (HitMap
    hitBox HitMap -> TypeKey -> HashSet TypeKey
    forall k a. (Eq k, Hashable k) => HashMap k a -> k -> a
    ! TypeKey
    t)

            op :: forall b . Data b => TypeMap (Maybe Transformer) -> b -> b
            op :: TypeMap (Maybe Transformer) -> b -> b
    op slice :: 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
                Nothing -> b -> b
    forall a. a -> a
    id
                Just 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 _ t :: 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_ ([]:xs :: [[Transformer]]
    xs) = [[Transformer]] -> a -> a
    forall a. Data a => [[Transformer]] -> a -> a
    transformBis_ [[Transformer]]
    xs
    transformBis_ ((Transformer _ t :: a -> a
    t:x :: [Transformer]
    x):xs :: [[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)