module DDC.Core.Eval.Compounds
(
tPair
, tList
, wGlobal
, wConst, wMutable
, wDistinct
, wLazy, wManifest
, wcGlobal
, wcConst, wcMutable
, wcDistinct
, wcLazy, wcManifest
, isCapConW
, takeMutableX
, xUnit
, isUnitX
, takeHandleT
, takeHandleX
, xLoc, takeLocX, stripLocX
, tInt, tcInt
, dcInt
, takeIntDC, takeIntX)
where
import DDC.Core.Eval.Name
import DDC.Type.Compounds
import DDC.Core.Compounds (wApps)
import DDC.Core.Exp
import DDC.Core.DaCon
tPair :: Region Name -> Type Name -> Type Name -> Type Name
tPair tR tA tB
= tApps (TCon tcPair) [tR, tA, tB]
where tcPair = TyConBound (UPrim (NamePrimCon PrimTyConPair) kPair) kPair
kPair = kFuns [kRegion, kData, kData] kData
tList :: Region Name -> Type Name -> Type Name
tList tR tA
= tApps (TCon tcList) [tR, tA]
where tcList = TyConBound (UPrim (NamePrimCon PrimTyConList) kList) kList
kList = kRegion `kFun` kData `kFun` kData
wGlobal :: Region Name -> Witness Name
wGlobal r = WApp (WCon wcGlobal) (WType r)
wConst :: Region Name -> Witness Name
wConst r = WApp (WCon wcConst) (WType r)
wMutable :: Region Name -> Witness Name
wMutable r = WApp (WCon wcMutable) (WType r)
wLazy :: Region Name -> Witness Name
wLazy r = WApp (WCon wcLazy) (WType r)
wManifest :: Region Name -> Witness Name
wManifest r = WApp (WCon wcManifest) (WType r)
wDistinct :: Int -> [Region Name] -> Witness Name
wDistinct n rs = wApps (WCon (wcDistinct n)) (map WType rs)
wcGlobal :: WiCon Name
wcGlobal = WiConBound (UPrim (NameCap CapGlobal) t) t
where t = tForall kRegion $ \r -> tGlobal r
wcConst :: WiCon Name
wcConst = WiConBound (UPrim (NameCap CapConst) t) t
where t = tForall kRegion $ \r -> tConst r
wcMutable :: WiCon Name
wcMutable = WiConBound (UPrim (NameCap CapMutable) t) t
where t = tForall kRegion $ \r -> tMutable r
wcLazy :: WiCon Name
wcLazy = WiConBound (UPrim (NameCap CapLazy) t) t
where t = tForall kRegion $ \r -> tLazy r
wcManifest :: WiCon Name
wcManifest = WiConBound (UPrim (NameCap CapManifest) t) t
where t = tForall kRegion $ \r -> tManifest r
wcDistinct :: Int -> WiCon Name
wcDistinct n = WiConBound (UPrim (NameCap (CapDistinct n)) t) t
where t = tForalls (replicate n kRegion) $ \ts -> tDistinct n ts
isCapConW :: Witness Name -> Bool
isCapConW ww
= case ww of
WCon WiConBound{} -> True
_ -> False
xUnit :: Exp () Name
xUnit = XCon () $ dcUnit
isUnitX :: Exp a Name -> Bool
isUnitX xx
= case xx of
XCon _ dc
-> case daConName dc of
DaConUnit -> True
_ -> False
_ -> False
takeHandleT :: Type Name -> Maybe Rgn
takeHandleT tt
= case tt of
TCon (TyConBound (UPrim (NameRgn r1) _) _)
-> Just r1
_ -> Nothing
takeHandleX :: Exp a Name -> Maybe Rgn
takeHandleX xx
= case xx of
XType t -> takeHandleT t
_ -> Nothing
xLoc :: Loc -> Type Name -> Exp () Name
xLoc l t
= XCon () $ mkDaConSolid (NameLoc l) t
takeLocX :: Exp a Name -> Maybe Loc
takeLocX xx
= case xx of
XCast _ (CastForget _) x
-> takeLocX x
XCon _ dc
-> case takeNameOfDaCon dc of
Just (NameLoc l) -> Just l
_ -> Nothing
_ -> Nothing
stripLocX :: Exp a Name -> Maybe Loc
stripLocX xx
= case xx of
XCast _ (CastForget _) x
-> stripLocX x
XCon _ dc
-> case takeNameOfDaCon dc of
Just (NameLoc l) -> Just l
_ -> Nothing
_ -> Nothing
takeMutableX :: Exp a Name -> Maybe Rgn
takeMutableX xx
= case xx of
XWitness (WApp (WCon wc) (WType tR1))
| WiConBound (UPrim (NameCap CapMutable) _) _ <- wc
-> takeHandleT tR1
_ -> Nothing
tInt :: Region Name -> Type Name
tInt r1
= TApp (TCon tcInt) r1
tcInt :: TyCon Name
tcInt = TyConBound (UPrim (NamePrimCon PrimTyConInt) kInt) kInt
where kInt = kFun kRegion kData
dcInt :: Integer -> DaCon Name
dcInt i = mkDaConAlg (NameInt i) (TCon tcInt)
takeIntDC :: DaCon Name -> Maybe Integer
takeIntDC dc
= case takeNameOfDaCon dc of
Just (NameInt i) -> Just i
_ -> Nothing
takeIntX :: Exp a Name -> Maybe Integer
takeIntX xx
= case xx of
XCon _ dc -> takeIntDC dc
_ -> Nothing