module DDC.Core.Tetra.Prim.TyConTetra
( kindTyConTetra
, readTyConTetra
, tTupleN
, tVector
, tUnboxed
, tFunValue
, tCloValue)
where
import DDC.Core.Tetra.Prim.Base
import DDC.Core.Exp.Simple.Exp
import DDC.Type.Compounds
import DDC.Base.Pretty
import Control.DeepSeq
import Data.List
import Data.Char
instance NFData TyConTetra where
rnf !_ = ()
instance Pretty TyConTetra where
ppr tc
= case tc of
TyConTetraTuple n -> text "Tuple" <> int n <> text "#"
TyConTetraVector -> text "Vector#"
TyConTetraU -> text "U#"
TyConTetraF -> text "F#"
TyConTetraC -> text "C#"
readTyConTetra :: String -> Maybe TyConTetra
readTyConTetra str
| Just rest <- stripPrefix "Tuple" str
, (ds, "#") <- span isDigit rest
, not $ null ds
, arity <- read ds
= Just $ TyConTetraTuple arity
| otherwise
= case str of
"Vector#" -> Just TyConTetraVector
"U#" -> Just TyConTetraU
"F#" -> Just TyConTetraF
"C#" -> Just TyConTetraC
_ -> Nothing
kindTyConTetra :: TyConTetra -> Type Name
kindTyConTetra tc
= case tc of
TyConTetraTuple n -> foldr kFun kData (replicate n kData)
TyConTetraVector -> kRegion `kFun` kData `kFun` kData
TyConTetraU -> kData `kFun` kData
TyConTetraF -> kData `kFun` kData
TyConTetraC -> kData `kFun` kData
tTupleN :: [Type Name] -> Type Name
tTupleN tys = tApps (tConTyConTetra (TyConTetraTuple (length tys))) tys
tVector :: Region Name -> Type Name -> Type Name
tVector tR tA = tApps (tConTyConTetra TyConTetraVector) [tR, tA]
tUnboxed :: Type Name -> Type Name
tUnboxed t = tApp (tConTyConTetra TyConTetraU) t
tFunValue :: Type Name -> Type Name
tFunValue t = tApp (tConTyConTetra TyConTetraF) t
tCloValue :: Type Name -> Type Name
tCloValue t = tApp (tConTyConTetra TyConTetraC) t
tConTyConTetra :: TyConTetra -> Type Name
tConTyConTetra tcf
= let k = kindTyConTetra tcf
u = UPrim (NameTyConTetra tcf) k
tc = TyConBound u k
in TCon tc