-- | A 'CoAxiom' is a \"coercion constructor\", i.e. a named equality axiom.
data CoAxiom
  = CoAxiom                   -- Type equality axiom.
    { co_ax_unique   :: Unique      -- unique identifier
    , co_ax_name     :: Name        -- name for pretty-printing
    , co_ax_tvs      :: [TyVar]     -- bound type variables
    , co_ax_lhs      :: Type        -- left-hand side of the equality
    , co_ax_rhs      :: Type        -- right-hand side of the equality
    , co_ax_implicit :: Bool        -- True <=> the axiom is "implicit"
                                    -- See Note [Implicit axioms]
    }
  deriving Typeable

coAxiomArity :: CoAxiom -> Arity
coAxiomArity ax = length (co_ax_tvs ax)

coAxiomName :: CoAxiom -> Name
coAxiomName = co_ax_name

coAxiomTyVars :: CoAxiom -> [TyVar]
coAxiomTyVars = co_ax_tvs

coAxiomLHS, coAxiomRHS :: CoAxiom -> Type
coAxiomLHS = co_ax_lhs
coAxiomRHS = co_ax_rhs

isImplicitCoAxiom :: CoAxiom -> Bool
isImplicitCoAxiom = co_ax_implicit

-- | A 'PrimRep' is an abstraction of a type.  It contains information that
-- the code generator needs in order to pass arguments, return results,
-- and store values of this type.
data PrimRep
  = VoidRep
  | PtrRep
  | IntRep              -- ^ Signed, word-sized value
  | WordRep             -- ^ Unsigned, word-sized value
  | Int64Rep            -- ^ Signed, 64 bit value (with 32-bit words only)
  | Word64Rep           -- ^ Unsigned, 64 bit value (with 32-bit words only)
  | AddrRep             -- ^ A pointer, but /not/ to a Haskell value (use 'PtrRep')
  | FloatRep
  | DoubleRep
  deriving( Eq, Show )

instance Outputable PrimRep where
  ppr r = text (show r)

-- | Find the size of a 'PrimRep', in words
primRepSizeW :: PrimRep -> Int
primRepSizeW IntRep   = 1
primRepSizeW WordRep  = 1
primRepSizeW Int64Rep = wORD64_SIZE `quot` wORD_SIZE
primRepSizeW Word64Rep= wORD64_SIZE `quot` wORD_SIZE
primRepSizeW FloatRep = 1    -- NB. might not take a full word
primRepSizeW DoubleRep= dOUBLE_SIZE `quot` wORD_SIZE
primRepSizeW AddrRep  = 1
primRepSizeW PtrRep   = 1
primRepSizeW VoidRep  = 0

-- | Given the name of the function type constructor and it's kind, create the
-- corresponding 'TyCon'. It is reccomended to use 'TypeRep.funTyCon' if you want
-- this functionality
mkFunTyCon :: Name -> Kind -> TyCon
mkFunTyCon name kind
  = FunTyCon {
        tyConUnique = nameUnique name,
        tyConName   = name,
        tc_kind   = kind,
        tyConArity  = 2
    }

-- | This is the making of an algebraic 'TyCon'. Notably, you have to
-- pass in the generic (in the -XGenerics sense) information about the
-- type constructor - you can get hold of it easily (see Generics
-- module)
mkAlgTyCon :: Name
           -> Kind              -- ^ Kind of the resulting 'TyCon'
           -> [TyVar]           -- ^ 'TyVar's scoped over: see 'tyConTyVars'.
                                --   Arity is inferred from the length of this list
           -> Maybe CType       -- ^ The C type this type corresponds to
                                --   when using the CAPI FFI
           -> [PredType]        -- ^ Stupid theta: see 'algTcStupidTheta'
           -> AlgTyConRhs       -- ^ Information about dat aconstructors
           -> TyConParent
           -> RecFlag           -- ^ Is the 'TyCon' recursive?
           -> Bool              -- ^ Was the 'TyCon' declared with GADT syntax?
           -> TyCon
mkAlgTyCon name kind tyvars cType stupid rhs parent is_rec gadt_syn
  = AlgTyCon {
        tyConName        = name,
        tyConUnique      = nameUnique name,
        tc_kind          = kind,
        tyConArity       = length tyvars,
        tyConTyVars      = tyvars,
        tyConCType       = cType,
        algTcStupidTheta = stupid,
        algTcRhs         = rhs,
        algTcParent      = ASSERT2( okParent name parent, ppr name $$ ppr parent ) parent,
        algTcRec         = is_rec,
        algTcGadtSyntax  = gadt_syn
    }

