    {-# 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 hiding (conP)
    import Language.Haskell.TH.Syntax hiding (lift)
    --import System.IO

    conP :: Name -> [Pat] -> Pat
    #if MIN_VERSION_template_haskell(2,18,0)
    conP :: Name -> [Pat] -> Pat
    conP Name
    c = Name -> [Type] -> [Pat] -> Pat
    ConP Name
    c []
    #else
    conP c = ConP c
    #endif

    ---- 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 :: forall a. UniverseBi a a => a -> [a]
    universe = a -> [a]
    forall s t. UniverseBi s t => s -> [t]
    universeBi

    transform :: (TransformBi a a) => (a -> a) -> a -> a
    transform :: forall a. TransformBi a a => (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 :: forall (m :: * -> *) a.
    TransformBiM m a a =>
    (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 :: forall a. DescendM Identity a => (a -> a) -> a -> a
    descend 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 a. 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 [TypeQ]
    stops 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' [TypeQ]
    stops (ForallT [TyVarBndr Specificity]
    _ [Type]
    _ Type
    t) = [TypeQ] -> Type -> Q [Dec]
    instanceUniverseBiT' [TypeQ]
    stops Type
    t
    instanceUniverseBiT' [TypeQ]
    stops Type
    ty | (TupleT Int
    _, [Type
    from, Type
    to]) <- Type -> (Type, [Type])
    splitTypeApp Type
    ty = do
        ([Dec]
    ds, Exp
    f) <- [TypeQ] -> Type -> Type -> Q ([Dec], Exp)
    uniBiQ [TypeQ]
    stops Type
    from Type
    to
        Name
    x <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "_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 a. a -> Q a
    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' [TypeQ]
    _ Type
    t = String -> Q [Dec]
    forall a. String -> a
    genError String
    "instanceUniverseBi: the argument should be of the form [t| (S, T) |]"

    funDef :: Name -> Exp -> [Dec]
    funDef :: Name -> Exp -> [Dec]
    funDef Name
    f 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 MIN_VERSION_template_haskell(2,11,0)
    instDef :: Name -> [Type] -> Name -> Exp -> [Dec]
    instDef Name
    cls [Type]
    ts Name
    met Exp
    e = [Maybe Overlap -> [Type] -> Type -> [Dec] -> Dec
    InstanceD Maybe Overlap
    forall a. Maybe a
    Nothing [] ((Type -> Type -> Type) -> Type -> [Type] -> Type
    forall b a. (b -> a -> b) -> b -> [a] -> b
    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)]
    #else
    instDef cls ts met e = [InstanceD [] (foldl AppT (ConT cls) ts) (funDef met 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 [TypeQ]
    stops 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
    $c== :: Mode -> Mode -> Bool
    == :: Mode -> Mode -> Bool
    $c/= :: Mode -> Mode -> Bool
    /= :: 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
    $ccompare :: Mode -> Mode -> Ordering
    compare :: Mode -> Mode -> Ordering
    $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
    >= :: Mode -> Mode -> Bool
    $cmax :: Mode -> Mode -> Mode
    max :: Mode -> Mode -> Mode
    $cmin :: Mode -> Mode -> Mode
    min :: Mode -> Mode -> 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
    $cshowsPrec :: Int -> Mode -> ShowS
    showsPrec :: Int -> Mode -> ShowS
    $cshow :: Mode -> String
    show :: Mode -> String
    $cshowList :: [Mode] -> ShowS
    showList :: [Mode] -> ShowS
    Show)

    instanceTransformBiT' :: Mode -> [TypeQ] -> Type -> Q [Dec]
    instanceTransformBiT' :: Mode -> [TypeQ] -> Type -> Q [Dec]
    instanceTransformBiT' Mode
    doDescend [TypeQ]
    stops (ForallT [TyVarBndr Specificity]
    _ [Type]
    _ Type
    t) = Mode -> [TypeQ] -> Type -> Q [Dec]
    instanceTransformBiT' Mode
    doDescend [TypeQ]
    stops Type
    t
    instanceTransformBiT' Mode
    doDescend [TypeQ]
    stops Type
    ty | (TupleT Int
    _, [Type
    ft, Type
    st]) <- Type -> (Type, [Type])
    splitTypeApp Type
    ty = do
        Name
    f <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "_f"
        Name
    x <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "_x"
        ([Dec]
    ds, 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 a. a -> Q a
    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' Mode
    _ [TypeQ]
    _ Type
    t = String -> Q [Dec]
    forall a. String -> a
    genError String
    "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 [TypeQ]
    stops TypeQ
    mndq 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 [TypeQ]
    stops TypeQ
    mndq 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 [TypeQ]
    stops TypeQ
    mndq 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' Mode
    doDescend [TypeQ]
    stops TypeQ
    mndq (ForallT [TyVarBndr Specificity]
    _ [Type]
    _ Type
    t) = Mode -> [TypeQ] -> TypeQ -> Type -> Q [Dec]
    instanceTransformBiMT' Mode
    doDescend [TypeQ]
    stops TypeQ
    mndq Type
    t
    instanceTransformBiMT'  Mode
    MDescend [TypeQ]
    stops TypeQ
    mndq Type
    ty = do
        Type
    mnd <- TypeQ
    mndq

        Name
    f <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "_f"
        Name
    x <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "_x"
        ([Dec]
    ds, 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 a. a -> Q a
    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' Mode
    doDescend [TypeQ]
    stops TypeQ
    mndq Type
    ty | (TupleT Int
    _, [Type
    ft, Type
    st]) <- Type -> (Type, [Type])
    splitTypeApp Type
    ty = do
    --    qRunIO $ do putStrLn "************"; hFlush stdout
        Type
    mnd <- TypeQ
    mndq

        Name
    f <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "_f"
        Name
    x <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "_x"
        ([Dec]
    ds, 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 Mode
    MTransformBi -> ''TransformBiM; Mode
    MDescendBi -> ''DescendBiM
            met :: Name
    met = case Mode
    doDescend of Mode
    MTransformBi ->  'transformBiM; Mode
    MDescendBi ->  'descendBiM
        [Dec] -> Q [Dec]
    forall a. a -> Q a
    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' Mode
    _ [TypeQ]
    _ TypeQ
    _ Type
    t = String -> Q [Dec]
    forall a. String -> a
    genError String
    "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 [TypeQ]
    stops = Name -> Q ([TyVarBndr Specificity], Type, Type)
    forall (q :: * -> *).
    Quasi q =>
    Name -> q ([TyVarBndr Specificity], Type, Type)
    getNameType (Name -> Q ([TyVarBndr Specificity], Type, Type))
    -> (([TyVarBndr Specificity], 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 Specificity], Type, Type) -> Q Exp
    forall a. [TypeQ] -> ([TyVarBndr a], Type, Type) -> Q Exp
    genUniverseBiTsplit [TypeQ]
    stops

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

    #if MIN_VERSION_template_haskell(2,17,0)
    genUniverseBiTsplit :: [TypeQ] -> ([TyVarBndr a], Type, Type) -> Q Exp
    #else
    genUniverseBiTsplit :: [TypeQ] -> ([TyVarBndr], Type, Type) -> Q Exp
    #endif
    genUniverseBiTsplit :: forall a. [TypeQ] -> ([TyVarBndr a], Type, Type) -> Q Exp
    genUniverseBiTsplit [TypeQ]
    stops ([TyVarBndr a]
    _tvs,Type
    from,Type
    tos) = do
        let to :: Type
    to = Type -> Type
    unList Type
    tos
    --    qRunIO $ print (from, to)
        ([Dec]
    ds, Exp
    f) <- [TypeQ] -> Type -> Type -> Q ([Dec], Exp)
    uniBiQ [TypeQ]
    stops Type
    from Type
    to
        Name
    x <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "_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 a. a -> Q a
    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 (m :: * -> *) a.
    Monad m =>
    m a -> StateT (Map Type Dec, Map Type Bool) m a
    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 Bool
    b = Q () -> U ()
    forall (m :: * -> *) a.
    Monad m =>
    m a -> StateT (Map Type Dec, Map Type Bool) m a
    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 :: forall a. U a -> U a -> U a
    qRecover = String -> U a -> U a -> U a
    forall a. HasCallStack => String -> a
    error String
    "Data.Generics.Geniplate: qRecover not implemented"
        qReify :: Name -> U Info
    qReify = Q Info -> U Info
    forall (m :: * -> *) a.
    Monad m =>
    m a -> StateT (Map Type Dec, Map Type Bool) m a
    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 MIN_VERSION_template_haskell(2,7,0)
        qReifyInstances :: Name -> [Type] -> U [Dec]
    qReifyInstances Name
    n = Q [Dec] -> U [Dec]
    forall (m :: * -> *) a.
    Monad m =>
    m a -> StateT (Map Type Dec, Map Type Bool) m a
    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 MIN_VERSION_template_haskell(2,5,0)
        qClassInstances n = lift . qClassInstances n
    #endif
        qLocation :: U Loc
    qLocation = Q Loc -> U Loc
    forall (m :: * -> *) a.
    Monad m =>
    m a -> StateT (Map Type Dec, Map Type Bool) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift Q Loc
    forall (m :: * -> *). Quasi m => m Loc
    qLocation
        qRunIO :: forall a. IO a -> U a
    qRunIO = Q a -> StateT (Map Type Dec, Map Type Bool) Q a
    forall (m :: * -> *) a.
    Monad m =>
    m a -> StateT (Map Type Dec, Map Type Bool) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Q a -> StateT (Map Type Dec, Map Type Bool) Q a)
    -> (IO a -> Q a)
    -> IO a
    -> StateT (Map Type Dec, Map Type Bool) Q a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . IO a -> Q a
    forall a. IO a -> Q a
    forall (m :: * -> *) a. Quasi m => IO a -> m a
    qRunIO
    #if MIN_VERSION_template_haskell(2,14,0)
        qAddForeignFilePath :: ForeignSrcLang -> String -> U ()
    qAddForeignFilePath ForeignSrcLang
    l = String -> U ()
    forall a. HasCallStack => a
    undefined -- lift . qAddForeignFilePath l
    #elif MIN_VERSION_template_haskell(2,12,0)
        qAddForeignFile l   = undefined -- lift . qAddForeignFile l
    #endif
    #if MIN_VERSION_template_haskell(2,7,0)
        qLookupName :: Bool -> String -> U (Maybe Name)
    qLookupName Bool
    ns = Q (Maybe Name) -> U (Maybe Name)
    forall (m :: * -> *) a.
    Monad m =>
    m a -> StateT (Map Type Dec, Map Type Bool) m a
    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 (m :: * -> *) a.
    Monad m =>
    m a -> StateT (Map Type Dec, Map Type Bool) m a
    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 MIN_VERSION_template_haskell(2,9,0)
        qReifyRoles :: Name -> U [Role]
    qReifyRoles = Q [Role] -> U [Role]
    forall (m :: * -> *) a.
    Monad m =>
    m a -> StateT (Map Type Dec, Map Type Bool) m a
    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 :: forall a. Data a => AnnLookup -> U [a]
    qReifyAnnotations = Q [a] -> StateT (Map Type Dec, Map Type Bool) Q [a]
    forall (m :: * -> *) a.
    Monad m =>
    m a -> StateT (Map Type Dec, Map Type Bool) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift (Q [a] -> StateT (Map Type Dec, Map Type Bool) Q [a])
    -> (AnnLookup -> Q [a])
    -> AnnLookup
    -> StateT (Map Type Dec, Map Type Bool) Q [a]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . AnnLookup -> Q [a]
    forall a. Data a => AnnLookup -> Q [a]
    forall (m :: * -> *) a. (Quasi m, Data a) => AnnLookup -> m [a]
    qReifyAnnotations
        qReifyModule :: Module -> U ModuleInfo
    qReifyModule = Q ModuleInfo -> U ModuleInfo
    forall (m :: * -> *) a.
    Monad m =>
    m a -> StateT (Map Type Dec, Map Type Bool) m a
    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 (m :: * -> *) a.
    Monad m =>
    m a -> StateT (Map Type Dec, Map Type Bool) m a
    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 (m :: * -> *) a.
    Monad m =>
    m a -> StateT (Map Type Dec, Map Type Bool) m a
    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 :: forall a. Typeable a => U (Maybe a)
    qGetQ = Q (Maybe a) -> StateT (Map Type Dec, Map Type Bool) Q (Maybe a)
    forall (m :: * -> *) a.
    Monad m =>
    m a -> StateT (Map Type Dec, Map Type Bool) m a
    forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
    (MonadTrans t, Monad m) =>
    m a -> t m a
    lift Q (Maybe a)
    forall a. Typeable a => Q (Maybe a)
    forall (m :: * -> *) a. (Quasi m, Typeable a) => m (Maybe a)
    qGetQ
        qPutQ :: forall a. Typeable a => a -> U ()
    qPutQ = Q () -> U ()
    forall (m :: * -> *) a.
    Monad m =>
    m a -> StateT (Map Type Dec, Map Type Bool) m a
    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 a. Typeable a => a -> Q ()
    forall (m :: * -> *) a. (Quasi m, Typeable a) => a -> m ()
    qPutQ
    #if MIN_VERSION_template_haskell(2,11,0)
        qReifyFixity :: Name -> U (Maybe Fixity)
    qReifyFixity        = Name -> U (Maybe Fixity)
    forall a. HasCallStack => a
    undefined -- lift . qReifyFixity
        qReifyConStrictness :: Name -> U [DecidedStrictness]
    qReifyConStrictness = Name -> U [DecidedStrictness]
    forall a. HasCallStack => a
    undefined -- lift . qReifyConStrictness
        qIsExtEnabled :: Extension -> U Bool
    qIsExtEnabled       = Extension -> U Bool
    forall a. HasCallStack => a
    undefined -- lift . qIsExtEnabled
        qExtsEnabled :: U [Extension]
    qExtsEnabled        = U [Extension]
    forall a. HasCallStack => a
    undefined -- lift (qExtsEnabled)
    #if MIN_VERSION_template_haskell(2,13,0)
        qAddCorePlugin :: String -> U ()
    qAddCorePlugin      = String -> U ()
    forall a. HasCallStack => a
    undefined -- lift . qAddCorePlugin
    #if MIN_VERSION_template_haskell(2,14,0)
        qAddTempFile :: String -> U String
    qAddTempFile        = String -> U String
    forall a. HasCallStack => a
    undefined -- lift . qAddTempFile
    #if MIN_VERSION_template_haskell(2,16,0)
        qReifyType :: Name -> U Type
    qReifyType          = Name -> U Type
    forall a. HasCallStack => a
    undefined -- lift . qReifyType
    #endif
    #endif
    #endif
    #endif
    #endif
    #endif

    uniBiQ :: [TypeQ] -> Type -> Type -> Q ([Dec], Exp)
    uniBiQ :: [TypeQ] -> Type -> Type -> Q ([Dec], Exp)
    uniBiQ [TypeQ]
    stops Type
    from Type
    ato = do
        [Type]
    ss <- [TypeQ] -> Q [Type]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [TypeQ]
    stops
        Type
    to <- Type -> TypeQ
    forall (q :: * -> *). Quasi q => Type -> q Type
    expandSyn Type
    ato
        (Exp
    f, (Map Type Dec
    m, Map Type Bool
    _)) <- 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 a. a -> Q a
    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 Type
    afrom Type
    to = do
        (Map Type Dec
    m, 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 -> U 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 Name
    n [Clause]
    _) -> Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp
    forall a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    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
            Maybe Dec
    _ -> do
                Name
    f <- String -> U Name
    forall (m :: * -> *). Quasi m => String -> m Name
    qNewName String
    "_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
    $ [Maybe 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 String
    "_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
    $ \ (Map Type Dec
    m', 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 : $(Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name -> Exp
    VarE Name
    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
    $ \ (Map Type Dec
    m', 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 a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    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 Type
    to Type
    afrom = do
    --    qRunIO $ print ("contains", to, from)
        Type
    from <- Type -> U 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 a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    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 Bool
    b  -> Bool -> U Bool
    forall a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    b
                Maybe Bool
    Nothing -> Type -> Type -> U Bool
    contains' Type
    to Type
    from

    mLookupSplits :: Type -> Map Type a -> Maybe a
    mLookupSplits :: forall a. Type -> Map Type a -> Maybe a
    mLookupSplits Type
    ty 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 Type
    u Type
    _) = Type
    tType -> [Type] -> [Type]
    forall a. a -> [a] -> [a]
    :Type -> [Type]
    splits Type
    u
        splits 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' Type
    to Type
    from = do
    --    qRunIO $ print ("contains'", to, from)
        let (Type
    con, [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
    $ \ (Map Type Dec
    m, 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 Name
    n    -> Name -> Type -> [Type] -> U Bool
    containsCon Name
    n Type
    to [Type]
    ts
             TupleT Int
    _  -> ([Bool] -> Bool)
    -> StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool
    forall a b.
    (a -> b)
    -> StateT (Map Type Dec, Map Type Bool) Q a
    -> StateT (Map Type Dec, Map Type Bool) Q b
    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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM (Type -> Type -> U Bool
    contains Type
    to) [Type]
    ts
             Type
    ArrowT    -> Bool -> U Bool
    forall a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
             Type
    ListT     -> if Type
    to Type -> Type -> Bool
    forall a. Eq a => a -> a -> Bool
    == Type
    from then Bool -> U Bool
    forall a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    True else Type -> Type -> U Bool
    contains Type
    to ([Type] -> Type
    forall a. HasCallStack => [a] -> a
    head [Type]
    ts)
             VarT Name
    _    -> Bool -> U Bool
    forall a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False
             Type
    t         -> String -> U Bool
    forall a. String -> a
    genError (String -> U Bool) -> String -> U Bool
    forall a b. (a -> b) -> a -> b
    $ String
    "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
    " (" 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]
    ++ String
    ")"
        ((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
    $ \ (Map Type Dec
    m, 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 a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    b

    containsCon :: Name -> Type -> [Type] -> U Bool
    containsCon :: Name -> Type -> [Type] -> U Bool
    containsCon Name
    con Type
    to [Type]
    ts = do
    --    qRunIO $ print ("containsCon", con, to, ts)
        ([TyVarBndr ()]
    tvs, [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 Name
    _ [BangType]
    xs) = ([Bool] -> Bool)
    -> StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool
    forall a b.
    (a -> b)
    -> StateT (Map Type Dec, Map Type Bool) Q a
    -> StateT (Map Type Dec, Map Type Bool) Q b
    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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 BangType
    x1 Name
    _ BangType
    x2) = ([Bool] -> Bool)
    -> StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool
    forall a b.
    (a -> b)
    -> StateT (Map Type Dec, Map Type Bool) Q a
    -> StateT (Map Type Dec, Map Type Bool) Q b
    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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 Name
    _ [VarBangType]
    xs) = ([Bool] -> Bool)
    -> StateT (Map Type Dec, Map Type Bool) Q [Bool] -> U Bool
    forall a b.
    (a -> b)
    -> StateT (Map Type Dec, Map Type Bool) Q a
    -> StateT (Map Type Dec, Map Type Bool) Q b
    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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Type -> U Bool
    field [ Type
    t | (Name
    _,Bang
    _,Type
    t) <- [VarBangType]
    xs ]
            conCon Con
    c = String -> U Bool
    forall a. String -> a
    genError (String -> U Bool) -> String -> U Bool
    forall a b. (a -> b) -> a -> b
    $ String
    "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
    forall a. [TyVarBndr a] -> [Type] -> Subst
    mkSubst [TyVarBndr ()]
    tvs [Type]
    ts
            field :: Type -> U Bool
    field 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 a b.
    (a -> b)
    -> StateT (Map Type Dec, Map Type Bool) Q a
    -> StateT (Map Type Dec, Map Type Bool) Q b
    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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
    mapM Con -> U Bool
    conCon [Con]
    cons

    unFunD :: [Dec] -> [Clause]
    unFunD :: [Dec] -> [Clause]
    unFunD [FunD Name
    _ [Clause]
    cs] = [Clause]
    cs
    unFunD [Dec]
    _ = String -> [Clause]
    forall a. String -> a
    genError (String -> [Clause]) -> String -> [Clause]
    forall a b. (a -> b) -> a -> b
    $ String
    "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 (m :: * -> *) a.
    Monad m =>
    m a -> StateT (Map Type Dec, Map Type Bool) m a
    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 a b. (a -> b) -> Q a -> Q b
    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 Type
    from Type
    to = do
        let (Type
    con, [Type]
    ts) = Type -> (Type, [Type])
    splitTypeApp Type
    from
        case Type
    con of
            ConT Name
    n    -> Name
    -> [Type]
    -> Type
    -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    uniBiCon Name
    n [Type]
    ts Type
    to
            TupleT Int
    _  -> [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
            Type
    ListT     -> Type -> Type -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    uniBiList ([Type] -> Type
    forall a. HasCallStack => [a] -> a
    head [Type]
    ts) Type
    to
            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
    $ String
    "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
    " (" 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]
    ++ String
    ")"

    uniBiList :: Type -> Type -> U [Clause]
    uniBiList :: Type -> Type -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    uniBiList Type
    t 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 = $(Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    uni) _x ($(Exp -> Q Exp
    forall a. a -> Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    rec) _xs _r) |]

    uniBiTuple :: [Type] -> Type -> U [Clause]
    uniBiTuple :: [Type] -> Type -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    uniBiTuple [Type]
    ts Type
    to = (Clause -> [Clause])
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall a b.
    (a -> b)
    -> StateT (Map Type Dec, Map Type Bool) Q a
    -> StateT (Map Type Dec, Map Type Bool) Q b
    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 Name
    con [Type]
    ts Type
    to = do
        ([TyVarBndr ()]
    tvs, [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 Name
    c [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 BangType
    x1 Name
    c 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 (\ [Pat
    p1, Pat
    p2] -> Pat -> Name -> Pat -> Pat
    InfixP Pat
    p1 Name
    c Pat
    p2) [BangType
    x1, BangType
    x2]
            genArm (RecC Name
    c [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) | (Name
    _,Bang
    b,Type
    t) <- [VarBangType]
    xs ]
            genArm 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
    $ String
    "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
    forall a. [TyVarBndr a] -> [Type] -> Subst
    mkSubst [TyVarBndr ()]
    tvs [Type]
    ts
            arm :: ([Pat] -> Pat)
    -> [(a, Type)] -> StateT (Map Type Dec, Map Type Bool) Q Clause
    arm [Pat] -> Pat
    c [(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 a. [a] -> 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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 Type
    to Subst
    s [Pat] -> Pat
    c [Type]
    ts = do
        Name
    r <- String -> U Name
    forall (m :: * -> *). Quasi m => String -> m Name
    qNewName String
    "_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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 String
    "_x") [Type]
    ts
        let sub :: Name -> Type -> StateT (Map Type Dec, Map Type Bool) Q (Exp -> Exp)
    sub Name
    v 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 a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    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 a b. (a -> b -> b) -> b -> [a] -> b
    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 a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    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)]

    #if MIN_VERSION_template_haskell(2,17,0)
    mkSubst :: [TyVarBndr a] -> [Type] -> Subst
    #else
    mkSubst :: [TyVarBndr] -> [Type] -> Subst
    #endif
    mkSubst :: forall a. [TyVarBndr a] -> [Type] -> Subst
    mkSubst [TyVarBndr a]
    vs [Type]
    ts =
       let vs' :: [Name]
    vs' = (TyVarBndr a -> Name) -> [TyVarBndr a] -> [Name]
    forall a b. (a -> b) -> [a] -> [b]
    map TyVarBndr a -> Name
    forall {flag}. TyVarBndr flag -> Name
    un [TyVarBndr a]
    vs
    #if MIN_VERSION_template_haskell(2,17,0)
           un :: TyVarBndr flag -> Name
    un (PlainTV Name
    v flag
    _) = Name
    v
           un (KindedTV Name
    v flag
    _ Type
    _) = Name
    v
    #else
           un (PlainTV v) = v
           un (KindedTV v _) = v
    #endif
       in  Bool -> Subst -> Subst
    forall a. HasCallStack => Bool -> a -> a
    assert ([Name] -> Int
    forall a. [a] -> 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 a. [a] -> 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 Subst
    s (ForallT [TyVarBndr Specificity]
    v [Type]
    c Type
    t) = [TyVarBndr Specificity] -> [Type] -> Type -> Type
    ForallT [TyVarBndr Specificity]
    v [Type]
    c (Type -> Type) -> Type -> Type
    forall a b. (a -> b) -> a -> b
    $ Subst -> Type -> Type
    subst Subst
    s Type
    t
    subst Subst
    s t :: Type
    t@(VarT 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 Subst
    s (AppT Type
    t1 Type
    t2) = Type -> Type -> Type
    AppT (Subst -> Type -> Type
    subst Subst
    s Type
    t1) (Subst -> Type -> Type
    subst Subst
    s Type
    t2)
    subst Subst
    s (SigT Type
    t Type
    k) = Type -> Type -> Type
    SigT (Subst -> Type -> Type
    subst Subst
    s Type
    t) Type
    k
    subst Subst
    _ Type
    t = Type
    t

    #if MIN_VERSION_template_haskell(2,17,0)
    getTyConInfo :: (Quasi q) => Name -> q ([TyVarBndr ()], [Con])
    #else
    getTyConInfo :: (Quasi q) => Name -> q ([TyVarBndr], [Con])
    #endif
    getTyConInfo :: forall (q :: * -> *). Quasi q => Name -> q ([TyVarBndr ()], [Con])
    getTyConInfo Name
    con = do
        Info
    info <- Name -> q Info
    forall (m :: * -> *). Quasi m => Name -> m Info
    qReify Name
    con
        case Info
    info of
    #if MIN_VERSION_template_haskell(2,11,0)
            TyConI (DataD [Type]
    _ Name
    _ [TyVarBndr ()]
    tvs Maybe Type
    _ [Con]
    cs [DerivClause]
    _)   -> ([TyVarBndr ()], [Con]) -> q ([TyVarBndr ()], [Con])
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([TyVarBndr ()]
    tvs, [Con]
    cs)
            TyConI (NewtypeD [Type]
    _ Name
    _ [TyVarBndr ()]
    tvs Maybe Type
    _ Con
    c [DerivClause]
    _) -> ([TyVarBndr ()], [Con]) -> q ([TyVarBndr ()], [Con])
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([TyVarBndr ()]
    tvs, [Con
    c])
    #else
            TyConI (DataD _ _ tvs cs _)   -> return (tvs, cs)
            TyConI (NewtypeD _ _ tvs c _) -> return (tvs, [c])
    #endif
            PrimTyConI{} -> ([TyVarBndr ()], [Con]) -> q ([TyVarBndr ()], [Con])
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([], [])
            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
    $ String
    "unexpected TyCon: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Info -> String
    forall a. Show a => a -> String
    show Info
    i

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

    #if MIN_VERSION_template_haskell(2,17,0)
    getNameType :: (Quasi q) => Name -> q ([TyVarBndr Specificity], Type, Type)
    #else
    getNameType :: (Quasi q) => Name -> q ([TyVarBndr], Type, Type)
    #endif
    getNameType :: forall (q :: * -> *).
    Quasi q =>
    Name -> q ([TyVarBndr Specificity], Type, Type)
    getNameType Name
    name = do
        Info
    info <- Name -> q Info
    forall (m :: * -> *). Quasi m => Name -> m Info
    qReify Name
    name
        case Info
    info of
    #if MIN_VERSION_template_haskell(2,11,0)
            VarI Name
    _ Type
    t Maybe Dec
    _  -> Type -> q ([TyVarBndr Specificity], Type, Type)
    forall (q :: * -> *).
    Quasi q =>
    Type -> q ([TyVarBndr Specificity], Type, Type)
    splitType Type
    t
    #else
            VarI _ t _ _ -> splitType t
    #endif
            Info
    _ -> String -> q ([TyVarBndr Specificity], Type, Type)
    forall a. String -> a
    genError (String -> q ([TyVarBndr Specificity], Type, Type))
    -> String -> q ([TyVarBndr Specificity], Type, Type)
    forall a b. (a -> b) -> a -> b
    $ String
    "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 Name
    n) Type
    t) | Name
    n Name -> Name -> Bool
    forall a. Eq a => a -> a -> Bool
    == ''[] = Type
    t
    unList (AppT Type
    ListT Type
    t) = Type
    t
    unList Type
    t = String -> Type
    forall a. String -> a
    genError (String -> Type) -> String -> Type
    forall a b. (a -> b) -> a -> b
    $ String
    "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 Type
    a Type
    r) = (Type
    c, [Type]
    rs [Type] -> [Type] -> [Type]
    forall a. [a] -> [a] -> [a]
    ++ [Type
    r]) where (Type
    c, [Type]
    rs) = Type -> (Type, [Type])
    splitTypeApp Type
    a
    splitTypeApp Type
    t = (Type
    t, [])

    expandSyn :: (Quasi q) => Type -> q Type
    expandSyn :: forall (q :: * -> *). Quasi q => Type -> q Type
    expandSyn (ForallT [TyVarBndr Specificity]
    tvs [Type]
    ctx Type
    t) = (Type -> Type) -> q Type -> q Type
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM ([TyVarBndr Specificity] -> [Type] -> Type -> Type
    ForallT [TyVarBndr Specificity]
    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 Type
    t Type
    k) = Type -> q Type
    forall (q :: * -> *). Quasi q => Type -> q Type
    expandSyn Type
    t   -- Ignore kind synonyms
    expandSyn Type
    t = Type -> q Type
    forall a. a -> q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    t

    expandSynApp :: (Quasi q) => Type -> [Type] -> q Type
    expandSynApp :: forall (q :: * -> *). Quasi q => Type -> [Type] -> q Type
    expandSynApp (AppT Type
    t1 Type
    t2) [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 Name
    n) [Type]
    ts | Name -> String
    nameBase Name
    n String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    "[]" = Type -> q Type
    forall a. a -> q a
    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 b a. (b -> a -> b) -> b -> [a] -> b
    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 Name
    n) [Type]
    ts = do
        Info
    info <- Name -> q Info
    forall (m :: * -> *). Quasi m => Name -> m Info
    qReify Name
    n
        case Info
    info of
            TyConI (TySynD Name
    _ [TyVarBndr ()]
    tvs Type
    rhs) ->
                let ([Type]
    ts', [Type]
    ts'') = Int -> [Type] -> ([Type], [Type])
    forall a. Int -> [a] -> ([a], [a])
    splitAt ([TyVarBndr ()] -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [TyVarBndr ()]
    tvs) [Type]
    ts
                    s :: Subst
    s = [TyVarBndr ()] -> [Type] -> Subst
    forall a. [TyVarBndr a] -> [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''
            Info
    _ -> Type -> q Type
    forall a. a -> q a
    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 b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl Type -> Type -> Type
    AppT Type
    t [Type]
    ts
    expandSynApp Type
    t [Type]
    ts = do Type
    t' <- Type -> q Type
    forall (q :: * -> *). Quasi q => Type -> q Type
    expandSyn Type
    t; Type -> q Type
    forall a. a -> q a
    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 b a. (b -> a -> b) -> b -> [a] -> b
    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 :: forall a. String -> a
    genError String
    msg = String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ String
    "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 Exp
    e = Exp -> Exp -> Exp
    AppE (Name -> Exp
    VarE 'Control.Monad.return) Exp
    e
            eap :: Exp -> Exp -> Exp
    eap Exp
    f 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 Exp
    f 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 RetAp
    ra [TypeQ]
    stops = Name -> Q ([TyVarBndr Specificity], Type, Type)
    forall (q :: * -> *).
    Quasi q =>
    Name -> q ([TyVarBndr Specificity], Type, Type)
    getNameType (Name -> Q ([TyVarBndr Specificity], Type, Type))
    -> (([TyVarBndr Specificity], 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 Specificity], 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' RetAp
    ra [TypeQ]
    stops TypeQ
    q = TypeQ
    q TypeQ
    -> (Type -> Q ([TyVarBndr Specificity], Type, Type))
    -> Q ([TyVarBndr Specificity], Type, Type)
    forall a b. Q a -> (a -> Q b) -> Q b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Type -> Q ([TyVarBndr Specificity], Type, Type)
    forall (q :: * -> *).
    Quasi q =>
    Type -> q ([TyVarBndr Specificity], Type, Type)
    splitType Q ([TyVarBndr Specificity], Type, Type)
    -> (([TyVarBndr Specificity], Type, Type) -> Q Exp) -> Q Exp
    forall a b. Q a -> (a -> Q b) -> Q b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Mode
    -> RetAp
    -> [TypeQ]
    -> ([TyVarBndr Specificity], 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 :: forall t. Mode -> RetAp -> [TypeQ] -> (t, Type, Type) -> Q Exp
    transformBiGsplit Mode
    doDescend RetAp
    ra [TypeQ]
    stops (t
    _tvs,Type
    fcn,Type
    res) = do
        Name
    f <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "_f"
        Name
    x <- String -> Q Name
    forall (m :: * -> *). Quote m => String -> m Name
    newName String
    "_x"
        ([Dec]
    ds, Exp
    tr) <-
            case (Type
    fcn, Type
    res) of
                (AppT (AppT Type
    ArrowT Type
    s) Type
    s',          AppT (AppT Type
    ArrowT Type
    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 Type
    ArrowT Type
    s) (AppT Type
    m Type
    s'), AppT (AppT Type
    ArrowT Type
    t) (AppT Type
    m' 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
                (Type, Type)
    _ -> String -> Q ([Dec], Exp)
    forall a. String -> a
    genError (String -> Q ([Dec], Exp)) -> String -> Q ([Dec], Exp)
    forall a b. (a -> b) -> a -> b
    $ String
    "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]
    ++ String
    ", 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 a. a -> Q a
    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 Mode
    doDescend RetAp
    ra [TypeQ]
    stops Name
    f Type
    aft Type
    st = do
        [Type]
    ss <- [TypeQ] -> Q [Type]
    forall (t :: * -> *) (m :: * -> *) a.
    (Traversable t, Monad m) =>
    t (m a) -> m (t a)
    forall (m :: * -> *) a. Monad m => [m a] -> m [a]
    sequence [TypeQ]
    stops
        Type
    ft <- Type -> TypeQ
    forall (q :: * -> *). Quasi q => Type -> q Type
    expandSyn Type
    aft
        (Exp
    tr, (Map Type Dec
    m, Map Type Bool
    _)) <- 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 a. a -> Q a
    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 Bool
    seenStop Mode
    doDescend ra :: RetAp
    ra@(Exp -> Exp
    ret, Exp -> Exp -> Exp
    _, Exp -> Exp -> Exp
    rbind) Exp
    f Type
    ft Type
    ast = do
    --    qRunIO $ do print (seenStop, doDescend, ft, ast); hFlush stdout
        (Map Type Dec
    m, 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 -> U 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 Name
    n [Clause]
    _) -> 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 a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Exp
    f
                 else
                    Exp -> StateT (Map Type Dec, Map Type Bool) Q Exp
    forall a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    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
            Maybe Dec
    _ -> do
                Name
    tr <- String -> U Name
    forall (m :: * -> *). Quasi m => String -> m Name
    qNewName String
    "_tr"
                let mkRec :: Bool -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    mkRec 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
    $ [Maybe 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 String
    "_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
    $ \ (Map Type Dec
    m', 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 String
    "_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 a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    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 String
    "_x"
                              [Clause] -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    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 String
    "_x"
                              [Clause] -> StateT (Map Type Dec, Map Type Bool) Q [Clause]
    forall a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    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
    $ \ (Map Type Dec
    m', 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 a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    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 Bool
    seenStop Mode
    doDescend RetAp
    ra Exp
    f Type
    ft Type
    st = do
        let (Type
    con, [Type]
    ts) = Type -> (Type, [Type])
    splitTypeApp Type
    st
        case Type
    con of
            ConT 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 Int
    _  -> 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
            Type
    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. HasCallStack => [a] -> a
    head [Type]
    ts)
            Type
    _         -> 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
    $ String
    "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
    " (" 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]
    ++ String
    ")"

    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 Bool
    seenStop Mode
    doDescend RetAp
    ra Exp
    f Type
    ft Type
    st 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 a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    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 Bool
    seenStop Mode
    doDescend RetAp
    ra Exp
    f Type
    ft Type
    st [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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 String
    "_t") [Type]
    ts
    #if MIN_VERSION_template_haskell(2,16,0)
        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
    $ [Maybe Exp] -> Exp
    TupE ((Name -> Maybe Exp) -> [Name] -> [Maybe Exp]
    forall a b. (a -> b) -> [a] -> [b]
    map (Exp -> Maybe Exp
    forall a. a -> Maybe a
    Just (Exp -> Maybe Exp) -> (Name -> Exp) -> Name -> Maybe Exp
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Name -> Exp
    VarE) [Name]
    vs)
    #else
        let tupE = LamE (map VarP vs) $ TupE (map VarE 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 a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    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 Bool
    seenStop Mode
    doDescend RetAp
    ra Exp
    f Name
    con Type
    ft Type
    st [Type]
    ts = do
        ([TyVarBndr ()]
    tvs, [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 Name
    c [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 BangType
    x1 Name
    c 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 (\ [Pat
    p1, Pat
    p2] -> Pat -> Name -> Pat -> Pat
    InfixP Pat
    p1 Name
    c Pat
    p2) (Name -> Exp
    ConE Name
    c) [BangType
    x1, BangType
    x2]
            genArm (RecC Name
    c [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) | (Name
    _,Bang
    b,Type
    t) <- [VarBangType]
    xs ]
            genArm 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
    $ String
    "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
    forall a. [TyVarBndr a] -> [Type] -> Subst
    mkSubst [TyVarBndr ()]
    tvs [Type]
    ts
            arm :: ([Pat] -> Pat)
    -> Exp
    -> [(a, Type)]
    -> StateT (Map Type Dec, Map Type Bool) Q Clause
    arm [Pat] -> Pat
    c Exp
    ec [(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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 Bool
    seenStop Mode
    doDescend ra :: RetAp
    ra@(Exp -> Exp
    ret, Exp -> Exp -> Exp
    apl, Exp -> Exp -> Exp
    _) Exp
    f Type
    ft Type
    st Subst
    s [Pat] -> Pat
    c Exp
    ec [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)
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [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 String
    "_x") [Type]
    ts
        let sub :: Name -> Type -> StateT (Map Type Dec, Map Type Bool) Q Exp
    sub Name
    v 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 a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    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 a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    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 b a. (b -> a -> b) -> b -> [a] -> b
    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 a. a -> StateT (Map Type Dec, Map Type Bool) Q a
    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 :: forall a b. 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 :: forall a b. Eq a => a -> Map a b -> Maybe b
    mLookup a
    a (Map [(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 :: forall a b. Eq a => a -> b -> Map a b -> Map a b
    mInsert a
    a b
    b (Map [(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 :: forall a b. Map a b -> [b]
    mElems (Map [(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 :: forall a b. [(a, b)] -> Map a b
    mFromList [(a, b)]
    xys = [(a, b)] -> Map a b
    forall a b. [(a, b)] -> Map a b
    Map [(a, b)]
    xys