{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998
-}moduleVarEnv(-- * Var, Id and TyVar environments (maps)VarEnv,IdEnv,TyVarEnv,CoVarEnv,TyCoVarEnv,-- ** Manipulating these environmentsemptyVarEnv,unitVarEnv,mkVarEnv,mkVarEnv_Directly,elemVarEnv,disjointVarEnv,extendVarEnv,extendVarEnv_C,extendVarEnv_Acc,extendVarEnv_Directly,extendVarEnvList,plusVarEnv,plusVarEnv_C,plusVarEnv_CD,plusMaybeVarEnv_C,plusVarEnvList,alterVarEnv,delVarEnvList,delVarEnv,delVarEnv_Directly,minusVarEnv,intersectsVarEnv,lookupVarEnv,lookupVarEnv_NF,lookupWithDefaultVarEnv,mapVarEnv,zipVarEnv,modifyVarEnv,modifyVarEnv_Directly,isEmptyVarEnv,elemVarEnvByKey,lookupVarEnv_Directly,filterVarEnv,filterVarEnv_Directly,restrictVarEnv,partitionVarEnv,-- * Deterministic Var environments (maps)DVarEnv,DIdEnv,DTyVarEnv,-- ** Manipulating these environmentsemptyDVarEnv,mkDVarEnv,dVarEnvElts,extendDVarEnv,extendDVarEnv_C,extendDVarEnvList,lookupDVarEnv,elemDVarEnv,isEmptyDVarEnv,foldDVarEnv,mapDVarEnv,filterDVarEnv,modifyDVarEnv,alterDVarEnv,plusDVarEnv,plusDVarEnv_C,unitDVarEnv,delDVarEnv,delDVarEnvList,minusDVarEnv,partitionDVarEnv,anyDVarEnv,-- * The InScopeSet typeInScopeSet,-- ** Operations on InScopeSetsemptyInScopeSet,mkInScopeSet,delInScopeSet,extendInScopeSet,extendInScopeSetList,extendInScopeSetSet,getInScopeVars,lookupInScope,lookupInScope_Directly,unionInScope,elemInScopeSet,uniqAway,varSetInScope,-- * The RnEnv2 typeRnEnv2,-- ** Operations on RnEnv2smkRnEnv2,rnBndr2,rnBndrs2,rnBndr2_var,rnOccL,rnOccR,inRnEnvL,inRnEnvR,rnOccL_maybe,rnOccR_maybe,rnBndrL,rnBndrR,nukeRnEnvL,nukeRnEnvR,rnSwap,delBndrL,delBndrR,delBndrsL,delBndrsR,addRnInScopeSet,rnEtaL,rnEtaR,rnInScope,rnInScopeSet,lookupRnInScope,rnEnvL,rnEnvR,-- * TidyEnv and its operationTidyEnv,emptyTidyEnv)whereimportGhcPreludeimportOccNameimportVarimportVarSetimportUniqSetimportUniqFMimportUniqDFMimportUniqueimportUtilimportMaybesimportOutputable{-
************************************************************************
* *
In-scope sets
* *
************************************************************************
-}-- | A set of variables that are in scope at some point-- "Secrets of the Glasgow Haskell Compiler inliner" Section 3.2 provides-- the motivation for this abstraction.dataInScopeSet=InScopeVarSet{-# UNPACK #-}!Int-- We store a VarSet here, but we use this for lookups rather than-- just membership tests. Typically the InScopeSet contains the-- canonical version of the variable (e.g. with an informative-- unfolding), so this lookup is useful.---- The Int is a kind of hash-value used by uniqAway-- For example, it might be the size of the set-- INVARIANT: it's not zero; we use it as a multiplier in uniqAwayinstanceOutputableInScopeSetwhereppr(InScopes_)=text"InScope"<+>braces(fsep(map(ppr.Var.varName)(nonDetEltsUniqSets)))-- It's OK to use nonDetEltsUniqSet here because it's-- only for pretty printing-- In-scope sets get big, and with -dppr-debug-- the output is overwhelmingemptyInScopeSet::InScopeSetemptyInScopeSet=InScopeemptyVarSet1getInScopeVars::InScopeSet->VarSetgetInScopeVars(InScopevs_)=vsmkInScopeSet::VarSet->InScopeSetmkInScopeSetin_scope=InScopein_scope1extendInScopeSet::InScopeSet->Var->InScopeSetextendInScopeSet(InScopein_scopen)v=InScope(extendVarSetin_scopev)(n+1)extendInScopeSetList::InScopeSet->[Var]->InScopeSetextendInScopeSetList(InScopein_scopen)vs=InScope(foldl(\sv->extendVarSetsv)in_scopevs)(n+lengthvs)extendInScopeSetSet::InScopeSet->VarSet->InScopeSetextendInScopeSetSet(InScopein_scopen)vs=InScope(in_scope`unionVarSet`vs)(n+sizeUniqSetvs)delInScopeSet::InScopeSet->Var->InScopeSetdelInScopeSet(InScopein_scopen)v=InScope(in_scope`delVarSet`v)nelemInScopeSet::Var->InScopeSet->BoolelemInScopeSetv(InScopein_scope_)=v`elemVarSet`in_scope-- | Look up a variable the 'InScopeSet'. This lets you map from-- the variable's identity (unique) to its full value.lookupInScope::InScopeSet->Var->MaybeVarlookupInScope(InScopein_scope_)v=lookupVarSetin_scopevlookupInScope_Directly::InScopeSet->Unique->MaybeVarlookupInScope_Directly(InScopein_scope_)uniq=lookupVarSet_Directlyin_scopeuniqunionInScope::InScopeSet->InScopeSet->InScopeSetunionInScope(InScopes1_)(InScopes2n2)=InScope(s1`unionVarSet`s2)n2varSetInScope::VarSet->InScopeSet->BoolvarSetInScopevars(InScopes1_)=vars`subVarSet`s1-- | @uniqAway in_scope v@ finds a unique that is not used in the-- in-scope set, and gives that to v.uniqAway::InScopeSet->Var->Var-- It starts with v's current unique, of course, in the hope that it won't-- have to change, and thereafter uses a combination of that and the hash-code-- found in the in-scope setuniqAwayin_scopevar|var`elemInScopeSet`in_scope=uniqAway'in_scopevar-- Make a new one|otherwise=var-- Nothing to douniqAway'::InScopeSet->Var->Var-- This one *always* makes up a new variableuniqAway'(InScopesetn)var=try1whereorig_unique=getUniquevartryk|debugIsOn&&(k>1000)=pprPanic"uniqAway loop:"msg|uniq`elemVarSetByKey`set=try(k+1)|k>3=pprTraceDebug"uniqAway:"msgsetVarUniquevaruniq|otherwise=setVarUniquevaruniqwheremsg=pprk<+>text"tries"<+>pprvar<+>intnuniq=deriveUniqueorig_unique(n*k){-
************************************************************************
* *
Dual renaming
* *
************************************************************************
-}-- | Rename Environment 2---- When we are comparing (or matching) types or terms, we are faced with-- \"going under\" corresponding binders. E.g. when comparing:---- > \x. e1 ~ \y. e2---- Basically we want to rename [@x@ -> @y@] or [@y@ -> @x@], but there are lots of-- things we must be careful of. In particular, @x@ might be free in @e2@, or-- y in @e1@. So the idea is that we come up with a fresh binder that is free-- in neither, and rename @x@ and @y@ respectively. That means we must maintain:---- 1. A renaming for the left-hand expression---- 2. A renaming for the right-hand expressions---- 3. An in-scope set---- Furthermore, when matching, we want to be able to have an 'occurs check',-- to prevent:---- > \x. f ~ \y. y---- matching with [@f@ -> @y@]. So for each expression we want to know that set of-- locally-bound variables. That is precisely the domain of the mappings 1.-- and 2., but we must ensure that we always extend the mappings as we go in.---- All of this information is bundled up in the 'RnEnv2'dataRnEnv2=RV2{envL::VarEnvVar-- Renaming for Left term,envR::VarEnvVar-- Renaming for Right term,in_scope::InScopeSet}-- In scope in left or right terms-- The renamings envL and envR are *guaranteed* to contain a binding-- for every variable bound as we go into the term, even if it is not-- renamed. That way we can ask what variables are locally bound-- (inRnEnvL, inRnEnvR)mkRnEnv2::InScopeSet->RnEnv2mkRnEnv2vars=RV2{envL=emptyVarEnv,envR=emptyVarEnv,in_scope=vars}addRnInScopeSet::RnEnv2->VarSet->RnEnv2addRnInScopeSetenvvs|isEmptyVarSetvs=env|otherwise=env{in_scope=extendInScopeSetSet(in_scopeenv)vs}rnInScope::Var->RnEnv2->BoolrnInScopexenv=x`elemInScopeSet`in_scopeenvrnInScopeSet::RnEnv2->InScopeSetrnInScopeSet=in_scope-- | Retrieve the left mappingrnEnvL::RnEnv2->VarEnvVarrnEnvL=envL-- | Retrieve the right mappingrnEnvR::RnEnv2->VarEnvVarrnEnvR=envRrnBndrs2::RnEnv2->[Var]->[Var]->RnEnv2-- ^ Applies 'rnBndr2' to several variables: the two variable lists must be of equal lengthrnBndrs2envbsLbsR=foldl2rnBndr2envbsLbsRrnBndr2::RnEnv2->Var->Var->RnEnv2-- ^ @rnBndr2 env bL bR@ goes under a binder @bL@ in the Left term,-- and binder @bR@ in the Right term.-- It finds a new binder, @new_b@,-- and returns an environment mapping @bL -> new_b@ and @bR -> new_b@rnBndr2envbLbR=fst$rnBndr2_varenvbLbRrnBndr2_var::RnEnv2->Var->Var->(RnEnv2,Var)-- ^ Similar to 'rnBndr2' but returns the new variable as well as the-- new environmentrnBndr2_var(RV2{envL=envL,envR=envR,in_scope=in_scope})bLbR=(RV2{envL=extendVarEnvenvLbLnew_b-- See Note,envR=extendVarEnvenvRbRnew_b-- [Rebinding],in_scope=extendInScopeSetin_scopenew_b},new_b)where-- Find a new binder not in scope in either termnew_b|not(bL`elemInScopeSet`in_scope)=bL|not(bR`elemInScopeSet`in_scope)=bR|otherwise=uniqAway'in_scopebL-- Note [Rebinding]-- If the new var is the same as the old one, note that-- the extendVarEnv *deletes* any current renaming-- E.g. (\x. \x. ...) ~ (\y. \z. ...)---- Inside \x \y { [x->y], [y->y], {y} }-- \x \z { [x->x], [y->y, z->x], {y,x} }rnBndrL::RnEnv2->Var->(RnEnv2,Var)-- ^ Similar to 'rnBndr2' but used when there's a binder on the left-- side only.rnBndrL(RV2{envL=envL,envR=envR,in_scope=in_scope})bL=(RV2{envL=extendVarEnvenvLbLnew_b,envR=envR,in_scope=extendInScopeSetin_scopenew_b},new_b)wherenew_b=uniqAwayin_scopebLrnBndrR::RnEnv2->Var->(RnEnv2,Var)-- ^ Similar to 'rnBndr2' but used when there's a binder on the right-- side only.rnBndrR(RV2{envL=envL,envR=envR,in_scope=in_scope})bR=(RV2{envR=extendVarEnvenvRbRnew_b,envL=envL,in_scope=extendInScopeSetin_scopenew_b},new_b)wherenew_b=uniqAwayin_scopebRrnEtaL::RnEnv2->Var->(RnEnv2,Var)-- ^ Similar to 'rnBndrL' but used for eta expansion-- See Note [Eta expansion]rnEtaL(RV2{envL=envL,envR=envR,in_scope=in_scope})bL=(RV2{envL=extendVarEnvenvLbLnew_b,envR=extendVarEnvenvRnew_bnew_b-- Note [Eta expansion],in_scope=extendInScopeSetin_scopenew_b},new_b)wherenew_b=uniqAwayin_scopebLrnEtaR::RnEnv2->Var->(RnEnv2,Var)-- ^ Similar to 'rnBndr2' but used for eta expansion-- See Note [Eta expansion]rnEtaR(RV2{envL=envL,envR=envR,in_scope=in_scope})bR=(RV2{envL=extendVarEnvenvLnew_bnew_b-- Note [Eta expansion],envR=extendVarEnvenvRbRnew_b,in_scope=extendInScopeSetin_scopenew_b},new_b)wherenew_b=uniqAwayin_scopebRdelBndrL,delBndrR::RnEnv2->Var->RnEnv2delBndrLrn@(RV2{envL=env,in_scope=in_scope})v=rn{envL=env`delVarEnv`v,in_scope=in_scope`extendInScopeSet`v}delBndrRrn@(RV2{envR=env,in_scope=in_scope})v=rn{envR=env`delVarEnv`v,in_scope=in_scope`extendInScopeSet`v}delBndrsL,delBndrsR::RnEnv2->[Var]->RnEnv2delBndrsLrn@(RV2{envL=env,in_scope=in_scope})v=rn{envL=env`delVarEnvList`v,in_scope=in_scope`extendInScopeSetList`v}delBndrsRrn@(RV2{envR=env,in_scope=in_scope})v=rn{envR=env`delVarEnvList`v,in_scope=in_scope`extendInScopeSetList`v}rnOccL,rnOccR::RnEnv2->Var->Var-- ^ Look up the renaming of an occurrence in the left or right termrnOccL(RV2{envL=env})v=lookupVarEnvenvv`orElse`vrnOccR(RV2{envR=env})v=lookupVarEnvenvv`orElse`vrnOccL_maybe,rnOccR_maybe::RnEnv2->Var->MaybeVar-- ^ Look up the renaming of an occurrence in the left or right termrnOccL_maybe(RV2{envL=env})v=lookupVarEnvenvvrnOccR_maybe(RV2{envR=env})v=lookupVarEnvenvvinRnEnvL,inRnEnvR::RnEnv2->Var->Bool-- ^ Tells whether a variable is locally boundinRnEnvL(RV2{envL=env})v=v`elemVarEnv`envinRnEnvR(RV2{envR=env})v=v`elemVarEnv`envlookupRnInScope::RnEnv2->Var->VarlookupRnInScopeenvv=lookupInScope(in_scopeenv)v`orElse`vnukeRnEnvL,nukeRnEnvR::RnEnv2->RnEnv2-- ^ Wipe the left or right side renamingnukeRnEnvLenv=env{envL=emptyVarEnv}nukeRnEnvRenv=env{envR=emptyVarEnv}rnSwap::RnEnv2->RnEnv2-- ^ swap the meaning of left and rightrnSwap(RV2{envL=envL,envR=envR,in_scope=in_scope})=RV2{envL=envR,envR=envL,in_scope=in_scope}{-
Note [Eta expansion]
~~~~~~~~~~~~~~~~~~~~
When matching
(\x.M) ~ N
we rename x to x' with, where x' is not in scope in
either term. Then we want to behave as if we'd seen
(\x'.M) ~ (\x'.N x')
Since x' isn't in scope in N, the form (\x'. N x') doesn't
capture any variables in N. But we must nevertheless extend
the envR with a binding [x' -> x'], to support the occurs check.
For example, if we don't do this, we can get silly matches like
forall a. (\y.a) ~ v
succeeding with [a -> v y], which is bogus of course.
************************************************************************
* *
Tidying
* *
************************************************************************
-}-- | Tidy Environment---- When tidying up print names, we keep a mapping of in-scope occ-names-- (the 'TidyOccEnv') and a Var-to-Var of the current renamingstypeTidyEnv=(TidyOccEnv,VarEnvVar)emptyTidyEnv::TidyEnvemptyTidyEnv=(emptyTidyOccEnv,emptyVarEnv){-
************************************************************************
* *
\subsection{@VarEnv@s}
* *
************************************************************************
-}-- | Variable EnvironmenttypeVarEnvelt=UniqFMelt-- | Identifier EnvironmenttypeIdEnvelt=VarEnvelt-- | Type Variable EnvironmenttypeTyVarEnvelt=VarEnvelt-- | Type or Coercion Variable EnvironmenttypeTyCoVarEnvelt=VarEnvelt-- | Coercion Variable EnvironmenttypeCoVarEnvelt=VarEnveltemptyVarEnv::VarEnvamkVarEnv::[(Var,a)]->VarEnvamkVarEnv_Directly::[(Unique,a)]->VarEnvazipVarEnv::[Var]->[a]->VarEnvaunitVarEnv::Var->a->VarEnvaalterVarEnv::(Maybea->Maybea)->VarEnva->Var->VarEnvaextendVarEnv::VarEnva->Var->a->VarEnvaextendVarEnv_C::(a->a->a)->VarEnva->Var->a->VarEnvaextendVarEnv_Acc::(a->b->b)->(a->b)->VarEnvb->Var->a->VarEnvbextendVarEnv_Directly::VarEnva->Unique->a->VarEnvaplusVarEnv::VarEnva->VarEnva->VarEnvaplusVarEnvList::[VarEnva]->VarEnvaextendVarEnvList::VarEnva->[(Var,a)]->VarEnvalookupVarEnv_Directly::VarEnva->Unique->MaybeafilterVarEnv_Directly::(Unique->a->Bool)->VarEnva->VarEnvadelVarEnv_Directly::VarEnva->Unique->VarEnvapartitionVarEnv::(a->Bool)->VarEnva->(VarEnva,VarEnva)restrictVarEnv::VarEnva->VarSet->VarEnvadelVarEnvList::VarEnva->[Var]->VarEnvadelVarEnv::VarEnva->Var->VarEnvaminusVarEnv::VarEnva->VarEnvb->VarEnvaintersectsVarEnv::VarEnva->VarEnva->BoolplusVarEnv_C::(a->a->a)->VarEnva->VarEnva->VarEnvaplusVarEnv_CD::(a->a->a)->VarEnva->a->VarEnva->a->VarEnvaplusMaybeVarEnv_C::(a->a->Maybea)->VarEnva->VarEnva->VarEnvamapVarEnv::(a->b)->VarEnva->VarEnvbmodifyVarEnv::(a->a)->VarEnva->Var->VarEnvaisEmptyVarEnv::VarEnva->BoollookupVarEnv::VarEnva->Var->MaybeafilterVarEnv::(a->Bool)->VarEnva->VarEnvalookupVarEnv_NF::VarEnva->Var->alookupWithDefaultVarEnv::VarEnva->a->Var->aelemVarEnv::Var->VarEnva->BoolelemVarEnvByKey::Unique->VarEnva->BooldisjointVarEnv::VarEnva->VarEnva->BoolelemVarEnv=elemUFMelemVarEnvByKey=elemUFM_DirectlydisjointVarEnv=disjointUFMalterVarEnv=alterUFMextendVarEnv=addToUFMextendVarEnv_C=addToUFM_CextendVarEnv_Acc=addToUFM_AccextendVarEnv_Directly=addToUFM_DirectlyextendVarEnvList=addListToUFMplusVarEnv_C=plusUFM_CplusVarEnv_CD=plusUFM_CDplusMaybeVarEnv_C=plusMaybeUFM_CdelVarEnvList=delListFromUFMdelVarEnv=delFromUFMminusVarEnv=minusUFMintersectsVarEnve1e2=not(isEmptyVarEnv(e1`intersectUFM`e2))plusVarEnv=plusUFMplusVarEnvList=plusUFMListlookupVarEnv=lookupUFMfilterVarEnv=filterUFMlookupWithDefaultVarEnv=lookupWithDefaultUFMmapVarEnv=mapUFMmkVarEnv=listToUFMmkVarEnv_Directly=listToUFM_DirectlyemptyVarEnv=emptyUFMunitVarEnv=unitUFMisEmptyVarEnv=isNullUFMlookupVarEnv_Directly=lookupUFM_DirectlyfilterVarEnv_Directly=filterUFM_DirectlydelVarEnv_Directly=delFromUFM_DirectlypartitionVarEnv=partitionUFMrestrictVarEnvenvvs=filterVarEnv_Directlykeepenvwherekeepu_=u`elemVarSetByKey`vszipVarEnvtyvarstys=mkVarEnv(zipEqual"zipVarEnv"tyvarstys)lookupVarEnv_NFenvid=caselookupVarEnvenvidofJustxx->xxNothing->panic"lookupVarEnv_NF: Nothing"{-
@modifyVarEnv@: Look up a thing in the VarEnv,
then mash it with the modify function, and put it back.
-}modifyVarEnvmangle_fnenvkey=case(lookupVarEnvenvkey)ofNothing->envJustxx->extendVarEnvenvkey(mangle_fnxx)modifyVarEnv_Directly::(a->a)->UniqFMa->Unique->UniqFMamodifyVarEnv_Directlymangle_fnenvkey=case(lookupUFM_Directlyenvkey)ofNothing->envJustxx->addToUFM_Directlyenvkey(mangle_fnxx)-- Deterministic VarEnv-- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need-- DVarEnv.-- | Deterministic Variable EnvironmenttypeDVarEnvelt=UniqDFMelt-- | Deterministic Identifier EnvironmenttypeDIdEnvelt=DVarEnvelt-- | Deterministic Type Variable EnvironmenttypeDTyVarEnvelt=DVarEnveltemptyDVarEnv::DVarEnvaemptyDVarEnv=emptyUDFMdVarEnvElts::DVarEnva->[a]dVarEnvElts=eltsUDFMmkDVarEnv::[(Var,a)]->DVarEnvamkDVarEnv=listToUDFMextendDVarEnv::DVarEnva->Var->a->DVarEnvaextendDVarEnv=addToUDFMminusDVarEnv::DVarEnva->DVarEnva'->DVarEnvaminusDVarEnv=minusUDFMlookupDVarEnv::DVarEnva->Var->MaybealookupDVarEnv=lookupUDFMfoldDVarEnv::(a->b->b)->b->DVarEnva->bfoldDVarEnv=foldUDFMmapDVarEnv::(a->b)->DVarEnva->DVarEnvbmapDVarEnv=mapUDFMfilterDVarEnv::(a->Bool)->DVarEnva->DVarEnvafilterDVarEnv=filterUDFMalterDVarEnv::(Maybea->Maybea)->DVarEnva->Var->DVarEnvaalterDVarEnv=alterUDFMplusDVarEnv::DVarEnva->DVarEnva->DVarEnvaplusDVarEnv=plusUDFMplusDVarEnv_C::(a->a->a)->DVarEnva->DVarEnva->DVarEnvaplusDVarEnv_C=plusUDFM_CunitDVarEnv::Var->a->DVarEnvaunitDVarEnv=unitUDFMdelDVarEnv::DVarEnva->Var->DVarEnvadelDVarEnv=delFromUDFMdelDVarEnvList::DVarEnva->[Var]->DVarEnvadelDVarEnvList=delListFromUDFMisEmptyDVarEnv::DVarEnva->BoolisEmptyDVarEnv=isNullUDFMelemDVarEnv::Var->DVarEnva->BoolelemDVarEnv=elemUDFMextendDVarEnv_C::(a->a->a)->DVarEnva->Var->a->DVarEnvaextendDVarEnv_C=addToUDFM_CmodifyDVarEnv::(a->a)->DVarEnva->Var->DVarEnvamodifyDVarEnvmangle_fnenvkey=case(lookupDVarEnvenvkey)ofNothing->envJustxx->extendDVarEnvenvkey(mangle_fnxx)partitionDVarEnv::(a->Bool)->DVarEnva->(DVarEnva,DVarEnva)partitionDVarEnv=partitionUDFMextendDVarEnvList::DVarEnva->[(Var,a)]->DVarEnvaextendDVarEnvList=addListToUDFManyDVarEnv::(a->Bool)->DVarEnva->BoolanyDVarEnv=anyUDFM