-- | Simpler specialization of 'mkAlgTyCon' for classes
mkClassTyCon :: Name -> Kind -> [TyVar] -> AlgTyConRhs -> Class -> RecFlag -> TyCon
mkClassTyCon name kind tyvars rhs clas is_rec =
  mkAlgTyCon name kind tyvars Nothing [] rhs (ClassTyCon clas) is_rec False

mkTupleTyCon :: Name
             -> Kind    -- ^ Kind of the resulting 'TyCon'
             -> Arity   -- ^ Arity of the tuple
             -> [TyVar] -- ^ 'TyVar's scoped over: see 'tyConTyVars'
             -> DataCon
             -> TupleSort  -- ^ Whether the tuple is boxed or unboxed
             -> TyCon
mkTupleTyCon name kind arity tyvars con sort
  = TupleTyCon {
        tyConUnique = nameUnique name,
        tyConName = name,
        tc_kind = kind,
        tyConArity = arity,
        tyConTupleSort = sort,
        tyConTyVars = tyvars,
        dataCon = con
    }

-- ^ Foreign-imported (.NET) type constructors are represented
-- as primitive, but /lifted/, 'TyCons' for now. They are lifted
-- because the Haskell type @T@ representing the (foreign) .NET
-- type @T@ is actually implemented (in ILX) as a @thunk<T>@
mkForeignTyCon :: Name
               -> Maybe FastString -- ^ Name of the foreign imported thing, maybe
               -> Kind
               -> Arity
               -> TyCon
mkForeignTyCon name ext_name kind arity
  = PrimTyCon {
        tyConName    = name,
        tyConUnique  = nameUnique name,
        tc_kind    = kind,
        tyConArity   = arity,
        primTyConRep = PtrRep, -- they all do
        isUnLifted   = False,
        tyConExtName = ext_name
    }


-- | Create an unlifted primitive 'TyCon', such as @Int#@
mkPrimTyCon :: Name  -> Kind -> Arity -> PrimRep -> TyCon
mkPrimTyCon name kind arity rep
  = mkPrimTyCon' name kind arity rep True

-- | Kind constructors
mkKindTyCon :: Name -> Kind -> TyCon
mkKindTyCon name kind
  = mkPrimTyCon' name kind 0 VoidRep True

-- | Create a lifted primitive 'TyCon' such as @RealWorld@
mkLiftedPrimTyCon :: Name  -> Kind -> Arity -> PrimRep -> TyCon
mkLiftedPrimTyCon name kind arity rep
  = mkPrimTyCon' name kind arity rep False

mkPrimTyCon' :: Name  -> Kind -> Arity -> PrimRep -> Bool -> TyCon
mkPrimTyCon' name kind arity rep is_unlifted
  = PrimTyCon {
        tyConName    = name,
        tyConUnique  = nameUnique name,
        tc_kind    = kind,
        tyConArity   = arity,
        primTyConRep = rep,
        isUnLifted   = is_unlifted,
        tyConExtName = Nothing
    }

-- | Create a type synonym 'TyCon'
mkSynTyCon :: Name -> Kind -> [TyVar] -> SynTyConRhs -> TyConParent -> TyCon
mkSynTyCon name kind tyvars rhs parent
  = SynTyCon {
        tyConName = name,
        tyConUnique = nameUnique name,
        tc_kind = kind,
        tyConArity = length tyvars,
        tyConTyVars = tyvars,
        synTcRhs = rhs,
        synTcParent = parent
    }

-- | Create a promoted data constructor 'TyCon'
-- Somewhat dodgily, we give it the same Name
-- as the data constructor itself; when we pretty-print
-- the TyCon we add a quote; see the Outputable TyCon instance
mkPromotedDataCon :: DataCon -> Name -> Unique -> Kind -> Arity -> TyCon
mkPromotedDataCon con name unique kind arity
  = PromotedDataCon {
        tyConName   = name,
        tyConUnique = unique,
        tyConArity  = arity,
        tc_kind     = kind,
        dataCon     = con
  }

