module DDC.Core.Eval.Compounds
(
tUnit
, tInt
, tPair
, tList
, wGlobal
, wConst, wMutable
, wLazy, wManifest
, wcGlobal
, wcConst, wcMutable
, wcLazy, wcManifest
, isCapConW
, isUnitX
, takeHandleT
, takeHandleX
, takeLocX, stripLocX
, takeMutableX)
where
import DDC.Core.Eval.Name
import DDC.Type.Compounds
import DDC.Core.Exp
tUnit :: Type Name
tUnit = TCon (TyConBound (UPrim (NamePrimCon PrimTyConUnit) kData))
tInt :: Region Name -> Type Name
tInt r1 = TApp (TCon (TyConBound (UPrim (NamePrimCon PrimTyConInt)
(kFun kRegion kData))))
r1
tPair :: Region Name -> Type Name -> Type Name -> Type Name
tPair tR tA tB
= tApps (TCon (TyConBound (UPrim (NamePrimCon PrimTyConPair)
(kFuns [kRegion, kData, kData] kData))))
[tR, tA, tB]
tList :: Region Name -> Type Name -> Type Name
tList tR tA
= tApps (TCon (TyConBound (UPrim (NamePrimCon PrimTyConList)
(kRegion `kFun` kData `kFun` kData))))
[tR, tA]
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)
wcGlobal :: WiCon Name
wcGlobal = WiConBound
$ UPrim (NameCap CapGlobal) (tForall kRegion $ \r -> tGlobal r)
wcConst :: WiCon Name
wcConst = WiConBound
$ UPrim (NameCap CapConst) (tForall kRegion $ \r -> tConst r)
wcMutable :: WiCon Name
wcMutable = WiConBound
$ UPrim (NameCap CapMutable) (tForall kRegion $ \r -> tMutable r)
wcLazy :: WiCon Name
wcLazy = WiConBound
$ UPrim (NameCap CapLazy) (tForall kRegion $ \r -> tLazy r)
wcManifest :: WiCon Name
wcManifest = WiConBound
$ UPrim (NameCap CapManifest) (tForall kRegion $ \r -> tManifest r)
isCapConW :: Witness Name -> Bool
isCapConW ww
= case ww of
WCon WiConBound{} -> True
_ -> False
isUnitX :: Exp a Name -> Bool
isUnitX xx
= case xx of
XCon _ (UPrim (NamePrimCon PrimDaConUnit) _) -> True
_ -> 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
takeLocX :: Exp a Name -> Maybe Loc
takeLocX xx
= case xx of
XCast _ (CastForget _) x
-> takeLocX x
XCon _ (UPrim (NameLoc l) _)
-> Just l
_ -> Nothing
stripLocX :: Exp a Name -> Maybe Loc
stripLocX xx
= case xx of
XCast _ (CastForget _) x
-> stripLocX x
XCon _ (UPrim (NameLoc l) _)
-> Just l
_ -> 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