module MuCheck.MuOp (MuOp
, (==>)
, (==>*)
, (*==>*)
, (~~>)
, mkMp'
, Mutable
) where
import Language.Haskell.Exts (Name, QName, QOp, Exp, Literal, GuardedRhs, Decl)
import qualified Data.Generics as G
import Control.Monad (MonadPlus, mzero)
data MuOp = N (Name, Name)
| QN (QName, QName)
| QO (QOp, QOp)
| E (Exp, Exp)
| D (Decl, Decl)
| L (Literal, Literal)
| G (GuardedRhs, GuardedRhs)
mkMp' (N (s,t)) = G.mkMp (s ~~> t)
mkMp' (QN (s,t)) = G.mkMp (s ~~> t)
mkMp' (QO (s,t)) = G.mkMp (s ~~> t)
mkMp' (E (s,t)) = G.mkMp (s ~~> t)
mkMp' (D (s,t)) = G.mkMp (s ~~> t)
mkMp' (L (s,t)) = G.mkMp (s ~~> t)
mkMp' (G (s,t)) = G.mkMp (s ~~> t)
showM (s, t) = "\n" ++ show s ++ " ==> " ++ show t
instance Show MuOp where
show (N a) = showM a
show (QN a) = showM a
show (QO a) = showM a
show (E a) = showM a
show (D a) = showM a
show (L a) = showM a
show (G a) = showM a
class Mutable a where
(==>) :: a -> a -> MuOp
(==>*) :: Mutable a => a -> [a] -> [MuOp]
(==>*) x lst = map (\i -> x ==> i) lst
(*==>*) :: Mutable a => [a] -> [a] -> [MuOp]
xs *==>* ys = concatMap (==>* ys) xs
(~~>) :: (MonadPlus m, Eq a) => a -> a -> (a -> m a)
x ~~> y = \z -> if z == x && x /= y then return y else mzero
instance Mutable Name where
(==>) = (N .) . (,)
instance Mutable QName where
(==>) = (QN .) . (,)
instance Mutable QOp where
(==>) = (QO .) . (,)
instance Mutable Exp where
(==>) = (E .) . (,)
instance Mutable Decl where
(==>) = (D .) . (,)
instance Mutable Literal where
(==>) = (L .) . (,)
instance Mutable GuardedRhs where
(==>) = (G .) . (,)