{-# LANGUAGE
CPP, FlexibleContexts, FlexibleInstances, TypeSynonymInstances,
MultiParamTypeClasses, DeriveDataTypeable, StandaloneDeriving,
TemplateHaskell, GeneralizedNewtypeDeriving, ViewPatterns
#-}{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}-- spurious warnings for view patterns-- |-- Copyright : (c) 2010, 2011 Benedikt Schmidt & Simon Meier-- License : GPL v3 (see LICENSE)-- -- Maintainer : Benedikt Schmidt <beschmi@gmail.com>---- Terms with logical variables and names.moduleTerm.LTerm(-- * NamesName(..),NameTag(..),NameId(..),NTerm-- ** Queries,sortOfName-- ** Construction,freshTerm,pubTerm-- * LVar,LSort(..),LVar(..),LTerm,LNTerm,freshLVar,sortPrefix,sortSuffix,sortCompare,sortOfLTerm,sortOfLNTerm,isMsgVar,isFreshVar,trivial,input-- ** Manging Free LVars,HasFrees(..),MonotoneFunction(..),occurs,freesList,frees,someInst,rename,renamePrecise,eqModuloFreshnessNoAC,avoid,evalFreshAvoiding,evalFreshTAvoiding,renameAvoiding-- * BVar,BVar(..),foldBVar,fromFree-- * Pretty-Printing,prettyLVar,prettyNTerm,prettyLNTerm-- * Convenience exports,moduleTerm.VTerm)whereimportTerm.VTermimportTerm.Rewriting.DefinitionsimportText.PrettyPrint.ClassimportControl.ApplicativeimportControl.Monad.FreshimportControl.Monad.BindimportControl.DeepSeqimportControl.Monad.IdentityimportData.DeriveTHimportqualifiedData.SetasSimportqualifiedData.MapasMimportData.Genericshiding(GT)importqualifiedData.DListasDimportData.TraversableimportData.MonoidimportData.BinaryimportData.Foldablehiding(concatMap,elem)importExtension.PreludeimportExtension.Data.MonoidimportLogic.Connectives-------------------------------------------------------------------------------- Names-------------------------------------------------------------------------------- | Type safety for names.newtypeNameId=NameId{getNameId::String}deriving(Eq,Ord,Typeable,Data,NFData,Binary)-- | Tags for names.dataNameTag=FreshName|PubNamederiving(Eq,Ord,Show,Typeable,Data)-- | Names.dataName=Name{nTag::NameTag,nId::NameId}deriving(Eq,Ord,Typeable,Data)-- | Terms with literals containing names and arbitrary variables.typeNTermv=VTermNamev-- Instances------------instanceIsConstNamewhereinstanceShowNamewhereshow(NameFreshNamen)="~'"++shown++"'"show(NamePubNamen)="'"++shown++"'"instanceShowNameIdwhereshow=getNameId-- Construction of terms with names------------------------------------- | @freshTerm f@ represents the fresh name @f@.freshTerm::String->NTermvfreshTerm=lit.Con.NameFreshName.NameId-- | @pubTerm f@ represents the pub name @f@.pubTerm::String->NTermvpubTerm=lit.Con.NamePubName.NameId-- | Return 'LSort' for given 'Name'.sortOfName::Name->LSortsortOfName(NameFreshName_)=LSortFreshsortOfName(NamePubName_)=LSortPub-------------------------------------------------------------------------------- LVar: logical variables-------------------------------------------------------------------------------- | Sorts for logical variables. They satisfy the following sub-sort relation:---- > LSortMsg < LSortMSet-- > LSortFresh < LSortMsg-- > LSortPub < LSortMsg--dataLSort=LSortPub-- ^ Arbitrary public names.|LSortFresh-- ^ Arbitrary fresh names.|LSortMsg-- ^ Arbitrary messages.|LSortMSet-- ^ Sort for multisets.|LSortNode-- ^ Sort for variables denoting nodes of derivation graphs.deriving(Eq,Ord,Show,Enum,Bounded,Typeable,Data)-- | Logical variables. Variables with the same name and index but different-- sorts are regarded as different variables.dataLVar=LVar{lvarName::String,lvarSort::!LSort,lvarIdx::!Integer}deriving(Typeable,Data)-- | Terms used for proving; i.e., variables fixed to logical variables.typeLTermc=VTermcLVar-- | Terms used for proving; i.e., variables fixed to logical variables-- and constants to Names.typeLNTerm=VTermNameLVar-- | @freshLVar v@ represents a fresh logical variable with name @v@.freshLVar::MonadFreshm=>String->LSort->mLVarfreshLVarns=LVarns<$>freshIdents1-- | Returns the most precise sort of an 'LTerm'.sortOfLTerm::Showc=>(c->LSort)->LTermc->LSortsortOfLTermsortOfConstt=caseviewTerm2tofLit2(Conc)->sortOfConstcLit2(Varlv)->lvarSortlvEmpty->LSortMSetFUnion_->LSortMSet_->LSortMsg-- | Returns the most precise sort of an 'LNTerm'.sortOfLNTerm::LNTerm->LSortsortOfLNTerm=sortOfLTermsortOfName-- | @sortCompare s1 s2@ compares @s1@ and @s2@ with respect to the partial order on sorts.-- Partial order: Node MSet-- |-- Msg-- / \-- Pub FreshsortCompare::LSort->LSort->MaybeOrderingsortCompares1s2=case(s1,s2)of(a,b)|a==b->JustEQ-- Node is incomparable to all other sorts, invalid input(LSortNode,_)->Nothing(_,LSortNode)->Nothing-- MSet is greater than all except Node(LSortMSet,_)->JustGT(_,LSortMSet)->JustLT-- Msg is greater than all sorts except Node and MSet(LSortMsg,_)->JustGT(_,LSortMsg)->JustLT-- The remaining combinations (Pub/Fresh) are incomparable_->Nothing-- | @sortPrefix s@ is the prefix we use for annotating variables of sort @s@.sortPrefix::LSort->StringsortPrefixLSortMsg=""sortPrefixLSortFresh="~"sortPrefixLSortPub="$"sortPrefixLSortNode="#"sortPrefixLSortMSet="%"-- | @sortSuffix s@ is the suffix we use for annotating variables of sort @s@.sortSuffix::LSort->StringsortSuffixLSortMsg="msg"sortSuffixLSortFresh="fresh"sortSuffixLSortPub="pub"sortSuffixLSortNode="node"sortSuffixLSortMSet="mset"-- | Is a term a message variable?isMsgVar::LNTerm->BoolisMsgVar(viewTerm->Lit(Varv))=(lvarSortv==LSortMsg)isMsgVar_=False-- | Is a term a fresh variable?isFreshVar::LNTerm->BoolisFreshVar(viewTerm->Lit(Varv))=(lvarSortv==LSortFresh)isFreshVar_=False-- | The required components to construct the message.input::LNTerm->[LNTerm]input(viewTerm2->FMultts)=concatMapinputtsinput(viewTerm2->FInvt1)=inputt1input(viewTerm2->FPairt1t2)=inputt1++inputt2inputt=[t]-- | Is a message trivial; i.e., can for sure be instantiated with something-- known to the intruder?trivial::LNTerm->Booltrivial(viewTerm->FApp_[])=Truetrivial(viewTerm->Lit(Con(NamePubName_)))=Truetrivial(viewTerm->Lit(Varv))=caselvarSortvofLSortPub->TrueLSortMsg->True_->Falsetrivial_=False-- BVar: Bound variables-------------------------- | Bound and free variables.dataBVarv=BoundInteger-- ^ A bound variable in De-Brujin notation.|Freev-- ^ A free variable.deriving(Eq,Ord,Show,Data,Typeable)-- | Fold a possibly bound variable.{-# INLINE foldBVar #-}foldBVar::(Integer->a)->(v->a)->BVarv->afoldBVarfBoundfFree=gowherego(Boundi)=fBoundigo(Freev)=fFreevinstanceFunctorBVarwherefmapf=foldBVarBound(Free.f)instanceFoldableBVarwherefoldMapf=foldBVarmemptyfinstanceTraversableBVarwheretraversef=foldBVar(pure.Bound)(fmapFree.f)instanceApplicativeBVarwherepure=return(<*>)=apinstanceMonadBVarwherereturn=Freem>>=f=foldBVarBoundfm-- | Extract the name of free variable under the assumption the variable is-- guaranteed to be of the form @Free a@.fromFree::BVarv->vfromFree(Freev)=vfromFree(Boundi)=error$"fromFree: bound variable '"++showi++"'"-- Instances------------instanceEqLVarwhere(LVarn1s1i1)==(LVarn2s2i2)=i1==i2&&s1==s2&&n1==n2-- An ord instane that prefers the 'lvarIdx' over the 'lvarName'.instanceOrdLVarwherecompare(LVarx1x2x3)(LVary1y2y3)=comparex3y3&comparex2y2&comparex1y1&EQwhereEQ&x=xx&_=xinstanceShowLVarwhereshow(LVarvsi)=sortPrefixs++bodywherebody|nullv=showi-- | isDigit (last v) = v ++ "." ++ show i|i==0=v|otherwise=v++"."++showiinstanceIsVarLVarwhere-------------------------------------------------------------------------------- Managing bound and free LVars-------------------------------------------------------------------------------- | For performance reasons, we distinguish between monotone functions on-- 'LVar's and arbitrary functions. The monotone functions much map 'LVar's to-- equal or larger 'LVar's. This ensures that the AC-normal form does not have-- to be recomputed. If you are unsure about what to use, then use the-- 'Arbitrary' function.dataMonotoneFunctionf=Monotone(LVar->fLVar)|Arbitrary(LVar->fLVar)-- | @HasFree t@ denotes that the type @t@ has free @LVar@ variables. They can-- be collected using 'foldFrees' and mapped in the context of an applicative-- functor using 'mapFrees'. ---- When defining instances of this class, you have to ensure that only the free-- LVars are collected and mapped and no others. The instances for standard-- Haskell types assume that all variables free in all type arguments are free.---- Once we need it, we can use type synonym instances to parametrize over the-- variable type.--classHasFreestwherefoldFrees::Monoidm=>(LVar->m)->t->mmapFrees::Applicativef=>MonotoneFunctionf->t->ft-- | @v `occurs` t@ iff variable @v@ occurs as a free variable in @t@.occurs::HasFreest=>LVar->t->Booloccursx=getAny.foldFrees(Any.(x==))-- | @freesDList t@ is the difference list of all free variables of @t@.freesDList::HasFreest=>t->D.DListLVarfreesDList=foldFreespure-- | @freesList t@ is the list of all free variables of @t@.freesList::HasFreest=>t->[LVar]freesList=D.toList.freesDList-- | @frees t@ is the sorted and duplicate-free list of all free variables in-- @t@.frees::HasFreest=>t->[LVar]frees=sortednub.freesList-- | @someInst t@ returns an instance of @t@ where all free variables whose-- binding is not yet determined by the caller are replaced with fresh-- variables.someInst::(MonadFreshm,MonadBindLVarLVarm,HasFreest)=>t->mtsomeInst=mapFrees(Arbitrary$\x->importBinding(`LVar`lvarSortx)x(lvarNamex))-- | @rename t@ replaces all variables in @t@ with fresh variables.-- Note that the result is not guaranteed to be equal for terms that are-- equal modulo changing the indices of variables.rename::(MonadFreshm,HasFreesa)=>a->marenamex=caseboundsVarIdxxofNothing->returnxJust(minVarIdx,maxVarIdx)->dofreshStart<-freshIdents(succ(maxVarIdx-minVarIdx))return.runIdentity.mapFrees(Monotone$incVar(freshStart-minVarIdx))$xwhereincVarshift(LVarnsoi)=pure$LVarnso(i+shift)-- | @renamePrecise t@ replaces all variables in @t@ with fresh variables.-- If 'Control.Monad.PreciseFresh' is used with non-AC terms and identical-- fresh state, the same result is returned for two terms that only differ-- in the indices of variables.renamePrecise::(MonadFreshm,HasFreesa)=>a->marenamePrecisex=evalBindT(someInstx)noBindings-- | @eqModuloFreshness t1 t2@ checks whether @t1@ is equal to @t2@ modulo-- renaming of indices of free variables. Note that the normal form is not-- unique with respect to AC symbols.eqModuloFreshnessNoAC::(HasFreesa,Eqa)=>a->a->BooleqModuloFreshnessNoACt1=-- this formulation shares normalisation of t1 among further calls to-- different t2.(normIndicest1==).normIndiceswherenormIndices=(`evalFresh`nothingUsed).(`evalBindT`noBindings).mapFrees(Arbitrary$\x->importBinding(`LVar`lvarSortx)x"")-- | The mininum and maximum index of all free variables.boundsVarIdx::HasFreest=>t->Maybe(Integer,Integer)boundsVarIdx=getMinMax.foldFrees(minMaxSingleton.lvarIdx)-- | @avoid t@ computes a 'FreshState' that avoids generating-- variables occurring in @t@.avoid::HasFreest=>t->FreshStateavoid=maybe0(succ.snd).boundsVarIdx-- | @m `evalFreshAvoiding` t@ evaluates the monadic action @m@ with a-- fresh-variable supply that avoids generating variables occurring in @t@.evalFreshAvoiding::HasFreest=>Fresha->t->aevalFreshAvoidingm=evalFreshm.avoid-- | @m `evalFreshTAvoiding` t@ evaluates the monadic action @m@ in the-- underlying monad with a fresh-variable supply that avoids generating-- variables occurring in @t@.evalFreshTAvoiding::(Monadm,HasFreest)=>FreshTma->t->maevalFreshTAvoidingm=evalFreshTm.avoid-- | @s `renameAvoiding` t@ replaces all free variables in @s@ by-- fresh variables avoiding variables in @t@.renameAvoiding::(HasFreess,HasFreest)=>s->t->ss`renameAvoiding`t=renames`evalFreshAvoiding`t-- Instances------------instanceHasFreesLVarwherefoldFrees=idmapFrees(Arbitraryf)=fmapFrees(Monotonef)=finstanceHasFreesv=>HasFrees(Litcv)wherefoldFreesf(Varx)=foldFreesfxfoldFrees__=memptymapFreesf(Varx)=Var<$>mapFreesfxmapFrees_l=purelinstanceHasFreesv=>HasFrees(BVarv)wherefoldFrees_(Bound_)=memptyfoldFreesf(Freev)=foldFreesfvmapFrees_b@(Bound_)=purebmapFreesf(Freev)=Free<$>mapFreesfvinstance(HasFreesl,Ordl)=>HasFrees(Terml)wherefoldFreesf=foldMap(foldFreesf)mapFreesf(viewTerm->Litl)=lit<$>mapFreesflmapFreesf@(Arbitrary_)(viewTerm->FAppol)=fAppo<$>mapFreesflmapFreesf@(Monotone_)(viewTerm->FAppol)=unsafefAppo<$>mapFreesflinstanceHasFreesa=>HasFrees(Equala)wherefoldFreesf=foldMap(foldFreesf)mapFreesf=traverse(mapFreesf)instanceHasFreesa=>HasFrees(Matcha)wherefoldFreesf=foldMap(foldFreesf)mapFreesf=traverse(mapFreesf)instanceHasFreesa=>HasFrees(RRulea)wherefoldFreesf=foldMap(foldFreesf)mapFreesf=traverse(mapFreesf)instanceHasFrees()wherefoldFrees_=constmemptymapFrees_=pureinstanceHasFreesIntwherefoldFrees_=constmemptymapFrees_=pureinstanceHasFreesIntegerwherefoldFrees_=constmemptymapFrees_=pureinstanceHasFreesBoolwherefoldFrees_=constmemptymapFrees_=pureinstanceHasFreesCharwherefoldFrees_=constmemptymapFrees_=pureinstanceHasFreesa=>HasFrees(Maybea)wherefoldFreesf=foldMap(foldFreesf)mapFreesf=traverse(mapFreesf)instance(HasFreesa,HasFreesb)=>HasFrees(Eitherab)wherefoldFreesf=either(foldFreesf)(foldFreesf)mapFreesf=either(fmapLeft.mapFreesf)(fmapRight.mapFreesf)instance(HasFreesa,HasFreesb)=>HasFrees(a,b)wherefoldFreesf(x,y)=foldFreesfx`mappend`foldFreesfymapFreesf(x,y)=(,)<$>mapFreesfx<*>mapFreesfyinstance(HasFreesa,HasFreesb,HasFreesc)=>HasFrees(a,b,c)wherefoldFreesf(x,y,z)=foldFreesf(x,(y,z))mapFreesf(x0,y0,z0)=(\(x,(y,z))->(x,y,z))<$>mapFreesf(x0,(y0,z0))instanceHasFreesa=>HasFrees[a]wherefoldFreesf=foldMap(foldFreesf)mapFreesf=traverse(mapFreesf)instanceHasFreesa=>HasFrees(Disja)wherefoldFreesf=foldMap(foldFreesf)mapFreesf=traverse(mapFreesf)instanceHasFreesa=>HasFrees(Conja)wherefoldFreesf=foldMap(foldFreesf)mapFreesf=traverse(mapFreesf)instance(Orda,HasFreesa)=>HasFrees(S.Seta)wherefoldFreesf=foldMap(foldFreesf)mapFreesf=fmapS.fromList.mapFreesf.S.toListinstance(Ordk,HasFreesk,HasFreesv)=>HasFrees(M.Mapkv)wherefoldFreesf=M.foldrWithKeycombinememptywherecombinekvm=foldFreesfk`mappend`(foldFreesfv`mappend`m)mapFreesf=fmapM.fromList.mapFreesf.M.toList-------------------------------------------------------------------------------- Pretty Printing-------------------------------------------------------------------------------- | Pretty print a 'LVar'.prettyLVar::Documentd=>LVar->dprettyLVar=text.show-- | Pretty print an @NTerm@.prettyNTerm::(Showv,Documentd)=>NTermv->dprettyNTerm=prettyTerm(text.show)-- | Pretty print an @LTerm@.prettyLNTerm::Documentd=>LNTerm->dprettyLNTerm=prettyNTerm-- derived instances--------------------$(derivemakeBinary''NameTag)$(derivemakeBinary''Name)$(derivemakeBinary''LSort)$(derivemakeBinary''LVar)$(derivemakeBinary''BVar)$(derivemakeNFData''NameTag)$(derivemakeNFData''Name)$(derivemakeNFData''LSort)$(derivemakeNFData''LVar)$(derivemakeNFData''BVar)