module Raaz.Core.Types.Equality
( Equality(..), (===)
, Result, isSuccessful
, oftenCorrectEqVector, eqVector
) where
import Control.Monad ( liftM )
import Data.Bits
#if !MIN_VERSION_base(4,8,0)
import Data.Monoid
#endif
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as GM
import Data.Vector.Unboxed ( MVector(..), Vector, Unbox )
import Data.Word
newtype Result = Result { unResult :: Word }
isSuccessful :: Result -> Bool
isSuccessful = (==0) . unResult
instance Monoid Result where
mempty = Result 0
mappend a b = Result (unResult a .|. unResult b)
newtype instance MVector s Result = MV_Result (MVector s Word)
newtype instance Vector Result = V_Result (Vector Word)
instance Unbox Result
instance GM.MVector MVector Result where
basicLength (MV_Result v) = GM.basicLength v
basicUnsafeSlice i n (MV_Result v) = MV_Result $ GM.basicUnsafeSlice i n v
basicOverlaps (MV_Result v1) (MV_Result v2) = GM.basicOverlaps v1 v2
basicUnsafeRead (MV_Result v) i = Result `liftM` GM.basicUnsafeRead v i
basicUnsafeWrite (MV_Result v) i (Result x) = GM.basicUnsafeWrite v i x
basicClear (MV_Result v) = GM.basicClear v
basicSet (MV_Result v) (Result x) = GM.basicSet v x
basicUnsafeNew n = MV_Result `liftM` GM.basicUnsafeNew n
basicUnsafeReplicate n (Result x) = MV_Result `liftM` GM.basicUnsafeReplicate n x
basicUnsafeCopy (MV_Result v1) (MV_Result v2) = GM.basicUnsafeCopy v1 v2
basicUnsafeGrow (MV_Result v) n = MV_Result `liftM` GM.basicUnsafeGrow v n
#if MIN_VERSION_vector(0,11,0)
basicInitialize (MV_Result v) = GM.basicInitialize v
#endif
instance G.Vector Vector Result where
basicUnsafeFreeze (MV_Result v) = V_Result `liftM` G.basicUnsafeFreeze v
basicUnsafeThaw (V_Result v) = MV_Result `liftM` G.basicUnsafeThaw v
basicLength (V_Result v) = G.basicLength v
basicUnsafeSlice i n (V_Result v) = V_Result $ G.basicUnsafeSlice i n v
basicUnsafeIndexM (V_Result v) i = Result `liftM` G.basicUnsafeIndexM v i
basicUnsafeCopy (MV_Result mv) (V_Result v) = G.basicUnsafeCopy mv v
elemseq _ (Result x) = G.elemseq (undefined :: Vector a) x
class Equality a where
eq :: a -> a -> Result
(===) :: Equality a => a -> a -> Bool
(===) a b = isSuccessful $ eq a b
instance Equality Word where
eq a b = Result $ a `xor` b
instance Equality Word8 where
eq w1 w2 = Result $ fromIntegral $ xor w1 w2
instance Equality Word16 where
eq w1 w2 = Result $ fromIntegral $ xor w1 w2
instance Equality Word32 where
eq w1 w2 = Result $ fromIntegral $ xor w1 w2
#include "MachDeps.h"
instance Equality Word64 where
#if WORD_SIZE_IN_BITS < 64
eq w1 w2 = eq w11 w21 `mappend` eq w12 w22
where
w11 :: Word
w12 :: Word
w21 :: Word
w22 :: Word
w11 = fromIntegral $ w1 `shiftR` 32
w12 = fromIntegral w1
w21 = fromIntegral $ w2 `shiftR` 32
w22 = fromIntegral w2
#else
eq w1 w2 = Result $ fromIntegral $ xor w1 w2
#endif
oftenCorrectEqVector :: (G.Vector v a, Equality a, G.Vector v Result) => v a -> v a -> Bool
oftenCorrectEqVector v1 v2 = isSuccessful $ G.foldl1' mappend $ G.zipWith eq v1 v2
eqVector :: (G.Vector v a, Equality a, G.Vector v Result) => v a -> v a -> Bool
eqVector v1 v2 | G.length v1 == G.length v2 = isSuccessful $ G.foldl' mappend (Result 0) $ G.zipWith eq v1 v2
| otherwise = False