lojysamban-0.0.8: src/NotUnif.hs

module NotUnif (
	merge,
	Result,
	unification,
	Term(..),
	checkAll,
	checkNot,
	deleteFromNot,
	notUnification,
	apply,
	lookupValue,
) where

import Unif
import Control.Applicative
import Data.Maybe

checkAll :: (Eq sc, Eq s) =>
	[([Term sc s], Maybe (Term sc s))] -> [Maybe [(Term sc s, Term sc s)]]
		-> Bool
checkAll _ [] = True
checkAll r (Nothing : nots) = checkAll r nots
checkAll r (Just [] : nots) = checkAll r nots
checkAll r (Just n : nots) =
	checkNot r (deleteFromNot r n) && checkAll r nots

deleteFromNot :: (Eq sc, Eq s) =>
	[([Term sc s], Maybe (Term sc s))] -> [(Term sc s, Term sc s)] ->
		[(Term sc s, Term sc s)]
deleteFromNot _ [] = []
deleteFromNot r ((t@(Var _ _), u@(Var _ _)) : ps)
	| not $ any ((t `elem`) . fst) r = deleteFromNot r ps
	| not $ any ((u `elem`) . fst) r = deleteFromNot r ps
	| otherwise = (t, u) : deleteFromNot r ps
deleteFromNot r ((t, u) : ps) = (t, u) : deleteFromNot r ps

checkNot :: (Eq sc, Eq s) =>
	[([Term sc s], Maybe (Term sc s))] -> [(Term sc s, Term sc s)] -> Bool
checkNot _ [] = False
checkNot r ((t@(Var _ _), u@(Var _ _)) : ps)
	= not (any ((\vs -> t `elem` vs && u `elem` vs) . fst) r) ||
--		null (filter ((t `elem`) .fst) r) ||
--		null (filter ((u `elem`) .fst) r) ||
		checkNot r ps
checkNot r ((t@(Var _ _), u) : ps)
	= snd (head $ filter ((t `elem`) . fst) r) /= Just u || checkNot r ps
checkNot _ _ = error "bad"

notUnification :: (Eq sc, Eq s) =>
	[Term sc s] -> [Term sc s] -> Maybe [(Term sc s, Term sc s)]
notUnification ts us = simplify <$> notUnifies ts us

notUnify :: (Eq sc, Eq s) =>
	Term sc s -> Term sc s -> Maybe (Maybe (Term sc s, Term sc s))
notUnify t u | t == u = Nothing
notUnify (Con _) (Con _) = Just Nothing
notUnify t u = Just $ Just (t, u)

notUnifies :: (Eq sc, Eq s) =>
	[Term sc s] -> [Term sc s] -> Maybe [(Term sc s, Term sc s)]
notUnifies [] [] = Nothing
notUnifies [t] [u] = maybeToList <$> notUnify t u
notUnifies (t : ts) (u : us) = case notUnify t u of
	Nothing -> notUnifies ts us
	Just Nothing -> Just []
	Just (Just p) -> case notUnifies ts us of
		Nothing -> Just [p]
		Just [] -> Just []
		Just ps -> Just $ p : ps
notUnifies _ _ = Just []

-- simplify :: [(Term, Term)] -> [(Term, Term)]
simplify :: (Eq sc, Eq s) =>
	[(Term sc s, Term sc s)] -> [(Term sc s, Term sc s)]
simplify = checkSame . map (uncurry order)

-- checkSame :: [(Term, Term)] -> [(Term, Term)]
checkSame :: (Eq sc, Eq s) =>
	[(Term sc s, Term sc s)] -> [(Term sc s, Term sc s)]
checkSame [] = []
checkSame (p : ps) = mapMaybe (isSame p) ps ++ p : checkSame ps

-- isSame :: (Term, Term) -> (Term, Term) -> Maybe (Term, Term)
isSame :: Eq a => (a, a) -> (a, a) -> Maybe (a, a)
isSame (x, y) (z, w)
	| x == z = Just (y, w)
	| y == w = Just (x, z)
	| x == w = Just (y, z)
	| y == z = Just (x, w)
	| otherwise = Nothing

order :: Term sc s -> Term sc s -> (Term sc s, Term sc s)
order (Con _) (Con _) = error "not occur"
order t@(Var _ _) u@(Con _) = (t, u)
order t@(Con _) u@(Var _ _) = (u, t)
order t u = (t, u)