{-# OPTIONS_HADDOCK hide #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleContexts #-}
module Raaz.Core.Types.Equality
(
Equality(..), (===)
, Result
) where
import qualified Data.Vector.Generic as G
import qualified Data.Vector.Generic.Mutable as GM
import Data.Vector.Unboxed ( MVector(..), Vector, Unbox )
import Raaz.Core.Prelude
class Equality a where
eq :: a -> a -> Result
(===) :: Equality a => a -> a -> Bool
=== :: a -> a -> Bool
(===) a
a a
b = Result -> Bool
isSuccessful (Result -> Bool) -> Result -> Bool
forall a b. (a -> b) -> a -> b
$ a -> a -> Result
forall a. Equality a => a -> a -> Result
eq a
a a
b
instance Equality Word where
eq :: Word -> Word -> Result
eq Word
a Word
b = Word -> Result
Result (Word -> Result) -> Word -> Result
forall a b. (a -> b) -> a -> b
$ Word
a Word -> Word -> Word
forall a. Bits a => a -> a -> a
`xor` Word
b
instance Equality Word8 where
eq :: Word8 -> Word8 -> Result
eq Word8
w1 Word8
w2 = Word -> Result
Result (Word -> Result) -> Word -> Result
forall a b. (a -> b) -> a -> b
$ Word8 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word8 -> Word) -> Word8 -> Word
forall a b. (a -> b) -> a -> b
$ Word8 -> Word8 -> Word8
forall a. Bits a => a -> a -> a
xor Word8
w1 Word8
w2
instance Equality Word16 where
eq :: Word16 -> Word16 -> Result
eq Word16
w1 Word16
w2 = Word -> Result
Result (Word -> Result) -> Word -> Result
forall a b. (a -> b) -> a -> b
$ Word16 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word16 -> Word) -> Word16 -> Word
forall a b. (a -> b) -> a -> b
$ Word16 -> Word16 -> Word16
forall a. Bits a => a -> a -> a
xor Word16
w1 Word16
w2
instance Equality Word32 where
eq :: Word32 -> Word32 -> Result
eq Word32
w1 Word32
w2 = Word -> Result
Result (Word -> Result) -> Word -> Result
forall a b. (a -> b) -> a -> b
$ Word32 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Word) -> Word32 -> Word
forall a b. (a -> b) -> a -> b
$ Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
xor Word32
w1 Word32
w2
#ifndef __HLINT__
#include "MachDeps.h"
#endif
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 :: Word64 -> Word64 -> Result
eq Word64
w1 Word64
w2 = Word -> Result
Result (Word -> Result) -> Word -> Result
forall a b. (a -> b) -> a -> b
$ Word64 -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word) -> Word64 -> Word
forall a b. (a -> b) -> a -> b
$ Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
xor Word64
w1 Word64
w2
#endif
instance ( Equality a
, Equality b
) => Equality (a , b) where
eq :: (a, b) -> (a, b) -> Result
eq (a
a1,b
a2) (a
b1,b
b2) = a -> a -> Result
forall a. Equality a => a -> a -> Result
eq a
a1 a
b1 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend` b -> b -> Result
forall a. Equality a => a -> a -> Result
eq b
a2 b
b2
instance ( Equality a
, Equality b
, Equality c
) => Equality (a , b, c) where
eq :: (a, b, c) -> (a, b, c) -> Result
eq (a
a1,b
a2,c
a3) (a
b1,b
b2,c
b3) = a -> a -> Result
forall a. Equality a => a -> a -> Result
eq a
a1 a
b1 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
b -> b -> Result
forall a. Equality a => a -> a -> Result
eq b
a2 b
b2 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
c -> c -> Result
forall a. Equality a => a -> a -> Result
eq c
a3 c
b3
instance ( Equality a
, Equality b
, Equality c
, Equality d
) => Equality (a , b, c, d) where
eq :: (a, b, c, d) -> (a, b, c, d) -> Result
eq (a
a1,b
a2,c
a3,d
a4) (a
b1,b
b2,c
b3,d
b4) = a -> a -> Result
forall a. Equality a => a -> a -> Result
eq a
a1 a
b1 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
b -> b -> Result
forall a. Equality a => a -> a -> Result
eq b
a2 b
b2 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
c -> c -> Result
forall a. Equality a => a -> a -> Result
eq c
a3 c
b3 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
d -> d -> Result
forall a. Equality a => a -> a -> Result
eq d
a4 d
b4
instance ( Equality a
, Equality b
, Equality c
, Equality d
, Equality e
) => Equality (a , b, c, d, e) where
eq :: (a, b, c, d, e) -> (a, b, c, d, e) -> Result
eq (a
a1,b
a2,c
a3,d
a4,e
a5) (a
b1,b
b2,c
b3,d
b4,e
b5) = a -> a -> Result
forall a. Equality a => a -> a -> Result
eq a
a1 a
b1 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
b -> b -> Result
forall a. Equality a => a -> a -> Result
eq b
a2 b
b2 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
c -> c -> Result
forall a. Equality a => a -> a -> Result
eq c
a3 c
b3 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
d -> d -> Result
forall a. Equality a => a -> a -> Result
eq d
a4 d
b4 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
e -> e -> Result
forall a. Equality a => a -> a -> Result
eq e
a5 e
b5
instance ( Equality a
, Equality b
, Equality c
, Equality d
, Equality e
, Equality f
) => Equality (a , b, c, d, e, f) where
eq :: (a, b, c, d, e, f) -> (a, b, c, d, e, f) -> Result
eq (a
a1,b
a2,c
a3,d
a4,e
a5,f
a6) (a
b1,b
b2,c
b3,d
b4,e
b5,f
b6) = a -> a -> Result
forall a. Equality a => a -> a -> Result
eq a
a1 a
b1 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
b -> b -> Result
forall a. Equality a => a -> a -> Result
eq b
a2 b
b2 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
c -> c -> Result
forall a. Equality a => a -> a -> Result
eq c
a3 c
b3 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
d -> d -> Result
forall a. Equality a => a -> a -> Result
eq d
a4 d
b4 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
e -> e -> Result
forall a. Equality a => a -> a -> Result
eq e
a5 e
b5 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
f -> f -> Result
forall a. Equality a => a -> a -> Result
eq f
a6 f
b6
instance ( Equality a
, Equality b
, Equality c
, Equality d
, Equality e
, Equality f
, Equality g
) => Equality (a , b, c, d, e, f, g) where
eq :: (a, b, c, d, e, f, g) -> (a, b, c, d, e, f, g) -> Result
eq (a
a1,b
a2,c
a3,d
a4,e
a5,f
a6,g
a7) (a
b1,b
b2,c
b3,d
b4,e
b5,f
b6,g
b7) = a -> a -> Result
forall a. Equality a => a -> a -> Result
eq a
a1 a
b1 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
b -> b -> Result
forall a. Equality a => a -> a -> Result
eq b
a2 b
b2 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
c -> c -> Result
forall a. Equality a => a -> a -> Result
eq c
a3 c
b3 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
d -> d -> Result
forall a. Equality a => a -> a -> Result
eq d
a4 d
b4 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
e -> e -> Result
forall a. Equality a => a -> a -> Result
eq e
a5 e
b5 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
f -> f -> Result
forall a. Equality a => a -> a -> Result
eq f
a6 f
b6 Result -> Result -> Result
forall a. Monoid a => a -> a -> a
`mappend`
g -> g -> Result
forall a. Equality a => a -> a -> Result
eq g
a7 g
b7
newtype Result = Result { Result -> Word
unResult :: Word }
instance Semigroup Result where
<> :: Result -> Result -> Result
(<>) Result
a Result
b = Word -> Result
Result (Result -> Word
unResult Result
a Word -> Word -> Word
forall a. Bits a => a -> a -> a
.|. Result -> Word
unResult Result
b)
instance Monoid Result where
mempty :: Result
mempty = Word -> Result
Result Word
0
mappend :: Result -> Result -> Result
mappend = Result -> Result -> Result
forall a. Semigroup a => a -> a -> a
(<>)
{-# INLINE mempty #-}
{-# INLINE mappend #-}
isSuccessful :: Result -> Bool
{-# INLINE isSuccessful #-}
isSuccessful :: Result -> Bool
isSuccessful = (Word -> Word -> Bool
forall a. Eq a => a -> a -> Bool
==Word
0) (Word -> Bool) -> (Result -> Word) -> Result -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Result -> Word
unResult
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
{-# INLINE basicLength #-}
{-# INLINE basicUnsafeSlice #-}
{-# INLINE basicOverlaps #-}
{-# INLINE basicUnsafeNew #-}
{-# INLINE basicUnsafeReplicate #-}
{-# INLINE basicUnsafeRead #-}
{-# INLINE basicUnsafeWrite #-}
{-# INLINE basicClear #-}
{-# INLINE basicSet #-}
{-# INLINE basicUnsafeCopy #-}
{-# INLINE basicUnsafeGrow #-}
basicLength :: MVector s Result -> Int
basicLength (MV_Result v) = MVector s Word -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
GM.basicLength MVector s Word
v
basicUnsafeSlice :: Int -> Int -> MVector s Result -> MVector s Result
basicUnsafeSlice Int
i Int
n (MV_Result v) = MVector s Word -> MVector s Result
forall s. MVector s Word -> MVector s Result
MV_Result (MVector s Word -> MVector s Result)
-> MVector s Word -> MVector s Result
forall a b. (a -> b) -> a -> b
$ Int -> Int -> MVector s Word -> MVector s Word
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> Int -> v s a -> v s a
GM.basicUnsafeSlice Int
i Int
n MVector s Word
v
basicOverlaps :: MVector s Result -> MVector s Result -> Bool
basicOverlaps (MV_Result v1) (MV_Result v2) = MVector s Word -> MVector s Word -> Bool
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> Bool
GM.basicOverlaps MVector s Word
v1 MVector s Word
v2
basicUnsafeRead :: MVector (PrimState m) Result -> Int -> m Result
basicUnsafeRead (MV_Result v) Int
i = Word -> Result
Result (Word -> Result) -> m Word -> m Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) Word -> Int -> m Word
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m a
GM.basicUnsafeRead MVector (PrimState m) Word
v Int
i
basicUnsafeWrite :: MVector (PrimState m) Result -> Int -> Result -> m ()
basicUnsafeWrite (MV_Result v) Int
i (Result Word
x) = MVector (PrimState m) Word -> Int -> Word -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> a -> m ()
GM.basicUnsafeWrite MVector (PrimState m) Word
v Int
i Word
x
basicClear :: MVector (PrimState m) Result -> m ()
basicClear (MV_Result v) = MVector (PrimState m) Word -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
GM.basicClear MVector (PrimState m) Word
v
basicSet :: MVector (PrimState m) Result -> Result -> m ()
basicSet (MV_Result v) (Result Word
x) = MVector (PrimState m) Word -> Word -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> a -> m ()
GM.basicSet MVector (PrimState m) Word
v Word
x
basicUnsafeNew :: Int -> m (MVector (PrimState m) Result)
basicUnsafeNew Int
n = MVector (PrimState m) Word -> MVector (PrimState m) Result
forall s. MVector s Word -> MVector s Result
MV_Result (MVector (PrimState m) Word -> MVector (PrimState m) Result)
-> m (MVector (PrimState m) Word)
-> m (MVector (PrimState m) Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> m (MVector (PrimState m) Word)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> m (v (PrimState m) a)
GM.basicUnsafeNew Int
n
basicUnsafeReplicate :: Int -> Result -> m (MVector (PrimState m) Result)
basicUnsafeReplicate Int
n (Result Word
x) = MVector (PrimState m) Word -> MVector (PrimState m) Result
forall s. MVector s Word -> MVector s Result
MV_Result (MVector (PrimState m) Word -> MVector (PrimState m) Result)
-> m (MVector (PrimState m) Word)
-> m (MVector (PrimState m) Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Word -> m (MVector (PrimState m) Word)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
Int -> a -> m (v (PrimState m) a)
GM.basicUnsafeReplicate Int
n Word
x
basicUnsafeCopy :: MVector (PrimState m) Result
-> MVector (PrimState m) Result -> m ()
basicUnsafeCopy (MV_Result v1) (MV_Result v2) = MVector (PrimState m) Word -> MVector (PrimState m) Word -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> v (PrimState m) a -> m ()
GM.basicUnsafeCopy MVector (PrimState m) Word
v1 MVector (PrimState m) Word
v2
basicUnsafeGrow :: MVector (PrimState m) Result
-> Int -> m (MVector (PrimState m) Result)
basicUnsafeGrow (MV_Result v) Int
n = MVector (PrimState m) Word -> MVector (PrimState m) Result
forall s. MVector s Word -> MVector s Result
MV_Result (MVector (PrimState m) Word -> MVector (PrimState m) Result)
-> m (MVector (PrimState m) Word)
-> m (MVector (PrimState m) Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector (PrimState m) Word -> Int -> m (MVector (PrimState m) Word)
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> Int -> m (v (PrimState m) a)
GM.basicUnsafeGrow MVector (PrimState m) Word
v Int
n
basicInitialize :: MVector (PrimState m) Result -> m ()
basicInitialize (MV_Result v) = MVector (PrimState m) Word -> m ()
forall (v :: * -> * -> *) a (m :: * -> *).
(MVector v a, PrimMonad m) =>
v (PrimState m) a -> m ()
GM.basicInitialize MVector (PrimState m) Word
v
instance G.Vector Vector Result where
{-# INLINE basicUnsafeFreeze #-}
{-# INLINE basicUnsafeThaw #-}
{-# INLINE basicLength #-}
{-# INLINE basicUnsafeSlice #-}
{-# INLINE basicUnsafeIndexM #-}
{-# INLINE elemseq #-}
basicUnsafeFreeze :: Mutable Vector (PrimState m) Result -> m (Vector Result)
basicUnsafeFreeze (MV_Result v) = Vector Word -> Vector Result
V_Result (Vector Word -> Vector Result)
-> m (Vector Word) -> m (Vector Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector (PrimState m) Word -> m (Vector Word)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> m (v a)
G.basicUnsafeFreeze MVector (PrimState m) Word
Mutable Vector (PrimState m) Word
v
basicUnsafeThaw :: Vector Result -> m (Mutable Vector (PrimState m) Result)
basicUnsafeThaw (V_Result v) = MVector (PrimState m) Word -> MVector (PrimState m) Result
forall s. MVector s Word -> MVector s Result
MV_Result (MVector (PrimState m) Word -> MVector (PrimState m) Result)
-> m (MVector (PrimState m) Word)
-> m (MVector (PrimState m) Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Word -> m (Mutable Vector (PrimState m) Word)
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
v a -> m (Mutable v (PrimState m) a)
G.basicUnsafeThaw Vector Word
v
basicLength :: Vector Result -> Int
basicLength (V_Result v) = Vector Word -> Int
forall (v :: * -> *) a. Vector v a => v a -> Int
G.basicLength Vector Word
v
basicUnsafeSlice :: Int -> Int -> Vector Result -> Vector Result
basicUnsafeSlice Int
i Int
n (V_Result v) = Vector Word -> Vector Result
V_Result (Vector Word -> Vector Result) -> Vector Word -> Vector Result
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Vector Word -> Vector Word
forall (v :: * -> *) a. Vector v a => Int -> Int -> v a -> v a
G.basicUnsafeSlice Int
i Int
n Vector Word
v
basicUnsafeIndexM :: Vector Result -> Int -> m Result
basicUnsafeIndexM (V_Result v) Int
i = Word -> Result
Result (Word -> Result) -> m Word -> m Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Word -> Int -> m Word
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, Monad m) =>
v a -> Int -> m a
G.basicUnsafeIndexM Vector Word
v Int
i
basicUnsafeCopy :: Mutable Vector (PrimState m) Result -> Vector Result -> m ()
basicUnsafeCopy (MV_Result mv) (V_Result v) = Mutable Vector (PrimState m) Word -> Vector Word -> m ()
forall (v :: * -> *) a (m :: * -> *).
(Vector v a, PrimMonad m) =>
Mutable v (PrimState m) a -> v a -> m ()
G.basicUnsafeCopy MVector (PrimState m) Word
Mutable Vector (PrimState m) Word
mv Vector Word
v
elemseq :: Vector Result -> Result -> b -> b
elemseq Vector Result
_ (Result Word
x) = Vector Word -> Word -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (forall a. Vector a
forall a. HasCallStack => a
undefined :: Vector a) Word
x