{-# LANGUAGE ExistentialQuantification, TypeSynonymInstances, FlexibleInstances #-}------------------------------------------------------------------------------- | License : GPL-- -- Maintainer : helium@cs.uu.nl-- Stability : provisional-- Portability : non-portable (requires extensions)---- This module contains a data type to represent (plain) types, some basic -- functionality for types, and an instance for Show.-------------------------------------------------------------------------------moduleTop.Types.SubstitutionwhereimportTop.Types.PrimitiveimportData.List(union,(\\),nub)importqualifiedData.MapasMimportqualifiedData.SetasSimportUtils(internalError)------------------------------------------------------------------------ * Substitutions and substitutablesinfix4|->classSubstitutionswherelookupInt::Int->s->Tp-- lookup the type of a type variable in a substitution removeDom::[Int]->s->s-- remove from the domain of the substitutionrestrictDom::[Int]->s->s-- restrict the domain of the substitutiondom::s->[Int]-- domain of substitutioncod::s->Tps-- co-domain of substitutionclassSubstitutableawhere(|->)::Substitutions=>s->a->a-- apply substitutionftv::a->[Int]-- free type variables-- |The next type variable that is not free (default is zero)nextFTV::Substitutablea=>a->IntnextFTVa=caseftvaof[]->0is->maximumis+1------------------------------------------------------------------------ * Substitution instances -- |A substitution represented by a finite map.typeMapSubstitution=M.MapIntTpinstanceSubstitutionMapSubstitutionwherelookupInti=M.findWithDefault(TVari)iremoveDom=flip(foldrM.delete)restrictDomis=letset=S.fromListisinM.filterWithKey(\i_->S.memberiset)dom=M.keyscod=M.elemsemptySubst::MapSubstitutionemptySubst=M.empty-- |Compose two finite map substitutions: safe.-- Note for 'M.union': bindings in right argument shadow those in the left(@@)::MapSubstitution->MapSubstitution->MapSubstitutionfm1@@fm2=fm1`M.union`M.map(\t->fm1|->t)fm2-- |Compose two finite map substitutions: quick and dirty!(@@@)::MapSubstitution->MapSubstitution->MapSubstitution(@@@)=M.unionsingleSubstitution::Int->Tp->MapSubstitutionsingleSubstitution=M.singletonlistToSubstitution::[(Int,Tp)]->MapSubstitutionlistToSubstitution=M.fromList-- |A fixpoint is computed when looking up the target of a type variable in this substitution. -- Combining two substitutions is cheap, whereas a lookup is more expensive than the -- normal finite map substitution.newtypeFixpointSubstitution=FixpointSubstitution(M.MapIntTp)instanceSubstitutionFixpointSubstitutionwherelookupIntioriginal@(FixpointSubstitutionfm)=caseM.lookupifmofJusttp|tp==TVari->TVari|otherwise->original|->tpNothing->TVariremoveDomis(FixpointSubstitutionfm)=FixpointSubstitution(M.filterWithKey(\i_->i`notElem`is)fm)restrictDomis(FixpointSubstitutionfm)=letjs=M.keysfm\\isinFixpointSubstitution(M.filterWithKey(\i_->i`notElem`js)fm)dom(FixpointSubstitutionfm)=M.keysfmcod(FixpointSubstitutionfm)=M.elemsfm-- |The empty fixpoint substitution emptyFPS::FixpointSubstitutionemptyFPS=FixpointSubstitutionM.empty-- |Combine two fixpoint substitutions that are disjointdisjointFPS::FixpointSubstitution->FixpointSubstitution->FixpointSubstitutiondisjointFPS(FixpointSubstitutionfm1)(FixpointSubstitutionfm2)=letnotDisjoint=internalError"Substitution""disjointFPS""the two fixpoint substitutions are not disjoint"inFixpointSubstitution(M.unionWithnotDisjointfm1fm2)------------------------------------------------------------------------ * Wrapper for substitutionswrapSubstitution::Substitutionsubstitution=>substitution->WrappedSubstitutionwrapSubstitutionsubstitution=WrappedSubstitutionsubstitution(lookupInt,removeDom,restrictDom,dom,cod)dataWrappedSubstitution=foralla.Substitutiona=>WrappedSubstitutiona(Int->a->Tp,[Int]->a->a,[Int]->a->a,a->[Int],a->Tps)instanceSubstitutionWrappedSubstitutionwherelookupInti(WrappedSubstitutionx(f,_,_,_,_))=fixremoveDomis(WrappedSubstitutionx(_,f,_,_,_))=wrapSubstitution(fisx)restrictDomis(WrappedSubstitutionx(_,_,f,_,_))=wrapSubstitution(fisx)dom(WrappedSubstitutionx(_,_,_,f,_))=fxcod(WrappedSubstitutionx(_,_,_,_,f))=fx------------------------------------------------------------------------ * Substitutables instancesinstanceSubstitutableTpwheresub|->tp=casetpofTVari->lookupIntisubTCon_->tpTAppt1t2->TApp(sub|->t1)(sub|->t2)ftvtp=casetpofTVari->[i]TCon_->[]TAppt1t2->ftvt1`union`ftvt2instanceSubstitutablea=>Substitutable[a]wheresub|->as=map(sub|->)asftv=foldr(union.ftv)[]instance(Substitutablea,Substitutableb)=>Substitutable(a,b)wheresub|->(a,b)=(sub|->a,sub|->b)ftv(a,b)=ftva`union`ftvbinstanceSubstitutablea=>Substitutable(Maybea)wheresub|->ma=fmap(sub|->)maftv=maybe[]ftvinstance(Substitutablea,Substitutableb)=>Substitutable(Eitherab)wheresub|->x=either(Left.(sub|->))(Right.(sub|->))xftv=eitherftvftvfreezeFTV::Substitutablea=>a->afreezeFTVa=letsub=listToSubstitution[(i,TCon('_':showi))|i<-ftva]insub|->aallTypeVariables::HasTypesa=>a->[Int]allTypeVariables=ftv.getTypesallTypeConstants::HasTypesa=>a->[String]allTypeConstants=letf(TVar_)=[]f(TCons)=[s]f(TApplr)=fl++frinnub.concatMapf.getTypes