-- | Create a promoted type constructor 'TyCon'
-- Somewhat dodgily, we give it the same Name
-- as the type constructor itself
mkPromotedTyCon :: TyCon -> Kind -> TyCon
mkPromotedTyCon tc kind
  = PromotedTyCon {
        tyConName   = getName tc,
        tyConUnique = getUnique tc,
        tyConArity  = tyConArity tc,
        tc_kind     = kind,
        ty_con      = tc
  }

isFunTyCon :: TyCon -> Bool
isFunTyCon (FunTyCon {}) = True
isFunTyCon _             = False

-- | Test if the 'TyCon' is algebraic but abstract (invisible data constructors)
isAbstractTyCon :: TyCon -> Bool
isAbstractTyCon (AlgTyCon { algTcRhs = AbstractTyCon {} }) = True
isAbstractTyCon _ = False

-- | Make an algebraic 'TyCon' abstract. Panics if the supplied 'TyCon' is not algebraic
makeTyConAbstract :: TyCon -> TyCon
makeTyConAbstract tc@(AlgTyCon { algTcRhs = rhs })
  = tc { algTcRhs = AbstractTyCon (isDistinctAlgRhs rhs) }
makeTyConAbstract tc = pprPanic "makeTyConAbstract" (ppr tc)

-- | Does this 'TyCon' represent something that cannot be defined in Haskell?
isPrimTyCon :: TyCon -> Bool
isPrimTyCon (PrimTyCon {}) = True
isPrimTyCon _              = False

-- | Is this 'TyCon' unlifted (i.e. cannot contain bottom)? Note that this can only
-- be true for primitive and unboxed-tuple 'TyCon's
isUnLiftedTyCon :: TyCon -> Bool
isUnLiftedTyCon (PrimTyCon  {isUnLifted = is_unlifted}) = is_unlifted
isUnLiftedTyCon (TupleTyCon {tyConTupleSort = sort})    = not (isBoxed (tupleSortBoxity sort))
isUnLiftedTyCon _                                       = False

-- | Returns @True@ if the supplied 'TyCon' resulted from either a
-- @data@ or @newtype@ declaration
isAlgTyCon :: TyCon -> Bool
isAlgTyCon (AlgTyCon {})   = True
isAlgTyCon (TupleTyCon {}) = True
isAlgTyCon _               = False

isDataTyCon :: TyCon -> Bool
-- ^ Returns @True@ for data types that are /definitely/ represented by
-- heap-allocated constructors.  These are scrutinised by Core-level
-- @case@ expressions, and they get info tables allocated for them.
--
-- Generally, the function will be true for all @data@ types and false
-- for @newtype@s, unboxed tuples and type family 'TyCon's. But it is
-- not guaranteed to return @True@ in all cases that it could.
--
-- NB: for a data type family, only the /instance/ 'TyCon's
--     get an info table.  The family declaration 'TyCon' does not
isDataTyCon (AlgTyCon {algTcRhs = rhs})
  = case rhs of
        DataTyCon {}       -> True
        NewTyCon {}        -> False
        DataFamilyTyCon {} -> False
        AbstractTyCon {}   -> False      -- We don't know, so return False
isDataTyCon (TupleTyCon {tyConTupleSort = sort}) = isBoxed (tupleSortBoxity sort)
isDataTyCon _ = False

-- | 'isDistinctTyCon' is true of 'TyCon's that are equal only to
-- themselves, even via coercions (except for unsafeCoerce).
-- This excludes newtypes, type functions, type synonyms.
-- It relates directly to the FC consistency story:
--     If the axioms are consistent,
--     and  co : S tys ~ T tys, and S,T are "distinct" TyCons,
--     then S=T.
-- Cf Note [Pruning dead case alternatives] in Unify
isDistinctTyCon :: TyCon -> Bool
isDistinctTyCon (AlgTyCon {algTcRhs = rhs}) = isDistinctAlgRhs rhs
isDistinctTyCon (FunTyCon {})               = True
isDistinctTyCon (TupleTyCon {})             = True
isDistinctTyCon (PrimTyCon {})              = True
isDistinctTyCon (PromotedDataCon {})        = True
isDistinctTyCon _                           = False

isDistinctAlgRhs :: AlgTyConRhs -> Bool
isDistinctAlgRhs (DataTyCon {})           = True
isDistinctAlgRhs (DataFamilyTyCon {})     = True
isDistinctAlgRhs (AbstractTyCon distinct) = distinct
isDistinctAlgRhs (NewTyCon {})            = False

