{-# LANGUAGE
    MagicHash
  , TypeOperators
  , DataKinds
  , BangPatterns
  , KindSignatures
  , TypeFamilies
  , StandaloneDeriving
  , GeneralizedNewtypeDeriving
  , TypeApplications
  , ScopedTypeVariables
  , InstanceSigs
  , BinaryLiterals
  , RankNTypes
  , UnboxedTuples
#-}

module Data.Word64Array.Word8
  ( WordArray(..)
  , Index(..)
  , toWordArray
  , readArray
  , writeArray
  , overIndex
  , iforWordArray
  , toList
  , toTuple
  , fromTuple
  , displayWordArray
  ) where

import Control.DeepSeq
import Data.MonoTraversable
import Data.Word
import Data.Maybe (fromMaybe)
import Data.Bits
import Numeric (showHex)
import Text.Show (showListWith)

{- Note [Representation of WordArray]
WordArray has its constituent Word8s packed in order from *left-to-right*, i.e.
the first Word8 occupies the most-significant bits.

Hence the offset to find the start of the ith Word8 is (-8*i) + 56.
-}

newtype WordArray = WordArray { WordArray -> Word64
fromWordArray :: Word64 }
  deriving (Int -> WordArray -> ShowS
[WordArray] -> ShowS
WordArray -> String
(Int -> WordArray -> ShowS)
-> (WordArray -> String)
-> ([WordArray] -> ShowS)
-> Show WordArray
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WordArray] -> ShowS
$cshowList :: [WordArray] -> ShowS
show :: WordArray -> String
$cshow :: WordArray -> String
showsPrec :: Int -> WordArray -> ShowS
$cshowsPrec :: Int -> WordArray -> ShowS
Show, WordArray -> WordArray -> Bool
(WordArray -> WordArray -> Bool)
-> (WordArray -> WordArray -> Bool) -> Eq WordArray
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WordArray -> WordArray -> Bool
$c/= :: WordArray -> WordArray -> Bool
== :: WordArray -> WordArray -> Bool
$c== :: WordArray -> WordArray -> Bool
Eq, Eq WordArray
Eq WordArray
-> (WordArray -> WordArray -> Ordering)
-> (WordArray -> WordArray -> Bool)
-> (WordArray -> WordArray -> Bool)
-> (WordArray -> WordArray -> Bool)
-> (WordArray -> WordArray -> Bool)
-> (WordArray -> WordArray -> WordArray)
-> (WordArray -> WordArray -> WordArray)
-> Ord WordArray
WordArray -> WordArray -> Bool
WordArray -> WordArray -> Ordering
WordArray -> WordArray -> WordArray
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: WordArray -> WordArray -> WordArray
$cmin :: WordArray -> WordArray -> WordArray
max :: WordArray -> WordArray -> WordArray
$cmax :: WordArray -> WordArray -> WordArray
>= :: WordArray -> WordArray -> Bool
$c>= :: WordArray -> WordArray -> Bool
> :: WordArray -> WordArray -> Bool
$c> :: WordArray -> WordArray -> Bool
<= :: WordArray -> WordArray -> Bool
$c<= :: WordArray -> WordArray -> Bool
< :: WordArray -> WordArray -> Bool
$c< :: WordArray -> WordArray -> Bool
compare :: WordArray -> WordArray -> Ordering
$ccompare :: WordArray -> WordArray -> Ordering
$cp1Ord :: Eq WordArray
Ord, WordArray -> ()
(WordArray -> ()) -> NFData WordArray
forall a. (a -> ()) -> NFData a
rnf :: WordArray -> ()
$crnf :: WordArray -> ()
NFData)

type instance Element WordArray = Word8

