word-array (empty) → 0.1.0.0
raw patch · 6 files changed
+439/−0 lines, 6 filesdep +HUnitdep +QuickCheckdep +base
Dependencies added: HUnit, QuickCheck, base, deepseq, mono-traversable, primitive, quickcheck-classes, tasty, tasty-bench, tasty-hunit, tasty-quickcheck, transformers, vector, weigh, word-array
Files
- CHANGELOG.md +5/−0
- LICENSE +20/−0
- bench/Main.hs +81/−0
- src/Data/Word64Array/Word8.hs +188/−0
- test/Main.hs +72/−0
- word-array.cabal +73/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for word-array++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2021 Zachary Churchill++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ bench/Main.hs view
@@ -0,0 +1,81 @@+{-# LANGUAGE+ BangPatterns+ , GADTs+ , DeriveGeneric+ , StandaloneDeriving+ , MagicHash+ , DataKinds+ , GeneralizedNewtypeDeriving+ , TypeApplications+ , ScopedTypeVariables+#-}++{-# OPTIONS_GHC+ -fno-warn-orphans+#-}++import Control.Monad.Primitive+import Data.Functor.Identity (Identity(Identity))+import Data.Primitive+import Data.Word+import Data.Word64Array.Word8+import Test.Tasty.Bench (bench, bgroup, defaultMain, env, nf, nfIO)+import Control.DeepSeq (deepseq, NFData (rnf))+import Control.Monad.Trans.State.Strict++{-# NOINLINE someArray #-}+someArray :: WordArray+someArray = toWordArray (maxBound `div` 2)++{-# NOINLINE mkPrimArray #-}+mkPrimArray :: IO (MutablePrimArray (PrimState IO) Word8)+mkPrimArray = do+ arr <- newPrimArray 7+ setPrimArray arr 0 7 (0 :: Word8)+ pure arr++{-# INLINE overIndexPA #-}+overIndexPA :: (Prim a, PrimMonad m) => Int -> (a -> a) -> MutablePrimArray (PrimState m) a -> m ()+overIndexPA i f arr = do+ v <- readPrimArray arr i+ writePrimArray arr i (f v)++{-# NOINLINE iforPrimArray #-}+iforPrimArray :: (Prim a, PrimMonad m) => MutablePrimArray (PrimState m) a -> (Int -> a -> m ()) -> m ()+iforPrimArray arr f = do+ readPrimArray arr 0 >>= f 0+ readPrimArray arr 1 >>= f 1+ readPrimArray arr 2 >>= f 2+ readPrimArray arr 3 >>= f 3+ readPrimArray arr 4 >>= f 4+ readPrimArray arr 5 >>= f 5+ readPrimArray arr 6 >>= f 6+ readPrimArray arr 7 >>= f 7++{-# NOINLINE iforWordArray' #-}+iforWordArray' :: Applicative f => WordArray+ -> (Int -> Word8 -> f ())+ -> f ()+iforWordArray' = iforWordArray++sumState :: Monad m => Int -> Word8 -> StateT Int m ()+sumState i w = + modify $ \s -> i + s + fromIntegral w++main :: IO ()+main = do++ defaultMain+ [ bgroup "word-array"+ [ bench "overIndex" $ nf (overIndex 0 (+1)) someArray+ , bench "ifor" $ nf (flip iforWordArray (\i w -> i `deepseq` w `deepseq` Identity ())) (toWordArray maxBound)+ , bench "ifor sum" $ nf (flip runState 0 . flip iforWordArray sumState) (toWordArray maxBound)+ ]+ , bgroup "prim-array"+ [ env mkPrimArray $ \arr -> bench "overIndex" $ nfIO (overIndexPA 0 (+1) arr)+ , env mkPrimArray $ \arr -> bench "ifor" $ nfIO (iforPrimArray arr (\i w -> i `deepseq` w `deepseq` pure ()))+ , env mkPrimArray $ \arr -> bench "ifor sum" $ nfIO $ do+ (_, !i) <- flip runStateT 0 $ iforPrimArray arr sumState+ pure i+ ]+ ]
+ src/Data/Word64Array/Word8.hs view
@@ -0,0 +1,188 @@+{-# 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 { fromWordArray :: Word64 }+ deriving (Show, Eq, Ord, NFData)++type instance Element WordArray = Word8++newtype Index = Index { getIndex :: Int }+ deriving (Show, Num, Eq, Ord)++instance Bounded Index where+ maxBound = 7+ minBound = 0++{-# INLINE toWordArray #-}+toWordArray :: Word64 -> WordArray+toWordArray = WordArray++displayWordArray :: WordArray -> String+displayWordArray wa = displayWordArrayS wa ""+ where+ displayHex x s = "0x" <> showHex x s+ displayWordArrayS = showListWith displayHex . toList++{-# INLINE toTuple #-}+toTuple :: WordArray -> (# Element WordArray, Element WordArray, Element WordArray, Element WordArray, Element WordArray, Element WordArray, Element WordArray, Element WordArray #)+toTuple (WordArray !w) = + let+ !w7 = w+ !w6 = unsafeShiftR w7 8+ !w5 = unsafeShiftR w6 8+ !w4 = unsafeShiftR w5 8+ !w3 = unsafeShiftR w4 8+ !w2 = unsafeShiftR w3 8+ !w1 = unsafeShiftR w2 8+ !w0 = unsafeShiftR w1 8+ in + (# fromIntegral w0+ , fromIntegral w1+ , fromIntegral w2+ , fromIntegral w3+ , fromIntegral w4+ , fromIntegral w5+ , fromIntegral w6+ , fromIntegral w7+ #)++{-# INLINE fromTuple #-}+fromTuple :: (# Element WordArray, Element WordArray, Element WordArray, Element WordArray, Element WordArray, Element WordArray, Element WordArray, Element WordArray #) -> WordArray+fromTuple (# !w0, !w1, !w2, !w3, !w4, !w5, !w6, !w7 #) =+ WordArray+ ( (fromIntegral w7)+ .|. unsafeShiftL (fromIntegral w6) 8+ .|. unsafeShiftL (fromIntegral w5) 16+ .|. unsafeShiftL (fromIntegral w4) 24+ .|. unsafeShiftL (fromIntegral w3) 32+ .|. unsafeShiftL (fromIntegral w2) 40+ .|. unsafeShiftL (fromIntegral w1) 48+ .|. unsafeShiftL (fromIntegral w0) 56+ )++{-# INLINE toList #-}+toList :: WordArray -> [Element WordArray]+toList w =+ let (# !w0, !w1, !w2, !w3, !w4, !w5, !w6, !w7 #) = toTuple w+ in [w0, w1, w2, w3, w4, w5, w6, w7]++{-# INLINE readArray #-}+readArray :: WordArray -> Index -> Element WordArray+readArray (WordArray !w) !i =+ -- See Note [Representation of WordArray]+ fromIntegral $ unsafeShiftR w (offset i)++{-# INLINE offset #-}+offset :: Index -> Int+offset !i = (-8 * getIndex i) + 56++{-# INLINE writeArray #-}+writeArray :: WordArray -> Index -> Element WordArray -> WordArray+writeArray (WordArray !w) !i !w8 =+ -- See Note [Representation of WordArray]+ let w64 :: Word64+ w64 = unsafeShiftL (fromIntegral w8) (offset i)+ in WordArray ((w .&. mask i) + w64)++{-# INLINE overIndex #-}+-- | Modify the word at a given index.+overIndex :: Index -> (Element WordArray -> Element WordArray) -> WordArray -> WordArray+overIndex !i f !w = writeArray w i $ f $ readArray w i++{-# INLINE mask #-}+mask :: Index -> Word64+mask 0 = 0x00ffffffffffffff+mask 1 = 0xff00ffffffffffff+mask 2 = 0xffff00ffffffffff+mask 3 = 0xffffff00ffffffff+mask 4 = 0xffffffff00ffffff+mask 5 = 0xffffffffff00ffff+mask 6 = 0xffffffffffff00ff+mask 7 = 0xffffffffffffff00+mask _ = error "mask"++{-# INLINE iforWordArray #-}+iforWordArray :: Applicative f => WordArray -> (Int -> Element WordArray -> f ()) -> f ()+iforWordArray !w f =+ let (# !w0, !w1, !w2, !w3, !w4, !w5, !w6, !w7 #) = toTuple w+ in f 0 w0 *> f 1 w1 *> f 2 w2 *> f 3 w3 + *> f 4 w4 *> f 5 w5 *> f 6 w6 *> f 7 w7++instance MonoFunctor WordArray where+ omap f w =+ let (# !w0, !w1, !w2, !w3, !w4, !w5, !w6, !w7 #) = toTuple w+ in fromTuple (# f w0, f w1, f w2, f w3, f w4, f w5, f w6, f w7 #)++instance MonoFoldable WordArray where+ {-# INLINE ofoldr #-}+ ofoldr f !b !w =+ let (# !w0, !w1, !w2, !w3, !w4, !w5, !w6, !w7 #) = toTuple w+ in f w0 $ f w1 $ f w2 $ f w3 $ f w4 $ f w5 $ f w6 $ f w7 b+ {-# INLINE ofoldl' #-}+ ofoldl' f z0 xs = ofoldr f' id xs z0+ where f' x k z = k $! f z x+ {-# INLINE ofoldMap #-}+ ofoldMap f = ofoldr (mappend . f) mempty+ {-# INLINE onull #-}+ onull _ = False+ {-# INLINE oelem #-}+ oelem e = ofoldr (\a b -> a == e || b) False+ {-# INLINE ofoldr1Ex #-}+ ofoldr1Ex f xs = fromMaybe + (errorWithoutStackTrace "error in word-array ofoldr1Ex: empty array")+ (ofoldr mf Nothing xs)+ where+ mf x m = Just $ case m of+ Nothing -> x+ Just y -> f x y+ {-# INLINE ofoldl1Ex' #-}+ ofoldl1Ex' f xs = fromMaybe + (errorWithoutStackTrace "error in word-array ofoldr1Ex: empty array")+ (ofoldl' mf Nothing xs)+ where+ mf m y = Just $ case m of+ Nothing -> y+ Just x -> f x y
+ test/Main.hs view
@@ -0,0 +1,72 @@+{-# LANGUAGE + MagicHash + , TemplateHaskell+ , TypeApplications+ , DataKinds+ , StandaloneDeriving+ , GeneralizedNewtypeDeriving+#-}++{-# OPTIONS_GHC+ -fno-warn-orphans+#-}++module Main where++-- import Test.Tasty.HUnit+import Data.MonoTraversable+import Data.Proxy+import Data.Vector+import Data.Word+import Data.Word64Array.Word8 as WordArray+import Test.QuickCheck+import Test.QuickCheck.Classes+import Test.Tasty+import Test.Tasty.QuickCheck+import qualified Data.Word64Array.Word8 as W64A+deriving instance Arbitrary W64A.WordArray++toVector :: WordArray -> Vector Word8+toVector = fromList . WordArray.toList++instance Arbitrary Index where+ arbitrary = Index <$> choose (0, 7)+ shrink (Index i) = if i == 0 then [] else [Index (i-1)]++main :: IO ()+main = do+ lawsCheckMany typeclassLaws+ defaultMain tests++tests :: TestTree+tests = + testGroup "Tests" [unitTests]++unitTests :: TestTree+unitTests = testGroup "Unit tests"+ [ testGroup "word-array" [+ testProperty "write" $ \(arr, ix@(Index i), w8) ->+ toVector (writeArray arr ix w8) == toVector arr // [(i, w8)]+ , testProperty "read" $ \(arr, ix@(Index i)) ->+ readArray arr ix == toVector arr ! i+ , testProperty "fold" $ \arr ->+ ofoldr (+) 0 arr == Prelude.foldr (+) 0 (toVector arr)+ ]+ ]++w64w8Laws :: [Laws]+w64w8Laws =+ let p = Proxy :: Proxy W64A.WordArray+ in [eqLaws p, ordLaws p]++typeclassLaws :: ([(String, [Laws])])+typeclassLaws = + [ ("Word64Array Word8", w64w8Laws)+ ]++unwrap :: Either a b -> b+unwrap = either (error "unwrap") id++testLaws :: Laws -> TestTree+testLaws (Laws tc lp) = testProperties tc lp+
+ word-array.cabal view
@@ -0,0 +1,73 @@+cabal-version: 2.4+name: word-array+version: 0.1.0.0+synopsis: treat integral types as arrays of smaller integral types++description: treat integral types as arrays of smaller integral types.+ mostly a collection of bitwise operations. you can, for instance,+ split a @Word64@ into 8 @Word8@s+homepage: https://github.com/goolord/word-array/++bug-reports: https://github.com/goolord/word-array/issues+license: MIT+license-file: LICENSE+author: Zachary Churchill+maintainer: zacharyachurchill@gmail.com++-- copyright:+category: Data+extra-source-files: CHANGELOG.md++library+ exposed-modules:+ Data.Word64Array.Word8++ build-depends: + , base >=4.13 && <5.0+ , mono-traversable+ , deepseq+ hs-source-dirs: src+ default-language: Haskell2010+ ghc-options: -Wall -O2++test-suite test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Main.hs+ build-depends:+ HUnit+ , tasty+ , QuickCheck+ , base+ , mono-traversable+ , primitive+ , quickcheck-classes+ , tasty+ , tasty-hunit+ , tasty-quickcheck+ , vector+ , word-array+ ghc-options:+ -Wall+ -O2+ default-language: Haskell2010++benchmark bench+ type: exitcode-stdio-1.0+ build-depends:+ base+ , tasty+ , weigh == 0.0.16+ , tasty-bench+ , word-array+ , deepseq+ , primitive+ , transformers+ ghc-options: -Wall -O3+ default-language: Haskell2010+ hs-source-dirs: bench+ main-is: Main.hs++source-repository head+ type: git+ location: https://github.com/goolord/word-array/