    -----------------------------------------------------------------------------
    -- |
    -- Module      :  Data.Singletons.Partition
    -- Copyright   :  (C) 2015 Richard Eisenberg
    -- License     :  BSD-style (see LICENSE)
    -- Maintainer  :  Ryan Scott
    -- Stability   :  experimental
    -- Portability :  non-portable
    --
    -- Partitions a list of declarations into its bits
    --
    ----------------------------------------------------------------------------

    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE TupleSections #-}

    module Data.Singletons.Partition where

    import Prelude hiding ( exp )
    import Data.Singletons.Syntax
    import Data.Singletons.Deriving.Ord
    import Data.Singletons.Deriving.Bounded
    import Data.Singletons.Deriving.Enum
    import Data.Singletons.Deriving.Foldable
    import Data.Singletons.Deriving.Functor
    import Data.Singletons.Deriving.Show
    import Data.Singletons.Deriving.Traversable
    import Data.Singletons.Deriving.Util
    import Data.Singletons.Names
    import Language.Haskell.TH.Syntax hiding (showName)
    import Language.Haskell.TH.Ppr
    import Language.Haskell.TH.Desugar
    import qualified Language.Haskell.TH.Desugar.OMap.Strict as OMap
    import Language.Haskell.TH.Desugar.OMap.Strict (OMap)
    import Data.Singletons.Util

    import Control.Monad
    import Data.Bifunctor (bimap)
    import qualified Data.Map as Map
    import Data.Map (Map)
    import Data.Maybe

    data PartitionedDecs =
      PDecs { PartitionedDecs -> [DLetDec]
    pd_let_decs :: [DLetDec]
            , PartitionedDecs -> [UClassDecl]
    pd_class_decs :: [UClassDecl]
            , PartitionedDecs -> [UInstDecl]
    pd_instance_decs :: [UInstDecl]
            , PartitionedDecs -> [DataDecl]
    pd_data_decs :: [DataDecl]
            , PartitionedDecs -> [TySynDecl]
    pd_ty_syn_decs :: [TySynDecl]
            , PartitionedDecs -> [OpenTypeFamilyDecl]
    pd_open_type_family_decs :: [OpenTypeFamilyDecl]
            , PartitionedDecs -> [ClosedTypeFamilyDecl]
    pd_closed_type_family_decs :: [ClosedTypeFamilyDecl]
            , PartitionedDecs -> [DerivedEqDecl]
    pd_derived_eq_decs :: [DerivedEqDecl]
            , PartitionedDecs -> [DerivedShowDecl]
    pd_derived_show_decs :: [DerivedShowDecl]
            }

    instance Semigroup PartitionedDecs where
      PDecs a1 :: [DLetDec]
    a1 b1 :: [UClassDecl]
    b1 c1 :: [UInstDecl]
    c1 d1 :: [DataDecl]
    d1 e1 :: [TySynDecl]
    e1 f1 :: [OpenTypeFamilyDecl]
    f1 g1 :: [ClosedTypeFamilyDecl]
    g1 h1 :: [DerivedEqDecl]
    h1 i1 :: [DerivedShowDecl]
    i1 <> :: PartitionedDecs -> PartitionedDecs -> PartitionedDecs
    <> PDecs a2 :: [DLetDec]
    a2 b2 :: [UClassDecl]
    b2 c2 :: [UInstDecl]
    c2 d2 :: [DataDecl]
    d2 e2 :: [TySynDecl]
    e2 f2 :: [OpenTypeFamilyDecl]
    f2 g2 :: [ClosedTypeFamilyDecl]
    g2 h2 :: [DerivedEqDecl]
    h2 i2 :: [DerivedShowDecl]
    i2 =
        [DLetDec]
    -> [UClassDecl]
    -> [UInstDecl]
    -> [DataDecl]
    -> [TySynDecl]
    -> [OpenTypeFamilyDecl]
    -> [ClosedTypeFamilyDecl]
    -> [DerivedEqDecl]
    -> [DerivedShowDecl]
    -> PartitionedDecs
    PDecs ([DLetDec]
    a1 [DLetDec] -> [DLetDec] -> [DLetDec]
    forall a. Semigroup a => a -> a -> a
    <> [DLetDec]
    a2) ([UClassDecl]
    b1 [UClassDecl] -> [UClassDecl] -> [UClassDecl]
    forall a. Semigroup a => a -> a -> a
    <> [UClassDecl]
    b2) ([UInstDecl]
    c1 [UInstDecl] -> [UInstDecl] -> [UInstDecl]
    forall a. Semigroup a => a -> a -> a
    <> [UInstDecl]
    c2) ([DataDecl]
    d1 [DataDecl] -> [DataDecl] -> [DataDecl]
    forall a. Semigroup a => a -> a -> a
    <> [DataDecl]
    d2) ([TySynDecl]
    e1 [TySynDecl] -> [TySynDecl] -> [TySynDecl]
    forall a. Semigroup a => a -> a -> a
    <> [TySynDecl]
    e2) ([OpenTypeFamilyDecl]
    f1 [OpenTypeFamilyDecl]
    -> [OpenTypeFamilyDecl] -> [OpenTypeFamilyDecl]
    forall a. Semigroup a => a -> a -> a
    <> [OpenTypeFamilyDecl]
    f2)
              ([ClosedTypeFamilyDecl]
    g1 [ClosedTypeFamilyDecl]
    -> [ClosedTypeFamilyDecl] -> [ClosedTypeFamilyDecl]
    forall a. Semigroup a => a -> a -> a
    <> [ClosedTypeFamilyDecl]
    g2) ([DerivedEqDecl]
    h1 [DerivedEqDecl] -> [DerivedEqDecl] -> [DerivedEqDecl]
    forall a. Semigroup a => a -> a -> a
    <> [DerivedEqDecl]
    h2) ([DerivedShowDecl]
    i1 [DerivedShowDecl] -> [DerivedShowDecl] -> [DerivedShowDecl]
    forall a. Semigroup a => a -> a -> a
    <> [DerivedShowDecl]
    i2)

    instance Monoid PartitionedDecs where
      mempty :: PartitionedDecs
    mempty = [DLetDec]
    -> [UClassDecl]
    -> [UInstDecl]
    -> [DataDecl]
    -> [TySynDecl]
    -> [OpenTypeFamilyDecl]
    -> [ClosedTypeFamilyDecl]
    -> [DerivedEqDecl]
    -> [DerivedShowDecl]
    -> PartitionedDecs
    PDecs [] [] [] [] [] [] [] [] []
      mappend :: PartitionedDecs -> PartitionedDecs -> PartitionedDecs
    mappend = PartitionedDecs -> PartitionedDecs -> PartitionedDecs
    forall a. Semigroup a => a -> a -> a
    (<>)

    -- | Split up a @[DDec]@ into its pieces, extracting 'Ord' instances
    -- from deriving clauses
    partitionDecs :: DsMonad m => [DDec] -> m PartitionedDecs
    partitionDecs :: [DDec] -> m PartitionedDecs
    partitionDecs = (DDec -> m PartitionedDecs) -> [DDec] -> m PartitionedDecs
    forall (monad :: * -> *) monoid (t :: * -> *) a.
    (Monad monad, Monoid monoid, Traversable t) =>
    (a -> monad monoid) -> t a -> monad monoid
    concatMapM DDec -> m PartitionedDecs
    forall (m :: * -> *). DsMonad m => DDec -> m PartitionedDecs
    partitionDec

    partitionDec :: DsMonad m => DDec -> m PartitionedDecs
    partitionDec :: DDec -> m PartitionedDecs
    partitionDec (DLetDec (DPragmaD {})) = PartitionedDecs -> m PartitionedDecs
    forall (m :: * -> *) a. Monad m => a -> m a
    return PartitionedDecs
    forall a. Monoid a => a
    mempty
    partitionDec (DLetDec letdec :: DLetDec
    letdec) = PartitionedDecs -> m PartitionedDecs
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PartitionedDecs -> m PartitionedDecs)
    -> PartitionedDecs -> m PartitionedDecs
    forall a b. (a -> b) -> a -> b
    $ PartitionedDecs
    forall a. Monoid a => a
    mempty { pd_let_decs :: [DLetDec]
    pd_let_decs = [DLetDec
    letdec] }

    partitionDec (DDataD _nd :: NewOrData
    _nd _cxt :: DCxt
    _cxt name :: Name
    name tvbs :: [DTyVarBndr]
    tvbs mk :: Maybe DKind
    mk cons :: [DCon]
    cons derivings :: [DDerivClause]
    derivings) = do
      [DTyVarBndr]
    all_tvbs <- [DTyVarBndr] -> Maybe DKind -> m [DTyVarBndr]
    forall (q :: * -> *).
    DsMonad q =>
    [DTyVarBndr] -> Maybe DKind -> q [DTyVarBndr]
    buildDataDTvbs [DTyVarBndr]
    tvbs Maybe DKind
    mk
      let data_decl :: DataDecl
    data_decl   = Name -> [DTyVarBndr] -> [DCon] -> DataDecl
    DataDecl Name
    name [DTyVarBndr]
    all_tvbs [DCon]
    cons
          derived_dec :: PartitionedDecs
    derived_dec = PartitionedDecs
    forall a. Monoid a => a
    mempty { pd_data_decs :: [DataDecl]
    pd_data_decs = [DataDecl
    data_decl] }
      [PartitionedDecs]
    derived_decs
        <- ((Maybe DDerivStrategy, DKind) -> m PartitionedDecs)
    -> [(Maybe DDerivStrategy, DKind)] -> m [PartitionedDecs]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (\(strat :: Maybe DDerivStrategy
    strat, deriv_pred :: DKind
    deriv_pred) ->
                  let etad_tvbs :: [DTyVarBndr]
    etad_tvbs
                        | (DConT pred_name :: Name
    pred_name, _) <- DKind -> (DKind, [DTypeArg])
    unfoldDType DKind
    deriv_pred
                        , Name -> Bool
    isFunctorLikeClassName Name
    pred_name
                          -- If deriving Functor, Foldable, or Traversable,
                          -- we need to use one less type variable than we normally do.
                        = Int -> [DTyVarBndr] -> [DTyVarBndr]
    forall a. Int -> [a] -> [a]
    take ([DTyVarBndr] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [DTyVarBndr]
    all_tvbs Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - 1) [DTyVarBndr]
    all_tvbs
                        | Bool
    otherwise
                        = [DTyVarBndr]
    all_tvbs
                      ty :: DKind
    ty = DKind -> [DTyVarBndr] -> DKind
    foldTypeTvbs (Name -> DKind
    DConT Name
    name) [DTyVarBndr]
    etad_tvbs
                  in Maybe DDerivStrategy
    -> DKind -> Maybe DCxt -> DKind -> DataDecl -> m PartitionedDecs
    forall (m :: * -> *).
    DsMonad m =>
    Maybe DDerivStrategy
    -> DKind -> Maybe DCxt -> DKind -> DataDecl -> m PartitionedDecs
    partitionDeriving Maybe DDerivStrategy
    strat DKind
    deriv_pred Maybe DCxt
    forall a. Maybe a
    Nothing DKind
    ty DataDecl
    data_decl)
          ([(Maybe DDerivStrategy, DKind)] -> m [PartitionedDecs])
    -> [(Maybe DDerivStrategy, DKind)] -> m [PartitionedDecs]
    forall a b. (a -> b) -> a -> b
    $ (DDerivClause -> [(Maybe DDerivStrategy, DKind)])
    -> [DDerivClause] -> [(Maybe DDerivStrategy, DKind)]
    forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
    concatMap DDerivClause -> [(Maybe DDerivStrategy, DKind)]
    flatten_clause [DDerivClause]
    derivings
      PartitionedDecs -> m PartitionedDecs
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PartitionedDecs -> m PartitionedDecs)
    -> PartitionedDecs -> m PartitionedDecs
    forall a b. (a -> b) -> a -> b
    $ [PartitionedDecs] -> PartitionedDecs
    forall a. Monoid a => [a] -> a
    mconcat ([PartitionedDecs] -> PartitionedDecs)
    -> [PartitionedDecs] -> PartitionedDecs
    forall a b. (a -> b) -> a -> b
    $ PartitionedDecs
    derived_dec PartitionedDecs -> [PartitionedDecs] -> [PartitionedDecs]
    forall a. a -> [a] -> [a]
    : [PartitionedDecs]
    derived_decs
      where
        flatten_clause :: DDerivClause -> [(Maybe DDerivStrategy, DPred)]
        flatten_clause :: DDerivClause -> [(Maybe DDerivStrategy, DKind)]
    flatten_clause (DDerivClause strat :: Maybe DDerivStrategy
    strat preds :: DCxt
    preds) =
          (DKind -> (Maybe DDerivStrategy, DKind))
    -> DCxt -> [(Maybe DDerivStrategy, DKind)]
    forall a b. (a -> b) -> [a] -> [b]
    map (\p :: DKind
    p -> (Maybe DDerivStrategy
    strat, DKind
    p)) DCxt
    preds

    partitionDec (DClassD cxt :: DCxt
    cxt name :: Name
    name tvbs :: [DTyVarBndr]
    tvbs fds :: [FunDep]
    fds decs :: [DDec]
    decs) = do
      (lde :: ULetDecEnv
    lde, otfs :: [OpenTypeFamilyDecl]
    otfs) <- (DDec -> m (ULetDecEnv, [OpenTypeFamilyDecl]))
    -> [DDec] -> m (ULetDecEnv, [OpenTypeFamilyDecl])
    forall (monad :: * -> *) monoid (t :: * -> *) a.
    (Monad monad, Monoid monoid, Traversable t) =>
    (a -> monad monoid) -> t a -> monad monoid
    concatMapM DDec -> m (ULetDecEnv, [OpenTypeFamilyDecl])
    forall (m :: * -> *).
    MonadFail m =>
    DDec -> m (ULetDecEnv, [OpenTypeFamilyDecl])
    partitionClassDec [DDec]
    decs
      PartitionedDecs -> m PartitionedDecs
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PartitionedDecs -> m PartitionedDecs)
    -> PartitionedDecs -> m PartitionedDecs
    forall a b. (a -> b) -> a -> b
    $ PartitionedDecs
    forall a. Monoid a => a
    mempty { pd_class_decs :: [UClassDecl]
    pd_class_decs = [ClassDecl :: forall (ann :: AnnotationFlag).
    DCxt
    -> Name
    -> [DTyVarBndr]
    -> [FunDep]
    -> LetDecEnv ann
    -> ClassDecl ann
    ClassDecl { cd_cxt :: DCxt
    cd_cxt       = DCxt
    cxt
                                                   , cd_name :: Name
    cd_name      = Name
    name
                                                   , cd_tvbs :: [DTyVarBndr]
    cd_tvbs      = [DTyVarBndr]
    tvbs
                                                   , cd_fds :: [FunDep]
    cd_fds       = [FunDep]
    fds
                                                   , cd_lde :: ULetDecEnv
    cd_lde       = ULetDecEnv
    lde }]
                      , pd_open_type_family_decs :: [OpenTypeFamilyDecl]
    pd_open_type_family_decs = [OpenTypeFamilyDecl]
    otfs }
    partitionDec (DInstanceD _ _ cxt :: DCxt
    cxt ty :: DKind
    ty decs :: [DDec]
    decs) = do
      (defns :: [(Name, ULetDecRHS)]
    defns, sigs :: OMap Name DKind
    sigs) <- (([Maybe (Name, ULetDecRHS)], [OMap Name DKind])
     -> ([(Name, ULetDecRHS)], OMap Name DKind))
    -> m ([Maybe (Name, ULetDecRHS)], [OMap Name DKind])
    -> m ([(Name, ULetDecRHS)], OMap Name DKind)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (([Maybe (Name, ULetDecRHS)] -> [(Name, ULetDecRHS)])
    -> ([OMap Name DKind] -> OMap Name DKind)
    -> ([Maybe (Name, ULetDecRHS)], [OMap Name DKind])
    -> ([(Name, ULetDecRHS)], OMap Name DKind)
    forall (p :: * -> * -> *) a b c d.
    Bifunctor p =>
    (a -> b) -> (c -> d) -> p a c -> p b d
    bimap [Maybe (Name, ULetDecRHS)] -> [(Name, ULetDecRHS)]
    forall a. [Maybe a] -> [a]
    catMaybes [OMap Name DKind] -> OMap Name DKind
    forall a. Monoid a => [a] -> a
    mconcat) (m ([Maybe (Name, ULetDecRHS)], [OMap Name DKind])
     -> m ([(Name, ULetDecRHS)], OMap Name DKind))
    -> m ([Maybe (Name, ULetDecRHS)], [OMap Name DKind])
    -> m ([(Name, ULetDecRHS)], OMap Name DKind)
    forall a b. (a -> b) -> a -> b
    $
                       (DDec -> m (Maybe (Name, ULetDecRHS), OMap Name DKind))
    -> [DDec] -> m ([Maybe (Name, ULetDecRHS)], [OMap Name DKind])
    forall (m :: * -> *) a b c.
    Applicative m =>
    (a -> m (b, c)) -> [a] -> m ([b], [c])
    mapAndUnzipM DDec -> m (Maybe (Name, ULetDecRHS), OMap Name DKind)
    forall (m :: * -> *).
    MonadFail m =>
    DDec -> m (Maybe (Name, ULetDecRHS), OMap Name DKind)
    partitionInstanceDec [DDec]
    decs
      (name :: Name
    name, tys :: DCxt
    tys) <- DCxt -> DKind -> m (Name, DCxt)
    forall (m :: * -> *).
    MonadFail m =>
    DCxt -> DKind -> m (Name, DCxt)
    split_app_tys [] DKind
    ty
      PartitionedDecs -> m PartitionedDecs
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PartitionedDecs -> m PartitionedDecs)
    -> PartitionedDecs -> m PartitionedDecs
    forall a b. (a -> b) -> a -> b
    $ PartitionedDecs
    forall a. Monoid a => a
    mempty { pd_instance_decs :: [UInstDecl]
    pd_instance_decs = [InstDecl :: forall (ann :: AnnotationFlag).
    DCxt
    -> Name
    -> DCxt
    -> OMap Name DKind
    -> [(Name, LetDecRHS ann)]
    -> InstDecl ann
    InstDecl { id_cxt :: DCxt
    id_cxt       = DCxt
    cxt
                                                     , id_name :: Name
    id_name      = Name
    name
                                                     , id_arg_tys :: DCxt
    id_arg_tys   = DCxt
    tys
                                                     , id_sigs :: OMap Name DKind
    id_sigs      = OMap Name DKind
    sigs
                                                     , id_meths :: [(Name, ULetDecRHS)]
    id_meths     = [(Name, ULetDecRHS)]
    defns }] }
      where
        split_app_tys :: DCxt -> DKind -> m (Name, DCxt)
    split_app_tys acc :: DCxt
    acc (DAppT t1 :: DKind
    t1 t2 :: DKind
    t2) = DCxt -> DKind -> m (Name, DCxt)
    split_app_tys (DKind
    t2DKind -> DCxt -> DCxt
    forall a. a -> [a] -> [a]
    :DCxt
    acc) DKind
    t1
        split_app_tys acc :: DCxt
    acc (DConT name :: Name
    name)  = (Name, DCxt) -> m (Name, DCxt)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Name
    name, DCxt
    acc)
        split_app_tys acc :: DCxt
    acc (DSigT t :: DKind
    t _)   = DCxt -> DKind -> m (Name, DCxt)
    split_app_tys DCxt
    acc DKind
    t
        split_app_tys _ _ = String -> m (Name, DCxt)
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> m (Name, DCxt)) -> String -> m (Name, DCxt)
    forall a b. (a -> b) -> a -> b
    $ "Illegal instance head: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ DKind -> String
    forall a. Show a => a -> String
    show DKind
    ty
    partitionDec (DRoleAnnotD {}) = PartitionedDecs -> m PartitionedDecs
    forall (m :: * -> *) a. Monad m => a -> m a
    return PartitionedDecs
    forall a. Monoid a => a
    mempty  -- ignore these
    partitionDec (DTySynD name :: Name
    name tvbs :: [DTyVarBndr]
    tvbs rhs :: DKind
    rhs) =
      -- See Note [Partitioning, type synonyms, and type families]
      PartitionedDecs -> m PartitionedDecs
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PartitionedDecs -> m PartitionedDecs)
    -> PartitionedDecs -> m PartitionedDecs
    forall a b. (a -> b) -> a -> b
    $ PartitionedDecs
    forall a. Monoid a => a
    mempty { pd_ty_syn_decs :: [TySynDecl]
    pd_ty_syn_decs = [Name -> [DTyVarBndr] -> DKind -> TySynDecl
    TySynDecl Name
    name [DTyVarBndr]
    tvbs DKind
    rhs] }
    partitionDec (DClosedTypeFamilyD tf_head :: DTypeFamilyHead
    tf_head _) =
      -- See Note [Partitioning, type synonyms, and type families]
      PartitionedDecs -> m PartitionedDecs
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PartitionedDecs -> m PartitionedDecs)
    -> PartitionedDecs -> m PartitionedDecs
    forall a b. (a -> b) -> a -> b
    $ PartitionedDecs
    forall a. Monoid a => a
    mempty { pd_closed_type_family_decs :: [ClosedTypeFamilyDecl]
    pd_closed_type_family_decs = [DTypeFamilyHead -> ClosedTypeFamilyDecl
    forall (info :: FamilyInfo). DTypeFamilyHead -> TypeFamilyDecl info
    TypeFamilyDecl DTypeFamilyHead
    tf_head] }
    partitionDec (DOpenTypeFamilyD tf_head :: DTypeFamilyHead
    tf_head) =
      -- See Note [Partitioning, type synonyms, and type families]
      PartitionedDecs -> m PartitionedDecs
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PartitionedDecs -> m PartitionedDecs)
    -> PartitionedDecs -> m PartitionedDecs
    forall a b. (a -> b) -> a -> b
    $ PartitionedDecs
    forall a. Monoid a => a
    mempty { pd_open_type_family_decs :: [OpenTypeFamilyDecl]
    pd_open_type_family_decs = [DTypeFamilyHead -> OpenTypeFamilyDecl
    forall (info :: FamilyInfo). DTypeFamilyHead -> TypeFamilyDecl info
    TypeFamilyDecl DTypeFamilyHead
    tf_head] }
    partitionDec (DTySynInstD {}) = PartitionedDecs -> m PartitionedDecs
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure PartitionedDecs
    forall a. Monoid a => a
    mempty
      -- There's no need to track type family instances, since
      -- we already record the type family itself separately.
    partitionDec (DStandaloneDerivD mb_strat :: Maybe DDerivStrategy
    mb_strat _ ctxt :: DCxt
    ctxt ty :: DKind
    ty) =
      case DKind -> (DKind, [DTypeArg])
    unfoldDType DKind
    ty of
        (cls_pred_ty :: DKind
    cls_pred_ty, cls_tys :: [DTypeArg]
    cls_tys)
          | let cls_normal_tys :: DCxt
    cls_normal_tys = [DTypeArg] -> DCxt
    filterDTANormals [DTypeArg]
    cls_tys
          , Bool -> Bool
    not (DCxt -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null DCxt
    cls_normal_tys) -- We can't handle zero-parameter type classes
          , let cls_arg_tys :: DCxt
    cls_arg_tys  = DCxt -> DCxt
    forall a. [a] -> [a]
    init DCxt
    cls_normal_tys
                data_ty :: DKind
    data_ty      = DCxt -> DKind
    forall a. [a] -> a
    last DCxt
    cls_normal_tys
                data_ty_head :: DKind
    data_ty_head = case DKind -> (DKind, [DTypeArg])
    unfoldDType DKind
    data_ty of (ty_head :: DKind
    ty_head, _) -> DKind
    ty_head
          , DConT data_tycon :: Name
    data_tycon <- DKind
    data_ty_head -- We can't handle deriving an instance for something
                                             -- other than a type constructor application
          -> do let cls_pred :: DKind
    cls_pred = DKind -> DCxt -> DKind
    foldType DKind
    cls_pred_ty DCxt
    cls_arg_tys
                Maybe DInfo
    dinfo <- Name -> m (Maybe DInfo)
    forall (q :: * -> *). DsMonad q => Name -> q (Maybe DInfo)
    dsReify Name
    data_tycon
                case Maybe DInfo
    dinfo of
                  Just (DTyConI (DDataD _ _ dn :: Name
    dn dtvbs :: [DTyVarBndr]
    dtvbs dk :: Maybe DKind
    dk dcons :: [DCon]
    dcons _) _) -> do
                    [DTyVarBndr]
    all_tvbs <- [DTyVarBndr] -> Maybe DKind -> m [DTyVarBndr]
    forall (q :: * -> *).
    DsMonad q =>
    [DTyVarBndr] -> Maybe DKind -> q [DTyVarBndr]
    buildDataDTvbs [DTyVarBndr]
    dtvbs Maybe DKind
    dk
                    let data_decl :: DataDecl
    data_decl = Name -> [DTyVarBndr] -> [DCon] -> DataDecl
    DataDecl Name
    dn [DTyVarBndr]
    all_tvbs [DCon]
    dcons
                    Maybe DDerivStrategy
    -> DKind -> Maybe DCxt -> DKind -> DataDecl -> m PartitionedDecs
    forall (m :: * -> *).
    DsMonad m =>
    Maybe DDerivStrategy
    -> DKind -> Maybe DCxt -> DKind -> DataDecl -> m PartitionedDecs
    partitionDeriving Maybe DDerivStrategy
    mb_strat DKind
    cls_pred (DCxt -> Maybe DCxt
    forall a. a -> Maybe a
    Just DCxt
    ctxt) DKind
    data_ty DataDecl
    data_decl
                  Just _ ->
                    String -> m PartitionedDecs
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> m PartitionedDecs) -> String -> m PartitionedDecs
    forall a b. (a -> b) -> a -> b
    $ "Standalone derived instance for something other than a datatype: "
                           String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ DKind -> String
    forall a. Show a => a -> String
    show DKind
    data_ty
                  _ -> String -> m PartitionedDecs
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> m PartitionedDecs) -> String -> m PartitionedDecs
    forall a b. (a -> b) -> a -> b
    $ "Cannot find " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ DKind -> String
    forall a. Show a => a -> String
    show DKind
    data_ty
        _ -> PartitionedDecs -> m PartitionedDecs
    forall (m :: * -> *) a. Monad m => a -> m a
    return PartitionedDecs
    forall a. Monoid a => a
    mempty
    partitionDec dec :: DDec
    dec =
      String -> m PartitionedDecs
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail (String -> m PartitionedDecs) -> String -> m PartitionedDecs
    forall a b. (a -> b) -> a -> b
    $ "Declaration cannot be promoted: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ [Dec] -> String
    forall a. Ppr a => a -> String
    pprint (DDec -> [Dec]
    decToTH DDec
    dec)

    partitionClassDec :: MonadFail m => DDec -> m (ULetDecEnv, [OpenTypeFamilyDecl])
    partitionClassDec :: DDec -> m (ULetDecEnv, [OpenTypeFamilyDecl])
    partitionClassDec (DLetDec (DSigD name :: Name
    name ty :: DKind
    ty)) =
      (ULetDecEnv, [OpenTypeFamilyDecl])
    -> m (ULetDecEnv, [OpenTypeFamilyDecl])
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Name -> DKind -> ULetDecEnv
    typeBinding Name
    name DKind
    ty, [OpenTypeFamilyDecl]
    forall a. Monoid a => a
    mempty)
    partitionClassDec (DLetDec (DValD (DVarP name :: Name
    name) exp :: DExp
    exp)) =
      (ULetDecEnv, [OpenTypeFamilyDecl])
    -> m (ULetDecEnv, [OpenTypeFamilyDecl])
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Name -> ULetDecRHS -> ULetDecEnv
    valueBinding Name
    name (DExp -> ULetDecRHS
    UValue DExp
    exp), [OpenTypeFamilyDecl]
    forall a. Monoid a => a
    mempty)
    partitionClassDec (DLetDec (DFunD name :: Name
    name clauses :: [DClause]
    clauses)) =
      (ULetDecEnv, [OpenTypeFamilyDecl])
    -> m (ULetDecEnv, [OpenTypeFamilyDecl])
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Name -> ULetDecRHS -> ULetDecEnv
    valueBinding Name
    name ([DClause] -> ULetDecRHS
    UFunction [DClause]
    clauses), [OpenTypeFamilyDecl]
    forall a. Monoid a => a
    mempty)
    partitionClassDec (DLetDec (DInfixD fixity :: Fixity
    fixity name :: Name
    name)) =
      (ULetDecEnv, [OpenTypeFamilyDecl])
    -> m (ULetDecEnv, [OpenTypeFamilyDecl])
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Fixity -> Name -> ULetDecEnv
    infixDecl Fixity
    fixity Name
    name, [OpenTypeFamilyDecl]
    forall a. Monoid a => a
    mempty)
    partitionClassDec (DLetDec (DPragmaD {})) =
      (ULetDecEnv, [OpenTypeFamilyDecl])
    -> m (ULetDecEnv, [OpenTypeFamilyDecl])
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ULetDecEnv
    forall a. Monoid a => a
    mempty, [OpenTypeFamilyDecl]
    forall a. Monoid a => a
    mempty)
    partitionClassDec (DOpenTypeFamilyD tf_head :: DTypeFamilyHead
    tf_head) =
      -- See Note [Partitioning, type synonyms, and type families]
      (ULetDecEnv, [OpenTypeFamilyDecl])
    -> m (ULetDecEnv, [OpenTypeFamilyDecl])
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ULetDecEnv
    forall a. Monoid a => a
    mempty, [DTypeFamilyHead -> OpenTypeFamilyDecl
    forall (info :: FamilyInfo). DTypeFamilyHead -> TypeFamilyDecl info
    TypeFamilyDecl DTypeFamilyHead
    tf_head])
    partitionClassDec (DTySynInstD {}) =
      -- There's no need to track associated type family default equations, since
      -- we already record the type family itself separately.
      (ULetDecEnv, [OpenTypeFamilyDecl])
    -> m (ULetDecEnv, [OpenTypeFamilyDecl])
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (ULetDecEnv
    forall a. Monoid a => a
    mempty, [OpenTypeFamilyDecl]
    forall a. Monoid a => a
    mempty)
    partitionClassDec _ =
      String -> m (ULetDecEnv, [OpenTypeFamilyDecl])
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "Only method declarations can be promoted within a class."

    partitionInstanceDec :: MonadFail m => DDec
                         -> m ( Maybe (Name, ULetDecRHS) -- right-hand sides of methods
                              , OMap Name DType          -- method type signatures
                              )
    partitionInstanceDec :: DDec -> m (Maybe (Name, ULetDecRHS), OMap Name DKind)
    partitionInstanceDec (DLetDec (DValD (DVarP name :: Name
    name) exp :: DExp
    exp)) =
      (Maybe (Name, ULetDecRHS), OMap Name DKind)
    -> m (Maybe (Name, ULetDecRHS), OMap Name DKind)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((Name, ULetDecRHS) -> Maybe (Name, ULetDecRHS)
    forall a. a -> Maybe a
    Just (Name
    name, DExp -> ULetDecRHS
    UValue DExp
    exp), OMap Name DKind
    forall a. Monoid a => a
    mempty)
    partitionInstanceDec (DLetDec (DFunD name :: Name
    name clauses :: [DClause]
    clauses)) =
      (Maybe (Name, ULetDecRHS), OMap Name DKind)
    -> m (Maybe (Name, ULetDecRHS), OMap Name DKind)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ((Name, ULetDecRHS) -> Maybe (Name, ULetDecRHS)
    forall a. a -> Maybe a
    Just (Name
    name, [DClause] -> ULetDecRHS
    UFunction [DClause]
    clauses), OMap Name DKind
    forall a. Monoid a => a
    mempty)
    partitionInstanceDec (DLetDec (DSigD name :: Name
    name ty :: DKind
    ty)) =
      (Maybe (Name, ULetDecRHS), OMap Name DKind)
    -> m (Maybe (Name, ULetDecRHS), OMap Name DKind)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe (Name, ULetDecRHS)
    forall a. Maybe a
    Nothing, Name -> DKind -> OMap Name DKind
    forall k v. k -> v -> OMap k v
    OMap.singleton Name
    name DKind
    ty)
    partitionInstanceDec (DLetDec (DPragmaD {})) =
      (Maybe (Name, ULetDecRHS), OMap Name DKind)
    -> m (Maybe (Name, ULetDecRHS), OMap Name DKind)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe (Name, ULetDecRHS)
    forall a. Maybe a
    Nothing, OMap Name DKind
    forall a. Monoid a => a
    mempty)
    partitionInstanceDec (DTySynInstD {}) =
      (Maybe (Name, ULetDecRHS), OMap Name DKind)
    -> m (Maybe (Name, ULetDecRHS), OMap Name DKind)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Maybe (Name, ULetDecRHS)
    forall a. Maybe a
    Nothing, OMap Name DKind
    forall a. Monoid a => a
    mempty)
      -- There's no need to track associated type family instances, since
      -- we already record the type family itself separately.
    partitionInstanceDec _ =
      String -> m (Maybe (Name, ULetDecRHS), OMap Name DKind)
    forall (m :: * -> *) a. MonadFail m => String -> m a
    fail "Only method bodies can be promoted within an instance."

    partitionDeriving
      :: forall m. DsMonad m
      => Maybe DDerivStrategy
                    -- ^ The deriving strategy, if present.
      -> DPred      -- ^ The class being derived (e.g., 'Eq'), possibly applied to
                    --   some number of arguments (e.g., @C Int Bool@).
      -> Maybe DCxt -- ^ @'Just' ctx@ if @ctx@ was provided via @StandaloneDeriving@.
                    --   'Nothing' if using a @deriving@ clause.
      -> DType      -- ^ The data type argument to the class.
      -> DataDecl   -- ^ The original data type information (e.g., its constructors).
      -> m PartitionedDecs
    partitionDeriving :: Maybe DDerivStrategy
    -> DKind -> Maybe DCxt -> DKind -> DataDecl -> m PartitionedDecs
    partitionDeriving mb_strat :: Maybe DDerivStrategy
    mb_strat deriv_pred :: DKind
    deriv_pred mb_ctxt :: Maybe DCxt
    mb_ctxt ty :: DKind
    ty data_decl :: DataDecl
    data_decl =
      case DKind -> (DKind, [DTypeArg])
    unfoldDType DKind
    deriv_pred of
        (DConT deriv_name :: Name
    deriv_name, arg_tys :: [DTypeArg]
    arg_tys)
             -- Here, we are more conservative than GHC: DeriveAnyClass only kicks
             -- in if the user explicitly chooses to do so with the anyclass
             -- deriving strategy
           | Just DAnyclassStrategy <- Maybe DDerivStrategy
    mb_strat
          -> PartitionedDecs -> m PartitionedDecs
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PartitionedDecs -> m PartitionedDecs)
    -> PartitionedDecs -> m PartitionedDecs
    forall a b. (a -> b) -> a -> b
    $ UInstDecl -> PartitionedDecs
    mk_derived_inst
               InstDecl :: forall (ann :: AnnotationFlag).
    DCxt
    -> Name
    -> DCxt
    -> OMap Name DKind
    -> [(Name, LetDecRHS ann)]
    -> InstDecl ann
    InstDecl { id_cxt :: DCxt
    id_cxt = DCxt -> Maybe DCxt -> DCxt
    forall a. a -> Maybe a -> a
    fromMaybe [] Maybe DCxt
    mb_ctxt
                          -- For now at least, there's no point in attempting to
                          -- infer an instance context for DeriveAnyClass, since
                          -- the other language feature that requires it,
                          -- DefaultSignatures, can't be singled. Thus, inferring an
                          -- empty context will Just Work for all currently supported
                          -- default implementations.
                          --
                          -- (Of course, if a user specifies a context with
                          -- StandaloneDeriving, use that.)

                        , id_name :: Name
    id_name      = Name
    deriv_name
                        , id_arg_tys :: DCxt
    id_arg_tys   = [DTypeArg] -> DCxt
    filterDTANormals [DTypeArg]
    arg_tys DCxt -> DCxt -> DCxt
    forall a. [a] -> [a] -> [a]
    ++ [DKind
    ty]
                        , id_sigs :: OMap Name DKind
    id_sigs      = OMap Name DKind
    forall a. Monoid a => a
    mempty
                        , id_meths :: [(Name, ULetDecRHS)]
    id_meths     = [] }

           | Just DNewtypeStrategy <- Maybe DDerivStrategy
    mb_strat
          -> do String -> m ()
    forall (q :: * -> *). Quasi q => String -> q ()
    qReportWarning "GeneralizedNewtypeDeriving is ignored by `singletons`."
                PartitionedDecs -> m PartitionedDecs
    forall (m :: * -> *) a. Monad m => a -> m a
    return PartitionedDecs
    forall a. Monoid a => a
    mempty

           | Just (DViaStrategy {}) <- Maybe DDerivStrategy
    mb_strat
          -> do String -> m ()
    forall (q :: * -> *). Quasi q => String -> q ()
    qReportWarning "DerivingVia is ignored by `singletons`."
                PartitionedDecs -> m PartitionedDecs
    forall (m :: * -> *) a. Monad m => a -> m a
    return PartitionedDecs
    forall a. Monoid a => a
    mempty

        -- Stock classes. These are derived only if `singletons` supports them
        -- (and, optionally, if an explicit stock deriving strategy is used)
        (DConT deriv_name :: Name
    deriv_name, []) -- For now, all stock derivable class supported in
                               -- singletons take just one argument (the data
                               -- type itself)
           | Bool
    stock_or_default
           , Just decs :: m PartitionedDecs
    decs <- Name -> Map Name (m PartitionedDecs) -> Maybe (m PartitionedDecs)
    forall k a. Ord k => k -> Map k a -> Maybe a
    Map.lookup Name
    deriv_name Map Name (m PartitionedDecs)
    stock_map
          -> m PartitionedDecs
    decs

             -- If we can't find a stock class, but the user bothered to use an
             -- explicit stock keyword, we can at least warn them about it.
           | Just DStockStrategy <- Maybe DDerivStrategy
    mb_strat
          -> do String -> m ()
    forall (q :: * -> *). Quasi q => String -> q ()
    qReportWarning (String -> m ()) -> String -> m ()
    forall a b. (a -> b) -> a -> b
    $ "`singletons` doesn't recognize the stock class "
                                 String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ Name -> String
    nameBase Name
    deriv_name
                PartitionedDecs -> m PartitionedDecs
    forall (m :: * -> *) a. Monad m => a -> m a
    return PartitionedDecs
    forall a. Monoid a => a
    mempty

        _ -> PartitionedDecs -> m PartitionedDecs
    forall (m :: * -> *) a. Monad m => a -> m a
    return PartitionedDecs
    forall a. Monoid a => a
    mempty -- singletons doesn't support deriving this instance
      where
          mk_instance :: DerivDesc m -> m UInstDecl
          mk_instance :: DerivDesc m -> m UInstDecl
    mk_instance maker :: DerivDesc m
    maker = DerivDesc m
    maker Maybe DCxt
    mb_ctxt DKind
    ty DataDecl
    data_decl

          mk_derived_inst :: UInstDecl -> PartitionedDecs
    mk_derived_inst    dec :: UInstDecl
    dec = PartitionedDecs
    forall a. Monoid a => a
    mempty { pd_instance_decs :: [UInstDecl]
    pd_instance_decs   = [UInstDecl
    dec] }
          mk_derived_eq_inst :: DerivedEqDecl -> PartitionedDecs
    mk_derived_eq_inst dec :: DerivedEqDecl
    dec = PartitionedDecs
    forall a. Monoid a => a
    mempty { pd_derived_eq_decs :: [DerivedEqDecl]
    pd_derived_eq_decs = [DerivedEqDecl
    dec] }

          derived_decl :: DerivedDecl cls
          derived_decl :: DerivedDecl cls
    derived_decl = DerivedDecl :: forall (cls :: * -> Constraint).
    Maybe DCxt -> DKind -> Name -> DataDecl -> DerivedDecl cls
    DerivedDecl { ded_mb_cxt :: Maybe DCxt
    ded_mb_cxt     = Maybe DCxt
    mb_ctxt
                                     , ded_type :: DKind
    ded_type       = DKind
    ty
                                     , ded_type_tycon :: Name
    ded_type_tycon = Name
    ty_tycon
                                     , ded_decl :: DataDecl
    ded_decl       = DataDecl
    data_decl }
            where
              ty_tycon :: Name
              ty_tycon :: Name
    ty_tycon = case DKind -> (DKind, [DTypeArg])
    unfoldDType DKind
    ty of
                           (DConT tc :: Name
    tc, _) -> Name
    tc
                           (t :: DKind
    t,        _) -> String -> Name
    forall a. HasCallStack => String -> a
    error (String -> Name) -> String -> Name
    forall a b. (a -> b) -> a -> b
    $ "Not a data type: " String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ DKind -> String
    forall a. Show a => a -> String
    show DKind
    t
          stock_or_default :: Bool
    stock_or_default = Maybe DDerivStrategy -> Bool
    isStockOrDefault Maybe DDerivStrategy
    mb_strat

          -- A mapping from all stock derivable classes (that singletons supports)
          -- to to derived code that they produce.
          stock_map :: Map Name (m PartitionedDecs)
          stock_map :: Map Name (m PartitionedDecs)
    stock_map = [(Name, m PartitionedDecs)] -> Map Name (m PartitionedDecs)
    forall k a. Ord k => [(k, a)] -> Map k a
    Map.fromList
            [ ( Name
    ordName,         UInstDecl -> PartitionedDecs
    mk_derived_inst (UInstDecl -> PartitionedDecs) -> m UInstDecl -> m PartitionedDecs
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DerivDesc m -> m UInstDecl
    mk_instance DerivDesc m
    forall (q :: * -> *). DsMonad q => DerivDesc q
    mkOrdInstance )
            , ( Name
    boundedName,     UInstDecl -> PartitionedDecs
    mk_derived_inst (UInstDecl -> PartitionedDecs) -> m UInstDecl -> m PartitionedDecs
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DerivDesc m -> m UInstDecl
    mk_instance DerivDesc m
    forall (q :: * -> *). DsMonad q => DerivDesc q
    mkBoundedInstance )
            , ( Name
    enumName,        UInstDecl -> PartitionedDecs
    mk_derived_inst (UInstDecl -> PartitionedDecs) -> m UInstDecl -> m PartitionedDecs
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DerivDesc m -> m UInstDecl
    mk_instance DerivDesc m
    forall (q :: * -> *). DsMonad q => DerivDesc q
    mkEnumInstance )
            , ( Name
    functorName,     UInstDecl -> PartitionedDecs
    mk_derived_inst (UInstDecl -> PartitionedDecs) -> m UInstDecl -> m PartitionedDecs
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DerivDesc m -> m UInstDecl
    mk_instance DerivDesc m
    forall (q :: * -> *). DsMonad q => DerivDesc q
    mkFunctorInstance )
            , ( Name
    foldableName,    UInstDecl -> PartitionedDecs
    mk_derived_inst (UInstDecl -> PartitionedDecs) -> m UInstDecl -> m PartitionedDecs
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DerivDesc m -> m UInstDecl
    mk_instance DerivDesc m
    forall (q :: * -> *). DsMonad q => DerivDesc q
    mkFoldableInstance )
            , ( Name
    traversableName, UInstDecl -> PartitionedDecs
    mk_derived_inst (UInstDecl -> PartitionedDecs) -> m UInstDecl -> m PartitionedDecs
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> DerivDesc m -> m UInstDecl
    mk_instance DerivDesc m
    forall (q :: * -> *). DsMonad q => DerivDesc q
    mkTraversableInstance )
              -- See Note [DerivedDecl] in Data.Singletons.Syntax
            , ( Name
    eqName, PartitionedDecs -> m PartitionedDecs
    forall (m :: * -> *) a. Monad m => a -> m a
    return (PartitionedDecs -> m PartitionedDecs)
    -> PartitionedDecs -> m PartitionedDecs
    forall a b. (a -> b) -> a -> b
    $ DerivedEqDecl -> PartitionedDecs
    mk_derived_eq_inst DerivedEqDecl
    forall (cls :: * -> Constraint). DerivedDecl cls
    derived_decl )
              -- See Note [DerivedDecl] in Data.Singletons.Syntax
            , ( Name
    showName, do -- These will become PShow/SShow instances...
                             UInstDecl
    inst_for_promotion <- DerivDesc m -> m UInstDecl
    mk_instance (DerivDesc m -> m UInstDecl) -> DerivDesc m -> m UInstDecl
    forall a b. (a -> b) -> a -> b
    $ ShowMode -> DerivDesc m
    forall (q :: * -> *). DsMonad q => ShowMode -> DerivDesc q
    mkShowInstance ShowMode
    ForPromotion
                             -- ...and this will become a Show instance.
                             let inst_for_show :: DerivedDecl cls
    inst_for_show = DerivedDecl cls
    forall (cls :: * -> Constraint). DerivedDecl cls
    derived_decl
                             PartitionedDecs -> m PartitionedDecs
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (PartitionedDecs -> m PartitionedDecs)
    -> PartitionedDecs -> m PartitionedDecs
    forall a b. (a -> b) -> a -> b
    $ PartitionedDecs
    forall a. Monoid a => a
    mempty { pd_instance_decs :: [UInstDecl]
    pd_instance_decs     = [UInstDecl
    inst_for_promotion]
                                           , pd_derived_show_decs :: [DerivedShowDecl]
    pd_derived_show_decs = [DerivedShowDecl
    forall (cls :: * -> Constraint). DerivedDecl cls
    inst_for_show] } )
            ]

    -- Is this being used with an explicit stock strategy, or no strategy at all?
    isStockOrDefault :: Maybe DDerivStrategy -> Bool
    isStockOrDefault :: Maybe DDerivStrategy -> Bool
    isStockOrDefault Nothing               = Bool
    True
    isStockOrDefault (Just DStockStrategy) = Bool
    True
    isStockOrDefault (Just _)              = Bool
    False

    {-
    Note [Partitioning, type synonyms, and type families]
    ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
    The process of singling does not produce any new declarations corresponding to
    type synonyms or type families, so they are "ignored" in a sense. Nevertheless,
    we explicitly track them during partitioning, since we want to create
    defunctionalization symbols for them.

    Also note that:

    1. Other uses of type synonyms in singled code will be expanded away.
    2. Other uses of type families in singled code are unlikely to work at present
       due to Trac #12564.
    -}