Difference.hs

-----------------------------------------------------------------------------
-- Copyright 2018, Ideas project team. This file is distributed under the
-- terms of the Apache License 2.0. For more information, see the files
-- "LICENSE.txt" and "NOTICE.txt", which are included in the distribution.
-----------------------------------------------------------------------------
-- |
-- Maintainer  :  bastiaan.heeren@ou.nl
-- Stability   :  provisional
-- Portability :  portable (depends on ghc)
--
-- Compute the difference of two terms generically, taking associativity
-- into account.
--
-----------------------------------------------------------------------------

module Ideas.Common.Rewriting.Difference (difference, differenceWith) where

import Control.Monad
import Data.Function
import Data.Maybe
import Ideas.Common.Rewriting.Term
import Ideas.Common.View

difference :: IsTerm a => a -> a -> Maybe (a, a)
difference = differenceWith termView

differenceWith :: View Term a -> a -> a -> Maybe (a, a)
differenceWith v a b = do
   (t1, t2) <- diffTerm (build v a) (build v b)
   liftM2 (,) (match v t1) (match v t2)

-- returns a result if the terms are different
diffTerm :: Term -> Term -> Maybe (Term, Term)
diffTerm p q =
   case (getFunctionA p, getFunctionA q) of
      (Just (s1, ps), Just (s2, qs))
         | s1 == s2  -> diffList ps qs
         | otherwise -> here
      _  | p == q    -> Nothing
         | otherwise -> here
 where
   here = Just (p, q)

   diffList xs ys
      | length xs /= length ys = here
      | otherwise =
           case catMaybes (zipWith diffTerm xs ys) of
              []    -> Nothing
              [one] -> Just one
              _     -> here

getFunctionA :: (Monad m, WithFunctions a) => a -> m (Symbol, [a])
getFunctionA a = f <$> getFunction a
 where
   f (s, xs) = (s, if isAssociative s then collectSym s a else xs)

collectSym :: WithFunctions a => Symbol -> a -> [a]
collectSym s a = maybe [a] (uncurry ((++) `on` collectSym s)) (isBinary s a)