-- | Is this 'TyCon' that for a @newtype@
isNewTyCon :: TyCon -> Bool
isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True
isNewTyCon _                                   = False

-- | Take a 'TyCon' apart into the 'TyVar's it scopes over, the 'Type' it expands
-- into, and (possibly) a coercion from the representation type to the @newtype@.
-- Returns @Nothing@ if this is not possible.
unwrapNewTyCon_maybe :: TyCon -> Maybe ([TyVar], Type, CoAxiom)
unwrapNewTyCon_maybe (AlgTyCon { tyConTyVars = tvs,
                                 algTcRhs = NewTyCon { nt_co = co,
                                                       nt_rhs = rhs }})
                           = Just (tvs, rhs, co)
unwrapNewTyCon_maybe _     = Nothing

isProductTyCon :: TyCon -> Bool
-- | A /product/ 'TyCon' must both:
--
-- 1. Have /one/ constructor
--
-- 2. /Not/ be existential
--
-- However other than this there are few restrictions: they may be @data@ or @newtype@
-- 'TyCon's of any boxity and may even be recursive.
isProductTyCon tc@(AlgTyCon {}) = case algTcRhs tc of
                                    DataTyCon{ data_cons = [data_con] }
                                                -> isVanillaDataCon data_con
                                    NewTyCon {} -> True
                                    _           -> False
isProductTyCon (TupleTyCon {})  = True
isProductTyCon _                = False

-- | Is this a 'TyCon' representing a type synonym (@type@)?
isSynTyCon :: TyCon -> Bool
isSynTyCon (SynTyCon {}) = True
isSynTyCon _             = False

-- As for newtypes, it is in some contexts important to distinguish between
-- closed synonyms and synonym families, as synonym families have no unique
-- right hand side to which a synonym family application can expand.
--

isDecomposableTyCon :: TyCon -> Bool
-- True iff we can decompose (T a b c) into ((T a b) c)
-- Specifically NOT true of synonyms (open and otherwise)
isDecomposableTyCon (SynTyCon {}) = False
isDecomposableTyCon _other        = True

-- | Is this an algebraic 'TyCon' declared with the GADT syntax?
isGadtSyntaxTyCon :: TyCon -> Bool
isGadtSyntaxTyCon (AlgTyCon { algTcGadtSyntax = res }) = res
isGadtSyntaxTyCon _                                    = False

-- | Is this an algebraic 'TyCon' which is just an enumeration of values?
isEnumerationTyCon :: TyCon -> Bool
-- See Note [Enumeration types] in TyCon
isEnumerationTyCon (AlgTyCon {algTcRhs = DataTyCon { is_enum = res }}) = res
isEnumerationTyCon (TupleTyCon {tyConArity = arity}) = arity == 0
isEnumerationTyCon _                                                   = False

-- | Is this a 'TyCon', synonym or otherwise, that may have further instances appear?
isFamilyTyCon :: TyCon -> Bool
isFamilyTyCon (SynTyCon {synTcRhs = SynFamilyTyCon {}})  = True
isFamilyTyCon (AlgTyCon {algTcRhs = DataFamilyTyCon {}}) = True
isFamilyTyCon _ = False

-- | Is this a synonym 'TyCon' that can have may have further instances appear?
isSynFamilyTyCon :: TyCon -> Bool
isSynFamilyTyCon (SynTyCon {synTcRhs = SynFamilyTyCon {}}) = True
isSynFamilyTyCon _ = False

-- | Is this a synonym 'TyCon' that can have may have further instances appear?
isDataFamilyTyCon :: TyCon -> Bool
isDataFamilyTyCon (AlgTyCon {algTcRhs = DataFamilyTyCon {}}) = True
isDataFamilyTyCon _ = False

-- | Is this a synonym 'TyCon' that can have no further instances appear?
isClosedSynTyCon :: TyCon -> Bool
isClosedSynTyCon tycon = isSynTyCon tycon && not (isFamilyTyCon tycon)

-- | Injective 'TyCon's can be decomposed, so that
--     T ty1 ~ T ty2  =>  ty1 ~ ty2
isInjectiveTyCon :: TyCon -> Bool
isInjectiveTyCon tc = not (isSynTyCon tc)
        -- Ultimately we may have injective associated types
        -- in which case this test will become more interesting
        --
        -- It'd be unusual to call isInjectiveTyCon on a regular H98
        -- type synonym, because you should probably have expanded it first
        -- But regardless, it's not injective!

