module DDC.Core.Flow.Prim.TyConFlow
( TyConFlow (..)
, readTyConFlow
, kindTyConFlow
, tTuple1
, tTuple2
, tTupleN
, tVector
, tSeries
, tSegd
, tSel1
, tSel2
, tRef
, tWorld
, tRateNat)
where
import DDC.Core.Flow.Prim.KiConFlow
import DDC.Core.Flow.Prim.Base
import DDC.Core.Compounds.Simple
import DDC.Core.Exp.Simple
import DDC.Base.Pretty
import Control.DeepSeq
import Data.Char
import Data.List
instance NFData TyConFlow
instance Pretty TyConFlow where
ppr dc
= case dc of
TyConFlowTuple n -> text "Tuple" <> int n <> text "#"
TyConFlowVector -> text "Vector#"
TyConFlowSeries -> text "Series#"
TyConFlowSegd -> text "Segd#"
TyConFlowSel n -> text "Sel" <> int n <> text "#"
TyConFlowRef -> text "Ref#"
TyConFlowWorld -> text "World#"
TyConFlowRateNat -> text "RateNat#"
readTyConFlow :: String -> Maybe TyConFlow
readTyConFlow str
| Just rest <- stripPrefix "Tuple" str
, (ds, "#") <- span isDigit rest
, not $ null ds
, arity <- read ds
= Just $ TyConFlowTuple arity
| otherwise
= case str of
"Vector#" -> Just $ TyConFlowVector
"Series#" -> Just $ TyConFlowSeries
"Segd#" -> Just $ TyConFlowSegd
"Sel1#" -> Just $ TyConFlowSel 1
"Ref#" -> Just $ TyConFlowRef
"World#" -> Just $ TyConFlowWorld
"RateNat#" -> Just $ TyConFlowRateNat
_ -> Nothing
kindTyConFlow :: TyConFlow -> Kind Name
kindTyConFlow tc
= case tc of
TyConFlowTuple n -> foldr kFun kData (replicate n kData)
TyConFlowVector -> kData `kFun` kData
TyConFlowSeries -> kRate `kFun` kData `kFun` kData
TyConFlowSegd -> kRate `kFun` kRate `kFun` kData
TyConFlowSel n -> foldr kFun kData (replicate (n + 1) kRate)
TyConFlowRef -> kData `kFun` kData
TyConFlowWorld -> kData
TyConFlowRateNat -> kRate `kFun` kData
tTuple1 :: Type Name -> Type Name
tTuple1 tA = tApps (tConTyConFlow (TyConFlowTuple 1)) [tA]
tTuple2 :: Type Name -> Type Name -> Type Name
tTuple2 tA tB = tApps (tConTyConFlow (TyConFlowTuple 2)) [tA, tB]
tTupleN :: [Type Name] -> Type Name
tTupleN tys = tApps (tConTyConFlow (TyConFlowTuple (length tys))) tys
tVector :: Type Name -> Type Name
tVector tA = tApps (tConTyConFlow TyConFlowVector) [tA]
tSeries :: Type Name -> Type Name -> Type Name
tSeries tK tA = tApps (tConTyConFlow TyConFlowSeries) [tK, tA]
tSegd :: Type Name -> Type Name -> Type Name
tSegd tK1 tK2 = tApps (tConTyConFlow TyConFlowSegd) [tK1, tK2]
tSel1 :: Type Name -> Type Name -> Type Name
tSel1 tK1 tK2 = tApps (tConTyConFlow $ TyConFlowSel 1) [tK1, tK2]
tSel2 :: Type Name -> Type Name -> Type Name -> Type Name
tSel2 tK1 tK2 tK3 = tApps (tConTyConFlow $ TyConFlowSel 2) [tK1, tK2, tK3]
tRef :: Type Name -> Type Name
tRef tVal = tApp (tConTyConFlow $ TyConFlowRef) tVal
tWorld :: Type Name
tWorld = tConTyConFlow TyConFlowWorld
tRateNat :: Type Name -> Type Name
tRateNat tK = tApps (tConTyConFlow TyConFlowRateNat) [tK]
tConTyConFlow :: TyConFlow -> Type Name
tConTyConFlow tcf
= let k = kindTyConFlow tcf
u = UPrim (NameTyConFlow tcf) k
tc = TyConBound u k
in TCon tc