content: {-|
    Copyright   :  (C) 2012-2016, University of Twente,
                       2016     , Myrtle Software Ltd,
                       2021-2024, QBayLogic B.V.
    License     :  BSD2 (see the file LICENSE)
    Maintainer  :  QBayLogic B.V. <devops@qbaylogic.com>
  
    Builtin Type and Kind definitions
  -}
  
  {-# LANGUAGE CPP #-}
  {-# LANGUAGE MagicHash #-}
  {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE TemplateHaskellQuotes #-}
  
  module Clash.Core.TysPrim
    ( liftedTypeKind
    , typeNatKind
    , typeSymbolKind
    , intPrimTy
    , integerPrimTy
    , charPrimTy
    , stringPrimTy
  #if !MIN_VERSION_ghc(9,2,0)
    , voidPrimTy
  #endif
    , wordPrimTy
    , int64PrimTy
    , word64PrimTy
    , int8PrimTy
    , int16PrimTy
    , int32PrimTy
    , word8PrimTy
    , word16PrimTy
    , word32PrimTy
    , floatPrimTy
    , doublePrimTy
    , naturalPrimTy
    , byteArrayPrimTy
    , eqPrimTy
    , tysPrimMap
    )
  where
  
  
  #if MIN_VERSION_ghc(9,0,0)
  import           GHC.Builtin.Names
  #else
  import           PrelNames
  #endif
  
  import           GHC.Base hiding (Type, TyCon)
  import           Data.Text.Extra (showt)
  
  #if MIN_VERSION_base(4,17,0)
  import           Clash.Core.DataCon (DataCon(..), DcStrictness(..))
  import           GHC.Num.Integer (Integer(..))
  import           GHC.Num.Natural (Natural(..))
  #endif
  
  import           Clash.Core.Name
  import           Clash.Core.TyCon
  import           Clash.Core.Type
  import           Clash.Core.Var (mkTyVar)
  import           Clash.Unique (fromGhcUnique)
  import qualified Clash.Data.UniqMap as UniqMap
  
  -- | Builtin Name
  liftedTypeKindTyConName, typeNatKindTyConName, typeSymbolKindTyConName :: TyConName
  liftedTypeKindTyConName   = mkUnsafeSystemName "Type"
                                (fromGhcUnique liftedTypeKindTyConKey)
  #if MIN_VERSION_ghc(9,2,0)
  typeNatKindTyConName      = naturalPrimTyConName
  #else
  typeNatKindTyConName      = mkUnsafeSystemName "Nat"
                                (fromGhcUnique typeNatKindConNameKey)
  #endif
  typeSymbolKindTyConName   = mkUnsafeSystemName "Symbol"
                                (fromGhcUnique typeSymbolKindConNameKey)
  
  -- | Builtin Kind
  liftedTypeKindTc, typeNatKindTc, typeSymbolKindTc :: TyCon
  liftedTypeKindTc = mkKindTyCon liftedTypeKindTyConName liftedTypeKind
  typeNatKindTc    = mkKindTyCon typeNatKindTyConName liftedTypeKind
  typeSymbolKindTc = mkKindTyCon typeSymbolKindTyConName liftedTypeKind
  
  liftedTypeKind, typeNatKind, typeSymbolKind :: Type
  liftedTypeKind = mkTyConTy liftedTypeKindTyConName
  typeNatKind    = mkTyConTy typeNatKindTyConName
  typeSymbolKind = mkTyConTy typeSymbolKindTyConName
  
  intPrimTyConName, integerPrimTyConName, charPrimTyConName, stringPrimTyConName,
    wordPrimTyConName,  int64PrimTyConName, word64PrimTyConName,
    floatPrimTyConName, doublePrimTyConName,
    naturalPrimTyConName, byteArrayPrimTyConName, eqPrimTyConName :: TyConName
  intPrimTyConName     = mkUnsafeSystemName "GHC.Prim.Int#"
                                  (fromGhcUnique intPrimTyConKey)
  #if MIN_VERSION_base(4,15,0)
  integerPrimTyConName = mkUnsafeSystemName "GHC.Num.Integer.Integer"
                                  (fromGhcUnique integerTyConKey)
  #else
  integerPrimTyConName = mkUnsafeSystemName "GHC.Integer.Type.Integer"
                                  (fromGhcUnique integerTyConKey)
  #endif
  stringPrimTyConName  = mkUnsafeSystemName "GHC.Prim.Addr#"
                          (fromGhcUnique addrPrimTyConKey)
  charPrimTyConName    = mkUnsafeSystemName "GHC.Prim.Char#"
                                  (fromGhcUnique charPrimTyConKey)
  wordPrimTyConName    = mkUnsafeSystemName "GHC.Prim.Word#"
                                  (fromGhcUnique wordPrimTyConKey)
  int64PrimTyConName   = mkUnsafeSystemName "GHC.Prim.Int64#"
                                  (fromGhcUnique int64PrimTyConKey)
  word64PrimTyConName  = mkUnsafeSystemName "GHC.Prim.Word64#"
                                  (fromGhcUnique word64PrimTyConKey)
  floatPrimTyConName   = mkUnsafeSystemName "GHC.Prim.Float#"
                                  (fromGhcUnique floatPrimTyConKey)
  doublePrimTyConName  = mkUnsafeSystemName "GHC.Prim.Double#"
                                  (fromGhcUnique doublePrimTyConKey)
  #if MIN_VERSION_base(4,15,0)
  naturalPrimTyConName = mkUnsafeSystemName "GHC.Num.Natural.Natural"
                                  (fromGhcUnique naturalTyConKey)
  #else
  naturalPrimTyConName = mkUnsafeSystemName "GHC.Natural.Natural"
                                  (fromGhcUnique naturalTyConKey)
  #endif
  byteArrayPrimTyConName = mkUnsafeSystemName "GHC.Prim.ByteArray#"
                            (fromGhcUnique byteArrayPrimTyConKey)
  
  eqPrimTyConName = mkUnsafeSystemName "GHC.Prim.~#" (fromGhcUnique eqPrimTyConKey)
  
  #if !MIN_VERSION_ghc(9,2,0)
  voidPrimTyConName :: TyConName
  voidPrimTyConName    = mkUnsafeSystemName "Void#" (fromGhcUnique voidPrimTyConKey)
  #endif
  
  int8PrimTyConName, int16PrimTyConName, int32PrimTyConName, word8PrimTyConName,
    word16PrimTyConName, word32PrimTyConName :: TyConName
  int8PrimTyConName   = mkUnsafeSystemName (showt ''Int8#)
                          (fromGhcUnique int8PrimTyConKey)
  int16PrimTyConName  = mkUnsafeSystemName (showt ''Int16#)
                          (fromGhcUnique int16PrimTyConKey)
  int32PrimTyConName  = mkUnsafeSystemName (showt ''Int32#)
                          (fromGhcUnique int32PrimTyConKey)
  word8PrimTyConName  = mkUnsafeSystemName (showt ''Word8#)
                          (fromGhcUnique word8PrimTyConKey)
  word16PrimTyConName = mkUnsafeSystemName (showt ''Word16#)
                          (fromGhcUnique word16PrimTyConKey)
  word32PrimTyConName = mkUnsafeSystemName (showt ''Word32#)
                          (fromGhcUnique word32PrimTyConKey)
  
  liftedPrimTC :: TyConName
               -> TyCon
  liftedPrimTC name = PrimTyCon (nameUniq name) name liftedTypeKind 0
  
  -- | Builtin Type
  intPrimTc, integerPrimTc, charPrimTc, stringPrimTc, wordPrimTc,
    int64PrimTc, word64PrimTc, floatPrimTc, doublePrimTc, naturalPrimTc,
    byteArrayPrimTc :: TyCon
  intPrimTc     = liftedPrimTC intPrimTyConName
  #if MIN_VERSION_base(4,17,0)
  -- While GHC might have dropped Integer and Natural literals, in Clash it is
  -- still nice to have them around. However, Integer and Natural are also no
  -- longer primitive types in GHC, but we still want to give the Integer and
  -- Natural type to our Integer and Natural literals.
  --
  -- So instead of recording the primitive types, we record the algebraic types,
  -- i.e. the complete data type for Integer and Natural, data constructors and all.
  
  integerPrimTc =
    let
      name = integerPrimTyConName
      uniq = nameUniq name
      isDcNm = mkUnsafeSystemName (showt 'IS) (fromGhcUnique integerISDataConKey)
      isDc = MkData
        { dcName = isDcNm
        , dcUniq = nameUniq isDcNm
        , dcTag  = 1
        , dcType = mkPolyFunTy integerPrimTy [Right intPrimTy]
        , dcUnivTyVars = []
        , dcExtTyVars = []
        , dcArgTys = [intPrimTy]
        , dcArgStrict = [Strict]
        , dcFieldLabels = []
        }
      ipDcNm = mkUnsafeSystemName (showt 'IP) (fromGhcUnique integerIPDataConKey)
      ipDc = MkData
        { dcName = ipDcNm
        , dcUniq = nameUniq ipDcNm
        , dcTag  = 2
        , dcType = mkPolyFunTy integerPrimTy [Right byteArrayPrimTy]
        , dcUnivTyVars = []
        , dcExtTyVars = []
        , dcArgTys = [byteArrayPrimTy]
        , dcArgStrict = [Strict]
        , dcFieldLabels = []
        }
      inDcNm = mkUnsafeSystemName (showt 'IN) (fromGhcUnique integerINDataConKey)
      inDc = MkData
        { dcName = inDcNm
        , dcUniq = nameUniq inDcNm
        , dcTag  = 3
        , dcType = mkPolyFunTy integerPrimTy [Right byteArrayPrimTy]
        , dcUnivTyVars = []
        , dcExtTyVars = []
        , dcArgTys = [byteArrayPrimTy]
        , dcArgStrict = [Strict]
        , dcFieldLabels = []
        }
      rhs = DataTyCon [isDc,ipDc,inDc]
    in
      AlgTyCon uniq name liftedTypeKind 0 rhs False
  
  naturalPrimTc =
    let
      name = naturalPrimTyConName
      uniq = nameUniq name
      nsDcNm = mkUnsafeSystemName (showt 'NS) (fromGhcUnique naturalNSDataConKey)
      nsDc = MkData
        { dcName = nsDcNm
        , dcUniq = nameUniq nsDcNm
        , dcTag  = 1
        , dcType = mkPolyFunTy naturalPrimTy [Right wordPrimTy]
        , dcUnivTyVars = []
        , dcExtTyVars = []
        , dcArgTys = [wordPrimTy]
        , dcArgStrict = [Strict]
        , dcFieldLabels = []
        }
      nbDcNm = mkUnsafeSystemName (showt 'NB) (fromGhcUnique naturalNBDataConKey)
      nbDc = MkData
        { dcName = nbDcNm
        , dcUniq = nameUniq nbDcNm
        , dcTag  = 2
        , dcType = mkPolyFunTy naturalPrimTy [Right byteArrayPrimTy]
        , dcUnivTyVars = []
        , dcExtTyVars = []
        , dcArgTys = [byteArrayPrimTy]
        , dcArgStrict = [Strict]
        , dcFieldLabels = []
        }
      rhs = DataTyCon [nsDc,nbDc]
     in
      AlgTyCon uniq name liftedTypeKind 0 rhs False
  #else
  integerPrimTc = liftedPrimTC integerPrimTyConName
  naturalPrimTc = liftedPrimTC naturalPrimTyConName
  #endif
  charPrimTc    = liftedPrimTC charPrimTyConName
  stringPrimTc  = liftedPrimTC stringPrimTyConName
  wordPrimTc    = liftedPrimTC wordPrimTyConName
  int64PrimTc   = liftedPrimTC int64PrimTyConName
  word64PrimTc  = liftedPrimTC word64PrimTyConName
  floatPrimTc   = liftedPrimTC floatPrimTyConName
  doublePrimTc  = liftedPrimTC doublePrimTyConName
  byteArrayPrimTc = liftedPrimTC  byteArrayPrimTyConName
  
  #if !MIN_VERSION_ghc(9,2,0)
  voidPrimTc :: TyCon
  voidPrimTc    = liftedPrimTC voidPrimTyConName
  #endif
  
  int8PrimTc, int16PrimTc, int32PrimTc, word8PrimTc, word16PrimTc,
    word32PrimTc :: TyCon
  int8PrimTc    = liftedPrimTC int8PrimTyConName
  int16PrimTc   = liftedPrimTC int16PrimTyConName
  int32PrimTc   = liftedPrimTC int32PrimTyConName
  word8PrimTc   = liftedPrimTC word8PrimTyConName
  word16PrimTc  = liftedPrimTC word16PrimTyConName
  word32PrimTc  = liftedPrimTC word32PrimTyConName
  
  eqPrimTc :: TyCon
  eqPrimTc = PrimTyCon (nameUniq eqPrimTyConName) eqPrimTyConName ty 4
   where
    -- forall (a :: Type). forall (b :: Type). a -> b -> Type
    --
    -- The "real" type for this in GHC has a codomain of `TYPE ('TupleRep '[])`
    -- instead of the `TYPE 'LiftedRep` used here.
    ty  = mkPolyFunTy liftedTypeKind
      [Left aTv, Left bTv, Right (VarTy aTv), Right (VarTy bTv)]
  
    aTv = mkTyVar liftedTypeKind (mkUnsafeSystemName "a" 0)
    bTv = mkTyVar liftedTypeKind (mkUnsafeSystemName "b" 1)
  
  intPrimTy, integerPrimTy, charPrimTy, stringPrimTy, wordPrimTy,
    int64PrimTy, word64PrimTy, floatPrimTy, doublePrimTy, naturalPrimTy,
    byteArrayPrimTy, eqPrimTy :: Type
  intPrimTy     = mkTyConTy intPrimTyConName
  integerPrimTy = mkTyConTy integerPrimTyConName
  charPrimTy    = mkTyConTy charPrimTyConName
  stringPrimTy  = mkTyConTy stringPrimTyConName
  wordPrimTy    = mkTyConTy wordPrimTyConName
  int64PrimTy   = mkTyConTy int64PrimTyConName
  word64PrimTy  = mkTyConTy word64PrimTyConName
  floatPrimTy   = mkTyConTy floatPrimTyConName
  doublePrimTy  = mkTyConTy doublePrimTyConName
  naturalPrimTy = mkTyConTy naturalPrimTyConName
  byteArrayPrimTy = mkTyConTy byteArrayPrimTyConName
  eqPrimTy = mkTyConTy eqPrimTyConName
  
  #if !MIN_VERSION_ghc(9,2,0)
  voidPrimTy :: Type
  voidPrimTy    = mkTyConTy voidPrimTyConName
  #endif
  
  int8PrimTy, int16PrimTy, int32PrimTy, word8PrimTy, word16PrimTy,
    word32PrimTy :: Type
  int8PrimTy    = mkTyConTy int8PrimTyConName
  int16PrimTy   = mkTyConTy int16PrimTyConName
  int32PrimTy   = mkTyConTy int32PrimTyConName
  word8PrimTy   = mkTyConTy word8PrimTyConName
  word16PrimTy  = mkTyConTy word16PrimTyConName
  word32PrimTy  = mkTyConTy word32PrimTyConName
  
  tysPrimMap :: TyConMap
  tysPrimMap = UniqMap.fromList
    [  (liftedTypeKindTyConName , liftedTypeKindTc)
    ,  (typeNatKindTyConName , typeNatKindTc)
    ,  (typeSymbolKindTyConName , typeSymbolKindTc)
    ,  (intPrimTyConName , intPrimTc)
    ,  (integerPrimTyConName , integerPrimTc)
    ,  (charPrimTyConName , charPrimTc)
    ,  (stringPrimTyConName , stringPrimTc)
  #if !MIN_VERSION_ghc(9,2,0)
    ,  (voidPrimTyConName , voidPrimTc)
  #endif
    ,  (wordPrimTyConName , wordPrimTc)
    ,  (int64PrimTyConName , int64PrimTc)
    ,  (word64PrimTyConName , word64PrimTc)
    ,  (int8PrimTyConName , int8PrimTc)
    ,  (int16PrimTyConName , int16PrimTc)
    ,  (int32PrimTyConName , int32PrimTc)
    ,  (word8PrimTyConName , word8PrimTc)
    ,  (word16PrimTyConName , word16PrimTc)
    ,  (word32PrimTyConName , word32PrimTc)
    ,  (floatPrimTyConName , floatPrimTc)
    ,  (doublePrimTyConName , doublePrimTc)
    ,  (naturalPrimTyConName , naturalPrimTc)
    ,  (byteArrayPrimTyConName , byteArrayPrimTc)
    ,  (eqPrimTyConName , eqPrimTc)
    ]
  