-- | Are we able to extract informationa 'TyVar' to class argument list
-- mappping from a given 'TyCon'?
isTyConAssoc :: TyCon -> Bool
isTyConAssoc tc = isJust (tyConAssoc_maybe tc)

tyConAssoc_maybe :: TyCon -> Maybe Class
tyConAssoc_maybe tc = case tyConParent tc of
                        AssocFamilyTyCon cls -> Just cls
                        _                    -> Nothing

-- The unit tycon didn't used to be classed as a tuple tycon
-- but I thought that was silly so I've undone it
-- If it can't be for some reason, it should be a AlgTyCon
isTupleTyCon :: TyCon -> Bool
-- ^ Does this 'TyCon' represent a tuple?
--
-- NB: when compiling @Data.Tuple@, the tycons won't reply @True@ to
-- 'isTupleTyCon', becuase they are built as 'AlgTyCons'.  However they
-- get spat into the interface file as tuple tycons, so I don't think
-- it matters.
isTupleTyCon (TupleTyCon {}) = True
isTupleTyCon _               = False

-- | Is this the 'TyCon' for an unboxed tuple?
isUnboxedTupleTyCon :: TyCon -> Bool
isUnboxedTupleTyCon (TupleTyCon {tyConTupleSort = sort}) = not (isBoxed (tupleSortBoxity sort))
isUnboxedTupleTyCon _                                    = False

-- | Is this the 'TyCon' for a boxed tuple?
isBoxedTupleTyCon :: TyCon -> Bool
isBoxedTupleTyCon (TupleTyCon {tyConTupleSort = sort}) = isBoxed (tupleSortBoxity sort)
isBoxedTupleTyCon _                                    = False

-- | Extract the boxity of the given 'TyCon', if it is a 'TupleTyCon'.
-- Panics otherwise
tupleTyConBoxity :: TyCon -> Boxity
tupleTyConBoxity tc = tupleSortBoxity (tyConTupleSort tc)

-- | Extract the 'TupleSort' of the given 'TyCon', if it is a 'TupleTyCon'.
-- Panics otherwise
tupleTyConSort :: TyCon -> TupleSort
tupleTyConSort tc = tyConTupleSort tc

-- | Extract the arity of the given 'TyCon', if it is a 'TupleTyCon'.
-- Panics otherwise
tupleTyConArity :: TyCon -> Arity
tupleTyConArity tc = tyConArity tc

-- | Is this a recursive 'TyCon'?
isRecursiveTyCon :: TyCon -> Bool
isRecursiveTyCon (AlgTyCon {algTcRec = Recursive}) = True
isRecursiveTyCon _                                 = False

-- | Is this the 'TyCon' of a foreign-imported type constructor?
isForeignTyCon :: TyCon -> Bool
isForeignTyCon (PrimTyCon {tyConExtName = Just _}) = True
isForeignTyCon _                                   = False

-- | Is this a PromotedDataCon?
isPromotedDataCon :: TyCon -> Bool
isPromotedDataCon (PromotedDataCon {}) = True
isPromotedDataCon _                    = False

-- | Is this a PromotedTyCon?
isPromotedTyCon :: TyCon -> Bool
isPromotedTyCon (PromotedTyCon {}) = True
isPromotedTyCon _                  = False

-- | Retrieves the promoted DataCon if this is a PromotedDataTyCon;
-- Panics otherwise
promotedDataCon :: TyCon -> DataCon
promotedDataCon = dataCon

-- | Retrieves the promoted TypeCon if this is a PromotedTypeTyCon;
-- Panics otherwise
promotedTyCon :: TyCon -> TyCon
promotedTyCon = ty_con

-- | Identifies implicit tycons that, in particular, do not go into interface
-- files (because they are implicitly reconstructed when the interface is
-- read).
--
-- Note that:
--
-- * Associated families are implicit, as they are re-constructed from
--   the class declaration in which they reside, and
--
-- * Family instances are /not/ implicit as they represent the instance body
--   (similar to a @dfun@ does that for a class instance).
isImplicitTyCon :: TyCon -> Bool
isImplicitTyCon tycon
  | isTyConAssoc tycon = True
  | isSynTyCon tycon   = False
  | isAlgTyCon tycon   = isTupleTyCon tycon
  | otherwise          = True
        -- 'otherwise' catches: FunTyCon, PrimTyCon,
        -- PromotedDataCon, PomotedTypeTyCon

