{-# 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
=== :: forall a. Equality a => 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 :: forall s. MVector s Result -> Int
basicLength (MV_Result MVector s Word
v) = MVector s Word -> Int
forall s. MVector s Word -> Int
forall (v :: * -> * -> *) a s. MVector v a => v s a -> Int
GM.basicLength MVector s Word
v
basicUnsafeSlice :: forall s. Int -> Int -> MVector s Result -> MVector s Result
basicUnsafeSlice Int
i Int
n (MV_Result MVector s Word
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 s. 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 :: forall s. MVector s Result -> MVector s Result -> Bool
basicOverlaps (MV_Result MVector s Word
v1) (MV_Result MVector s Word
v2) = MVector s Word -> MVector s Word -> Bool
forall s. 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 :: forall s. MVector s Result -> Int -> ST s Result
basicUnsafeRead (MV_Result MVector s Word
v) Int
i = Word -> Result
Result (Word -> Result) -> ST s Word -> ST s Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector s Word -> Int -> ST s Word
forall s. MVector s Word -> Int -> ST s Word
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s a
GM.basicUnsafeRead MVector s Word
v Int
i
basicUnsafeWrite :: forall s. MVector s Result -> Int -> Result -> ST s ()
basicUnsafeWrite (MV_Result MVector s Word
v) Int
i (Result Word
x) = MVector s Word -> Int -> Word -> ST s ()
forall s. MVector s Word -> Int -> Word -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> a -> ST s ()
GM.basicUnsafeWrite MVector s Word
v Int
i Word
x
basicClear :: forall s. MVector s Result -> ST s ()
basicClear (MV_Result MVector s Word
v) = MVector s Word -> ST s ()
forall s. MVector s Word -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
GM.basicClear MVector s Word
v
basicSet :: forall s. MVector s Result -> Result -> ST s ()
basicSet (MV_Result MVector s Word
v) (Result Word
x) = MVector s Word -> Word -> ST s ()
forall s. MVector s Word -> Word -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> a -> ST s ()
GM.basicSet MVector s Word
v Word
x
basicUnsafeNew :: forall s. Int -> ST s (MVector s Result)
basicUnsafeNew Int
n = MVector s Word -> MVector s Result
forall s. MVector s Word -> MVector s Result
MV_Result (MVector s Word -> MVector s Result)
-> ST s (MVector s Word) -> ST s (MVector s Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ST s (MVector s Word)
forall s. Int -> ST s (MVector s Word)
forall (v :: * -> * -> *) a s. MVector v a => Int -> ST s (v s a)
GM.basicUnsafeNew Int
n
basicUnsafeReplicate :: forall s. Int -> Result -> ST s (MVector s Result)
basicUnsafeReplicate Int
n (Result Word
x) = MVector s Word -> MVector s Result
forall s. MVector s Word -> MVector s Result
MV_Result (MVector s Word -> MVector s Result)
-> ST s (MVector s Word) -> ST s (MVector s Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Word -> ST s (MVector s Word)
forall s. Int -> Word -> ST s (MVector s Word)
forall (v :: * -> * -> *) a s.
MVector v a =>
Int -> a -> ST s (v s a)
GM.basicUnsafeReplicate Int
n Word
x
basicUnsafeCopy :: forall s. MVector s Result -> MVector s Result -> ST s ()
basicUnsafeCopy (MV_Result MVector s Word
v1) (MV_Result MVector s Word
v2) = MVector s Word -> MVector s Word -> ST s ()
forall s. MVector s Word -> MVector s Word -> ST s ()
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> v s a -> ST s ()
GM.basicUnsafeCopy MVector s Word
v1 MVector s Word
v2
basicUnsafeGrow :: forall s. MVector s Result -> Int -> ST s (MVector s Result)
basicUnsafeGrow (MV_Result MVector s Word
v) Int
n = MVector s Word -> MVector s Result
forall s. MVector s Word -> MVector s Result
MV_Result (MVector s Word -> MVector s Result)
-> ST s (MVector s Word) -> ST s (MVector s Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MVector s Word -> Int -> ST s (MVector s Word)
forall s. MVector s Word -> Int -> ST s (MVector s Word)
forall (v :: * -> * -> *) a s.
MVector v a =>
v s a -> Int -> ST s (v s a)
GM.basicUnsafeGrow MVector s Word
v Int
n
basicInitialize :: forall s. MVector s Result -> ST s ()
basicInitialize (MV_Result MVector s Word
v) = MVector s Word -> ST s ()
forall s. MVector s Word -> ST s ()
forall (v :: * -> * -> *) a s. MVector v a => v s a -> ST s ()
GM.basicInitialize MVector s Word
v
instance G.Vector Vector Result where
{-# INLINE basicUnsafeFreeze #-}
{-# INLINE basicUnsafeThaw #-}
{-# INLINE basicLength #-}
{-# INLINE basicUnsafeSlice #-}
{-# INLINE basicUnsafeIndexM #-}
{-# INLINE elemseq #-}
basicUnsafeFreeze :: forall s. Mutable Vector s Result -> ST s (Vector Result)
basicUnsafeFreeze (MV_Result MVector s Word
v) = Vector Word -> Vector Result
V_Result (Vector Word -> Vector Result)
-> ST s (Vector Word) -> ST s (Vector Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mutable Vector s Word -> ST s (Vector Word)
forall s. Mutable Vector s Word -> ST s (Vector Word)
forall (v :: * -> *) a s. Vector v a => Mutable v s a -> ST s (v a)
G.basicUnsafeFreeze Mutable Vector s Word
MVector s Word
v
basicUnsafeThaw :: forall s. Vector Result -> ST s (Mutable Vector s Result)
basicUnsafeThaw (V_Result Vector Word
v) = MVector s Word -> MVector s Result
forall s. MVector s Word -> MVector s Result
MV_Result (MVector s Word -> MVector s Result)
-> ST s (MVector s Word) -> ST s (MVector s Result)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Word -> ST s (Mutable Vector s Word)
forall s. Vector Word -> ST s (Mutable Vector s Word)
forall (v :: * -> *) a s. Vector v a => v a -> ST s (Mutable v s a)
G.basicUnsafeThaw Vector Word
v
basicLength :: Vector Result -> Int
basicLength (V_Result Vector Word
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 Vector Word
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 -> Box Result
basicUnsafeIndexM (V_Result Vector Word
v) Int
i = Word -> Result
Result (Word -> Result) -> Box Word -> Box Result
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Vector Word -> Int -> Box Word
forall (v :: * -> *) a. Vector v a => v a -> Int -> Box a
G.basicUnsafeIndexM Vector Word
v Int
i
basicUnsafeCopy :: forall s. Mutable Vector s Result -> Vector Result -> ST s ()
basicUnsafeCopy (MV_Result MVector s Word
mv) (V_Result Vector Word
v) = Mutable Vector s Word -> Vector Word -> ST s ()
forall s. Mutable Vector s Word -> Vector Word -> ST s ()
forall (v :: * -> *) a s.
Vector v a =>
Mutable v s a -> v a -> ST s ()
G.basicUnsafeCopy Mutable Vector s Word
MVector s Word
mv Vector Word
v
elemseq :: forall b. Vector Result -> Result -> b -> b
elemseq Vector Result
_ (Result Word
x) = Vector Word -> Word -> b -> b
forall b. Vector Word -> Word -> b -> b
forall (v :: * -> *) a b. Vector v a => v a -> a -> b -> b
G.elemseq (Vector a
forall {a}. Vector a
forall a. HasCallStack => a
undefined :: Vector a) Word
x