{-# LANGUAGE MultiParamTypeClasses, GADTs, FlexibleInstances,
OverlappingInstances, TypeOperators, TemplateHaskell #-}---------------------------------------------------------------------------------- |-- Module : Data.Comp.Variables-- Copyright : (c) 2010-2011 Patrick Bahr-- License : BSD3-- Maintainer : Patrick Bahr <paba@diku.dk> and Tom Hvitved <hvitved@diku.dk>-- Stability : experimental-- Portability : non-portable (GHC Extensions)---- This module defines an abstract notion of (bound) variables in compositional-- data types, and scoped substitution. Capture-avoidance is /not/ taken into-- account.----------------------------------------------------------------------------------moduleData.Comp.Variables(HasVars(..),Subst,CxtSubst,varsToHoles,containsVar,variables,variableList,variables',substVars,appSubst,compSubst)whereimportData.Comp.TermimportData.Comp.NumberimportData.Comp.AlgebraimportData.Comp.DeriveimportData.Foldablehiding(elem,notElem)importData.MaybeimportData.Set(Set)importqualifiedData.SetasSetimportData.Map(Map)importqualifiedData.MapasMapimportPreludehiding(or,foldl)-- | This type represents substitutions of contexts, i.e. finite-- mappings from variables to contexts.typeCxtSubsthafv=Mapv(Cxthfa)-- | This type represents substitutions of terms, i.e. finite mappings-- from variables to terms.typeSubstfv=CxtSubstNoHole()fv{-| This multiparameter class defines functors with variables. An instance
@HasVar f v@ denotes that values over @f@ might contain and bind variables of
type @v@. -}classHasVarsfvwhere-- | Indicates whether the @f@ constructor is a variable. The-- default implementation returns @Nothing@.isVar::fa->MaybevisVar_=Nothing-- | Indicates the set of variables bound by the @f@ constructor-- for each argument of the constructor. For example for a-- non-recursive let binding:-- @-- data Let e = Let Var e e-- instance HasVars Let Var where-- bindsVars (Let v x y) = Map.fromList [(y, (Set.singleton v))]-- @-- If, instead, the let binding is recursive, the methods has to-- be implemented like this:-- @-- bindsVars (Let v x y) = Map.fromList [(x, (Set.singleton v)),-- (y, (Set.singleton v))]-- @-- This indicates that the scope of the bound variable also-- extends to the right-hand side of the variable binding.---- The default implementation returns the empty map.bindsVars::Orda=>fa->Mapa(Setv)bindsVars_=Map.empty$(derive[liftSum][''HasVars])-- | Same as 'isVar' but it returns Nothing@ instead of @Just v@ if-- @v@ is contained in the given set of variables.isVar'::(HasVarsfv,Ordv)=>Setv->fa->MaybevisVar'bt=dov<-isVartifv`Set.member`bthenNothingelsereturnv-- | This combinator pairs every argument of a given constructor with-- the set of (newly) bound variables according to the corresponding-- 'HasVars' type class instance.getBoundVars::(HasVarsfv,Traversablef)=>fa->f(Setv,a)getBoundVarst=letn=numbertm=bindsVarsntransx=(Map.findWithDefaultSet.emptyxm,unNumberedx)infmaptransn-- | This combinator combines 'getBoundVars' with the generic 'fmap' function.fmapBoundVars::(HasVarsfv,Traversablef)=>(Setv->a->b)->fa->fbfmapBoundVarsft=letn=numbertm=bindsVarsntransx=f(Map.findWithDefaultSet.emptyxm)(unNumberedx)infmaptransn-- | This combinator combines 'getBoundVars' with the generic 'foldl' function. foldlBoundVars::(HasVarsfv,Traversablef)=>(b->Setv->a->b)->b->fa->bfoldlBoundVarsfet=letn=numbertm=bindsVarsntransxy=fx(Map.findWithDefaultSet.emptyym)(unNumberedy)infoldltransen-- | Convert variables to holes, except those that are bound.varsToHoles::(Traversablef,HasVarsfv,Ordv)=>Termf->ContextfvvarsToHolest=cataalgtSet.emptywherealg::(Traversablef,HasVarsfv,Ordv)=>Algf(Setv->Contextfv)algtvars=caseisVartofJustv|v`Set.member`vars->Holev_->Term$fmapBoundVarsruntwhererunnewVarsf=f$newVars`Set.union`vars-- |Algebra for checking whether a variable is contained in a term, except those-- that are bound.containsVarAlg::(Eqv,HasVarsfv,Traversablef,Ordv)=>v->AlgfBoolcontainsVarAlgvt=foldlBoundVarsrunlocaltwherelocal=caseisVartofJustv'->v==v'Nothing->Falserunaccvarsb=acc||(not(v`Set.member`vars)&&b){-| This function checks whether a variable is contained in a context. -}containsVar::(Eqv,HasVarsfv,Traversablef,Ordv)=>v->Cxthfa->BoolcontainsVarv=free(containsVarAlgv)(constFalse)-- |Algebra for generating a set of variables contained in a term, except those-- that are bound.variablesAlg::(Ordv,HasVarsfv,Traversablef)=>Algf(Setv)variablesAlgt=foldlBoundVarsrunlocaltwherelocal=caseisVartofJustv->Set.singletonvNothing->Set.emptyrunaccbvarsvars=acc`Set.union`(vars`Set.difference`bvars){-| This function computes the list of variables occurring in a context. -}variableList::(Ordv,HasVarsfv,Traversablef)=>Cxthfa->[v]variableList=Set.toList.variables{-| This function computes the set of variables occurring in a context. -}variables::(Ordv,HasVarsfv,Traversablef)=>Cxthfa->Setvvariables=freevariablesAlg(constSet.empty){-| This function computes the set of variables occurring in a constant. -}variables'::(Ordv,HasVarsfv,Foldablef,Functorf)=>Constf->Setvvariables'c=caseisVarcofNothing->Set.emptyJustv->Set.singletonv{-| This multiparameter class defines substitution of values of type @t@ for
variables of type @v@ in values of type @a@. -}classSubstVarsvtawheresubstVars::(v->Maybet)->a->a-- |Apply the given substitution.appSubst::(Ordv,SubstVarsvta)=>Mapvt->a->aappSubstsubst=substVarsfwherefv=Map.lookupvsubstinstance(Ordv,HasVarsfv,Traversablef)=>SubstVarsv(Cxthfa)(Cxthfa)where-- have to use explicit GADT pattern matching!!-- subst f = free (substAlg f) HolesubstVarssubst=doSubstSet.emptywheredoSubst_(Holea)=HoleadoSubstb(Termt)=caseisVar'bt>>=substofJustnew->newNothing->Term$fmapBoundVarsruntwhererunvarss=doSubst(b`Set.union`vars)sinstance(SubstVarsvta,Functorf)=>SubstVarsvt(fa)wheresubstVarsf=fmap(substVarsf){-| This function composes two substitutions @s1@ and @s2@. That is,
applying the resulting substitution is equivalent to first applying
@s2@ and then @s1@. -}compSubst::(Ordv,HasVarsfv,Traversablef)=>CxtSubsthafv->CxtSubsthafv->CxtSubsthafvcompSubsts1s2=fmap(appSubsts1)s2`Map.union`s1