tyConCType_maybe :: TyCon -> Maybe CType
tyConCType_maybe tc@(AlgTyCon {}) = tyConCType tc
tyConCType_maybe _ = Nothing

tcExpandTyCon_maybe, coreExpandTyCon_maybe
        :: TyCon
        -> [tyco]                 -- ^ Arguments to 'TyCon'
        -> Maybe ([(TyVar,tyco)],
                  Type,
                  [tyco])         -- ^ Returns a 'TyVar' substitution, the body type
                                  -- of the synonym (not yet substituted) and any arguments
                                  -- remaining from the application

-- ^ Used to create the view the /typechecker/ has on 'TyCon's.
-- We expand (closed) synonyms only, cf. 'coreExpandTyCon_maybe'
tcExpandTyCon_maybe (SynTyCon {tyConTyVars = tvs,
                               synTcRhs = SynonymTyCon rhs }) tys
   = expand tvs rhs tys
tcExpandTyCon_maybe _ _ = Nothing

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

-- ^ Used to create the view /Core/ has on 'TyCon's. We expand
-- not only closed synonyms like 'tcExpandTyCon_maybe',
-- but also non-recursive @newtype@s
coreExpandTyCon_maybe tycon tys = tcExpandTyCon_maybe tycon tys


----------------
expand  :: [TyVar] -> Type                 -- Template
        -> [a]                             -- Args
        -> Maybe ([(TyVar,a)], Type, [a])  -- Expansion
expand tvs rhs tys
  = case n_tvs `compare` length tys of
        LT -> Just (tvs `zip` tys, rhs, drop n_tvs tys)
        EQ -> Just (tvs `zip` tys, rhs, [])
        GT -> Nothing
   where
     n_tvs = length tvs

tyConKind :: TyCon -> Kind
tyConKind = tc_kind

-- | As 'tyConDataCons_maybe', but returns the empty list of constructors if no constructors
-- could be found
tyConDataCons :: TyCon -> [DataCon]
-- It's convenient for tyConDataCons to return the
-- empty list for type synonyms etc
tyConDataCons tycon = tyConDataCons_maybe tycon `orElse` []

-- | Determine the 'DataCon's originating from the given 'TyCon', if the 'TyCon' is the
-- sort that can have any constructors (note: this does not include abstract algebraic types)
tyConDataCons_maybe :: TyCon -> Maybe [DataCon]
tyConDataCons_maybe (AlgTyCon {algTcRhs = DataTyCon { data_cons = cons }}) = Just cons
tyConDataCons_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = con }})    = Just [con]
tyConDataCons_maybe (TupleTyCon {dataCon = con})                           = Just [con]
tyConDataCons_maybe _                                                      = Nothing

-- | Determine the number of value constructors a 'TyCon' has. Panics if the 'TyCon'
-- is not algebraic or a tuple
tyConFamilySize  :: TyCon -> Int
tyConFamilySize (AlgTyCon   {algTcRhs = DataTyCon {data_cons = cons}}) =
  length cons
tyConFamilySize (AlgTyCon   {algTcRhs = NewTyCon {}})        = 1
tyConFamilySize (AlgTyCon   {algTcRhs = DataFamilyTyCon {}}) = 0
tyConFamilySize (TupleTyCon {})                              = 1
tyConFamilySize other = pprPanic "tyConFamilySize:" (ppr other)

-- | Extract an 'AlgTyConRhs' with information about data constructors from an algebraic or tuple
-- 'TyCon'. Panics for any other sort of 'TyCon'
algTyConRhs :: TyCon -> AlgTyConRhs
algTyConRhs (AlgTyCon {algTcRhs = rhs}) = rhs
algTyConRhs (TupleTyCon {dataCon = con, tyConArity = arity})
    = DataTyCon { data_cons = [con], is_enum = arity == 0 }
algTyConRhs other = pprPanic "algTyConRhs" (ppr other)

-- | Extract the bound type variables and type expansion of a type synonym 'TyCon'. Panics if the
-- 'TyCon' is not a synonym
newTyConRhs :: TyCon -> ([TyVar], Type)
newTyConRhs (AlgTyCon {tyConTyVars = tvs, algTcRhs = NewTyCon { nt_rhs = rhs }}) = (tvs, rhs)
newTyConRhs tycon = pprPanic "newTyConRhs" (ppr tycon)

