module DDC.Core.Flow.Env
( primDataDefs
, primSortEnv
, primKindEnv
, primTypeEnv)
where
import DDC.Core.Flow.Prim
import DDC.Core.Flow.Compounds
import DDC.Type.DataDef
import DDC.Type.Exp
import DDC.Type.Env (Env)
import qualified DDC.Type.Env as Env
primDataDefs :: DataDefs Name
primDataDefs
= fromListDataDefs
$
[ DataDef (NamePrimTyCon PrimTyConBool)
[]
(Just [ (NameLitBool True, [])
, (NameLitBool False, []) ])
, DataDef (NamePrimTyCon PrimTyConNat) [] Nothing
, DataDef (NamePrimTyCon PrimTyConInt) [] Nothing
, DataDef (NamePrimTyCon (PrimTyConWord 64)) [] Nothing
, DataDef (NamePrimTyCon (PrimTyConWord 32)) [] Nothing
, DataDef (NamePrimTyCon (PrimTyConWord 16)) [] Nothing
, DataDef (NamePrimTyCon (PrimTyConWord 8)) [] Nothing
, DataDef
(NameTyConFlow TyConFlowVector)
[kRate, kData]
(Just [])
, DataDef
(NameTyConFlow TyConFlowSeries)
[kRate, kData]
(Just [])
]
++ [ makeTupleDataDef arity | arity <- [2..32] ]
makeTupleDataDef :: Int -> DataDef Name
makeTupleDataDef n
= DataDef
(NameTyConFlow (TyConFlowTuple n))
(replicate n kData)
(Just [ ( NameDaConFlow (DaConFlowTuple n)
, (reverse [tIx kData i | i <- [0..n 1]]))])
primSortEnv :: Env Name
primSortEnv = Env.setPrimFun sortOfPrimName Env.empty
sortOfPrimName :: Name -> Maybe (Sort Name)
sortOfPrimName _ = Nothing
primKindEnv :: Env Name
primKindEnv = Env.setPrimFun kindOfPrimName Env.empty
kindOfPrimName :: Name -> Maybe (Kind Name)
kindOfPrimName nn
= case nn of
NameKiConFlow KiConFlowRate -> Just sProp
NameTyConFlow tc -> Just $ kindTyConFlow tc
NamePrimTyCon tc -> Just $ kindPrimTyCon tc
_ -> Nothing
primTypeEnv :: Env Name
primTypeEnv = Env.setPrimFun typeOfPrimName Env.empty
typeOfPrimName :: Name -> Maybe (Type Name)
typeOfPrimName dc
= case dc of
NameOpFlow p -> Just $ typeOpFlow p
NameOpLoop p -> Just $ typeOpLoop p
NameOpStore p -> Just $ typeOpStore p
NameDaConFlow p -> Just $ typeDaConFlow p
NamePrimCast p -> Just $ typePrimCast p
NamePrimArith p -> Just $ typePrimArith p
NameLitBool _ -> Just $ tBool
NameLitNat _ -> Just $ tNat
NameLitInt _ -> Just $ tInt
NameLitWord _ bits -> Just $ tWord bits
_ -> Nothing