    {-# LANGUAGE TemplateHaskell, MultiParamTypeClasses, FlexibleInstances, FlexibleContexts, TypeSynonymInstances, PatternGuards, CPP, DoAndIfThenElse #-}
    module Data.Generics.Geniplate(
        genUniverseBi, genUniverseBi', genUniverseBiT, genUniverseBiT',
        genTransformBi, genTransformBi', genTransformBiT, genTransformBiT',
        genTransformBiM, genTransformBiM', genTransformBiMT, genTransformBiMT',
        UniverseBi(..), universe, instanceUniverseBi, instanceUniverseBiT,
        TransformBi(..), transform, instanceTransformBi, instanceTransformBiT,
        TransformBiM(..), transformM, instanceTransformBiM, instanceTransformBiMT,
        DescendBiM(..), instanceDescendBiM, instanceDescendBiMT,
        DescendM(..), descend, instanceDescendM, instanceDescendMT,
        ) where
    import Control.Monad
    import Control.Exception(assert)
    import Control.Monad.State.Strict
    import Control.Monad.Identity
    import Data.Maybe
    import Language.Haskell.TH
    import Language.Haskell.TH.Syntax hiding (lift)
    --import System.IO

    ---- Overloaded interface, same as Uniplate.

    -- | Class for 'universeBi'.
    class UniverseBi s t where
        universeBi :: s -> [t]

    -- | Class for 'transformBi'.
    class TransformBi s t where
        transformBi :: (s -> s) -> t -> t

    -- | Class for 'transformBiM'.
    class {-(Monad m) => -} TransformBiM m s t where
        transformBiM :: (s -> m s) -> t -> m t

    -- | Class for 'descendBiM'.
    class {-(Monad m) => -} DescendBiM m s t where
        descendBiM :: (s -> m s) -> t -> m t

    -- | Class for 'descendM'.
    class {-(Monad m) => -} DescendM m t where
        descendM :: (t -> m t) -> t -> m t

    universe :: (UniverseBi a a) => a -> [a]
    universe :: a -> [a]
    universe = a -> [a]
    forall s t. UniverseBi s t => s -> [t]
    universeBi

    transform :: (TransformBi a a) => (a -> a) -> a -> a
    transform :: (a -> a) -> a -> a
    transform = (a -> a) -> a -> a
    forall s t. TransformBi s t => (s -> s) -> t -> t
    transformBi

    transformM :: (TransformBiM m a a) => (a -> m a) -> a -> m a
    transformM :: (a -> m a) -> a -> m a
    transformM = (a -> m a) -> a -> m a
    forall (m :: * -> *) s t.
    TransformBiM m s t =>
    (s -> m s) -> t -> m t
    transformBiM

    descend :: (DescendM Identity a) => (a -> a) -> (a -> a)
    descend :: (a -> a) -> a -> a
    descend f :: a -> a
    f = Identity a -> a
    forall a. Identity a -> a
    runIdentity (Identity a -> a) -> (a -> Identity a) -> a -> a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a -> Identity a) -> a -> Identity a
    forall (m :: * -> *) t. DescendM m t => (t -> m t) -> t -> m t
    descendM (a -> Identity a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (a -> Identity a) -> (a -> a) -> a -> Identity a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> a
    f)

    ----

    -- | Create a 'UniverseBi' instance.
    -- The 'TypeQ' argument should be a pair; the /source/ and /target/ types for 'universeBi'.
    instanceUniverseBi :: TypeQ         -- ^(source, target) types
                       -> Q [Dec]
    instanceUniverseBi :: TypeQ -> Q [Dec]
    instanceUniverseBi = [TypeQ] -> TypeQ -> Q [Dec]
    instanceUniverseBiT []

    -- | Create a 'UniverseBi' instance with certain types being abstract.
    -- The 'TypeQ' argument should be a pair; the /source/ and /target/ types for 'universeBi'.
    instanceUniverseBiT :: [TypeQ]      -- ^types not touched by 'universeBi'
                        -> TypeQ        -- ^(source, target) types
                        -> Q [Dec]
    instanceUniverseBiT :: [TypeQ] -> TypeQ -> Q [Dec]
    instanceUniverseBiT stops :: [TypeQ]
    stops ty :: TypeQ
    ty = [TypeQ] -> Type -> Q [Dec]
    instanceUniverseBiT' [TypeQ]
    stops (Type -> Q [Dec]) -> TypeQ -> Q [Dec]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< TypeQ
    ty

    instanceUniverseBiT' :: [TypeQ] -> Type -> Q [Dec]
    instanceUniverseBiT' :: [TypeQ] -> Type -> Q [Dec]
    instanceUniverseBiT' stops :: [TypeQ]
    stops (ForallT _ _ t :: Type
    t) = [TypeQ] -> Type -> Q [Dec]
    instanceUniverseBiT' [TypeQ]
    stops Type
    t
    instanceUniverseBiT' stops :: [TypeQ]
    stops ty :: Type
    ty | (TupleT _, [from :: Type
    from, to :: Type
    to]) <- Type -> (Type, [Type])
    splitTypeApp Type
    ty = do
        (ds :: [Dec]
    ds, f :: Exp
    f) <- [TypeQ] -> Type -> Type -> Q ([Dec], Exp)
    uniBiQ [TypeQ]
    stops Type
    from Type
    to
        Name
    x <- String -> Q Name
    newName "_x"
        let e :: Exp
    e = [Pat] -> Exp -> Exp
    LamE [Name -> Pat
    VarP Name
    x] (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ [Dec] -> Exp -> Exp
    LetE [Dec]
    ds (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    AppE (Exp -> Exp -> Exp
    AppE Exp
    f (Name -> Exp
    VarE Name
    x)) ([Exp] -> Exp
    ListE [])
        [Dec] -> Q [Dec]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
    forall a b. (a -> b) -> a -> b
    $ Name -> [Type] -> Name -> Exp -> [Dec]
    instDef ''UniverseBi [Type
    from, Type
    to] 'universeBi Exp
    e
    instanceUniverseBiT' _ t :: Type
    t = String -> Q [Dec]
    forall a. String -> a
    genError "instanceUniverseBi: the argument should be of the form [t| (S, T) |]"

    funDef :: Name -> Exp -> [Dec]
    funDef :: Name -> Exp -> [Dec]
    funDef f :: Name
    f e :: Exp
    e = [Name -> [Clause] -> Dec
    FunD Name
    f [[Pat] -> Body -> [Dec] -> Clause
    Clause [] (Exp -> Body
    NormalB Exp
    e) []]]

    instDef :: Name -> [Type] -> Name -> Exp -> [Dec]
    #if __GLASGOW_HASKELL__ <= 710
    instDef cls ts met e = [InstanceD [] (foldl AppT (ConT cls) ts) (funDef met e)]
    #else
    instDef :: Name -> [Type] -> Name -> Exp -> [Dec]
    instDef cls :: Name
    cls ts :: [Type]
    ts met :: Name
    met e :: Exp
    e = [Maybe Overlap -> [Type] -> Type -> [Dec] -> Dec
    InstanceD Maybe Overlap
    forall a. Maybe a
    Nothing [] ((Type -> Type -> Type) -> Type -> [Type] -> Type
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Type -> Type -> Type
    AppT (Name -> Type
    ConT Name
    cls) [Type]
    ts) (Name -> Exp -> [Dec]
    funDef Name
    met Exp
    e)]
    #endif

    -- | Create a 'TransformBi' instance.
    -- The 'TypeQ' argument should be a pair; the /inner/ and /outer/ types for 'transformBi'.
    instanceTransformBi :: TypeQ        -- ^(inner, outer) types
                        -> Q [Dec]
    instanceTransformBi :: TypeQ -> Q [Dec]
    instanceTransformBi = [TypeQ] -> TypeQ -> Q [Dec]
    instanceTransformBiT []

    -- | Create a 'TransformBi' instance with certain types being abstract.
    -- The 'TypeQ' argument should be a pair; the /inner/ and /outer/ types for 'transformBi'.
    instanceTransformBiT :: [TypeQ]      -- ^types not touched by 'transformBi'
                         -> TypeQ        -- ^(inner, outer) types
                         -> Q [Dec]
    instanceTransformBiT :: [TypeQ] -> TypeQ -> Q [Dec]
    instanceTransformBiT stops :: [TypeQ]
    stops ty :: TypeQ
    ty = Mode -> [TypeQ] -> Type -> Q [Dec]
    instanceTransformBiT' Mode
    MTransformBi [TypeQ]
    stops (Type -> Q [Dec]) -> TypeQ -> Q [Dec]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< TypeQ
    ty

    data Mode = MTransformBi | MDescendBi | MDescend
        deriving (Mode -> Mode -> Bool
    (Mode -> Mode -> Bool) -> (Mode -> Mode -> Bool) -> Eq Mode
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: Mode -> Mode -> Bool
    $c/= :: Mode -> Mode -> Bool
    == :: Mode -> Mode -> Bool
    $c== :: Mode -> Mode -> Bool
    Eq, Eq Mode
    Eq Mode =>
    (Mode -> Mode -> Ordering)
    -> (Mode -> Mode -> Bool)
    -> (Mode -> Mode -> Bool)
    -> (Mode -> Mode -> Bool)
    -> (Mode -> Mode -> Bool)
    -> (Mode -> Mode -> Mode)
    -> (Mode -> Mode -> Mode)
    -> Ord Mode
    Mode -> Mode -> Bool
    Mode -> Mode -> Ordering
    Mode -> Mode -> Mode
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    min :: Mode -> Mode -> Mode
    $cmin :: Mode -> Mode -> Mode
    max :: Mode -> Mode -> Mode
    $cmax :: Mode -> Mode -> Mode
    >= :: Mode -> Mode -> Bool
    $c>= :: Mode -> Mode -> Bool
    > :: Mode -> Mode -> Bool
    $c> :: Mode -> Mode -> Bool
    <= :: Mode -> Mode -> Bool
    $c<= :: Mode -> Mode -> Bool
    < :: Mode -> Mode -> Bool
    $c< :: Mode -> Mode -> Bool
    compare :: Mode -> Mode -> Ordering
    $ccompare :: Mode -> Mode -> Ordering
    $cp1Ord :: Eq Mode
    Ord, Int -> Mode -> ShowS
    [Mode] -> ShowS
    Mode -> String
    (Int -> Mode -> ShowS)
    -> (Mode -> String) -> ([Mode] -> ShowS) -> Show Mode
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    showList :: [Mode] -> ShowS
    $cshowList :: [Mode] -> ShowS
    show :: Mode -> String
    $cshow :: Mode -> String
    showsPrec :: Int -> Mode -> ShowS
    $cshowsPrec :: Int -> Mode -> ShowS
    Show)

    instanceTransformBiT' :: Mode -> [TypeQ] -> Type -> Q [Dec]
    instanceTransformBiT' :: Mode -> [TypeQ] -> Type -> Q [Dec]
    instanceTransformBiT' doDescend :: Mode
    doDescend stops :: [TypeQ]
    stops (ForallT _ _ t :: Type
    t) = Mode -> [TypeQ] -> Type -> Q [Dec]
    instanceTransformBiT' Mode
    doDescend [TypeQ]
    stops Type
    t
    instanceTransformBiT' doDescend :: Mode
    doDescend stops :: [TypeQ]
    stops ty :: Type
    ty | (TupleT _, [ft :: Type
    ft, st :: Type
    st]) <- Type -> (Type, [Type])
    splitTypeApp Type
    ty = do
        Name
    f <- String -> Q Name
    newName "_f"
        Name
    x <- String -> Q Name
    newName "_x"
        (ds :: [Dec]
    ds, tr :: Exp
    tr) <- Mode -> RetAp -> [TypeQ] -> Name -> Type -> Type -> Q ([Dec], Exp)
    trBiQ Mode
    doDescend RetAp
    raNormal [TypeQ]
    stops Name
    f Type
    ft Type
    st
        let e :: Exp
    e = [Pat] -> Exp -> Exp
    LamE [Name -> Pat
    VarP Name
    f, Name -> Pat
    VarP Name
    x] (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ [Dec] -> Exp -> Exp
    LetE [Dec]
    ds (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    AppE Exp
    tr (Name -> Exp
    VarE Name
    x)

        [Dec] -> Q [Dec]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
    forall a b. (a -> b) -> a -> b
    $ Name -> [Type] -> Name -> Exp -> [Dec]
    instDef ''TransformBi [Type
    ft, Type
    st] 'transformBi Exp
    e
    instanceTransformBiT' _ _ t :: Type
    t = String -> Q [Dec]
    forall a. String -> a
    genError "instanceTransformBiT: the argument should be of the form [t| (S, T) |]"

    -- | Create a 'DescendBiM' instance.
    instanceDescendM :: TypeQ
                         -> TypeQ
                         -> Q [Dec]
    instanceDescendM :: TypeQ -> TypeQ -> Q [Dec]
    instanceDescendM = [TypeQ] -> TypeQ -> TypeQ -> Q [Dec]
    instanceDescendMT []

    -- | Create a 'DescendBiM' instance with certain types being abstract.
    instanceDescendMT :: [TypeQ]
                          -> TypeQ
                          -> TypeQ
                          -> Q [Dec]
    instanceDescendMT :: [TypeQ] -> TypeQ -> TypeQ -> Q [Dec]
    instanceDescendMT stops :: [TypeQ]
    stops mndq :: TypeQ
    mndq ty :: TypeQ
    ty = Mode -> [TypeQ] -> TypeQ -> Type -> Q [Dec]
    instanceTransformBiMT' Mode
    MDescend [TypeQ]
    stops TypeQ
    mndq (Type -> Q [Dec]) -> TypeQ -> Q [Dec]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< TypeQ
    ty

    -- | Create a 'DescendBiM' instance.
    instanceDescendBiM :: TypeQ
                         -> TypeQ
                         -> Q [Dec]
    instanceDescendBiM :: TypeQ -> TypeQ -> Q [Dec]
    instanceDescendBiM = [TypeQ] -> TypeQ -> TypeQ -> Q [Dec]
    instanceDescendBiMT []

    -- | Create a 'DescendBiM' instance with certain types being abstract.
    instanceDescendBiMT :: [TypeQ]
                          -> TypeQ
                          -> TypeQ
                          -> Q [Dec]
    instanceDescendBiMT :: [TypeQ] -> TypeQ -> TypeQ -> Q [Dec]
    instanceDescendBiMT stops :: [TypeQ]
    stops mndq :: TypeQ
    mndq ty :: TypeQ
    ty = Mode -> [TypeQ] -> TypeQ -> Type -> Q [Dec]
    instanceTransformBiMT' Mode
    MDescendBi [TypeQ]
    stops TypeQ
    mndq (Type -> Q [Dec]) -> TypeQ -> Q [Dec]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< TypeQ
    ty

    -- | Create a 'TransformBiM' instance.
    instanceTransformBiM :: TypeQ
                         -> TypeQ
                         -> Q [Dec]
    instanceTransformBiM :: TypeQ -> TypeQ -> Q [Dec]
    instanceTransformBiM = [TypeQ] -> TypeQ -> TypeQ -> Q [Dec]
    instanceTransformBiMT []

    -- | Create a 'TransformBiM' instance with certain types being abstract.
    instanceTransformBiMT :: [TypeQ]
                          -> TypeQ
                          -> TypeQ
                          -> Q [Dec]
    instanceTransformBiMT :: [TypeQ] -> TypeQ -> TypeQ -> Q [Dec]
    instanceTransformBiMT stops :: [TypeQ]
    stops mndq :: TypeQ
    mndq ty :: TypeQ
    ty = Mode -> [TypeQ] -> TypeQ -> Type -> Q [Dec]
    instanceTransformBiMT' Mode
    MTransformBi [TypeQ]
    stops TypeQ
    mndq (Type -> Q [Dec]) -> TypeQ -> Q [Dec]
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<< TypeQ
    ty

    instanceTransformBiMT' :: Mode -> [TypeQ] -> TypeQ -> Type -> Q [Dec]
    instanceTransformBiMT' :: Mode -> [TypeQ] -> TypeQ -> Type -> Q [Dec]
    instanceTransformBiMT' doDescend :: Mode
    doDescend stops :: [TypeQ]
    stops mndq :: TypeQ
    mndq (ForallT _ _ t :: Type
    t) = Mode -> [TypeQ] -> TypeQ -> Type -> Q [Dec]
    instanceTransformBiMT' Mode
    doDescend [TypeQ]
    stops TypeQ
    mndq Type
    t
    instanceTransformBiMT'  MDescend stops :: [TypeQ]
    stops mndq :: TypeQ
    mndq ty :: Type
    ty = do
        Type
    mnd <- TypeQ
    mndq

        Name
    f <- String -> Q Name
    newName "_f"
        Name
    x <- String -> Q Name
    newName "_x"
        (ds :: [Dec]
    ds, tr :: Exp
    tr) <- Mode -> RetAp -> [TypeQ] -> Name -> Type -> Type -> Q ([Dec], Exp)
    trBiQ Mode
    MDescend RetAp
    raMonad [TypeQ]
    stops Name
    f Type
    ty Type
    ty
        let e :: Exp
    e = [Pat] -> Exp -> Exp
    LamE [Name -> Pat
    VarP Name
    f, Name -> Pat
    VarP Name
    x] (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ [Dec] -> Exp -> Exp
    LetE [Dec]
    ds (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    AppE Exp
    tr (Name -> Exp
    VarE Name
    x)
        [Dec] -> Q [Dec]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
    forall a b. (a -> b) -> a -> b
    $ Name -> [Type] -> Name -> Exp -> [Dec]
    instDef ''DescendM [Type
    mnd, Type
    ty] 'descendM Exp
    e
    instanceTransformBiMT' doDescend :: Mode
    doDescend stops :: [TypeQ]
    stops mndq :: TypeQ
    mndq ty :: Type
    ty | (TupleT _, [ft :: Type
    ft, st :: Type
    st]) <- Type -> (Type, [Type])
    splitTypeApp Type
    ty = do
    --    qRunIO $ do putStrLn "************"; hFlush stdout
        Type
    mnd <- TypeQ
    mndq

        Name
    f <- String -> Q Name
    newName "_f"
        Name
    x <- String -> Q Name
    newName "_x"
        (ds :: [Dec]
    ds, tr :: Exp
    tr) <- Mode -> RetAp -> [TypeQ] -> Name -> Type -> Type -> Q ([Dec], Exp)
    trBiQ Mode
    doDescend RetAp
    raMonad [TypeQ]
    stops Name
    f Type
    ft Type
    st
        let e :: Exp
    e = [Pat] -> Exp -> Exp
    LamE [Name -> Pat
    VarP Name
    f, Name -> Pat
    VarP Name
    x] (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ [Dec] -> Exp -> Exp
    LetE [Dec]
    ds (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    AppE Exp
    tr (Name -> Exp
    VarE Name
    x)
            cls :: Name
    cls = case Mode
    doDescend of MTransformBi -> ''TransformBiM; MDescendBi -> ''DescendBiM; MDescend -> String -> Name
    forall a. HasCallStack => String -> a
    error "MDescend"
            met :: Name
    met = case Mode
    doDescend of MTransformBi ->  'transformBiM; MDescendBi ->  'descendBiM; MDescend -> String -> Name
    forall a. HasCallStack => String -> a
    error "MDescend"
        [Dec] -> Q [Dec]
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([Dec] -> Q [Dec]) -> [Dec] -> Q [Dec]
    forall a b. (a -> b) -> a -> b
    $ Name -> [Type] -> Name -> Exp -> [Dec]
    instDef Name
    cls [Type
    mnd, Type
    ft, Type
    st] Name
    met Exp
    e
    instanceTransformBiMT' _ _ _ t :: Type
    t = String -> Q [Dec]
    forall a. String -> a
    genError "instanceTransformBiMT: the argument should be of the form [t| (S, T) |]"

    -- | Generate TH code for a function that extracts all subparts of a certain type.
    -- The argument to 'genUniverseBi' is a name with the type @S -> [T]@, for some types
    -- @S@ and @T@.  The function will extract all subparts of type @T@ from @S@.
    genUniverseBi :: Name             -- ^function of type @S -> [T]@
                  -> Q Exp
    genUniverseBi :: Name -> Q Exp
    genUniverseBi = [TypeQ] -> Name -> Q Exp
    genUniverseBiT []

    genUniverseBi' :: TypeQ -> Q Exp
    genUniverseBi' :: TypeQ -> Q Exp
    genUniverseBi' = [TypeQ] -> TypeQ -> Q Exp
    genUniverseBiT' []

    -- | Same as 'genUniverseBi', but does not look inside any types mention in the
    -- list of types.
    genUniverseBiT :: [TypeQ]         -- ^types not touched by 'universeBi'
                    -> Name            -- ^function of type @S -> [T]@
                    -> Q Exp
    genUniverseBiT :: [TypeQ] -> Name -> Q Exp
    genUniverseBiT stops :: [TypeQ]
    stops = Name -> Q ([TyVarBndr], Type, Type)
    forall (q :: * -> *).
    Quasi q =>
    Name -> q ([TyVarBndr], Type, Type)
    getNameType (Name -> Q ([TyVarBndr], Type, Type))
    -> (([TyVarBndr], Type, Type) -> Q Exp) -> Name -> Q Exp
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> [TypeQ] -> ([TyVarBndr], Type, Type) -> Q Exp
    genUniverseBiTsplit [TypeQ]
    stops

    genUniverseBiT' :: [TypeQ] -> TypeQ -> Q Exp
    genUniverseBiT' :: [TypeQ] -> TypeQ -> Q Exp
    genUniverseBiT' stops :: [TypeQ]
    stops q :: TypeQ
    q = TypeQ
    q TypeQ
    -> (Type -> Q ([TyVarBndr], Type, Type))
    -> Q ([TyVarBndr], Type, Type)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Type -> Q ([TyVarBndr], Type, Type)
    forall (q :: * -> *).
    Quasi q =>
    Type -> q ([TyVarBndr], Type, Type)
    splitType Q ([TyVarBndr], Type, Type)
    -> (([TyVarBndr], Type, Type) -> Q Exp) -> Q Exp
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= [TypeQ] -> ([TyVarBndr], Type, Type) -> Q Exp
    genUniverseBiTsplit [TypeQ]
    stops

    genUniverseBiTsplit :: [TypeQ] -> ([TyVarBndr], Type, Type) -> Q Exp
    genUniverseBiTsplit :: [TypeQ] -> ([TyVarBndr], Type, Type) -> Q Exp
    genUniverseBiTsplit stops :: [TypeQ]
    stops (_tvs :: [TyVarBndr]
    _tvs,from :: Type
    from,tos :: Type
    tos) = do
        let to :: Type
    to = Type -> Type
    unList Type
    tos
    --    qRunIO $ print (from, to)
        (ds :: [Dec]
    ds, f :: Exp
    f) <- [TypeQ] -> Type -> Type -> Q ([Dec], Exp)
    uniBiQ [TypeQ]
    stops Type
    from Type
    to
        Name
    x <- String -> Q Name
    newName "_x"
        let e :: Exp
    e = [Pat] -> Exp -> Exp
    LamE [Name -> Pat
    VarP Name
    x] (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ [Dec] -> Exp -> Exp
    LetE [Dec]
    ds (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    AppE (Exp -> Exp -> Exp
    AppE Exp
    f (Name -> Exp
    VarE Name
    x)) ([Exp] -> Exp
    ListE [])
    --    qRunIO $ do putStrLn $ pprint e; hFlush stdout
        Exp -> Q Exp
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    e

    type U = StateT (Map Type Dec, Map Type Bool) Q

    instance Quasi U where
        qNewName :: String -> U Name
    qNewName = Q Name -> U Name
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Q Name -> U Name) -> (String -> Q Name) -> String -> U Name
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Q Name
    forall (m :: * -> *). Quasi m => String -> m Name
    qNewName
        qReport :: Bool -> String -> U ()
    qReport b :: Bool
    b = Q () -> U ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Q () -> U ()) -> (String -> Q ()) -> String -> U ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> String -> Q ()
    forall (m :: * -> *). Quasi m => Bool -> String -> m ()
    qReport Bool
    b
        qRecover :: U a -> U a -> U a
    qRecover = String -> U a -> U a -> U a
    forall a. HasCallStack => String -> a
    error "Data.Generics.Geniplate: qRecover not implemented"
        qReify :: Name -> U Info
    qReify = Q Info -> U Info
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Q Info -> U Info) -> (Name -> Q Info) -> Name -> U Info
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Q Info
    forall (m :: * -> *). Quasi m => Name -> m Info
    qReify
    #if __GLASGOW_HASKELL__ >= 704
        qReifyInstances :: Name -> [Type] -> U [Dec]
    qReifyInstances n :: Name
    n = Q [Dec] -> U [Dec]
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Q [Dec] -> U [Dec]) -> ([Type] -> Q [Dec]) -> [Type] -> U [Dec]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> [Type] -> Q [Dec]
    forall (m :: * -> *). Quasi m => Name -> [Type] -> m [Dec]
    qReifyInstances Name
    n
    #elif __GLASGOW_HASKELL__ >= 702
        qClassInstances n = lift . qClassInstances n
    #endif
        qLocation :: U Loc
    qLocation = Q Loc -> U Loc
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift Q Loc
    forall (m :: * -> *). Quasi m => m Loc
    qLocation
        qRunIO :: IO a -> U a
    qRunIO = Q a -> U a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Q a -> U a) -> (IO a -> Q a) -> IO a -> U a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO a -> Q a
    forall (m :: * -> *) a. Quasi m => IO a -> m a
    qRunIO
    #if __GLASGOW_HASKELL__ >= 706
        qLookupName :: Bool -> String -> U (Maybe Name)
    qLookupName ns :: Bool
    ns = Q (Maybe Name) -> U (Maybe Name)
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Q (Maybe Name) -> U (Maybe Name))
    -> (String -> Q (Maybe Name)) -> String -> U (Maybe Name)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Bool -> String -> Q (Maybe Name)
    forall (m :: * -> *). Quasi m => Bool -> String -> m (Maybe Name)
    qLookupName Bool
    ns
        qAddDependentFile :: String -> U ()
    qAddDependentFile = Q () -> U ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Q () -> U ()) -> (String -> Q ()) -> String -> U ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Q ()
    forall (m :: * -> *). Quasi m => String -> m ()
    qAddDependentFile
    #if __GLASGOW_HASKELL__ >= 708
        qReifyRoles :: Name -> U [Role]
    qReifyRoles = Q [Role] -> U [Role]
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Q [Role] -> U [Role]) -> (Name -> Q [Role]) -> Name -> U [Role]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Q [Role]
    forall (m :: * -> *). Quasi m => Name -> m [Role]
    qReifyRoles
        qReifyAnnotations :: AnnLookup -> U [a]
    qReifyAnnotations = Q [a] -> U [a]
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Q [a] -> U [a]) -> (AnnLookup -> Q [a]) -> AnnLookup -> U [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AnnLookup -> Q [a]
    forall (m :: * -> *) a. (Quasi m, Data a) => AnnLookup -> m [a]
    qReifyAnnotations
        qReifyModule :: Module -> U ModuleInfo
    qReifyModule = Q ModuleInfo -> U ModuleInfo
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Q ModuleInfo -> U ModuleInfo)
    -> (Module -> Q ModuleInfo) -> Module -> U ModuleInfo
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Module -> Q ModuleInfo
    forall (m :: * -> *). Quasi m => Module -> m ModuleInfo
    qReifyModule
        qAddTopDecls :: [Dec] -> U ()
    qAddTopDecls = Q () -> U ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Q () -> U ()) -> ([Dec] -> Q ()) -> [Dec] -> U ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Dec] -> Q ()
    forall (m :: * -> *). Quasi m => [Dec] -> m ()
    qAddTopDecls
        qAddModFinalizer :: Q () -> U ()
    qAddModFinalizer = Q () -> U ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Q () -> U ()) -> (Q () -> Q ()) -> Q () -> U ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Q () -> Q ()
    forall (m :: * -> *). Quasi m => Q () -> m ()
    qAddModFinalizer
        qGetQ :: U (Maybe a)
    qGetQ = U (Maybe a)
    forall a. HasCallStack => a
    undefined -- lift . qGetQ
        qPutQ :: a -> U ()
    qPutQ = Q () -> U ()
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Q () -> U ()) -> (a -> Q ()) -> a -> U ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> Q ()
    forall (m :: * -> *) a. (Quasi m, Typeable a) => a -> m ()
    qPutQ
    #endif
    #endif

    uniBiQ :: [TypeQ] -> Type -> Type -> Q ([Dec], Exp)
    uniBiQ :: [TypeQ] -> Type -> Type -> Q ([Dec], Exp)
    uniBiQ stops :: [TypeQ]
    stops from :: Type
    from ato :: Type
    ato = do
        [Type]
    ss <- [TypeQ] -> Q [Type]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence [TypeQ]
    stops
        Type
    to <- Type -> TypeQ
    forall (q :: * -> *). Quasi q => Type -> q Type
    expandSyn Type
    ato
        (f :: Exp
    f, (m :: Map Type Dec
    m, _)) <- StateT (Map Type Dec, Map Type Bool) Q Exp
    -> (Map Type Dec, Map Type Bool)
    -> Q (Exp, (Map Type Dec, Map Type Bool))
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT (Type -> Type -> StateT (Map Type Dec, Map Type Bool) Q Exp
    uniBi Type
    from Type
    to) (Map Type Dec
    forall a b. Map a b
    mEmpty, [(Type, Bool)] -> Map Type Bool
    forall a b. [(a, b)] -> Map a b
    mFromList ([(Type, Bool)] -> Map Type Bool)
    -> [(Type, Bool)] -> Map Type Bool
    forall a b. (a -> b) -> a -> b
    $ [Type] -> [Bool] -> [(Type, Bool)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Type]
    ss (Bool -> [Bool]
    forall a. a -> [a]
    repeat Bool
    False))
        ([Dec], Exp) -> Q ([Dec], Exp)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map Type Dec -> [Dec]
    forall a b. Map a b -> [b]
    mElems Map Type Dec
    m, Exp
    f)

    uniBi :: Type -> Type -> U Exp
    uniBi :: Type -> Type -> StateT (Map Type Dec, Map Type Bool) Q Exp
    uniBi afrom :: Type
    afrom to :: Type
    to = do
        (m :: Map Type Dec
    m, c :: Map Type Bool
    c) <- StateT
      (Map Type Dec, Map Type Bool) Q (Map Type Dec, Map Type Bool)
    forall s (m :: * -> *). MonadState s m => m s
    get
        Type
    from <- Type -> StateT (Map Type Dec, Map Type Bool) Q Type
    forall (q :: * -> *). Quasi q => Type -> q Type
    expandSyn Type
    afrom
        case Type -> Map Type Dec -> Maybe Dec
    forall a b. Eq a => a -> Map a b -> Maybe b
    mLookup Type
    from Map Type Dec
    m of
            Just (FunD n :: Name
    n _) -> Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp)
    -> Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    n
            _ -> do
                Name
    f <- String -> U Name
    forall (m :: * -> *). Quasi m => String -> m Name
    qNewName "_f"
                let mkRec :: StateT (Map Type Dec, Map Type Bool) Q [Clause]
    mkRec = do
                        (Map Type Dec, Map Type Bool) -> U ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (Type -> Dec -> Map Type Dec -> Map Type Dec
    forall a b. Eq a => a -> b -> Map a b -> Map a b
    mInsert Type
    from (Name -> [Clause] -> Dec
    FunD Name
    f [[Pat] -> Body -> [Dec] -> Clause
    Clause [] (Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $ [Exp] -> Exp
    TupE []) []]) Map Type Dec
    m, Map Type Bool
    c)   -- insert something to break recursion, will be replaced below.
                        Type -> Type -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    uniBiCase Type
    from Type
    to
                [Clause]
    cs <- if Type
    from Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Type
    to then do
                          Bool
    b <- Type -> Type -> U Bool
    contains' Type
    to Type
    from
                          if Bool
    b then do
                              -- Recursive data type, we need the current value and all values inside.
                              Name
    g <- String -> U Name
    forall (m :: * -> *). Quasi m => String -> m Name
    qNewName "_g"
                              [Clause]
    gcs <- StateT (Map Type Dec, Map Type Bool) Q [Clause]
    mkRec
                              let dg :: Dec
    dg = Name -> [Clause] -> Dec
    FunD Name
    g [Clause]
    gcs
                              -- Insert with a dummy type, just to get the definition in the map for mElems.
                              ((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
    -> U ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
     -> U ())
    -> ((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
    -> U ()
    forall a b. (a -> b) -> a -> b
    $ \ (m' :: Map Type Dec
    m', c' :: Map Type Bool
    c') -> (Type -> Dec -> Map Type Dec -> Map Type Dec
    forall a b. Eq a => a -> b -> Map a b -> Map a b
    mInsert (Name -> Type
    ConT Name
    g) Dec
    dg Map Type Dec
    m', Map Type Bool
    c')
                              Q [Dec] -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    unFun [d| f _x _r = _x : $(return (VarE g)) _x _r |]
                           else
                              -- Non-recursive type, just use this value.
                              Q [Dec] -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    unFun [d| f _x _r = _x : _r |]
                      else do
                          -- Types differ, look inside.
                          Bool
    b <- Type -> Type -> U Bool
    contains Type
    to Type
    from
                          if Bool
    b then do
                              -- Occurrences inside, recurse.
                              StateT (Map Type Dec, Map Type Bool) Q [Clause]
    mkRec
                           else
                              -- No occurrences of to inside from, so add nothing.
                              Q [Dec] -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    unFun [d| f _ _r = _r |]
                let d :: Dec
    d = Name -> [Clause] -> Dec
    FunD Name
    f [Clause]
    cs
                ((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
    -> U ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
     -> U ())
    -> ((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
    -> U ()
    forall a b. (a -> b) -> a -> b
    $ \ (m' :: Map Type Dec
    m', c' :: Map Type Bool
    c') -> (Type -> Dec -> Map Type Dec -> Map Type Dec
    forall a b. Eq a => a -> b -> Map a b -> Map a b
    mInsert Type
    from Dec
    d Map Type Dec
    m', Map Type Bool
    c')
                Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp)
    -> Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    f

    -- Check if the second type is contained anywhere in the first type.
    contains :: Type -> Type -> U Bool
    contains :: Type -> Type -> U Bool
    contains to :: Type
    to afrom :: Type
    afrom = do
    --    qRunIO $ print ("contains", to, from)
        Type
    from <- Type -> StateT (Map Type Dec, Map Type Bool) Q Type
    forall (q :: * -> *). Quasi q => Type -> q Type
    expandSyn Type
    afrom
        if Type
    from Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Type
    to then
            Bool -> U Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True
         else do
            Map Type Bool
    c <- ((Map Type Dec, Map Type Bool) -> Map Type Bool)
    -> StateT (Map Type Dec, Map Type Bool) Q (Map Type Bool)
    forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
    gets (Map Type Dec, Map Type Bool) -> Map Type Bool
    forall a b. (a, b) -> b
    snd
            case Type -> Map Type Bool -> Maybe Bool
    forall a. Type -> Map Type a -> Maybe a
    mLookupSplits Type
    from Map Type Bool
    c of
                Just b :: Bool
    b  -> Bool -> U Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    b
                Nothing -> Type -> Type -> U Bool
    contains' Type
    to Type
    from

    mLookupSplits :: Type -> Map Type a -> Maybe a
    mLookupSplits :: Type -> Map Type a -> Maybe a
    mLookupSplits ty :: Type
    ty m :: Map Type a
    m = [Maybe a] -> Maybe a
    forall (t :: * -> *) (m :: * -> *) a.
    (Foldable t, MonadPlus m) =>
    t (m a) -> m a
    msum [ Type -> Map Type a -> Maybe a
    forall a b. Eq a => a -> Map a b -> Maybe b
    mLookup Type
    ty' Map Type a
    m | Type
    ty' <- Type -> [Type]
    splits Type
    ty ]
      where
        splits :: Type -> [Type]
    splits t :: Type
    t@(AppT u :: Type
    u _) = Type
    tType -> [Type] -> [Type]
    forall a. a -> [a] -> [a]
    :Type -> [Type]
    splits Type
    u
        splits t :: Type
    t = [Type
    t]

    -- Check if the second type is contained somewhere inside the first.
    contains' :: Type -> Type -> U Bool
    contains' :: Type -> Type -> U Bool
    contains' to :: Type
    to from :: Type
    from = do
    --    qRunIO $ print ("contains'", to, from)
        let (con :: Type
    con, ts :: [Type]
    ts) = Type -> (Type, [Type])
    splitTypeApp Type
    from
        ((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
    -> U ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
     -> U ())
    -> ((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
    -> U ()
    forall a b. (a -> b) -> a -> b
    $ \ (m :: Map Type Dec
    m, c :: Map Type Bool
    c) -> (Map Type Dec
    m, Type -> Bool -> Map Type Bool -> Map Type Bool
    forall a b. Eq a => a -> b -> Map a b -> Map a b
    mInsert Type
    from Bool
    False Map Type Bool
    c)        -- To make the fixpoint of the recursion False.
        Bool
    b <- case Type
    con of
             ConT n :: Name
    n    -> Name -> Type -> [Type] -> U Bool
    containsCon Name
    n Type
    to [Type]
    ts
             TupleT _  -> ([Bool] -> Bool)
    -> StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or (StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool)
    -> StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool
    forall a b. (a -> b) -> a -> b
    $ (Type -> U Bool)
    -> [Type] -> StateT (Map Type Dec, Map Type Bool) Q [Bool]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Type -> Type -> U Bool
    contains Type
    to) [Type]
    ts
             ArrowT    -> Bool -> U Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
             ListT     -> if Type
    to Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Type
    from then Bool -> U Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True else Type -> Type -> U Bool
    contains Type
    to ([Type] -> Type
    forall a. [a] -> a
    head [Type]
    ts)
             VarT _    -> Bool -> U Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
             t :: Type
    t         -> String -> U Bool
    forall a. String -> a
    genError (String -> U Bool) -> String -> U Bool
    forall a b. (a -> b) -> a -> b
    $ "contains: unexpected type: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Ppr a => a -> String
    pprint Type
    from String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " (" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Show a => a -> String
    show Type
    t String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ")"
        ((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
    -> U ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
     -> U ())
    -> ((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
    -> U ()
    forall a b. (a -> b) -> a -> b
    $ \ (m :: Map Type Dec
    m, c :: Map Type Bool
    c) -> (Map Type Dec
    m, Type -> Bool -> Map Type Bool -> Map Type Bool
    forall a b. Eq a => a -> b -> Map a b -> Map a b
    mInsert Type
    from Bool
    b Map Type Bool
    c)
        Bool -> U Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    b

    containsCon :: Name -> Type -> [Type] -> U Bool
    containsCon :: Name -> Type -> [Type] -> U Bool
    containsCon con :: Name
    con to :: Type
    to ts :: [Type]
    ts = do
    --    qRunIO $ print ("containsCon", con, to, ts)
        (tvs :: [TyVarBndr]
    tvs, cons :: [Con]
    cons) <- Name -> StateT (Map Type Dec, Map Type Bool) Q ([TyVarBndr], [Con])
    forall (q :: * -> *). Quasi q => Name -> q ([TyVarBndr], [Con])
    getTyConInfo Name
    con
        let conCon :: Con -> U Bool
    conCon (NormalC _ xs :: [BangType]
    xs) = ([Bool] -> Bool)
    -> StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or (StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool)
    -> StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool
    forall a b. (a -> b) -> a -> b
    $ (BangType -> U Bool)
    -> [BangType] -> StateT (Map Type Dec, Map Type Bool) Q [Bool]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Type -> U Bool
    field (Type -> U Bool) -> (BangType -> Type) -> BangType -> U Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . BangType -> Type
    forall a b. (a, b) -> b
    snd) [BangType]
    xs
            conCon (InfixC x1 :: BangType
    x1 _ x2 :: BangType
    x2) = ([Bool] -> Bool)
    -> StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or (StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool)
    -> StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool
    forall a b. (a -> b) -> a -> b
    $ (Type -> U Bool)
    -> [Type] -> StateT (Map Type Dec, Map Type Bool) Q [Bool]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Type -> U Bool
    field [BangType -> Type
    forall a b. (a, b) -> b
    snd BangType
    x1, BangType -> Type
    forall a b. (a, b) -> b
    snd BangType
    x2]
            conCon (RecC _ xs :: [VarBangType]
    xs) = ([Bool] -> Bool)
    -> StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or (StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool)
    -> StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool
    forall a b. (a -> b) -> a -> b
    $ (Type -> U Bool)
    -> [Type] -> StateT (Map Type Dec, Map Type Bool) Q [Bool]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Type -> U Bool
    field [ Type
    t | (_,_,t :: Type
    t) <- [VarBangType]
    xs ]
            conCon c :: Con
    c = String -> U Bool
    forall a. String -> a
    genError (String -> U Bool) -> String -> U Bool
    forall a b. (a -> b) -> a -> b
    $ "containsCon: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Con -> String
    forall a. Show a => a -> String
    show Con
    c
            s :: Subst
    s = [TyVarBndr] -> [Type] -> Subst
    mkSubst [TyVarBndr]
    tvs [Type]
    ts
            field :: Type -> U Bool
    field t :: Type
    t = Type -> Type -> U Bool
    contains Type
    to (Subst -> Type -> Type
    subst Subst
    s Type
    t)
        ([Bool] -> Bool)
    -> StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Bool] -> Bool
    forall (t :: * -> *). Foldable t => t Bool -> Bool
    or (StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool)
    -> StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool
    forall a b. (a -> b) -> a -> b
    $ (Con -> U Bool)
    -> [Con] -> StateT (Map Type Dec, Map Type Bool) Q [Bool]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Con -> U Bool
    conCon [Con]
    cons

    unFunD :: [Dec] -> [Clause]
    unFunD :: [Dec] -> [Clause]
    unFunD [FunD _ cs :: [Clause]
    cs] = [Clause]
    cs
    unFunD _ = String -> [Clause]
    forall a. String -> a
    genError (String -> [Clause]) -> String -> [Clause]
    forall a b. (a -> b) -> a -> b
    $ "unFunD"

    unFun :: Q [Dec] -> U [Clause]
    unFun :: Q [Dec] -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    unFun = Q [Clause] -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Q [Clause] -> StateT (Map Type Dec, Map Type Bool) Q [Clause])
    -> (Q [Dec] -> Q [Clause])
    -> Q [Dec]
    -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([Dec] -> [Clause]) -> Q [Dec] -> Q [Clause]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap [Dec] -> [Clause]
    unFunD

    uniBiCase :: Type -> Type -> U [Clause]
    uniBiCase :: Type -> Type -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    uniBiCase from :: Type
    from to :: Type
    to = do
        let (con :: Type
    con, ts :: [Type]
    ts) = Type -> (Type, [Type])
    splitTypeApp Type
    from
        case Type
    con of
            ConT n :: Name
    n    -> Name
    -> [Type]
    -> Type
    -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    uniBiCon Name
    n [Type]
    ts Type
    to
            TupleT _  -> [Type] -> Type -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    uniBiTuple [Type]
    ts Type
    to
    --        ArrowT    -> unFun [d| f _ _r = _r |]           -- Stop at functions
            ListT     -> Type -> Type -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    uniBiList ([Type] -> Type
    forall a. [a] -> a
    head [Type]
    ts) Type
    to
            t :: Type
    t         -> String -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall a. String -> a
    genError (String -> StateT (Map Type Dec, Map Type Bool) Q [Clause])
    -> String -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall a b. (a -> b) -> a -> b
    $ "uniBiCase: unexpected type: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Ppr a => a -> String
    pprint Type
    from String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " (" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Show a => a -> String
    show Type
    t String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ")"

    uniBiList :: Type -> Type -> U [Clause]
    uniBiList :: Type -> Type -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    uniBiList t :: Type
    t to :: Type
    to = do
        Exp
    uni <- Type -> Type -> StateT (Map Type Dec, Map Type Bool) Q Exp
    uniBi Type
    t Type
    to
        Exp
    rec <- Type -> Type -> StateT (Map Type Dec, Map Type Bool) Q Exp
    uniBi (Type -> Type -> Type
    AppT Type
    ListT Type
    t) Type
    to
        Q [Dec] -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    unFun [d| f [] _r = _r; f (_x:_xs) _r = $(return uni) _x ($(return rec) _xs _r) |]

    uniBiTuple :: [Type] -> Type -> U [Clause]
    uniBiTuple :: [Type] -> Type -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    uniBiTuple ts :: [Type]
    ts to :: Type
    to = (Clause -> [Clause])
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (Clause -> [Clause] -> [Clause]
    forall a. a -> [a] -> [a]
    :[]) (StateT (Map Type Dec, Map Type Bool) Q Clause
     -> StateT (Map Type Dec, Map Type Bool) Q [Clause])
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall a b. (a -> b) -> a -> b
    $ Type
    -> Subst
    -> ([Pat] -> Pat)
    -> [Type]
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    mkArm Type
    to [] [Pat] -> Pat
    TupP [Type]
    ts

    uniBiCon :: Name -> [Type] -> Type -> U [Clause]
    uniBiCon :: Name
    -> [Type]
    -> Type
    -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    uniBiCon con :: Name
    con ts :: [Type]
    ts to :: Type
    to = do
        (tvs :: [TyVarBndr]
    tvs, cons :: [Con]
    cons) <- Name -> StateT (Map Type Dec, Map Type Bool) Q ([TyVarBndr], [Con])
    forall (q :: * -> *). Quasi q => Name -> q ([TyVarBndr], [Con])
    getTyConInfo Name
    con
        let genArm :: Con -> StateT (Map Type Dec, Map Type Bool) Q Clause
    genArm (NormalC c :: Name
    c xs :: [BangType]
    xs) = ([Pat] -> Pat)
    -> [BangType] -> StateT (Map Type Dec, Map Type Bool) Q Clause
    forall a.
    ([Pat] -> Pat)
    -> [(a, Type)] -> StateT (Map Type Dec, Map Type Bool) Q Clause
    arm (Name -> [Pat] -> Pat
    ConP Name
    c) [BangType]
    xs
            genArm (InfixC x1 :: BangType
    x1 c :: Name
    c x2 :: BangType
    x2) = ([Pat] -> Pat)
    -> [BangType] -> StateT (Map Type Dec, Map Type Bool) Q Clause
    forall a.
    ([Pat] -> Pat)
    -> [(a, Type)] -> StateT (Map Type Dec, Map Type Bool) Q Clause
    arm (\ [p1 :: Pat
    p1, p2 :: Pat
    p2] -> Pat -> Name -> Pat -> Pat
    InfixP Pat
    p1 Name
    c Pat
    p2) [BangType
    x1, BangType
    x2]
            genArm (RecC c :: Name
    c xs :: [VarBangType]
    xs) = ([Pat] -> Pat)
    -> [BangType] -> StateT (Map Type Dec, Map Type Bool) Q Clause
    forall a.
    ([Pat] -> Pat)
    -> [(a, Type)] -> StateT (Map Type Dec, Map Type Bool) Q Clause
    arm (Name -> [Pat] -> Pat
    ConP Name
    c) [ (Bang
    b,Type
    t) | (_,b :: Bang
    b,t :: Type
    t) <- [VarBangType]
    xs ]
            genArm c :: Con
    c = String -> StateT (Map Type Dec, Map Type Bool) Q Clause
    forall a. String -> a
    genError (String -> StateT (Map Type Dec, Map Type Bool) Q Clause)
    -> String -> StateT (Map Type Dec, Map Type Bool) Q Clause
    forall a b. (a -> b) -> a -> b
    $ "uniBiCon: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Con -> String
    forall a. Show a => a -> String
    show Con
    c
            s :: Subst
    s = [TyVarBndr] -> [Type] -> Subst
    mkSubst [TyVarBndr]
    tvs [Type]
    ts
            arm :: ([Pat] -> Pat)
    -> [(a, Type)] -> StateT (Map Type Dec, Map Type Bool) Q Clause
    arm c :: [Pat] -> Pat
    c xs :: [(a, Type)]
    xs = Type
    -> Subst
    -> ([Pat] -> Pat)
    -> [Type]
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    mkArm Type
    to Subst
    s [Pat] -> Pat
    c ([Type] -> StateT (Map Type Dec, Map Type Bool) Q Clause)
    -> [Type] -> StateT (Map Type Dec, Map Type Bool) Q Clause
    forall a b. (a -> b) -> a -> b
    $ ((a, Type) -> Type) -> [(a, Type)] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map (a, Type) -> Type
    forall a b. (a, b) -> b
    snd [(a, Type)]
    xs

        if [Con] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [Con]
    cons then
            -- No constructurs, return nothing
            Q [Dec] -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    unFun [d| f _ _r = _r |]
         else
            (Con -> StateT (Map Type Dec, Map Type Bool) Q Clause)
    -> [Con] -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Con -> StateT (Map Type Dec, Map Type Bool) Q Clause
    genArm [Con]
    cons

    mkArm :: Type -> Subst -> ([Pat] -> Pat) -> [Type] -> U Clause
    mkArm :: Type
    -> Subst
    -> ([Pat] -> Pat)
    -> [Type]
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    mkArm to :: Type
    to s :: Subst
    s c :: [Pat] -> Pat
    c ts :: [Type]
    ts = do
        Name
    r <- String -> U Name
    forall (m :: * -> *). Quasi m => String -> m Name
    qNewName "_r"
        [Name]
    vs <- (Type -> U Name)
    -> [Type] -> StateT (Map Type Dec, Map Type Bool) Q [Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (U Name -> Type -> U Name
    forall a b. a -> b -> a
    const (U Name -> Type -> U Name) -> U Name -> Type -> U Name
    forall a b. (a -> b) -> a -> b
    $ String -> U Name
    forall (m :: * -> *). Quasi m => String -> m Name
    qNewName "_x") [Type]
    ts
        let sub :: Name -> Type -> StateT (Map Type Dec, Map Type Bool) Q (Exp -> Exp)
    sub v :: Name
    v t :: Type
    t = do
                let t' :: Type
    t' = Subst -> Type -> Type
    subst Subst
    s Type
    t
                Exp
    uni <- Type -> Type -> StateT (Map Type Dec, Map Type Bool) Q Exp
    uniBi Type
    t' Type
    to
                (Exp -> Exp) -> StateT (Map Type Dec, Map Type Bool) Q (Exp -> Exp)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Exp -> Exp)
     -> StateT (Map Type Dec, Map Type Bool) Q (Exp -> Exp))
    -> (Exp -> Exp)
    -> StateT (Map Type Dec, Map Type Bool) Q (Exp -> Exp)
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    AppE (Exp -> Exp -> Exp
    AppE Exp
    uni (Name -> Exp
    VarE Name
    v))
        [Exp -> Exp]
    es <- (Name
     -> Type -> StateT (Map Type Dec, Map Type Bool) Q (Exp -> Exp))
    -> [Name]
    -> [Type]
    -> StateT (Map Type Dec, Map Type Bool) Q [Exp -> Exp]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Name -> Type -> StateT (Map Type Dec, Map Type Bool) Q (Exp -> Exp)
    sub [Name]
    vs [Type]
    ts
        let body :: Exp
    body = ((Exp -> Exp) -> Exp -> Exp) -> Exp -> [Exp -> Exp] -> Exp
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    ($) (Name -> Exp
    VarE Name
    r) [Exp -> Exp]
    es
        Clause -> StateT (Map Type Dec, Map Type Bool) Q Clause
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Clause -> StateT (Map Type Dec, Map Type Bool) Q Clause)
    -> Clause -> StateT (Map Type Dec, Map Type Bool) Q Clause
    forall a b. (a -> b) -> a -> b
    $ [Pat] -> Body -> [Dec] -> Clause
    Clause [[Pat] -> Pat
    c ((Name -> Pat) -> [Name] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Pat
    VarP [Name]
    vs), Name -> Pat
    VarP Name
    r] (Exp -> Body
    NormalB Exp
    body) []

    type Subst = [(Name, Type)]

    mkSubst :: [TyVarBndr] -> [Type] -> Subst
    mkSubst :: [TyVarBndr] -> [Type] -> Subst
    mkSubst vs :: [TyVarBndr]
    vs ts :: [Type]
    ts =
       let vs' :: [Name]
    vs' = (TyVarBndr -> Name) -> [TyVarBndr] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map TyVarBndr -> Name
    un [TyVarBndr]
    vs
           un :: TyVarBndr -> Name
    un (PlainTV v :: Name
    v) = Name
    v
           un (KindedTV v :: Name
    v _) = Name
    v
       in  Bool -> Subst -> Subst
    forall a. HasCallStack => Bool -> a -> a
    assert ([Name] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Name]
    vs' Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == [Type] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [Type]
    ts) (Subst -> Subst) -> Subst -> Subst
    forall a b. (a -> b) -> a -> b
    $ [Name] -> [Type] -> Subst
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Name]
    vs' [Type]
    ts

    subst :: Subst -> Type -> Type
    subst :: Subst -> Type -> Type
    subst s :: Subst
    s (ForallT v :: [TyVarBndr]
    v c :: [Type]
    c t :: Type
    t) = [TyVarBndr] -> [Type] -> Type -> Type
    ForallT [TyVarBndr]
    v [Type]
    c (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ Subst -> Type -> Type
    subst Subst
    s Type
    t
    subst s :: Subst
    s t :: Type
    t@(VarT n :: Name
    n) = Type -> Maybe Type -> Type
    forall a. a -> Maybe a -> a
    fromMaybe Type
    t (Maybe Type -> Type) -> Maybe Type -> Type
    forall a b. (a -> b) -> a -> b
    $ Name -> Subst -> Maybe Type
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup Name
    n Subst
    s
    subst s :: Subst
    s (AppT t1 :: Type
    t1 t2 :: Type
    t2) = Type -> Type -> Type
    AppT (Subst -> Type -> Type
    subst Subst
    s Type
    t1) (Subst -> Type -> Type
    subst Subst
    s Type
    t2)
    subst s :: Subst
    s (SigT t :: Type
    t k :: Type
    k) = Type -> Type -> Type
    SigT (Subst -> Type -> Type
    subst Subst
    s Type
    t) Type
    k
    subst _ t :: Type
    t = Type
    t

    getTyConInfo :: (Quasi q) => Name -> q ([TyVarBndr], [Con])
    getTyConInfo :: Name -> q ([TyVarBndr], [Con])
    getTyConInfo con :: Name
    con = do
        Info
    info <- Name -> q Info
    forall (m :: * -> *). Quasi m => Name -> m Info
    qReify Name
    con
        case Info
    info of
    #if __GLASGOW_HASKELL__ <= 710
            TyConI (DataD _ _ tvs cs _)   -> return (tvs, cs)
            TyConI (NewtypeD _ _ tvs c _) -> return (tvs, [c])
    #else
            TyConI (DataD _ _ tvs :: [TyVarBndr]
    tvs _ cs :: [Con]
    cs _)   -> ([TyVarBndr], [Con]) -> q ([TyVarBndr], [Con])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([TyVarBndr]
    tvs, [Con]
    cs)
            TyConI (NewtypeD _ _ tvs :: [TyVarBndr]
    tvs _ c :: Con
    c _) -> ([TyVarBndr], [Con]) -> q ([TyVarBndr], [Con])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([TyVarBndr]
    tvs, [Con
    c])
    #endif
            PrimTyConI{} -> ([TyVarBndr], [Con]) -> q ([TyVarBndr], [Con])
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [])
            i :: Info
    i -> String -> q ([TyVarBndr], [Con])
    forall a. String -> a
    genError (String -> q ([TyVarBndr], [Con]))
    -> String -> q ([TyVarBndr], [Con])
    forall a b. (a -> b) -> a -> b
    $ "unexpected TyCon: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Info -> String
    forall a. Show a => a -> String
    show Info
    i

    splitType :: (Quasi q) => Type -> q ([TyVarBndr], Type, Type)
    splitType :: Type -> q ([TyVarBndr], Type, Type)
    splitType t :: Type
    t =
      case Type
    t of
        (ForallT tvs :: [TyVarBndr]
    tvs _ t :: Type
    t) -> do
          (tvs' :: [TyVarBndr]
    tvs', from :: Type
    from, to :: Type
    to) <- Type -> q ([TyVarBndr], Type, Type)
    forall (q :: * -> *).
    Quasi q =>
    Type -> q ([TyVarBndr], Type, Type)
    splitType Type
    t
          ([TyVarBndr], Type, Type) -> q ([TyVarBndr], Type, Type)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([TyVarBndr]
    tvs [TyVarBndr] -> [TyVarBndr] -> [TyVarBndr]
    forall a. [a] -> [a] -> [a]
    ++ [TyVarBndr]
    tvs', Type
    from, Type
    to)
        (AppT (AppT ArrowT from :: Type
    from) to :: Type
    to) -> ([TyVarBndr], Type, Type) -> q ([TyVarBndr], Type, Type)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], Type
    from, Type
    to)
        _ -> String -> q ([TyVarBndr], Type, Type)
    forall a. String -> a
    genError (String -> q ([TyVarBndr], Type, Type))
    -> String -> q ([TyVarBndr], Type, Type)
    forall a b. (a -> b) -> a -> b
    $ "Type is not an arrow: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Ppr a => a -> String
    pprint Type
    t

    getNameType :: (Quasi q) => Name -> q ([TyVarBndr], Type, Type)
    getNameType :: Name -> q ([TyVarBndr], Type, Type)
    getNameType name :: Name
    name = do
        Info
    info <- Name -> q Info
    forall (m :: * -> *). Quasi m => Name -> m Info
    qReify Name
    name
        case Info
    info of
    #if __GLASGOW_HASKELL__ <= 710
            VarI _ t _ _ -> splitType t
    #else
            VarI _ t :: Type
    t _  -> Type -> q ([TyVarBndr], Type, Type)
    forall (q :: * -> *).
    Quasi q =>
    Type -> q ([TyVarBndr], Type, Type)
    splitType Type
    t
    #endif
            _ -> String -> q ([TyVarBndr], Type, Type)
    forall a. String -> a
    genError (String -> q ([TyVarBndr], Type, Type))
    -> String -> q ([TyVarBndr], Type, Type)
    forall a b. (a -> b) -> a -> b
    $ "Name is not variable: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    forall a. Ppr a => a -> String
    pprint Name
    name

    unList :: Type -> Type
    unList :: Type -> Type
    unList (AppT (ConT n :: Name
    n) t :: Type
    t) | Name
    n Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == ''[] = Type
    t
    unList (AppT ListT t :: Type
    t) = Type
    t
    unList t :: Type
    t = String -> Type
    forall a. String -> a
    genError (String -> Type) -> String -> Type
    forall a b. (a -> b) -> a -> b
    $ "universeBi: Type is not a list: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Ppr a => a -> String
    pprint Type
    t -- ++ " (" ++ show t ++ ")"

    splitTypeApp :: Type -> (Type, [Type])
    splitTypeApp :: Type -> (Type, [Type])
    splitTypeApp (AppT a :: Type
    a r :: Type
    r) = (Type
    c, [Type]
    rs [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ [Type
    r]) where (c :: Type
    c, rs :: [Type]
    rs) = Type -> (Type, [Type])
    splitTypeApp Type
    a
    splitTypeApp t :: Type
    t = (Type
    t, [])

    expandSyn :: (Quasi q) => Type -> q Type
    expandSyn :: Type -> q Type
    expandSyn (ForallT tvs :: [TyVarBndr]
    tvs ctx :: [Type]
    ctx t :: Type
    t) = (Type -> Type) -> q Type -> q Type
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ([TyVarBndr] -> [Type] -> Type -> Type
    ForallT [TyVarBndr]
    tvs [Type]
    ctx) (q Type -> q Type) -> q Type -> q Type
    forall a b. (a -> b) -> a -> b
    $ Type -> q Type
    forall (q :: * -> *). Quasi q => Type -> q Type
    expandSyn Type
    t
    expandSyn t :: Type
    t@AppT{} = Type -> [Type] -> q Type
    forall (q :: * -> *). Quasi q => Type -> [Type] -> q Type
    expandSynApp Type
    t []
    expandSyn t :: Type
    t@ConT{} = Type -> [Type] -> q Type
    forall (q :: * -> *). Quasi q => Type -> [Type] -> q Type
    expandSynApp Type
    t []
    expandSyn (SigT t :: Type
    t k :: Type
    k) = Type -> q Type
    forall (q :: * -> *). Quasi q => Type -> q Type
    expandSyn Type
    t   -- Ignore kind synonyms
    expandSyn t :: Type
    t = Type -> q Type
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    t

    expandSynApp :: (Quasi q) => Type -> [Type] -> q Type
    expandSynApp :: Type -> [Type] -> q Type
    expandSynApp (AppT t1 :: Type
    t1 t2 :: Type
    t2) ts :: [Type]
    ts = do Type
    t2' <- Type -> q Type
    forall (q :: * -> *). Quasi q => Type -> q Type
    expandSyn Type
    t2; Type -> [Type] -> q Type
    forall (q :: * -> *). Quasi q => Type -> [Type] -> q Type
    expandSynApp Type
    t1 (Type
    t2'Type -> [Type] -> [Type]
    forall a. a -> [a] -> [a]
    :[Type]
    ts)
    expandSynApp (ConT n :: Name
    n) ts :: [Type]
    ts | Name -> String
    nameBase Name
    n String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == "[]" = Type -> q Type
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> q Type) -> Type -> q Type
    forall a b. (a -> b) -> a -> b
    $ (Type -> Type -> Type) -> Type -> [Type] -> Type
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Type -> Type -> Type
    AppT Type
    ListT [Type]
    ts
    expandSynApp t :: Type
    t@(ConT n :: Name
    n) ts :: [Type]
    ts = do
        Info
    info <- Name -> q Info
    forall (m :: * -> *). Quasi m => Name -> m Info
    qReify Name
    n
        case Info
    info of
            TyConI (TySynD _ tvs :: [TyVarBndr]
    tvs rhs :: Type
    rhs) ->
                let (ts' :: [Type]
    ts', ts'' :: [Type]
    ts'') = Int -> [Type] -> ([Type], [Type])
    forall a. Int -> [a] -> ([a], [a])
    splitAt ([TyVarBndr] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [TyVarBndr]
    tvs) [Type]
    ts
                    s :: Subst
    s = [TyVarBndr] -> [Type] -> Subst
    mkSubst [TyVarBndr]
    tvs [Type]
    ts'
                    rhs' :: Type
    rhs' = Subst -> Type -> Type
    subst Subst
    s Type
    rhs
                in  Type -> [Type] -> q Type
    forall (q :: * -> *). Quasi q => Type -> [Type] -> q Type
    expandSynApp Type
    rhs' [Type]
    ts''
            _ -> Type -> q Type
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> q Type) -> Type -> q Type
    forall a b. (a -> b) -> a -> b
    $ (Type -> Type -> Type) -> Type -> [Type] -> Type
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Type -> Type -> Type
    AppT Type
    t [Type]
    ts
    expandSynApp t :: Type
    t ts :: [Type]
    ts = do Type
    t' <- Type -> q Type
    forall (q :: * -> *). Quasi q => Type -> q Type
    expandSyn Type
    t; Type -> q Type
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Type -> q Type) -> Type -> q Type
    forall a b. (a -> b) -> a -> b
    $ (Type -> Type -> Type) -> Type -> [Type] -> Type
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Type -> Type -> Type
    AppT Type
    t' [Type]
    ts

    genError :: String -> a
    genError :: String -> a
    genError msg :: String
    msg = String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ "Data.Generics.Geniplate: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    msg

    ----------------------------------------------------

    -- Exp has type (S -> S) -> T -> T, for some S and T
    -- | Generate TH code for a function that transforms all subparts of a certain type.
    -- The argument to 'genTransformBi' is a name with the type @(S->S) -> T -> T@, for some types
    -- @S@ and @T@.  The function will transform all subparts of type @S@ inside @T@ using the given function.
    genTransformBi :: Name       -- ^function of type @(S->S) -> T -> T@
                   -> Q Exp
    genTransformBi :: Name -> Q Exp
    genTransformBi = [TypeQ] -> Name -> Q Exp
    genTransformBiT []

    genTransformBi' :: TypeQ -> Q Exp
    genTransformBi' :: TypeQ -> Q Exp
    genTransformBi' = [TypeQ] -> TypeQ -> Q Exp
    genTransformBiT' []

    -- | Same as 'genTransformBi', but does not look inside any types mention in the
    -- list of types.
    genTransformBiT :: [TypeQ] -> Name -> Q Exp
    genTransformBiT :: [TypeQ] -> Name -> Q Exp
    genTransformBiT = RetAp -> [TypeQ] -> Name -> Q Exp
    transformBiG RetAp
    raNormal

    genTransformBiT' :: [TypeQ] -> TypeQ -> Q Exp
    genTransformBiT' :: [TypeQ] -> TypeQ -> Q Exp
    genTransformBiT' = RetAp -> [TypeQ] -> TypeQ -> Q Exp
    transformBiG' RetAp
    raNormal

    raNormal :: RetAp
    raNormal :: RetAp
    raNormal = (Exp -> Exp
    forall a. a -> a
    id, Exp -> Exp -> Exp
    AppE, Exp -> Exp -> Exp
    AppE)

    genTransformBiM :: Name -> Q Exp
    genTransformBiM :: Name -> Q Exp
    genTransformBiM = [TypeQ] -> Name -> Q Exp
    genTransformBiMT []

    genTransformBiM' :: TypeQ -> Q Exp
    genTransformBiM' :: TypeQ -> Q Exp
    genTransformBiM' = [TypeQ] -> TypeQ -> Q Exp
    genTransformBiMT' []

    genTransformBiMT :: [TypeQ] -> Name -> Q Exp
    genTransformBiMT :: [TypeQ] -> Name -> Q Exp
    genTransformBiMT = RetAp -> [TypeQ] -> Name -> Q Exp
    transformBiG RetAp
    raMonad

    genTransformBiMT' :: [TypeQ] -> TypeQ -> Q Exp
    genTransformBiMT' :: [TypeQ] -> TypeQ -> Q Exp
    genTransformBiMT' = RetAp -> [TypeQ] -> TypeQ -> Q Exp
    transformBiG' RetAp
    raMonad

    raMonad :: RetAp
    raMonad :: RetAp
    raMonad = (Exp -> Exp
    eret, Exp -> Exp -> Exp
    eap, Exp -> Exp -> Exp
    emap)
      where eret :: Exp -> Exp
    eret e :: Exp
    e = Exp -> Exp -> Exp
    AppE (Name -> Exp
    VarE 'Control.Monad.return) Exp
    e
            eap :: Exp -> Exp -> Exp
    eap f :: Exp
    f a :: Exp
    a = Exp -> Exp -> Exp
    AppE (Exp -> Exp -> Exp
    AppE (Name -> Exp
    VarE 'Control.Monad.ap) Exp
    f) Exp
    a
            emap :: Exp -> Exp -> Exp
    emap f :: Exp
    f a :: Exp
    a = Exp -> Exp -> Exp
    AppE (Exp -> Exp -> Exp
    AppE (Name -> Exp
    VarE '(Control.Monad.=<<)) Exp
    f) Exp
    a

    type RetAp = (Exp -> Exp, Exp -> Exp -> Exp, Exp -> Exp -> Exp)

    transformBiG :: RetAp -> [TypeQ] -> Name -> Q Exp
    transformBiG :: RetAp -> [TypeQ] -> Name -> Q Exp
    transformBiG ra :: RetAp
    ra stops :: [TypeQ]
    stops = Name -> Q ([TyVarBndr], Type, Type)
    forall (q :: * -> *).
    Quasi q =>
    Name -> q ([TyVarBndr], Type, Type)
    getNameType (Name -> Q ([TyVarBndr], Type, Type))
    -> (([TyVarBndr], Type, Type) -> Q Exp) -> Name -> Q Exp
    forall (m :: * -> *) a b c.
    Monad m =>
    (a -> m b) -> (b -> m c) -> a -> m c
    >=> Mode -> RetAp -> [TypeQ] -> ([TyVarBndr], Type, Type) -> Q Exp
    forall t. Mode -> RetAp -> [TypeQ] -> (t, Type, Type) -> Q Exp
    transformBiGsplit Mode
    MTransformBi RetAp
    ra [TypeQ]
    stops

    transformBiG' :: RetAp -> [TypeQ] -> TypeQ -> Q Exp
    transformBiG' :: RetAp -> [TypeQ] -> TypeQ -> Q Exp
    transformBiG' ra :: RetAp
    ra stops :: [TypeQ]
    stops q :: TypeQ
    q = TypeQ
    q TypeQ
    -> (Type -> Q ([TyVarBndr], Type, Type))
    -> Q ([TyVarBndr], Type, Type)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Type -> Q ([TyVarBndr], Type, Type)
    forall (q :: * -> *).
    Quasi q =>
    Type -> q ([TyVarBndr], Type, Type)
    splitType Q ([TyVarBndr], Type, Type)
    -> (([TyVarBndr], Type, Type) -> Q Exp) -> Q Exp
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Mode -> RetAp -> [TypeQ] -> ([TyVarBndr], Type, Type) -> Q Exp
    forall t. Mode -> RetAp -> [TypeQ] -> (t, Type, Type) -> Q Exp
    transformBiGsplit Mode
    MTransformBi RetAp
    ra [TypeQ]
    stops

    transformBiGsplit :: Mode -> RetAp -> [TypeQ] -> (t, Type, Type) -> Q Exp
    transformBiGsplit :: Mode -> RetAp -> [TypeQ] -> (t, Type, Type) -> Q Exp
    transformBiGsplit doDescend :: Mode
    doDescend ra :: RetAp
    ra stops :: [TypeQ]
    stops (_tvs :: t
    _tvs,fcn :: Type
    fcn,res :: Type
    res) = do
        Name
    f <- String -> Q Name
    newName "_f"
        Name
    x <- String -> Q Name
    newName "_x"
        (ds :: [Dec]
    ds, tr :: Exp
    tr) <-
            case (Type
    fcn, Type
    res) of
                (AppT (AppT ArrowT s :: Type
    s) s' :: Type
    s',          AppT (AppT ArrowT t :: Type
    t) t' :: Type
    t')           | Type
    s Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Type
    s' Bool -> Bool -> Bool
    && Type
    t Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Type
    t'            -> Mode -> RetAp -> [TypeQ] -> Name -> Type -> Type -> Q ([Dec], Exp)
    trBiQ Mode
    doDescend RetAp
    ra [TypeQ]
    stops Name
    f Type
    s Type
    t
                (AppT (AppT ArrowT s :: Type
    s) (AppT m :: Type
    m s' :: Type
    s'), AppT (AppT ArrowT t :: Type
    t) (AppT m' :: Type
    m' t' :: Type
    t')) | Type
    s Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Type
    s' Bool -> Bool -> Bool
    && Type
    t Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Type
    t' Bool -> Bool -> Bool
    && Type
    m Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Type
    m' -> Mode -> RetAp -> [TypeQ] -> Name -> Type -> Type -> Q ([Dec], Exp)
    trBiQ Mode
    doDescend RetAp
    ra [TypeQ]
    stops Name
    f Type
    s Type
    t
                _ -> String -> Q ([Dec], Exp)
    forall a. String -> a
    genError (String -> Q ([Dec], Exp)) -> String -> Q ([Dec], Exp)
    forall a b. (a -> b) -> a -> b
    $ "transformBi: malformed type: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Ppr a => a -> String
    pprint (Type -> Type -> Type
    AppT (Type -> Type -> Type
    AppT Type
    ArrowT Type
    fcn) Type
    res) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ", should have form (S->S) -> (T->T)"
        let e :: Exp
    e = [Pat] -> Exp -> Exp
    LamE [Name -> Pat
    VarP Name
    f, Name -> Pat
    VarP Name
    x] (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ [Dec] -> Exp -> Exp
    LetE [Dec]
    ds (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    AppE Exp
    tr (Name -> Exp
    VarE Name
    x)
    --    qRunIO $ do putStrLn $ pprint e; hFlush stdout
        Exp -> Q Exp
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    e

    trBiQ :: Mode -> RetAp -> [TypeQ] -> Name -> Type -> Type -> Q ([Dec], Exp)
    trBiQ :: Mode -> RetAp -> [TypeQ] -> Name -> Type -> Type -> Q ([Dec], Exp)
    trBiQ doDescend :: Mode
    doDescend ra :: RetAp
    ra stops :: [TypeQ]
    stops f :: Name
    f aft :: Type
    aft st :: Type
    st = do
        [Type]
    ss <- [TypeQ] -> Q [Type]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    sequence [TypeQ]
    stops
        Type
    ft <- Type -> TypeQ
    forall (q :: * -> *). Quasi q => Type -> q Type
    expandSyn Type
    aft
        (tr :: Exp
    tr, (m :: Map Type Dec
    m, _)) <- StateT (Map Type Dec, Map Type Bool) Q Exp
    -> (Map Type Dec, Map Type Bool)
    -> Q (Exp, (Map Type Dec, Map Type Bool))
    forall s (m :: * -> *) a. StateT s m a -> s -> m (a, s)
    runStateT (Bool
    -> Mode
    -> RetAp
    -> Exp
    -> Type
    -> Type
    -> StateT (Map Type Dec, Map Type Bool) Q Exp
    trBi Bool
    False Mode
    doDescend RetAp
    ra (Name -> Exp
    VarE Name
    f) Type
    ft Type
    st) (Map Type Dec
    forall a b. Map a b
    mEmpty, [(Type, Bool)] -> Map Type Bool
    forall a b. [(a, b)] -> Map a b
    mFromList ([(Type, Bool)] -> Map Type Bool)
    -> [(Type, Bool)] -> Map Type Bool
    forall a b. (a -> b) -> a -> b
    $ [Type] -> [Bool] -> [(Type, Bool)]
    forall a b. [a] -> [b] -> [(a, b)]
    zip [Type]
    ss (Bool -> [Bool]
    forall a. a -> [a]
    repeat Bool
    False))
        ([Dec], Exp) -> Q ([Dec], Exp)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Map Type Dec -> [Dec]
    forall a b. Map a b -> [b]
    mElems Map Type Dec
    m, Exp
    tr)

    --arrow :: Type -> Type -> Type
    --arrow t1 t2 = AppT (AppT ArrowT t1) t2

    trBi :: Bool -> Mode -> RetAp -> Exp -> Type -> Type -> U Exp
    --trBi True DescendBiM (ret, _, _) _ _ _ = return ret
    trBi :: Bool
    -> Mode
    -> RetAp
    -> Exp
    -> Type
    -> Type
    -> StateT (Map Type Dec, Map Type Bool) Q Exp
    trBi seenStop :: Bool
    seenStop doDescend :: Mode
    doDescend ra :: RetAp
    ra@(ret :: Exp -> Exp
    ret, _, rbind :: Exp -> Exp -> Exp
    rbind) f :: Exp
    f ft :: Type
    ft ast :: Type
    ast = do
    --    qRunIO $ do print (seenStop, doDescend, ft, ast); hFlush stdout
        (m :: Map Type Dec
    m, c :: Map Type Bool
    c) <- StateT
      (Map Type Dec, Map Type Bool) Q (Map Type Dec, Map Type Bool)
    forall s (m :: * -> *). MonadState s m => m s
    get
        Type
    st <- Type -> StateT (Map Type Dec, Map Type Bool) Q Type
    forall (q :: * -> *). Quasi q => Type -> q Type
    expandSyn Type
    ast
    --    qRunIO $ print (ft, st)
    {-
        if ft == st && seenStop && doDescend == MDescend then
          return f
         else
    -}
        case Type -> Map Type Dec -> Maybe Dec
    forall a b. Eq a => a -> Map a b -> Maybe b
    mLookup Type
    st Map Type Dec
    m of
            Just (FunD n :: Name
    n _) -> do
    --            qRunIO $ print ("found", ft == st, seenStop, doDescend == MDescend)
                if Mode
    doDescend Mode -> Mode -> Bool
    forall a. Eq a => a -> a -> Bool
    == Mode
    MDescend Bool -> Bool -> Bool
    && Type
    ft Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Type
    st then
                    Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    f
                 else
                    Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp)
    -> Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    n
            _ -> do
                Name
    tr <- String -> U Name
    forall (m :: * -> *). Quasi m => String -> m Name
    qNewName "_tr"
                let mkRec :: Bool -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    mkRec same :: Bool
    same = do
    --                    qRunIO $ do putStrLn $ "mkRec " ++ show (same, tr); hFlush stdout
                        (Map Type Dec, Map Type Bool) -> U ()
    forall s (m :: * -> *). MonadState s m => s -> m ()
    put (Type -> Dec -> Map Type Dec -> Map Type Dec
    forall a b. Eq a => a -> b -> Map a b -> Map a b
    mInsert Type
    st (Name -> [Clause] -> Dec
    FunD Name
    tr [[Pat] -> Body -> [Dec] -> Clause
    Clause [] (Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $ [Exp] -> Exp
    TupE []) []]) Map Type Dec
    m, Map Type Bool
    c)  -- insert something to break recursion, will be replaced below.
                        Bool
    -> Mode
    -> RetAp
    -> Exp
    -> Type
    -> Type
    -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    trBiCase Bool
    same Mode
    doDescend RetAp
    ra Exp
    f Type
    ft Type
    st

                [Clause]
    cs <- if Type
    ft Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Type
    st then do
                          Bool
    b <- Type -> Type -> U Bool
    contains' Type
    ft Type
    st
    --                      qRunIO $ do print ("equal", b, doDescend == MDescend, seenStop); hFlush stdout
                          if Bool
    b then do
    --                          qRunIO $ do putStrLn "create g"; hFlush stdout
                              Name
    g <- String -> U Name
    forall (m :: * -> *). Quasi m => String -> m Name
    qNewName "_g"
                              [Clause]
    gcs <- Bool -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    mkRec Bool
    True
                              let dg :: Dec
    dg = Name -> [Clause] -> Dec
    FunD Name
    g [Clause]
    gcs
                              -- Insert with a dummy type, just to get the definition in the map for mElems.
                              ((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
    -> U ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
     -> U ())
    -> ((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
    -> U ()
    forall a b. (a -> b) -> a -> b
    $ \ (m' :: Map Type Dec
    m', c' :: Map Type Bool
    c') -> (Type -> Dec -> Map Type Dec -> Map Type Dec
    forall a b. Eq a => a -> b -> Map a b -> Map a b
    mInsert (Name -> Type
    ConT Name
    g) Dec
    dg Map Type Dec
    m', Map Type Bool
    c')
                              Name
    x <- String -> U Name
    forall (m :: * -> *). Quasi m => String -> m Name
    qNewName "_x"
                              let f' :: Exp -> Exp
    f' = if Mode
    doDescend Mode -> Mode -> Bool
    forall a. Eq a => a -> a -> Bool
    == Mode
    MDescend then Exp -> Exp
    forall a. a -> a
    id else Exp -> Exp -> Exp
    rbind Exp
    f
                              [Clause] -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [[Pat] -> Body -> [Dec] -> Clause
    Clause [Name -> Pat
    VarP Name
    x] (Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp
    f' (Exp -> Exp -> Exp
    AppE (Name -> Exp
    VarE Name
    g) (Name -> Exp
    VarE Name
    x))) []]
                           else do
    --                          qRunIO $ do putStrLn "call f"; hFlush stdout
                              Name
    x <- String -> U Name
    forall (m :: * -> *). Quasi m => String -> m Name
    qNewName "_x"
                              [Clause] -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [[Pat] -> Body -> [Dec] -> Clause
    Clause [Name -> Pat
    VarP Name
    x] (Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    AppE Exp
    f (Name -> Exp
    VarE Name
    x)) []]
                      else do
                          Bool
    b <- Type -> Type -> U Bool
    contains Type
    ft Type
    st
    --                      qRunIO $ print (b, ft, st)
                          if Bool
    b then do
                              Bool -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    mkRec Bool
    False
                           else do
                              Name
    x <- String -> U Name
    forall (m :: * -> *). Quasi m => String -> m Name
    qNewName "_x"
                              [Clause] -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [[Pat] -> Body -> [Dec] -> Clause
    Clause [Name -> Pat
    VarP Name
    x] (Exp -> Body
    NormalB (Exp -> Body) -> Exp -> Body
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp
    ret (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    x) []]
                let d :: Dec
    d = Name -> [Clause] -> Dec
    FunD Name
    tr [Clause]
    cs
                ((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
    -> U ()
    forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
    modify (((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
     -> U ())
    -> ((Map Type Dec, Map Type Bool) -> (Map Type Dec, Map Type Bool))
    -> U ()
    forall a b. (a -> b) -> a -> b
    $ \ (m' :: Map Type Dec
    m', c' :: Map Type Bool
    c') -> (Type -> Dec -> Map Type Dec -> Map Type Dec
    forall a b. Eq a => a -> b -> Map a b -> Map a b
    mInsert Type
    st Dec
    d Map Type Dec
    m', Map Type Bool
    c')  -- overwrite dummy binding from mkRec
                Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp)
    -> Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp
    forall a b. (a -> b) -> a -> b
    $ Name -> Exp
    VarE Name
    tr

    trBiCase :: Bool -> Mode -> RetAp -> Exp -> Type -> Type -> U [Clause]
    trBiCase :: Bool
    -> Mode
    -> RetAp
    -> Exp
    -> Type
    -> Type
    -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    trBiCase seenStop :: Bool
    seenStop doDescend :: Mode
    doDescend ra :: RetAp
    ra f :: Exp
    f ft :: Type
    ft st :: Type
    st = do
        let (con :: Type
    con, ts :: [Type]
    ts) = Type -> (Type, [Type])
    splitTypeApp Type
    st
        case Type
    con of
            ConT n :: Name
    n    -> Bool
    -> Mode
    -> RetAp
    -> Exp
    -> Name
    -> Type
    -> Type
    -> [Type]
    -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    trBiCon Bool
    seenStop Mode
    doDescend RetAp
    ra Exp
    f Name
    n Type
    ft Type
    st [Type]
    ts
            TupleT _  -> Bool
    -> Mode
    -> RetAp
    -> Exp
    -> Type
    -> Type
    -> [Type]
    -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    trBiTuple Bool
    seenStop Mode
    doDescend RetAp
    ra Exp
    f Type
    ft Type
    st [Type]
    ts
    --        ArrowT    -> unFun [d| f _ _r = _r |]           -- Stop at functions
            ListT     -> Bool
    -> Mode
    -> RetAp
    -> Exp
    -> Type
    -> Type
    -> Type
    -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    trBiList Bool
    seenStop Mode
    doDescend RetAp
    ra Exp
    f Type
    ft Type
    st ([Type] -> Type
    forall a. [a] -> a
    head [Type]
    ts)
            _         -> String -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall a. String -> a
    genError (String -> StateT (Map Type Dec, Map Type Bool) Q [Clause])
    -> String -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall a b. (a -> b) -> a -> b
    $ "trBiCase: unexpected type: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Ppr a => a -> String
    pprint Type
    st String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ " (" String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Type -> String
    forall a. Show a => a -> String
    show Type
    st String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ ")"

    trBiList :: Bool -> Mode -> RetAp -> Exp -> Type -> Type -> Type -> U [Clause]
    trBiList :: Bool
    -> Mode
    -> RetAp
    -> Exp
    -> Type
    -> Type
    -> Type
    -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    trBiList seenStop :: Bool
    seenStop doDescend :: Mode
    doDescend ra :: RetAp
    ra f :: Exp
    f ft :: Type
    ft st :: Type
    st et :: Type
    et = do
        Clause
    nil <- Bool
    -> Mode
    -> RetAp
    -> Exp
    -> Type
    -> Type
    -> Subst
    -> ([Pat] -> Pat)
    -> Exp
    -> [Type]
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    trMkArm Bool
    seenStop Mode
    doDescend RetAp
    ra Exp
    f Type
    ft Type
    st [] (Pat -> [Pat] -> Pat
    forall a b. a -> b -> a
    const (Pat -> [Pat] -> Pat) -> Pat -> [Pat] -> Pat
    forall a b. (a -> b) -> a -> b
    $ [Pat] -> Pat
    ListP []) ([Exp] -> Exp
    ListE []) []
        Clause
    cons <- Bool
    -> Mode
    -> RetAp
    -> Exp
    -> Type
    -> Type
    -> Subst
    -> ([Pat] -> Pat)
    -> Exp
    -> [Type]
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    trMkArm Bool
    seenStop Mode
    doDescend RetAp
    ra Exp
    f Type
    ft Type
    st [] (Name -> [Pat] -> Pat
    ConP '(:)) (Name -> Exp
    ConE '(:)) [Type
    et, Type
    st]
        [Clause] -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Clause
    nil, Clause
    cons]

    trBiTuple :: Bool -> Mode -> RetAp -> Exp -> Type -> Type -> [Type] -> U [Clause]
    trBiTuple :: Bool
    -> Mode
    -> RetAp
    -> Exp
    -> Type
    -> Type
    -> [Type]
    -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    trBiTuple seenStop :: Bool
    seenStop doDescend :: Mode
    doDescend ra :: RetAp
    ra f :: Exp
    f ft :: Type
    ft st :: Type
    st ts :: [Type]
    ts = do
        [Name]
    vs <- (Type -> U Name)
    -> [Type] -> StateT (Map Type Dec, Map Type Bool) Q [Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (U Name -> Type -> U Name
    forall a b. a -> b -> a
    const (U Name -> Type -> U Name) -> U Name -> Type -> U Name
    forall a b. (a -> b) -> a -> b
    $ String -> U Name
    forall (m :: * -> *). Quasi m => String -> m Name
    qNewName "_t") [Type]
    ts
    #if __GLASGOW_HASKELL__ >= 810
    -- `TupE` handles tuple sections since template-haskell 2.16.
        let tupE = LamE (map VarP vs) $ TupE (map (Just . VarE) vs)
    #else
        let tupE :: Exp
    tupE = [Pat] -> Exp -> Exp
    LamE ((Name -> Pat) -> [Name] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Pat
    VarP [Name]
    vs) (Exp -> Exp) -> Exp -> Exp
    forall a b. (a -> b) -> a -> b
    $ [Exp] -> Exp
    TupE ((Name -> Exp) -> [Name] -> [Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Exp
    VarE [Name]
    vs)
    #endif
        Clause
    c <- Bool
    -> Mode
    -> RetAp
    -> Exp
    -> Type
    -> Type
    -> Subst
    -> ([Pat] -> Pat)
    -> Exp
    -> [Type]
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    trMkArm Bool
    seenStop Mode
    doDescend RetAp
    ra Exp
    f Type
    ft Type
    st [] [Pat] -> Pat
    TupP Exp
    tupE [Type]
    ts
        [Clause] -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Clause
    c]

    trBiCon :: Bool -> Mode -> RetAp -> Exp -> Name -> Type -> Type -> [Type] -> U [Clause]
    trBiCon :: Bool
    -> Mode
    -> RetAp
    -> Exp
    -> Name
    -> Type
    -> Type
    -> [Type]
    -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    trBiCon seenStop :: Bool
    seenStop doDescend :: Mode
    doDescend ra :: RetAp
    ra f :: Exp
    f con :: Name
    con ft :: Type
    ft st :: Type
    st ts :: [Type]
    ts = do
        (tvs :: [TyVarBndr]
    tvs, cons :: [Con]
    cons) <- Name -> StateT (Map Type Dec, Map Type Bool) Q ([TyVarBndr], [Con])
    forall (q :: * -> *). Quasi q => Name -> q ([TyVarBndr], [Con])
    getTyConInfo Name
    con
        let genArm :: Con -> StateT (Map Type Dec, Map Type Bool) Q Clause
    genArm (NormalC c :: Name
    c xs :: [BangType]
    xs) = ([Pat] -> Pat)
    -> Exp
    -> [BangType]
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    forall a.
    ([Pat] -> Pat)
    -> Exp
    -> [(a, Type)]
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    arm (Name -> [Pat] -> Pat
    ConP Name
    c) (Name -> Exp
    ConE Name
    c) [BangType]
    xs
            genArm (InfixC x1 :: BangType
    x1 c :: Name
    c x2 :: BangType
    x2) = ([Pat] -> Pat)
    -> Exp
    -> [BangType]
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    forall a.
    ([Pat] -> Pat)
    -> Exp
    -> [(a, Type)]
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    arm (\ [p1 :: Pat
    p1, p2 :: Pat
    p2] -> Pat -> Name -> Pat -> Pat
    InfixP Pat
    p1 Name
    c Pat
    p2) (Name -> Exp
    ConE Name
    c) [BangType
    x1, BangType
    x2]
            genArm (RecC c :: Name
    c xs :: [VarBangType]
    xs) = ([Pat] -> Pat)
    -> Exp
    -> [BangType]
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    forall a.
    ([Pat] -> Pat)
    -> Exp
    -> [(a, Type)]
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    arm (Name -> [Pat] -> Pat
    ConP Name
    c) (Name -> Exp
    ConE Name
    c) [ (Bang
    b,Type
    t) | (_,b :: Bang
    b,t :: Type
    t) <- [VarBangType]
    xs ]
            genArm c :: Con
    c = String -> StateT (Map Type Dec, Map Type Bool) Q Clause
    forall a. String -> a
    genError (String -> StateT (Map Type Dec, Map Type Bool) Q Clause)
    -> String -> StateT (Map Type Dec, Map Type Bool) Q Clause
    forall a b. (a -> b) -> a -> b
    $ "trBiCon: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Con -> String
    forall a. Show a => a -> String
    show Con
    c
            s :: Subst
    s = [TyVarBndr] -> [Type] -> Subst
    mkSubst [TyVarBndr]
    tvs [Type]
    ts
            arm :: ([Pat] -> Pat)
    -> Exp
    -> [(a, Type)]
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    arm c :: [Pat] -> Pat
    c ec :: Exp
    ec xs :: [(a, Type)]
    xs = Bool
    -> Mode
    -> RetAp
    -> Exp
    -> Type
    -> Type
    -> Subst
    -> ([Pat] -> Pat)
    -> Exp
    -> [Type]
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    trMkArm Bool
    seenStop Mode
    doDescend RetAp
    ra Exp
    f Type
    ft Type
    st Subst
    s [Pat] -> Pat
    c Exp
    ec ([Type] -> StateT (Map Type Dec, Map Type Bool) Q Clause)
    -> [Type] -> StateT (Map Type Dec, Map Type Bool) Q Clause
    forall a b. (a -> b) -> a -> b
    $ ((a, Type) -> Type) -> [(a, Type)] -> [Type]
    forall a b. (a -> b) -> [a] -> [b]
    map (a, Type) -> Type
    forall a b. (a, b) -> b
    snd [(a, Type)]
    xs
        (Con -> StateT (Map Type Dec, Map Type Bool) Q Clause)
    -> [Con] -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM Con -> StateT (Map Type Dec, Map Type Bool) Q Clause
    genArm [Con]
    cons

    trMkArm :: Bool -> Mode -> RetAp -> Exp -> Type -> Type -> Subst -> ([Pat] -> Pat) -> Exp -> [Type] -> U Clause
    trMkArm :: Bool
    -> Mode
    -> RetAp
    -> Exp
    -> Type
    -> Type
    -> Subst
    -> ([Pat] -> Pat)
    -> Exp
    -> [Type]
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    trMkArm seenStop :: Bool
    seenStop doDescend :: Mode
    doDescend ra :: RetAp
    ra@(ret :: Exp -> Exp
    ret, apl :: Exp -> Exp -> Exp
    apl, _) f :: Exp
    f ft :: Type
    ft st :: Type
    st s :: Subst
    s c :: [Pat] -> Pat
    c ec :: Exp
    ec ts :: [Type]
    ts = do
        [Name]
    vs <- (Type -> U Name)
    -> [Type] -> StateT (Map Type Dec, Map Type Bool) Q [Name]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (U Name -> Type -> U Name
    forall a b. a -> b -> a
    const (U Name -> Type -> U Name) -> U Name -> Type -> U Name
    forall a b. (a -> b) -> a -> b
    $ String -> U Name
    forall (m :: * -> *). Quasi m => String -> m Name
    qNewName "_x") [Type]
    ts
        let sub :: Name -> Type -> StateT (Map Type Dec, Map Type Bool) Q Exp
    sub v :: Name
    v t :: Type
    t = do
    --            qRunIO $ print ("put", seenStop, doDescend, ft == st)
                if Bool
    seenStop Bool -> Bool -> Bool
    && Mode
    doDescend Mode -> Mode -> Bool
    forall a. Eq a => a -> a -> Bool
    == Mode
    MDescendBi then do
                    Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp)
    -> Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp
    ret (Name -> Exp
    VarE Name
    v)
                else do
                    let t' :: Type
    t' = Subst -> Type -> Type
    subst Subst
    s Type
    t
                    Exp
    tr <- Bool
    -> Mode
    -> RetAp
    -> Exp
    -> Type
    -> Type
    -> StateT (Map Type Dec, Map Type Bool) Q Exp
    trBi Bool
    seenStop Mode
    doDescend RetAp
    ra Exp
    f Type
    ft Type
    t'
                    Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp)
    -> Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp
    forall a b. (a -> b) -> a -> b
    $ Exp -> Exp -> Exp
    AppE Exp
    tr (Name -> Exp
    VarE Name
    v)
    --        conTy = foldr arrow st (map (subst s) ts)
        [Exp]
    es <- (Name -> Type -> StateT (Map Type Dec, Map Type Bool) Q Exp)
    -> [Name] -> [Type] -> StateT (Map Type Dec, Map Type Bool) Q [Exp]
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> b -> m c) -> [a] -> [b] -> m [c]
    zipWithM Name -> Type -> StateT (Map Type Dec, Map Type Bool) Q Exp
    sub [Name]
    vs [Type]
    ts
        let body :: Exp
    body = (Exp -> Exp -> Exp) -> Exp -> [Exp] -> Exp
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Exp -> Exp -> Exp
    apl (Exp -> Exp
    ret Exp
    ec) [Exp]
    es
        Clause -> StateT (Map Type Dec, Map Type Bool) Q Clause
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Clause -> StateT (Map Type Dec, Map Type Bool) Q Clause)
    -> Clause -> StateT (Map Type Dec, Map Type Bool) Q Clause
    forall a b. (a -> b) -> a -> b
    $ [Pat] -> Body -> [Dec] -> Clause
    Clause [[Pat] -> Pat
    c ((Name -> Pat) -> [Name] -> [Pat]
    forall a b. (a -> b) -> [a] -> [b]
    map Name -> Pat
    VarP [Name]
    vs)] (Exp -> Body
    NormalB Exp
    body) []

    ----------------------------------------------------

    -- Can't use Data.Map since TH stuff is not in Ord

    newtype Map a b = Map [(a, b)]

    mEmpty :: Map a b
    mEmpty :: Map a b
    mEmpty = [(a, b)] -> Map a b
    forall a b. [(a, b)] -> Map a b
    Map []

    mLookup :: (Eq a) => a -> Map a b -> Maybe b
    mLookup :: a -> Map a b -> Maybe b
    mLookup a :: a
    a (Map xys :: [(a, b)]
    xys) = a -> [(a, b)] -> Maybe b
    forall a b. Eq a => a -> [(a, b)] -> Maybe b
    lookup a
    a [(a, b)]
    xys

    mInsert :: (Eq a) => a -> b -> Map a b -> Map a b
    mInsert :: a -> b -> Map a b -> Map a b
    mInsert a :: a
    a b :: b
    b (Map xys :: [(a, b)]
    xys) = [(a, b)] -> Map a b
    forall a b. [(a, b)] -> Map a b
    Map ([(a, b)] -> Map a b) -> [(a, b)] -> Map a b
    forall a b. (a -> b) -> a -> b
    $ (a
    a, b
    b) (a, b) -> [(a, b)] -> [(a, b)]
    forall a. a -> [a] -> [a]
    : ((a, b) -> Bool) -> [(a, b)] -> [(a, b)]
    forall a. (a -> Bool) -> [a] -> [a]
    filter ((a -> a -> Bool
    forall a. Eq a => a -> a -> Bool
    /= a
    a) (a -> Bool) -> ((a, b) -> a) -> (a, b) -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (a, b) -> a
    forall a b. (a, b) -> a
    fst) [(a, b)]
    xys

    mElems :: Map a b -> [b]
    mElems :: Map a b -> [b]
    mElems (Map xys :: [(a, b)]
    xys) = ((a, b) -> b) -> [(a, b)] -> [b]
    forall a b. (a -> b) -> [a] -> [b]
    map (a, b) -> b
    forall a b. (a, b) -> b
    snd [(a, b)]
    xys

    mFromList :: [(a, b)] -> Map a b
    mFromList :: [(a, b)] -> Map a b
    mFromList xys :: [(a, b)]
    xys = [(a, b)] -> Map a b
    forall a b. [(a, b)] -> Map a b
    Map [(a, b)]
    xys