-- | Utilities for constructing and destructing compound expressions.---- For the annotated version of the AST.moduleDDC.Core.Compounds.Annot(moduleDDC.Type.Compounds-- * Annotations,takeAnnotOfExp-- * Lambdas,xLAMs,xLams,makeXLamFlags,takeXLAMs,takeXLams,takeXLamFlags-- * Applications,xApps,makeXAppsWithAnnots,takeXApps,takeXApps1,takeXAppsAsList,takeXAppsWithAnnots,takeXConApps,takeXPrimApps-- * Lets,xLets,xLetsAnnot,splitXLets,bindsOfLets,specBindsOfLets,valwitBindsOfLets-- * Patterns,bindsOfPat-- * Alternatives,takeCtorNameOfAlt-- * Witnesses,wApp,wApps,takeXWitness,takeWAppsAsList,takePrimWiConApps-- * Types,takeXType-- * Data Constructors,xUnit,dcUnit,mkDaConAlg,mkDaConSolid,takeNameOfDaCon,typeOfDaCon)whereimportDDC.Type.CompoundsimportDDC.Core.ExpimportDDC.Core.Exp.DaCon-- Annotations ------------------------------------------------------------------ | Take the outermost annotation from an expression,-- or Nothing if this is an `XType` or `XWitness` without an annotation.takeAnnotOfExp::Expan->MaybeatakeAnnotOfExpxx=casexxofXVara_->JustaXCona_->JustaXLAMa__->JustaXLama__->JustaXAppa__->JustaXLeta__->JustaXCasea__->JustaXCasta__->JustaXType{}->NothingXWitness{}->Nothing-- Lambdas ----------------------------------------------------------------------- | Make some nested type lambdas.xLAMs::a->[Bindn]->Expan->ExpanxLAMsabsx=foldr(XLAMa)xbs-- | Make some nested value or witness lambdas.xLams::a->[Bindn]->Expan->ExpanxLamsabsx=foldr(XLama)xbs-- | Split type lambdas from the front of an expression,-- or `Nothing` if there aren't any.takeXLAMs::Expan->Maybe([Bindn],Expan)takeXLAMsxx=letgobs(XLAM_bx)=go(b:bs)xgobsx=(reversebs,x)incasego[]xxof([],_)->Nothing(bs,body)->Just(bs,body)-- | Split nested value or witness lambdas from the front of an expression,-- or `Nothing` if there aren't any.takeXLams::Expan->Maybe([Bindn],Expan)takeXLamsxx=letgobs(XLam_bx)=go(b:bs)xgobsx=(reversebs,x)incasego[]xxof([],_)->Nothing(bs,body)->Just(bs,body)-- | Make some nested lambda abstractions,-- using a flag to indicate whether the lambda is a-- level-1 (True), or level-0 (False) binder.makeXLamFlags::a->[(Bool,Bindn)]->Expan->ExpanmakeXLamFlagsafbsx=foldr(\(f,b)x'->iffthenXLAMabx'elseXLamabx')xfbs-- | Split nested lambdas from the front of an expression, -- with a flag indicating whether the lambda was a level-1 (True), -- or level-0 (False) binder.takeXLamFlags::Expan->Maybe([(Bool,Bindn)],Expan)takeXLamFlagsxx=letgobs(XLAM_bx)=go((True,b):bs)xgobs(XLam_bx)=go((False,b):bs)xgobsx=(reversebs,x)incasego[]xxof([],_)->Nothing(bs,body)->Just(bs,body)-- Applications ----------------------------------------------------------------- | Build sequence of value applications.xApps::a->Expan->[Expan]->ExpanxAppsat1ts=foldl(XAppa)t1ts-- | Build sequence of applications.-- Similar to `xApps` but also takes list of annotations for -- the `XApp` constructors.makeXAppsWithAnnots::Expan->[(Expan,a)]->ExpanmakeXAppsWithAnnotsfxas=casexasof[]->f(arg,a):as->makeXAppsWithAnnots(XAppafarg)as-- | Flatten an application into the function part and its arguments.---- Returns `Nothing` if there is no outer application.takeXApps::Expan->Maybe(Expan,[Expan])takeXAppsxx=casetakeXAppsAsListxxof(x1:xsArgs)->Just(x1,xsArgs)_->Nothing-- | Flatten an application into the function part and its arguments.---- This is like `takeXApps` above, except we know there is at least one argument.takeXApps1::Expan->Expan->(Expan,[Expan])takeXApps1x1x2=casetakeXAppsx1ofNothing->(x1,[x2])Just(x11,x12s)->(x11,x12s++[x2])-- | Flatten an application into the function parts and arguments, if any.takeXAppsAsList::Expan->[Expan]takeXAppsAsListxx=casexxofXApp_x1x2->takeXAppsAsListx1++[x2]_->[xx]-- | Destruct sequence of applications.-- Similar to `takeXAppsAsList` but also keeps annotations for later.takeXAppsWithAnnots::Expan->(Expan,[(Expan,a)])takeXAppsWithAnnotsxx=casexxofXAppafarg->let(f',args')=takeXAppsWithAnnotsfin(f',args'++[(arg,a)])_->(xx,[])-- | Flatten an application of a primop into the variable-- and its arguments.-- -- Returns `Nothing` if the expression isn't a primop application.takeXPrimApps::Expan->Maybe(n,[Expan])takeXPrimAppsxx=casetakeXAppsAsListxxofXVar_(UPrimp_):xs->Just(p,xs)_->Nothing-- | Flatten an application of a data constructor into the constructor-- and its arguments. ---- Returns `Nothing` if the expression isn't a constructor application.takeXConApps::Expan->Maybe(DaConn,[Expan])takeXConAppsxx=casetakeXAppsAsListxxofXCon_dc:xs->Just(dc,xs)_->Nothing-- Lets ------------------------------------------------------------------------- | Wrap some let-bindings around an expression.xLets::a->[Letsan]->Expan->ExpanxLetsaltsx=foldr(XLeta)xlts-- | Wrap some let-bindings around an expression, with individual annotations.xLetsAnnot::[(Letsan,a)]->Expan->ExpanxLetsAnnotltsx=foldr(\(l,a)x'->XLetalx')xlts-- | Split let-bindings from the front of an expression, if any.splitXLets::Expan->([Letsan],Expan)splitXLetsxx=casexxofXLet_ltsx->let(lts',x')=splitXLetsxin(lts:lts',x')_->([],xx)-- | Take the binds of a `Lets`.---- The level-1 and level-0 binders are returned separately.bindsOfLets::Letsan->([Bindn],[Bindn])bindsOfLetsll=casellofLLetb_->([],[b])LRecbxs->([],mapfstbxs)LLetRegionsbsbbs->(bs,bbs)LWithRegion{}->([],[])-- | Like `bindsOfLets` but only take the spec (level-1) binders.specBindsOfLets::Letsan->[Bindn]specBindsOfLetsll=casellofLLet__->[]LRec_->[]LLetRegionsbs_->bsLWithRegion{}->[]-- | Like `bindsOfLets` but only take the value and witness (level-0) binders.valwitBindsOfLets::Letsan->[Bindn]valwitBindsOfLetsll=casellofLLetb_->[b]LRecbxs->mapfstbxsLLetRegions_bs->bsLWithRegion{}->[]-- Alternatives ----------------------------------------------------------------- | Take the constructor name of an alternative, if there is one.takeCtorNameOfAlt::Altan->MaybentakeCtorNameOfAltaa=caseaaofAAlt(PDatadc_)_->takeNameOfDaCondc_->Nothing-- Patterns --------------------------------------------------------------------- | Take the binds of a `Pat`.bindsOfPat::Patn->[Bindn]bindsOfPatpp=caseppofPDefault->[]PData_bs->bs-- Witnesses -------------------------------------------------------------------- | Construct a witness applicationwApp::a->Witnessan->Witnessan->WitnessanwApp=WApp-- | Construct a sequence of witness applicationswApps::a->Witnessan->[Witnessan]->WitnessanwAppsa=foldl(wAppa)-- | Take the witness from an `XWitness` argument, if any.takeXWitness::Expan->Maybe(Witnessan)takeXWitnessxx=casexxofXWitnesst->Justt_->Nothing-- | Flatten an application into the function parts and arguments, if any.takeWAppsAsList::Witnessan->[Witnessan]takeWAppsAsListww=casewwofWApp_w1w2->takeWAppsAsListw1++[w2]_->[ww]-- | Flatten an application of a witness into the witness constructor-- name and its arguments.---- Returns nothing if there is no witness constructor in head position.takePrimWiConApps::Witnessan->Maybe(n,[Witnessan])takePrimWiConAppsww=casetakeWAppsAsListwwofWCon_wc:args|WiConBound(UPrimn_)_<-wc->Just(n,args)_->Nothing-- Types ------------------------------------------------------------------------ | Take the type from an `XType` argument, if any.takeXType::Expan->Maybe(Typen)takeXTypexx=casexxofXTypet->Justt_->Nothing-- Units ------------------------------------------------------------------------- | Construct a value of unit type.xUnit::a->ExpanxUnita=XConadcUnit