{-# LANGUAGE FlexibleContexts #-}--------------------------------------------------------------------------------- |-- Module : Data.Comp.Unification-- Copyright : (c) 2010-2011 Patrick Bahr-- License : BSD3-- Maintainer : Patrick Bahr <paba@diku.dk>-- Stability : experimental-- Portability : non-portable (GHC Extensions)---- This module implements a simple unification algorithm using compositional-- data types.----------------------------------------------------------------------------------moduleData.Comp.UnificationwhereimportData.Comp.TermimportData.Comp.VariablesimportData.Comp.DecomposeimportControl.Monad.ErrorimportControl.Monad.StateimportqualifiedData.MapasMap{-| This type represents equations between terms over a specific
signature. -}typeEquationf=(Termf,Termf){-| This type represents list of equations. -}typeEquationsf=[Equationf]{-| This type represents errors that might occur during the
unification. -}dataUnifErrorfv=FailedOccursCheckv(Termf)|HeadSymbolMismatch(Termf)(Termf)|UnifErrorStringinstanceError(UnifErrorfv)wherestrMsg=UnifError-- | This is used in order to signal a failed occurs check during-- unification.failedOccursCheck::(MonadError(UnifErrorfv)m)=>v->Termf->mafailedOccursCheckvt=throwError$FailedOccursCheckvt-- | This is used in order to signal a head symbol mismatch during-- unification.headSymbolMismatch::(MonadError(UnifErrorfv)m)=>Termf->Termf->maheadSymbolMismatchfg=throwError$HeadSymbolMismatchfg-- | This function applies a substitution to each term in a list of-- equations.appSubstEq::(Ordv,HasVarsfv,Functorf)=>Substfv->Equationf->EquationfappSubstEqs(t1,t2)=(appSubstst1,appSubstst2){-| This function returns the most general unifier of the given
equations using the algorithm of Martelli and Montanari. -}unify::(MonadError(UnifErrorfv)m,Decomposefv,Ordv,Eq(Constf))=>Equationsf->m(Substfv)unify=runUnifyMrunUnify-- | This type represents the state for the unification algorithm.dataUnifyStatefv=UnifyState{usEqs::Equationsf,usSubst::Substfv}-- | This is the unification monad that is used to run the unification-- algorithm.typeUnifyMfvma=StateT(UnifyStatefv)ma-- | This function runs a unification monad with the given initial-- list of equations.runUnifyM::MonadError(UnifErrorfv)m=>UnifyMfvma->Equationsf->m(Substfv)runUnifyMmeqs=liftM(usSubst.snd)$runStateTmUnifyState{usEqs=eqs,usSubst=Map.empty}withNextEq::Monadm=>(Equationf->UnifyMfvm())->UnifyMfvm()withNextEqm=doeqs<-getsusEqscaseeqsof[]->return()x:xs->modify(\s->s{usEqs=xs})>>mxputEqs::Monadm=>Equationsf->UnifyMfvm()putEqseqs=modifyaddEqswhereaddEqss=s{usEqs=eqs++usEqss}putBinding::(Monadm,Ordv,HasVarsfv,Functorf)=>(v,Termf)->UnifyMfvm()putBindingbind=modifyappSubstwherebinds=Map.fromList[bind]appSubsts=s{usEqs=map(appSubstEqbinds)(usEqss),usSubst=compSubstbinds(usSubsts)}runUnify::(MonadError(UnifErrorfv)m,Decomposefv,Ordv,Eq(Constf))=>UnifyMfvm()runUnify=withNextEq(\e->unifyStepe>>runUnify)unifyStep::(MonadError(UnifErrorfv)m,Decomposefv,Ordv,Eq(Constf))=>Equationf->UnifyMfvm()unifyStep(s,t)=casedecomposesofVarv1->casedecomposetofVarv2->unless(v1==v2)$putBinding(v1,t)_->ifcontainsVarv1tthenfailedOccursCheckv1telseputBinding(v1,t)Funs1args1->casedecomposetofVarv->ifcontainsVarvsthenfailedOccursCheckvselseputBinding(v,s)Funs2args2->ifs1==s2thenputEqs$zipargs1args2elseheadSymbolMismatchst