newtype Index = Index { Index -> Int
getIndex :: Int }
  deriving (Int -> Index -> ShowS
[Index] -> ShowS
Index -> String
(Int -> Index -> ShowS)
-> (Index -> String) -> ([Index] -> ShowS) -> Show Index
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Index] -> ShowS
$cshowList :: [Index] -> ShowS
show :: Index -> String
$cshow :: Index -> String
showsPrec :: Int -> Index -> ShowS
$cshowsPrec :: Int -> Index -> ShowS
Show, Integer -> Index
Index -> Index
Index -> Index -> Index
(Index -> Index -> Index)
-> (Index -> Index -> Index)
-> (Index -> Index -> Index)
-> (Index -> Index)
-> (Index -> Index)
-> (Index -> Index)
-> (Integer -> Index)
-> Num Index
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> Index
$cfromInteger :: Integer -> Index
signum :: Index -> Index
$csignum :: Index -> Index
abs :: Index -> Index
$cabs :: Index -> Index
negate :: Index -> Index
$cnegate :: Index -> Index
* :: Index -> Index -> Index
$c* :: Index -> Index -> Index
- :: Index -> Index -> Index
$c- :: Index -> Index -> Index
+ :: Index -> Index -> Index
$c+ :: Index -> Index -> Index
Num, Index -> Index -> Bool
(Index -> Index -> Bool) -> (Index -> Index -> Bool) -> Eq Index
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Index -> Index -> Bool
$c/= :: Index -> Index -> Bool
== :: Index -> Index -> Bool
$c== :: Index -> Index -> Bool
Eq, Eq Index
Eq Index
-> (Index -> Index -> Ordering)
-> (Index -> Index -> Bool)
-> (Index -> Index -> Bool)
-> (Index -> Index -> Bool)
-> (Index -> Index -> Bool)
-> (Index -> Index -> Index)
-> (Index -> Index -> Index)
-> Ord Index
Index -> Index -> Bool
Index -> Index -> Ordering
Index -> Index -> Index
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Index -> Index -> Index
$cmin :: Index -> Index -> Index
max :: Index -> Index -> Index
$cmax :: Index -> Index -> Index
>= :: Index -> Index -> Bool
$c>= :: Index -> Index -> Bool
> :: Index -> Index -> Bool
$c> :: Index -> Index -> Bool
<= :: Index -> Index -> Bool
$c<= :: Index -> Index -> Bool
< :: Index -> Index -> Bool
$c< :: Index -> Index -> Bool
compare :: Index -> Index -> Ordering
$ccompare :: Index -> Index -> Ordering
$cp1Ord :: Eq Index
Ord)

instance Bounded Index where
  maxBound :: Index
maxBound = Index
7
  minBound :: Index
minBound = Index
0