-- | Extract the bound type variables and type expansion of an eta-contracted type synonym 'TyCon'.
-- Panics if the 'TyCon' is not a synonym
newTyConEtadRhs :: TyCon -> ([TyVar], Type)
newTyConEtadRhs (AlgTyCon {algTcRhs = NewTyCon { nt_etad_rhs = tvs_rhs }}) = tvs_rhs
newTyConEtadRhs tycon = pprPanic "newTyConEtadRhs" (ppr tycon)

-- | Extracts the @newtype@ coercion from such a 'TyCon', which can be used to construct something
-- with the @newtype@s type from its representation type (right hand side). If the supplied 'TyCon'
-- is not a @newtype@, returns @Nothing@
newTyConCo_maybe :: TyCon -> Maybe CoAxiom
newTyConCo_maybe (AlgTyCon {algTcRhs = NewTyCon { nt_co = co }}) = Just co
newTyConCo_maybe _                                               = Nothing

newTyConCo :: TyCon -> CoAxiom
newTyConCo tc = case newTyConCo_maybe tc of
                 Just co -> co
                 Nothing -> pprPanic "newTyConCo" (ppr tc)

-- | Find the primitive representation of a 'TyCon'
tyConPrimRep :: TyCon -> PrimRep
tyConPrimRep (PrimTyCon {primTyConRep = rep}) = rep
tyConPrimRep tc = ASSERT(not (isUnboxedTupleTyCon tc)) PtrRep

-- | Find the \"stupid theta\" of the 'TyCon'. A \"stupid theta\" is the context to the left of
-- an algebraic type declaration, e.g. @Eq a@ in the declaration @data Eq a => T a ...@
tyConStupidTheta :: TyCon -> [PredType]
tyConStupidTheta (AlgTyCon {algTcStupidTheta = stupid}) = stupid
tyConStupidTheta (TupleTyCon {})                        = []
tyConStupidTheta tycon = pprPanic "tyConStupidTheta" (ppr tycon)

-- | Extract the 'TyVar's bound by a type synonym and the corresponding (unsubstituted) right hand side.
-- If the given 'TyCon' is not a type synonym, panics
synTyConDefn :: TyCon -> ([TyVar], Type)
synTyConDefn (SynTyCon {tyConTyVars = tyvars, synTcRhs = SynonymTyCon ty})
  = (tyvars, ty)
synTyConDefn tycon = pprPanic "getSynTyConDefn" (ppr tycon)

-- | Extract the information pertaining to the right hand side of a type synonym (@type@) declaration. Panics
-- if the given 'TyCon' is not a type synonym
synTyConRhs :: TyCon -> SynTyConRhs
synTyConRhs (SynTyCon {synTcRhs = rhs}) = rhs
synTyConRhs tc                          = pprPanic "synTyConRhs" (ppr tc)

-- | Find the expansion of the type synonym represented by the given 'TyCon'. The free variables of this
-- type will typically include those 'TyVar's bound by the 'TyCon'. Panics if the 'TyCon' is not that of
-- a type synonym
synTyConType :: TyCon -> Type
synTyConType tc = case synTcRhs tc of
                    SynonymTyCon t -> t
                    _              -> pprPanic "synTyConType" (ppr tc)

-- | If the given 'TyCon' has a /single/ data constructor, i.e. it is a @data@ type with one
-- alternative, a tuple type or a @newtype@ then that constructor is returned. If the 'TyCon'
-- has more than one constructor, or represents a primitive or function type constructor then
-- @Nothing@ is returned. In any other case, the function panics
tyConSingleDataCon_maybe :: TyCon -> Maybe DataCon
tyConSingleDataCon_maybe (TupleTyCon {dataCon = c})                            = Just c
tyConSingleDataCon_maybe (AlgTyCon {algTcRhs = DataTyCon { data_cons = [c] }}) = Just c
tyConSingleDataCon_maybe (AlgTyCon {algTcRhs = NewTyCon { data_con = c }})     = Just c
tyConSingleDataCon_maybe _                                                     = Nothing

-- | Is this 'TyCon' that for a class instance?
isClassTyCon :: TyCon -> Bool
isClassTyCon (AlgTyCon {algTcParent = ClassTyCon _}) = True
isClassTyCon _                                       = False

