{-# 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
#if MIN_VERSION_ghc(8,8,0)
, int8PrimTy
, int16PrimTy
, int32PrimTy
, word8PrimTy
, word16PrimTy
, word32PrimTy
#endif
, floatPrimTy
, doublePrimTy
, naturalPrimTy
, byteArrayPrimTy
, eqPrimTy
, tysPrimMap
)
where
#if MIN_VERSION_ghc(9,0,0)
import GHC.Builtin.Names
#else
import PrelNames
#endif
#if MIN_VERSION_ghc(8,8,0)
import GHC.Base hiding (Type, TyCon)
import Data.Text.Extra (showt)
#endif
#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
liftedTypeKindTyConName, typeNatKindTyConName, typeSymbolKindTyConName :: TyConName
liftedTypeKindTyConName :: TyConName
liftedTypeKindTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"Type"
(Unique -> Unique
fromGhcUnique Unique
liftedTypeKindTyConKey)
#if MIN_VERSION_ghc(9,2,0)
typeNatKindTyConName = naturalPrimTyConName
#else
typeNatKindTyConName :: TyConName
typeNatKindTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"Nat"
(Unique -> Unique
fromGhcUnique Unique
typeNatKindConNameKey)
#endif
typeSymbolKindTyConName :: TyConName
typeSymbolKindTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"Symbol"
(Unique -> Unique
fromGhcUnique Unique
typeSymbolKindConNameKey)
liftedTypeKindTc, typeNatKindTc, typeSymbolKindTc :: TyCon
liftedTypeKindTc :: TyCon
liftedTypeKindTc = TyConName -> Kind -> TyCon
mkKindTyCon TyConName
liftedTypeKindTyConName Kind
liftedTypeKind
typeNatKindTc :: TyCon
typeNatKindTc = TyConName -> Kind -> TyCon
mkKindTyCon TyConName
typeNatKindTyConName Kind
liftedTypeKind
typeSymbolKindTc :: TyCon
typeSymbolKindTc = TyConName -> Kind -> TyCon
mkKindTyCon TyConName
typeSymbolKindTyConName Kind
liftedTypeKind
liftedTypeKind, typeNatKind, typeSymbolKind :: Type
liftedTypeKind :: Kind
liftedTypeKind = TyConName -> Kind
mkTyConTy TyConName
liftedTypeKindTyConName
typeNatKind :: Kind
typeNatKind = TyConName -> Kind
mkTyConTy TyConName
typeNatKindTyConName
typeSymbolKind :: Kind
typeSymbolKind = TyConName -> Kind
mkTyConTy TyConName
typeSymbolKindTyConName
intPrimTyConName, integerPrimTyConName, charPrimTyConName, stringPrimTyConName,
wordPrimTyConName, int64PrimTyConName, word64PrimTyConName,
floatPrimTyConName, doublePrimTyConName,
naturalPrimTyConName, byteArrayPrimTyConName, eqPrimTyConName :: TyConName
intPrimTyConName :: TyConName
intPrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"GHC.Prim.Int#"
(Unique -> Unique
fromGhcUnique Unique
intPrimTyConKey)
#if MIN_VERSION_base(4,15,0)
integerPrimTyConName = mkUnsafeSystemName "GHC.Num.Integer.Integer"
(fromGhcUnique integerTyConKey)
#else
integerPrimTyConName :: TyConName
integerPrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"GHC.Integer.Type.Integer"
(Unique -> Unique
fromGhcUnique Unique
integerTyConKey)
#endif
stringPrimTyConName :: TyConName
stringPrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"GHC.Prim.Addr#"
(Unique -> Unique
fromGhcUnique Unique
addrPrimTyConKey)
charPrimTyConName :: TyConName
charPrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"GHC.Prim.Char#"
(Unique -> Unique
fromGhcUnique Unique
charPrimTyConKey)
wordPrimTyConName :: TyConName
wordPrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"GHC.Prim.Word#"
(Unique -> Unique
fromGhcUnique Unique
wordPrimTyConKey)
int64PrimTyConName :: TyConName
int64PrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"GHC.Prim.Int64#"
(Unique -> Unique
fromGhcUnique Unique
int64PrimTyConKey)
word64PrimTyConName :: TyConName
word64PrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"GHC.Prim.Word64#"
(Unique -> Unique
fromGhcUnique Unique
word64PrimTyConKey)
floatPrimTyConName :: TyConName
floatPrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"GHC.Prim.Float#"
(Unique -> Unique
fromGhcUnique Unique
floatPrimTyConKey)
doublePrimTyConName :: TyConName
doublePrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"GHC.Prim.Double#"
(Unique -> Unique
fromGhcUnique Unique
doublePrimTyConKey)
#if MIN_VERSION_base(4,15,0)
naturalPrimTyConName = mkUnsafeSystemName "GHC.Num.Natural.Natural"
(fromGhcUnique naturalTyConKey)
#else
naturalPrimTyConName :: TyConName
naturalPrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"GHC.Natural.Natural"
(Unique -> Unique
fromGhcUnique Unique
naturalTyConKey)
#endif
byteArrayPrimTyConName :: TyConName
byteArrayPrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"GHC.Prim.ByteArray#"
(Unique -> Unique
fromGhcUnique Unique
byteArrayPrimTyConKey)
eqPrimTyConName :: TyConName
eqPrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"GHC.Prim.~#" (Unique -> Unique
fromGhcUnique Unique
eqPrimTyConKey)
#if !MIN_VERSION_ghc(9,2,0)
voidPrimTyConName :: TyConName
voidPrimTyConName :: TyConName
voidPrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"Void#" (Unique -> Unique
fromGhcUnique Unique
voidPrimTyConKey)
#endif
#if MIN_VERSION_ghc(8,8,0)
int8PrimTyConName, int16PrimTyConName, int32PrimTyConName, word8PrimTyConName,
word16PrimTyConName, word32PrimTyConName :: TyConName
int8PrimTyConName :: TyConName
int8PrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName (Name -> Text
forall a. Show a => a -> Text
showt ''Int8#)
(Unique -> Unique
fromGhcUnique Unique
int8PrimTyConKey)
int16PrimTyConName :: TyConName
int16PrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName (Name -> Text
forall a. Show a => a -> Text
showt ''Int16#)
(Unique -> Unique
fromGhcUnique Unique
int16PrimTyConKey)
int32PrimTyConName :: TyConName
int32PrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName (Name -> Text
forall a. Show a => a -> Text
showt ''Int32#)
(Unique -> Unique
fromGhcUnique Unique
int32PrimTyConKey)
word8PrimTyConName :: TyConName
word8PrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName (Name -> Text
forall a. Show a => a -> Text
showt ''Word8#)
(Unique -> Unique
fromGhcUnique Unique
word8PrimTyConKey)
word16PrimTyConName :: TyConName
word16PrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName (Name -> Text
forall a. Show a => a -> Text
showt ''Word16#)
(Unique -> Unique
fromGhcUnique Unique
word16PrimTyConKey)
word32PrimTyConName :: TyConName
word32PrimTyConName = Text -> Unique -> TyConName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName (Name -> Text
forall a. Show a => a -> Text
showt ''Word32#)
(Unique -> Unique
fromGhcUnique Unique
word32PrimTyConKey)
#endif
liftedPrimTC :: TyConName
-> TyCon
liftedPrimTC :: TyConName -> TyCon
liftedPrimTC TyConName
name = Unique -> TyConName -> Kind -> Unique -> TyCon
PrimTyCon (TyConName -> Unique
forall a. Name a -> Unique
nameUniq TyConName
name) TyConName
name Kind
liftedTypeKind Unique
0
intPrimTc, integerPrimTc, charPrimTc, stringPrimTc, wordPrimTc,
int64PrimTc, word64PrimTc, floatPrimTc, doublePrimTc, naturalPrimTc,
byteArrayPrimTc :: TyCon
intPrimTc :: TyCon
intPrimTc = TyConName -> TyCon
liftedPrimTC TyConName
intPrimTyConName
#if MIN_VERSION_base(4,17,0)
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 :: TyCon
integerPrimTc = TyConName -> TyCon
liftedPrimTC TyConName
integerPrimTyConName
naturalPrimTc :: TyCon
naturalPrimTc = TyConName -> TyCon
liftedPrimTC TyConName
naturalPrimTyConName
#endif
charPrimTc :: TyCon
charPrimTc = TyConName -> TyCon
liftedPrimTC TyConName
charPrimTyConName
stringPrimTc :: TyCon
stringPrimTc = TyConName -> TyCon
liftedPrimTC TyConName
stringPrimTyConName
wordPrimTc :: TyCon
wordPrimTc = TyConName -> TyCon
liftedPrimTC TyConName
wordPrimTyConName
int64PrimTc :: TyCon
int64PrimTc = TyConName -> TyCon
liftedPrimTC TyConName
int64PrimTyConName
word64PrimTc :: TyCon
word64PrimTc = TyConName -> TyCon
liftedPrimTC TyConName
word64PrimTyConName
floatPrimTc :: TyCon
floatPrimTc = TyConName -> TyCon
liftedPrimTC TyConName
floatPrimTyConName
doublePrimTc :: TyCon
doublePrimTc = TyConName -> TyCon
liftedPrimTC TyConName
doublePrimTyConName
byteArrayPrimTc :: TyCon
byteArrayPrimTc = TyConName -> TyCon
liftedPrimTC TyConName
byteArrayPrimTyConName
#if !MIN_VERSION_ghc(9,2,0)
voidPrimTc :: TyCon
voidPrimTc :: TyCon
voidPrimTc = TyConName -> TyCon
liftedPrimTC TyConName
voidPrimTyConName
#endif
#if MIN_VERSION_ghc(8,8,0)
int8PrimTc, int16PrimTc, int32PrimTc, word8PrimTc, word16PrimTc,
word32PrimTc :: TyCon
int8PrimTc :: TyCon
int8PrimTc = TyConName -> TyCon
liftedPrimTC TyConName
int8PrimTyConName
int16PrimTc :: TyCon
int16PrimTc = TyConName -> TyCon
liftedPrimTC TyConName
int16PrimTyConName
int32PrimTc :: TyCon
int32PrimTc = TyConName -> TyCon
liftedPrimTC TyConName
int32PrimTyConName
word8PrimTc :: TyCon
word8PrimTc = TyConName -> TyCon
liftedPrimTC TyConName
word8PrimTyConName
word16PrimTc :: TyCon
word16PrimTc = TyConName -> TyCon
liftedPrimTC TyConName
word16PrimTyConName
word32PrimTc :: TyCon
word32PrimTc = TyConName -> TyCon
liftedPrimTC TyConName
word32PrimTyConName
#endif
eqPrimTc :: TyCon
eqPrimTc :: TyCon
eqPrimTc = Unique -> TyConName -> Kind -> Unique -> TyCon
PrimTyCon (TyConName -> Unique
forall a. Name a -> Unique
nameUniq TyConName
eqPrimTyConName) TyConName
eqPrimTyConName Kind
ty Unique
4
where
ty :: Kind
ty = Kind -> [Either TyVar Kind] -> Kind
mkPolyFunTy Kind
liftedTypeKind
[TyVar -> Either TyVar Kind
forall a b. a -> Either a b
Left TyVar
aTv, TyVar -> Either TyVar Kind
forall a b. a -> Either a b
Left TyVar
bTv, Kind -> Either TyVar Kind
forall a b. b -> Either a b
Right (TyVar -> Kind
VarTy TyVar
aTv), Kind -> Either TyVar Kind
forall a b. b -> Either a b
Right (TyVar -> Kind
VarTy TyVar
bTv)]
aTv :: TyVar
aTv = Kind -> TyName -> TyVar
mkTyVar Kind
liftedTypeKind (Text -> Unique -> TyName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"a" Unique
0)
bTv :: TyVar
bTv = Kind -> TyName -> TyVar
mkTyVar Kind
liftedTypeKind (Text -> Unique -> TyName
forall a. Text -> Unique -> Name a
mkUnsafeSystemName Text
"b" Unique
1)
intPrimTy, integerPrimTy, charPrimTy, stringPrimTy, wordPrimTy,
int64PrimTy, word64PrimTy, floatPrimTy, doublePrimTy, naturalPrimTy,
byteArrayPrimTy, eqPrimTy :: Type
intPrimTy :: Kind
intPrimTy = TyConName -> Kind
mkTyConTy TyConName
intPrimTyConName
integerPrimTy :: Kind
integerPrimTy = TyConName -> Kind
mkTyConTy TyConName
integerPrimTyConName
charPrimTy :: Kind
charPrimTy = TyConName -> Kind
mkTyConTy TyConName
charPrimTyConName
stringPrimTy :: Kind
stringPrimTy = TyConName -> Kind
mkTyConTy TyConName
stringPrimTyConName
wordPrimTy :: Kind
wordPrimTy = TyConName -> Kind
mkTyConTy TyConName
wordPrimTyConName
int64PrimTy :: Kind
int64PrimTy = TyConName -> Kind
mkTyConTy TyConName
int64PrimTyConName
word64PrimTy :: Kind
word64PrimTy = TyConName -> Kind
mkTyConTy TyConName
word64PrimTyConName
floatPrimTy :: Kind
floatPrimTy = TyConName -> Kind
mkTyConTy TyConName
floatPrimTyConName
doublePrimTy :: Kind
doublePrimTy = TyConName -> Kind
mkTyConTy TyConName
doublePrimTyConName
naturalPrimTy :: Kind
naturalPrimTy = TyConName -> Kind
mkTyConTy TyConName
naturalPrimTyConName
byteArrayPrimTy :: Kind
byteArrayPrimTy = TyConName -> Kind
mkTyConTy TyConName
byteArrayPrimTyConName
eqPrimTy :: Kind
eqPrimTy = TyConName -> Kind
mkTyConTy TyConName
eqPrimTyConName
#if !MIN_VERSION_ghc(9,2,0)
voidPrimTy :: Type
voidPrimTy :: Kind
voidPrimTy = TyConName -> Kind
mkTyConTy TyConName
voidPrimTyConName
#endif
#if MIN_VERSION_ghc(8,8,0)
int8PrimTy, int16PrimTy, int32PrimTy, word8PrimTy, word16PrimTy,
word32PrimTy :: Type
int8PrimTy :: Kind
int8PrimTy = TyConName -> Kind
mkTyConTy TyConName
int8PrimTyConName
int16PrimTy :: Kind
int16PrimTy = TyConName -> Kind
mkTyConTy TyConName
int16PrimTyConName
int32PrimTy :: Kind
int32PrimTy = TyConName -> Kind
mkTyConTy TyConName
int32PrimTyConName
word8PrimTy :: Kind
word8PrimTy = TyConName -> Kind
mkTyConTy TyConName
word8PrimTyConName
word16PrimTy :: Kind
word16PrimTy = TyConName -> Kind
mkTyConTy TyConName
word16PrimTyConName
word32PrimTy :: Kind
word32PrimTy = TyConName -> Kind
mkTyConTy TyConName
word32PrimTyConName
#endif
tysPrimMap :: TyConMap
tysPrimMap :: TyConMap
tysPrimMap = [(TyConName, TyCon)] -> TyConMap
forall a b. Uniquable a => [(a, b)] -> UniqMap b
UniqMap.fromList
[ (TyConName
liftedTypeKindTyConName , TyCon
liftedTypeKindTc)
, (TyConName
typeNatKindTyConName , TyCon
typeNatKindTc)
, (TyConName
typeSymbolKindTyConName , TyCon
typeSymbolKindTc)
, (TyConName
intPrimTyConName , TyCon
intPrimTc)
, (TyConName
integerPrimTyConName , TyCon
integerPrimTc)
, (TyConName
charPrimTyConName , TyCon
charPrimTc)
, (TyConName
stringPrimTyConName , TyCon
stringPrimTc)
#if !MIN_VERSION_ghc(9,2,0)
, (TyConName
voidPrimTyConName , TyCon
voidPrimTc)
#endif
, (TyConName
wordPrimTyConName , TyCon
wordPrimTc)
, (TyConName
int64PrimTyConName , TyCon
int64PrimTc)
, (TyConName
word64PrimTyConName , TyCon
word64PrimTc)
#if MIN_VERSION_ghc(8,8,0)
, (TyConName
int8PrimTyConName , TyCon
int8PrimTc)
, (TyConName
int16PrimTyConName , TyCon
int16PrimTc)
, (TyConName
int32PrimTyConName , TyCon
int32PrimTc)
, (TyConName
word8PrimTyConName , TyCon
word8PrimTc)
, (TyConName
word16PrimTyConName , TyCon
word16PrimTc)
, (TyConName
word32PrimTyConName , TyCon
word32PrimTc)
#endif
, (TyConName
floatPrimTyConName , TyCon
floatPrimTc)
, (TyConName
doublePrimTyConName , TyCon
doublePrimTc)
, (TyConName
naturalPrimTyConName , TyCon
naturalPrimTc)
, (TyConName
byteArrayPrimTyConName , TyCon
byteArrayPrimTc)
, (TyConName
eqPrimTyConName , TyCon
eqPrimTc)
]