{-# INLINE toWordArray #-}
toWordArray :: Word64 -> WordArray
toWordArray :: Word64 -> WordArray
toWordArray = Word64 -> WordArray
WordArray

displayWordArray :: WordArray -> String
displayWordArray :: WordArray -> String
displayWordArray WordArray
wa = WordArray -> ShowS
displayWordArrayS WordArray
wa String
""
  where
  displayHex :: a -> ShowS
displayHex a
x String
s = String
"0x" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> a -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
showHex a
x String
s
  displayWordArrayS :: WordArray -> ShowS
displayWordArrayS = (Word8 -> ShowS) -> [Word8] -> ShowS
forall a. (a -> ShowS) -> [a] -> ShowS
showListWith Word8 -> ShowS
forall a. (Integral a, Show a) => a -> ShowS
displayHex ([Word8] -> ShowS) -> (WordArray -> [Word8]) -> WordArray -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WordArray -> [Word8]
WordArray -> [Element WordArray]
toList

{-# INLINE toTuple #-}
toTuple :: WordArray -> (# Element WordArray, Element WordArray, Element WordArray, Element WordArray, Element WordArray, Element WordArray, Element WordArray, Element WordArray #)
toTuple :: WordArray
-> (# Element WordArray, Element WordArray, Element WordArray,
      Element WordArray, Element WordArray, Element WordArray,
      Element WordArray, Element WordArray #)
toTuple (WordArray !Word64
w) = 
  let
    !w7 :: Word64
w7 = Word64
w
    !w6 :: Word64
w6 = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w7 Int
8
    !w5 :: Word64
w5 = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w6 Int
8
    !w4 :: Word64
w4 = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w5 Int
8
    !w3 :: Word64
w3 = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w4 Int
8
    !w2 :: Word64
w2 = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w3 Int
8
    !w1 :: Word64
w1 = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w2 Int
8
    !w0 :: Word64
w0 = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w1 Int
8
  in 
  (# Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w0
  ,  Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w1
  ,  Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w2
  ,  Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w3
  ,  Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w4
  ,  Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w5
  ,  Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w6
  ,  Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w7
  #)

{-# INLINE fromTuple #-}
fromTuple :: (# Element WordArray, Element WordArray, Element WordArray, Element WordArray, Element WordArray, Element WordArray, Element WordArray, Element WordArray #) -> WordArray
fromTuple :: (# Element WordArray, Element WordArray, Element WordArray,
   Element WordArray, Element WordArray, Element WordArray,
   Element WordArray, Element WordArray #)
-> WordArray
fromTuple (# !Element WordArray
w0, !Element WordArray
w1, !Element WordArray
w2, !Element WordArray
w3, !Element WordArray
w4, !Element WordArray
w5, !Element WordArray
w6, !Element WordArray
w7 #) =
    Word64 -> WordArray
WordArray
      (                (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
Element WordArray
w7)
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
Element WordArray
w6) Int
8
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
Element WordArray
w5) Int
16
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
Element WordArray
w4) Int
24
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
Element WordArray
w3) Int
32
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
Element WordArray
w2) Int
40
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
Element WordArray
w1) Int
48
      Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.|. Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
Element WordArray
w0) Int
56
      )

{-# INLINE toList #-}
toList :: WordArray -> [Element WordArray]
toList :: WordArray -> [Element WordArray]
toList WordArray
w =
  let (# !Word8
w0, !Word8
w1, !Word8
w2, !Word8
w3, !Word8
w4, !Word8
w5, !Word8
w6, !Word8
w7 #) = WordArray
-> (# Element WordArray, Element WordArray, Element WordArray,
      Element WordArray, Element WordArray, Element WordArray,
      Element WordArray, Element WordArray #)
toTuple WordArray
w
  in [Word8
Element WordArray
w0, Word8
Element WordArray
w1, Word8
Element WordArray
w2, Word8
Element WordArray
w3, Word8
Element WordArray
w4, Word8
Element WordArray
w5, Word8
Element WordArray
w6, Word8
Element WordArray
w7]

{-# INLINE readArray #-}
readArray :: WordArray -> Index -> Element WordArray
readArray :: WordArray -> Index -> Element WordArray
readArray (WordArray !Word64
w) !Index
i =
  -- See Note [Representation of WordArray]
  Word64 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word8) -> Word64 -> Word8
forall a b. (a -> b) -> a -> b
$ Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftR Word64
w (Index -> Int
offset Index
i)

{-# INLINE offset #-}
offset :: Index -> Int
offset :: Index -> Int
offset !Index
i = (-Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Index -> Int
getIndex Index
i) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
56

{-# INLINE writeArray #-}
writeArray :: WordArray -> Index -> Element WordArray -> WordArray
writeArray :: WordArray -> Index -> Element WordArray -> WordArray
writeArray (WordArray !Word64
w) !Index
i !Element WordArray
w8 =
  -- See Note [Representation of WordArray]
  let w64 :: Word64
      w64 :: Word64
w64 = Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
unsafeShiftL (Word8 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
Element WordArray
w8) (Index -> Int
offset Index
i)
  in Word64 -> WordArray
WordArray ((Word64
w Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
.&. Index -> Word64
mask Index
i) Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
+ Word64
w64)

{-# INLINE overIndex #-}
-- | Modify the word at a given index.
overIndex :: Index -> (Element WordArray -> Element WordArray) -> WordArray -> WordArray
overIndex :: Index
-> (Element WordArray -> Element WordArray)
-> WordArray
-> WordArray
overIndex !Index
i Element WordArray -> Element WordArray
f !WordArray
w = WordArray -> Index -> Element WordArray -> WordArray
writeArray WordArray
w Index
i (Element WordArray -> WordArray) -> Element WordArray -> WordArray
forall a b. (a -> b) -> a -> b
$ Element WordArray -> Element WordArray
f (Element WordArray -> Element WordArray)
-> Element WordArray -> Element WordArray
forall a b. (a -> b) -> a -> b
$ WordArray -> Index -> Element WordArray
readArray WordArray
w Index
i

{-# INLINE mask #-}
mask :: Index -> Word64
mask :: Index -> Word64
mask Index
0 = Word64
0x00ffffffffffffff
mask Index
1 = Word64
0xff00ffffffffffff
mask Index
2 = Word64
0xffff00ffffffffff
mask Index
3 = Word64
0xffffff00ffffffff
mask Index
4 = Word64
0xffffffff00ffffff
mask Index
5 = Word64
0xffffffffff00ffff
mask Index
6 = Word64
0xffffffffffff00ff
mask Index
7 = Word64
0xffffffffffffff00
mask Index
_ = String -> Word64
forall a. HasCallStack => String -> a
error String
"mask"

{-# INLINE iforWordArray #-}
iforWordArray :: Applicative f => WordArray -> (Int -> Element WordArray -> f ()) -> f ()
iforWordArray :: WordArray -> (Int -> Element WordArray -> f ()) -> f ()
iforWordArray !WordArray
w Int -> Element WordArray -> f ()
f =
  let (# !Word8
w0, !Word8
w1, !Word8
w2, !Word8
w3, !Word8
w4, !Word8
w5, !Word8
w6, !Word8
w7 #) = WordArray
-> (# Element WordArray, Element WordArray, Element WordArray,
      Element WordArray, Element WordArray, Element WordArray,
      Element WordArray, Element WordArray #)
toTuple WordArray
w
  in   Int -> Element WordArray -> f ()
f Int
0 Word8
Element WordArray
w0 f () -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Element WordArray -> f ()
f Int
1 Word8
Element WordArray
w1 f () -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Element WordArray -> f ()
f Int
2 Word8
Element WordArray
w2 f () -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Element WordArray -> f ()
f Int
3 Word8
Element WordArray
w3 
    f () -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Element WordArray -> f ()
f Int
4 Word8
Element WordArray
w4 f () -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Element WordArray -> f ()
f Int
5 Word8
Element WordArray
w5 f () -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Element WordArray -> f ()
f Int
6 Word8
Element WordArray
w6 f () -> f () -> f ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Element WordArray -> f ()
f Int
7 Word8
Element WordArray
w7

instance MonoFunctor WordArray where
  omap :: (Element WordArray -> Element WordArray) -> WordArray -> WordArray
omap Element WordArray -> Element WordArray
f WordArray
w =
    let (# !Word8
w0, !Word8
w1, !Word8
w2, !Word8
w3, !Word8
w4, !Word8
w5, !Word8
w6, !Word8
w7 #) = WordArray
-> (# Element WordArray, Element WordArray, Element WordArray,
      Element WordArray, Element WordArray, Element WordArray,
      Element WordArray, Element WordArray #)
toTuple WordArray
w
    in (# Element WordArray, Element WordArray, Element WordArray,
   Element WordArray, Element WordArray, Element WordArray,
   Element WordArray, Element WordArray #)
-> WordArray
fromTuple (# Element WordArray -> Element WordArray
f Word8
Element WordArray
w0, Element WordArray -> Element WordArray
f Word8
Element WordArray
w1, Element WordArray -> Element WordArray
f Word8
Element WordArray
w2, Element WordArray -> Element WordArray
f Word8
Element WordArray
w3, Element WordArray -> Element WordArray
f Word8
Element WordArray
w4, Element WordArray -> Element WordArray
f Word8
Element WordArray
w5, Element WordArray -> Element WordArray
f Word8
Element WordArray
w6, Element WordArray -> Element WordArray
f Word8
Element WordArray
w7 #)

instance MonoFoldable WordArray where
  {-# INLINE ofoldr #-}
  ofoldr :: (Element WordArray -> b -> b) -> b -> WordArray -> b
ofoldr Element WordArray -> b -> b
f !b
b !WordArray
w =
    let (# !Word8
w0, !Word8
w1, !Word8
w2, !Word8
w3, !Word8
w4, !Word8
w5, !Word8
w6, !Word8
w7 #) = WordArray
-> (# Element WordArray, Element WordArray, Element WordArray,
      Element WordArray, Element WordArray, Element WordArray,
      Element WordArray, Element WordArray #)
toTuple WordArray
w
    in  Element WordArray -> b -> b
f Word8
Element WordArray
w0 (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Element WordArray -> b -> b
f Word8
Element WordArray
w1 (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Element WordArray -> b -> b
f Word8
Element WordArray
w2 (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Element WordArray -> b -> b
f Word8
Element WordArray
w3 (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Element WordArray -> b -> b
f Word8
Element WordArray
w4 (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Element WordArray -> b -> b
f Word8
Element WordArray
w5 (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Element WordArray -> b -> b
f Word8
Element WordArray
w6 (b -> b) -> b -> b
forall a b. (a -> b) -> a -> b
$ Element WordArray -> b -> b
f Word8
Element WordArray
w7 b
b
  {-# INLINE ofoldl' #-}
  ofoldl' :: (a -> Element WordArray -> a) -> a -> WordArray -> a
ofoldl' a -> Element WordArray -> a
f a
z0 WordArray
xs = (Element WordArray -> (a -> a) -> a -> a)
-> (a -> a) -> WordArray -> a -> a
forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
ofoldr Word8 -> (a -> a) -> a -> a
Element WordArray -> (a -> a) -> a -> a
f' a -> a
forall a. a -> a
id WordArray
xs a
z0
    where f' :: Word8 -> (a -> a) -> a -> a
f' Word8
x a -> a
k a
z = a -> a
k (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$! a -> Element WordArray -> a
f a
z Word8
Element WordArray
x
  {-# INLINE ofoldMap #-}
  ofoldMap :: (Element WordArray -> m) -> WordArray -> m
ofoldMap Element WordArray -> m
f = (Element WordArray -> m -> m) -> m -> WordArray -> m
forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
ofoldr (m -> m -> m
forall a. Monoid a => a -> a -> a
mappend (m -> m -> m) -> (Word8 -> m) -> Word8 -> m -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word8 -> m
Element WordArray -> m
f) m
forall a. Monoid a => a
mempty
  {-# INLINE onull #-}
  onull :: WordArray -> Bool
onull WordArray
_ = Bool
False
  {-# INLINE oelem #-}
  oelem :: Element WordArray -> WordArray -> Bool
oelem Element WordArray
e = (Element WordArray -> Bool -> Bool) -> Bool -> WordArray -> Bool
forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
ofoldr (\Element WordArray
a Bool
b -> Word8
Element WordArray
a Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
Element WordArray
e Bool -> Bool -> Bool
|| Bool
b) Bool
False
  {-# INLINE ofoldr1Ex #-}
  ofoldr1Ex :: (Element WordArray -> Element WordArray -> Element WordArray)
-> WordArray -> Element WordArray
ofoldr1Ex Element WordArray -> Element WordArray -> Element WordArray
f WordArray
xs = Word8 -> Maybe Word8 -> Word8
forall a. a -> Maybe a -> a
fromMaybe 
      (String -> Word8
forall a. String -> a
errorWithoutStackTrace String
"error in word-array ofoldr1Ex: empty array")
      ((Element WordArray -> Maybe Word8 -> Maybe Word8)
-> Maybe Word8 -> WordArray -> Maybe Word8
forall mono b.
MonoFoldable mono =>
(Element mono -> b -> b) -> b -> mono -> b
ofoldr Word8 -> Maybe Word8 -> Maybe Word8
Element WordArray -> Maybe Word8 -> Maybe Word8
mf Maybe Word8
forall a. Maybe a
Nothing WordArray
xs)
    where
    mf :: Word8 -> Maybe Word8 -> Maybe Word8
mf Word8
x Maybe Word8
m = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$ case Maybe Word8
m of
      Maybe Word8
Nothing -> Word8
x
      Just Word8
y  -> Element WordArray -> Element WordArray -> Element WordArray
f Word8
Element WordArray
x Word8
Element WordArray
y
  {-# INLINE ofoldl1Ex' #-}
  ofoldl1Ex' :: (Element WordArray -> Element WordArray -> Element WordArray)
-> WordArray -> Element WordArray
ofoldl1Ex' Element WordArray -> Element WordArray -> Element WordArray
f WordArray
xs = Word8 -> Maybe Word8 -> Word8
forall a. a -> Maybe a -> a
fromMaybe 
      (String -> Word8
forall a. String -> a
errorWithoutStackTrace String
"error in word-array ofoldr1Ex: empty array")
      ((Maybe Word8 -> Element WordArray -> Maybe Word8)
-> Maybe Word8 -> WordArray -> Maybe Word8
forall mono a.
MonoFoldable mono =>
(a -> Element mono -> a) -> a -> mono -> a
ofoldl' Maybe Word8 -> Word8 -> Maybe Word8
Maybe Word8 -> Element WordArray -> Maybe Word8
mf Maybe Word8
forall a. Maybe a
Nothing WordArray
xs)
    where
    mf :: Maybe Word8 -> Word8 -> Maybe Word8
mf Maybe Word8
m Word8
y = Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Word8 -> Maybe Word8) -> Word8 -> Maybe Word8
forall a b. (a -> b) -> a -> b
$ case Maybe Word8
m of
      Maybe Word8
Nothing -> Word8
y
      Just Word8
x  -> Element WordArray -> Element WordArray -> Element WordArray
f Word8
Element WordArray
x Word8
Element WordArray
y