moduleDDC.Core.Eval.Check(checkCapsX,Error(..))whereimportDDC.Core.Eval.CompoundsimportDDC.Core.Eval.NameimportDDC.Core.ExpimportDDC.Base.PrettyimportControl.MonadimportData.MaybeimportDDC.Type.Check.Monad(throw,result)importData.Set(Set)importqualifiedDDC.Type.Check.MonadasGimportqualifiedData.SetasSettypeCheckMa=G.CheckMError-- | Check for conflicting store capabilities in the program.checkCapsX::ExpaName->MaybeErrorcheckCapsXxx=caseresult$checkCapsXMxxofLefterr->JusterrRightws->letcaps=foldrmustInsertCapemptyCapSetwsincheckCapSetcaps-- CapSet --------------------------------------------------------------------dataCapSet=CapSet{capsGlobal::SetRgn,capsConst::SetRgn,capsMutable::SetRgn,capsLazy::SetRgn,capsManifest::SetRgn}derivingShow-- | An empty capability setemptyCapSet::CapSetemptyCapSet=CapSet{capsGlobal=Set.empty,capsConst=Set.empty,capsMutable=Set.empty,capsLazy=Set.empty,capsManifest=Set.empty}-- | Insert a capability, or `error` if this isn't one.mustInsertCap::WitnessName->CapSet->CapSetmustInsertCapwwcaps|WApp(WCon(WiConBound(UPrimnc_)))(WType(TCon(TyConBound(UPrimnh_))))<-ww,NameCapc<-nc,NameRgnr<-nh=casecofCapGlobal->caps{capsGlobal=Set.insertr(capsGlobalcaps)}CapConst->caps{capsConst=Set.insertr(capsConstcaps)}CapMutable->caps{capsMutable=Set.insertr(capsMutablecaps)}CapLazy->caps{capsLazy=Set.insertr(capsLazycaps)}CapManifest->caps{capsManifest=Set.insertr(capsManifestcaps)}|otherwise=error"mustInsertCap: not a capability"-- | Check a capability set for conflicts between the capabilities.checkCapSet::CapSet->MaybeErrorcheckCapSetcs|r:_<-Set.toList$Set.intersection(capsConstcs)(capsMutablecs)=Just$ErrorConflictrCapConstCapMutable|r:_<-Set.toList$Set.intersection(capsLazycs)(capsManifestcs)=Just$ErrorConflictrCapLazyCapManifest|otherwise=Nothing-- Error ------------------------------------------------------------------------ | Things that can go wrong with the capabilities in a program.dataError-- | Conflicting capabilities in program.=ErrorConflict{errorRegions::Rgn,errorCap1::Cap,errorCap2::Cap}-- | A partially applied capability constructor.-- In the formal semantics, capabilities are atomic, so this isn't-- a problem. However, as we're representing them with general witness-- appliction we need to ensure the constructors aren't partially -- applied.|ErrorPartial{errorWitness::WitnessName}-- | A capability constructor applied to a non-region handle.-- As with `ErrorPartial` we only need to check for this because we're-- using general witness application to represent capabilities, instead-- of having an atomic form. |ErrorNonHandle{errorWitness::WitnessName}instancePrettyErrorwherepprerr=caseerrofErrorConflictrc1c2->vcat[text"Conflicting capabilities in core program.",text" region: "<>pprr,text" can't be both: "<>pprc1,text" and: "<>pprc2]ErrorPartialw1->vcat[text"Partially applied capability constructor.",text"with: "<>pprw1]ErrorNonHandlew1->vcat[text"Capability constructor applied to a non-region handle.",text"with: "<>pprw1]--------------------------------------------------------------------------------- | Collect the list of capabilities in an expression, -- and check that they are well-formed.checkCapsXM::ExpaName->CheckMa[WitnessName]checkCapsXMxx=letnone=return[]incasexxofXVar{}->noneXCon{}->noneXLAM__x->checkCapsXMxXLam__x->checkCapsXMxXApp_x1x2->liftM2(++)(checkCapsXMx1)(checkCapsXMx2)XLet_ltsx1->liftM2(++)(checkCapsLMlts)(checkCapsXMx1)XCase_x1alts->liftM2(++)(checkCapsXMx1)(liftMconcat$mapMcheckCapsAMalts)XCast_ccx1->liftM2(++)(checkCapsCMcc)(checkCapsXMx1)XType{}->noneXWitnessw->checkCapsWMwcheckCapsCM::CastName->CheckMa[WitnessName]checkCapsCMcc=letnone=return[]incaseccofCastWeakenEffect{}->noneCastWeakenClosure{}->noneCastPurifyw->checkCapsWMwCastForgetw->checkCapsWMwcheckCapsLM::LetsaName->CheckMa[WitnessName]checkCapsLMll=letnone=return[]incasellofLLetm_x->liftM2(++)(checkCapsMMm)(checkCapsXMx)LRecbxs->liftMconcat(mapMcheckCapsXM$mapsndbxs)LLetRegion{}->noneLWithRegion{}->nonecheckCapsMM::LetModeName->CheckMa[WitnessName]checkCapsMMmm=letnone=return[]incasemmofLetStrict->noneLetLazy(Justw)->checkCapsWMwLetLazyNothing->nonecheckCapsAM::AltaName->CheckMa[WitnessName]checkCapsAMaa=caseaaofAAlt_x->checkCapsXMxcheckCapsWM::WitnessName->CheckMa[WitnessName]checkCapsWMww=letnone=return[]incasewwofWVar{}->noneWCon{}|isCapConWww->throw$ErrorPartialww|otherwise->noneWAppw1@WCon{}w2@(WTypetR)|isCapConWw1->ifisJust$takeHandleTtRthenreturn[ww]elsethrow$ErrorNonHandleww|otherwise->liftM2(++)(checkCapsWMw1)(checkCapsWMw2)WAppw1w2->liftM2(++)(checkCapsWMw1)(checkCapsWMw2)WJoinw1w2->liftM2(++)(checkCapsWMw1)(checkCapsWMw2)WType{}->none