    {-|
      Copyright   :  (C) 2012-2016, University of Twente
                         2021,      QBayLogic B.V.
      License     :  BSD2 (see the file LICENSE)
      Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>

      Type Constructors in CoreHW
    -}

    {-# LANGUAGE CPP #-}
    {-# LANGUAGE DeriveAnyClass #-}
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE MultiParamTypeClasses #-}

    module Clash.Core.TyCon
      ( TyCon (..)
      , TyConName
      , TyConMap
      , AlgTyConRhs (..)
      , mkKindTyCon
      , isTupleTyConLike
      , isPrimTc
      , isNewTypeTc
      , isPromotedDc
      , tyConDataCons
      )
    where

    -- External Import
    import Control.DeepSeq
    import Data.Binary                            (Binary)
    import Data.Function                          (on)
    import qualified Data.Text as T
    import GHC.Generics

    -- Internal Imports
    import Clash.Core.DataCon                     (DataCon)
    import Clash.Core.Name
    import {-# SOURCE #-} Clash.Core.Type         (Kind, Type)
    import Clash.Core.Var                         (TyVar)
    import Clash.Data.UniqMap (UniqMap)
    import Clash.Unique

    -- | Type Constructor
    data TyCon
      -- | Algorithmic DataCons
      = AlgTyCon
      { TyCon -> Unique
    tyConUniq   :: {-# UNPACK #-} !Unique
      , TyCon -> TyConName
    tyConName   :: !TyConName   -- ^ Name of the TyCon
      , TyCon -> Kind
    tyConKind   :: !Kind        -- ^ Kind of the TyCon
      , TyCon -> Unique
    tyConArity  :: !Int         -- ^ Number of type arguments
      , TyCon -> AlgTyConRhs
    algTcRhs    :: !AlgTyConRhs -- ^ DataCon definitions
      , TyCon -> Bool
    isClassTc   :: !Bool        -- ^ Is this a class dictionary?
      }
      | PromotedDataCon
      { tyConUniq   :: {-# UNPACK #-} !Unique -- invariant (same as dcUniq)
      , tyConName   :: !TyConName   -- ^ Name of the TyCon
      , tyConKind   :: !Kind        -- ^ Kind of the TyCon
      , tyConArity  :: !Int         -- ^ Number of type arguments
      , TyCon -> DataCon
    tyConData   :: !DataCon     -- ^ DataCon which is promoted
      }
      -- | Function TyCons (e.g. type families)
      | FunTyCon
      { tyConUniq   :: {-# UNPACK #-} !Unique
      , tyConName   :: !TyConName      -- ^ Name of the TyCon
      , tyConKind   :: !Kind           -- ^ Kind of the TyCon
      , tyConArity  :: !Int            -- ^ Number of type arguments
      , TyCon -> [([Kind], Kind)]
    tyConSubst  :: [([Type],Type)] -- ^ List of: ([LHS match types], RHS type)
      }
      -- | Primitive TyCons
      | PrimTyCon
      { tyConUniq    :: {-# UNPACK #-} !Unique
      , tyConName    :: !TyConName  -- ^ Name of the TyCon
      , tyConKind    :: !Kind       -- ^ Kind of the TyCon
      , tyConArity   :: !Int        -- ^ Number of type arguments
      }
      deriving (Unique -> TyCon -> ShowS
    [TyCon] -> ShowS
    TyCon -> String
    (Unique -> TyCon -> ShowS)
    -> (TyCon -> String) -> ([TyCon] -> ShowS) -> Show TyCon
    forall a.
    (Unique -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Unique -> TyCon -> ShowS
    showsPrec :: Unique -> TyCon -> ShowS
    $cshow :: TyCon -> String
    show :: TyCon -> String
    $cshowList :: [TyCon] -> ShowS
    showList :: [TyCon] -> ShowS
    Show,(forall x. TyCon -> Rep TyCon x)
    -> (forall x. Rep TyCon x -> TyCon) -> Generic TyCon
    forall x. Rep TyCon x -> TyCon
    forall x. TyCon -> Rep TyCon x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. TyCon -> Rep TyCon x
    from :: forall x. TyCon -> Rep TyCon x
    $cto :: forall x. Rep TyCon x -> TyCon
    to :: forall x. Rep TyCon x -> TyCon
    Generic,TyCon -> ()
    (TyCon -> ()) -> NFData TyCon
    forall a. (a -> ()) -> NFData a
    $crnf :: TyCon -> ()
    rnf :: TyCon -> ()
    NFData,Get TyCon
    [TyCon] -> Put
    TyCon -> Put
    (TyCon -> Put) -> Get TyCon -> ([TyCon] -> Put) -> Binary TyCon
    forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
    $cput :: TyCon -> Put
    put :: TyCon -> Put
    $cget :: Get TyCon
    get :: Get TyCon
    $cputList :: [TyCon] -> Put
    putList :: [TyCon] -> Put
    Binary)

    {-
    instance Show TyCon where
      show (AlgTyCon       {tyConName = n}) = "AlgTyCon: " ++ show n
      show (FunTyCon       {tyConName = n}) = "FunTyCon: " ++ show n
      show (PrimTyCon      {tyConName = n}) = "PrimTyCon: " ++ show n
    -}

    instance Eq TyCon where
      == :: TyCon -> TyCon -> Bool
    (==) = Unique -> Unique -> Bool
    forall a. Eq a => a -> a -> Bool
    (==) (Unique -> Unique -> Bool)
    -> (TyCon -> Unique) -> TyCon -> TyCon -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` TyCon -> Unique
    tyConUniq
      /= :: TyCon -> TyCon -> Bool
    (/=) = Unique -> Unique -> Bool
    forall a. Eq a => a -> a -> Bool
    (/=) (Unique -> Unique -> Bool)
    -> (TyCon -> Unique) -> TyCon -> TyCon -> Bool
    forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
    `on` TyCon -> Unique
    tyConUniq

    instance Uniquable TyCon where
      getUnique :: TyCon -> Unique
    getUnique = TyCon -> Unique
    tyConUniq
      setUnique :: TyCon -> Unique -> TyCon
    setUnique TyCon
    tyCon Unique
    u = TyCon
    tyCon {tyConUniq :: Unique
    tyConUniq=Unique
    u}

    -- | TyCon reference
    type TyConName = Name TyCon
    type TyConMap  = UniqMap TyCon

    -- | The RHS of an Algebraic Datatype
    data AlgTyConRhs
      = DataTyCon
      { AlgTyConRhs -> [DataCon]
    dataCons :: [DataCon]        -- ^ The DataCons of a TyCon
      }
      | NewTyCon
      { AlgTyConRhs -> DataCon
    dataCon   :: !DataCon        -- ^ The newtype DataCon
      , AlgTyConRhs -> ([TyVar], Kind)
    ntEtadRhs :: ([TyVar],Type)  -- ^ The argument type of the newtype
                                     -- DataCon in eta-reduced form, which is
                                     -- just the representation of the TyCon.
                                     -- The TyName's are the type-variables from
                                     -- the corresponding TyCon.
      }
      deriving (Unique -> AlgTyConRhs -> ShowS
    [AlgTyConRhs] -> ShowS
    AlgTyConRhs -> String
    (Unique -> AlgTyConRhs -> ShowS)
    -> (AlgTyConRhs -> String)
    -> ([AlgTyConRhs] -> ShowS)
    -> Show AlgTyConRhs
    forall a.
    (Unique -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Unique -> AlgTyConRhs -> ShowS
    showsPrec :: Unique -> AlgTyConRhs -> ShowS
    $cshow :: AlgTyConRhs -> String
    show :: AlgTyConRhs -> String
    $cshowList :: [AlgTyConRhs] -> ShowS
    showList :: [AlgTyConRhs] -> ShowS
    Show,(forall x. AlgTyConRhs -> Rep AlgTyConRhs x)
    -> (forall x. Rep AlgTyConRhs x -> AlgTyConRhs)
    -> Generic AlgTyConRhs
    forall x. Rep AlgTyConRhs x -> AlgTyConRhs
    forall x. AlgTyConRhs -> Rep AlgTyConRhs x
    forall a.
    (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
    $cfrom :: forall x. AlgTyConRhs -> Rep AlgTyConRhs x
    from :: forall x. AlgTyConRhs -> Rep AlgTyConRhs x
    $cto :: forall x. Rep AlgTyConRhs x -> AlgTyConRhs
    to :: forall x. Rep AlgTyConRhs x -> AlgTyConRhs
    Generic,AlgTyConRhs -> ()
    (AlgTyConRhs -> ()) -> NFData AlgTyConRhs
    forall a. (a -> ()) -> NFData a
    $crnf :: AlgTyConRhs -> ()
    rnf :: AlgTyConRhs -> ()
    NFData,Get AlgTyConRhs
    [AlgTyConRhs] -> Put
    AlgTyConRhs -> Put
    (AlgTyConRhs -> Put)
    -> Get AlgTyConRhs -> ([AlgTyConRhs] -> Put) -> Binary AlgTyConRhs
    forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
    $cput :: AlgTyConRhs -> Put
    put :: AlgTyConRhs -> Put
    $cget :: Get AlgTyConRhs
    get :: Get AlgTyConRhs
    $cputList :: [AlgTyConRhs] -> Put
    putList :: [AlgTyConRhs] -> Put
    Binary)

    -- | Create a Kind out of a TyConName
    mkKindTyCon :: TyConName
                -> Kind
                -> TyCon
    mkKindTyCon :: TyConName -> Kind -> TyCon
    mkKindTyCon TyConName
    name Kind
    kind
      = Unique -> TyConName -> Kind -> Unique -> TyCon
    PrimTyCon (TyConName -> Unique
    forall a. Name a -> Unique
    nameUniq TyConName
    name) TyConName
    name Kind
    kind Unique
    0

    -- | Does the TyCon look like a tuple TyCon
    isTupleTyConLike :: TyConName -> Bool
    isTupleTyConLike :: TyConName -> Bool
    isTupleTyConLike TyConName
    nm = Text -> Bool
    tupleName ((Char -> Bool) -> Text -> Text
    T.takeWhileEnd (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '.') (TyConName -> Text
    forall a. Name a -> Text
    nameOcc TyConName
    nm))
      where
        tupleName :: Text -> Bool
    tupleName Text
    nm0
          | Just (Char
    '(', Text
    nm1) <- Text -> Maybe (Char, Text)
    T.uncons Text
    nm0
          , Just (Text
    nm2, Char
    ')') <- Text -> Maybe (Text, Char)
    T.unsnoc Text
    nm1
          = (Char -> Bool) -> Text -> Bool
    T.all (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ',') Text
    nm2
        tupleName Text
    _ = String -> Text
    T.pack String
    "GHC.Tuple.Prim.Tuple" Text -> Text -> Bool
    `T.isPrefixOf` (TyConName -> Text
    forall a. Name a -> Text
    nameOcc TyConName
    nm)

    -- | Get the DataCons belonging to a TyCon
    tyConDataCons :: TyCon -> [DataCon]
    tyConDataCons :: TyCon -> [DataCon]
    tyConDataCons (AlgTyCon {algTcRhs :: TyCon -> AlgTyConRhs
    algTcRhs = DataTyCon { dataCons :: AlgTyConRhs -> [DataCon]
    dataCons = [DataCon]
    cons}}) = [DataCon]
    cons
    tyConDataCons (AlgTyCon {algTcRhs :: TyCon -> AlgTyConRhs
    algTcRhs = NewTyCon  { dataCon :: AlgTyConRhs -> DataCon
    dataCon  = DataCon
    con }}) = [DataCon
    con]
    tyConDataCons TyCon
    _                                                    = []

    isPrimTc
      :: TyCon
      -> Bool
    isPrimTc :: TyCon -> Bool
    isPrimTc PrimTyCon{} = Bool
    True
    isPrimTc TyCon
    _ = Bool
    False

    isNewTypeTc
      :: TyCon
      -> Bool
    isNewTypeTc :: TyCon -> Bool
    isNewTypeTc (AlgTyCon {algTcRhs :: TyCon -> AlgTyConRhs
    algTcRhs = NewTyCon {}}) = Bool
    True
    isNewTypeTc TyCon
    _ = Bool
    False

    isPromotedDc
      :: TyCon
      -> Bool
    isPromotedDc :: TyCon -> Bool
    isPromotedDc PromotedDataCon{} = Bool
    True
    isPromotedDc TyCon
    _ = Bool
    False