-- | If this 'TyCon' is that for a class instance, return the class it is for.
-- Otherwise returns @Nothing@
tyConClass_maybe :: TyCon -> Maybe Class
tyConClass_maybe (AlgTyCon {algTcParent = ClassTyCon clas}) = Just clas
tyConClass_maybe _                                          = Nothing

tyConTuple_maybe :: TyCon -> Maybe TupleSort
tyConTuple_maybe (TupleTyCon {tyConTupleSort = sort}) = Just sort
tyConTuple_maybe _                                    = Nothing

----------------------------------------------------------------------------
tyConParent :: TyCon -> TyConParent
tyConParent (AlgTyCon {algTcParent = parent}) = parent
tyConParent (SynTyCon {synTcParent = parent}) = parent
tyConParent _                                 = NoParentTyCon

----------------------------------------------------------------------------
-- | Is this 'TyCon' that for a family instance, be that for a synonym or an
-- algebraic family instance?
isFamInstTyCon :: TyCon -> Bool
isFamInstTyCon tc = case tyConParent tc of
                      FamInstTyCon {} -> True
                      _               -> False

tyConFamInstSig_maybe :: TyCon -> Maybe (TyCon, [Type], CoAxiom)
tyConFamInstSig_maybe tc
  = case tyConParent tc of
      FamInstTyCon ax f ts -> Just (f, ts, ax)
      _                    -> Nothing

-- | If this 'TyCon' is that of a family instance, return the family in question
-- and the instance types. Otherwise, return @Nothing@
tyConFamInst_maybe :: TyCon -> Maybe (TyCon, [Type])
tyConFamInst_maybe tc
  = case tyConParent tc of
      FamInstTyCon _ f ts -> Just (f, ts)
      _                   -> Nothing

-- | If this 'TyCon' is that of a family instance, return a 'TyCon' which represents
-- a coercion identifying the representation type with the type instance family.
-- Otherwise, return @Nothing@
tyConFamilyCoercion_maybe :: TyCon -> Maybe CoAxiom
tyConFamilyCoercion_maybe tc
  = case tyConParent tc of
      FamInstTyCon co _ _ -> Just co
      _                   -> Nothing

instance Eq TyCon where
    a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
    a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }

instance Ord TyCon where
    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
    a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
    a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
    compare a b = getUnique a `compare` getUnique b

instance Uniquable TyCon where
    getUnique tc = tyConUnique tc

instance Outputable TyCon where
  -- At the moment a promoted TyCon has the same Name as its
  -- corresponding TyCon, so we add the quote to distinguish it here
  ppr tc = pprPromotionQuote tc <> ppr (tyConName tc)

pprPromotionQuote :: TyCon -> SDoc
pprPromotionQuote (PromotedDataCon {}) = char '\''   -- Quote promoted DataCons in types
pprPromotionQuote (PromotedTyCon {})   = ifPprDebug (char '\'') 
pprPromotionQuote _                    = empty       -- However, we don't quote TyCons in kinds
                                                     -- e.g.   type family T a :: Bool -> *
                                                     -- cf Trac #5952.  Except with -dppr-debug

instance NamedThing TyCon where
    getName = tyConName

instance Data.Data TyCon where
    -- don't traverse?
    toConstr _   = abstractConstr "TyCon"
    gunfold _ _  = error "gunfold"
    dataTypeOf _ = mkNoRepType "TyCon"

-------------------
instance Eq CoAxiom where
    a == b = case (a `compare` b) of { EQ -> True;   _ -> False }
    a /= b = case (a `compare` b) of { EQ -> False;  _ -> True  }

instance Ord CoAxiom where
    a <= b = case (a `compare` b) of { LT -> True;  EQ -> True;  GT -> False }
    a <  b = case (a `compare` b) of { LT -> True;  EQ -> False; GT -> False }
    a >= b = case (a `compare` b) of { LT -> False; EQ -> True;  GT -> True  }
    a >  b = case (a `compare` b) of { LT -> False; EQ -> False; GT -> True  }
    compare a b = getUnique a `compare` getUnique b

instance Uniquable CoAxiom where
    getUnique = co_ax_unique

instance Outputable CoAxiom where
    ppr = ppr . getName

instance NamedThing CoAxiom where
    getName = co_ax_name

instance Data.Data CoAxiom where
    -- don't traverse?
    toConstr _   = abstractConstr "CoAxiom"
    gunfold _ _  = error "gunfold"
    dataTypeOf _ = mkNoRepType "CoAxiom"