hw-bits (empty) → 0.0.0.1
raw patch · 35 files changed
+2171/−0 lines, 35 filesdep +QuickCheckdep +arraydep +attoparsecsetup-changed
Dependencies added: QuickCheck, array, attoparsec, base, bytestring, conduit, criterion, deepseq, ghc-prim, hspec, hw-bits, lens, mmap, mono-traversable, parsec, random, resourcet, safe, text, transformers, vector, word8
Files
- LICENSE +30/−0
- README.md +101/−0
- Setup.hs +2/−0
- app/Main.hs +4/−0
- bench/Main.hs +20/−0
- hw-bits.cabal +119/−0
- src/HaskellWorks/Data/Attoparsec/Final/IsChar.hs +15/−0
- src/HaskellWorks/Data/Attoparsec/Final/Parser.hs +42/−0
- src/HaskellWorks/Data/Bits.hs +16/−0
- src/HaskellWorks/Data/Bits/BitLength.hs +112/−0
- src/HaskellWorks/Data/Bits/BitParse.hs +127/−0
- src/HaskellWorks/Data/Bits/BitRead.hs +78/−0
- src/HaskellWorks/Data/Bits/BitShow.hs +104/−0
- src/HaskellWorks/Data/Bits/BitShown.hs +46/−0
- src/HaskellWorks/Data/Bits/BitWise.hs +213/−0
- src/HaskellWorks/Data/Bits/ElemFixedBitSize.hs +82/−0
- src/HaskellWorks/Data/Bits/FixedBitSize.hs +30/−0
- src/HaskellWorks/Data/Bits/PopCount.hs +19/−0
- src/HaskellWorks/Data/Bits/PopCount/PopCount0.hs +96/−0
- src/HaskellWorks/Data/Bits/PopCount/PopCount1.hs +11/−0
- src/HaskellWorks/Data/Bits/PopCount/PopCount1/Broadword.hs +111/−0
- src/HaskellWorks/Data/Bits/PopCount/PopCount1/GHC.hs +95/−0
- src/HaskellWorks/Data/ByteString.hs +11/−0
- src/HaskellWorks/Data/FromByteString.hs +8/−0
- src/HaskellWorks/Data/FromForeignRegion.hs +7/−0
- src/HaskellWorks/Data/Positioning.hs +34/−0
- src/HaskellWorks/Data/Search.hs +12/−0
- src/HaskellWorks/Data/Vector/BoxedVectorLike.hs +56/−0
- src/HaskellWorks/Data/Vector/StorableVectorLike.hs +56/−0
- src/HaskellWorks/Data/Vector/VectorLike.hs +329/−0
- src/HaskellWorks/Data/Word.hs +40/−0
- test/HaskellWorks/Data/Bits/BitReadSpec.hs +48/−0
- test/HaskellWorks/Data/Bits/BitWiseSpec.hs +68/−0
- test/Spec.hs +1/−0
- test/data/sample.json +28/−0
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright John Ky (c) 2016++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Author name here nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ README.md view
@@ -0,0 +1,101 @@+# hw-succinct+[](https://circleci.com/gh/haskell-works/hw-succinct)+Conduits for tokenizing streams.++`hw-succinct` is a succinct JSON parsing library. It uses succinct data-structures to allow traversal of+large JSON strings with minimal memory overhead.++It is currently considered experimental.++For an example, see [`app/Main.hs`](../master/app/Main.hs)++## Prerequisites+* Install `haskell-stack`.+* Install `hlint` (eg. `stack install hlint`)++## Building++Run the following in the shell:++ git clone git@github.com:haskell-works/hw-succinct.git+ cd hw-succinct+ stack setup+ stack build+ stack test+ stack ghci --ghc-options -XOverloadedStrings \+ --main-is hw-succinct:exe:hw-succinct-example++## Memory benchmark++### Parsing large Json files in Scala with Argonaut++ S0U EU OU MU CCSU CMD+ --------- --------- ----------- -------- -------- ---------------------------------------------------------------+ 0.0 80,526.3 76,163.6 72,338.6 13,058.6 sbt console+ 0.0 536,660.4 76,163.6 72,338.6 13,058.6 import java.io._, argonaut._, Argonaut._+ 0.0 552,389.1 76,163.6 72,338.6 13,058.6 val file = new File("/Users/jky/Downloads/78mbs.json"+ 0.0 634,066.5 76,163.6 72,338.6 13,058.6 val array = new Array[Byte](file.length.asInstanceOf[Int])+ 0.0 644,552.3 76,163.6 72,338.6 13,058.6 val is = new FileInputStream("/Users/jky/Downloads/78mbs.json")+ 0.0 655,038.1 76,163.6 72,338.6 13,058.6 is.read(array)+ 294,976.0 160,159.7 1,100,365.0 79,310.8 13,748.1 val json = new String(array)+ 285,182.9 146,392.6 1,956,264.5 82,679.8 14,099.6 val data = Parse.parse(json)+ ***********++### Parsing large Json files in Haskell with Aeson++ Mem (MB) CMD+ -------- ---------------------------------------------------------+ 302 import Data.Aeson+ 302 import qualified Data.ByteString.Lazy as BSL+ 302 json78m <- BSL.readFile "/Users/jky/Downloads/78mbs.json"+ 1400 let !x = decode json78m :: Maybe Value++### Parsing large Json files in Haskell with hw-succinct++ Mem (MB) CMD+ -------- ---------------------------------------------------------+ 274 import Foreign+ 274 import qualified Data.Vector.Storable as DVS+ 274 import qualified Data.ByteString as BS+ 274 import System.IO.MMap+ 274 import Data.Word+ 274 (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr "/Users/jky/Downloads/78mbs.json" ReadOnly Nothing+ 601 cursor <- measure (fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))++## Examples++ import Foreign+ import qualified Data.Vector.Storable as DVS+ import qualified Data.ByteString as BS+ import qualified Data.ByteString.Internal as BSI+ import System.IO.MMap+ import Data.Word+ import System.CPUTime+ (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr "/Users/jky/Downloads/78mbs.json" ReadOnly Nothing+ cursor <- measure (fromForeignRegion (fptr, offset, size) :: JsonCursor BS.ByteString (BitShown (DVS.Vector Word64)) (SimpleBalancedParens (DVS.Vector Word64)))+ let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size+ x <- measure $ jsonBsToInterestBs bs+ let !y = runListConduit [bs] (unescape' "")++ import Foreign+ import qualified Data.Vector.Storable as DVS+ import qualified Data.ByteString as BS+ import qualified Data.ByteString.Internal as BSI+ import System.IO.MMap+ import Data.Word+ import System.CPUTime+ (fptr :: ForeignPtr Word8, offset, size) <- mmapFileForeignPtr "/Users/jky/Downloads/part40.json" ReadOnly Nothing+ let !bs = BSI.fromForeignPtr (castForeignPtr fptr) offset size+ x <- measure $ BS.concat $ runListConduit [bs] (blankJson =$= blankedJsonToInterestBits)+ x <- measure $ jsonBsToInterestBs bs+ + jsonTokenAt $ J.nextSibling $ J.firstChild $ J.nextSibling $ J.firstChild $ J.firstChild cursor++## References+* [Succinct Data Structures talk by Edward Kmett](https://www.youtube.com/watch?v=uA0Z7_4J7u8)+* [Typed Tagless Final Interpreters](http://okmij.org/ftp/tagless-final/course/lecture.pdf)+* [Conduit Overview](https://www.schoolofhaskell.com/school/to-infinity-and-beyond/pick-of-the-week/conduit-overview)+++## Special mentions+* [Sydney Paper Club](http://www.meetup.com/Sydney-Paper-Club/)
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ app/Main.hs view
@@ -0,0 +1,4 @@+module Main where++main :: IO ()+main = print "Hello world"
+ bench/Main.hs view
@@ -0,0 +1,20 @@+module Main where++import Criterion.Main+import qualified Data.ByteString as BS++setupEnvBs :: Int -> IO BS.ByteString+setupEnvBs n = return $ BS.pack (take n (cycle [maxBound, 0]))++setupEnvBss :: Int -> Int -> IO [BS.ByteString]+setupEnvBss n k = setupEnvBs n >>= \v -> return (replicate k v)++benchIdentity :: [Benchmark]+benchIdentity =+ [ env (setupEnvBss 4060 19968) $ \_ -> bgroup "Rank"+ [ bench "Rechunk" (whnf id "")+ ]+ ]++main :: IO ()+main = defaultMain benchIdentity
+ hw-bits.cabal view
@@ -0,0 +1,119 @@+name: hw-bits+version: 0.0.0.1+synopsis: Conduits for tokenizing streams.+description: Please see README.md+homepage: http://github.com/haskell-works/hw-bits#readme+license: BSD3+license-file: LICENSE+author: John Ky+maintainer: newhoggy@gmail.com+copyright: 2016 John Ky+category: Data, Conduit+build-type: Simple+extra-source-files: README.md+cabal-version: >= 1.10+data-files: test/data/sample.json++executable hw-bits-example+ hs-source-dirs: app+ main-is: Main.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -O2 -Wall -msse4.2+ build-depends: base >= 4 && < 5 ,+ bytestring ,+ conduit ,+ criterion >= 1.1.0.0 && < 1.2 ,+ hw-bits ,+ mmap ,+ resourcet ,+ vector >= 0.6 && < 0.12+ default-language: Haskell2010++library+ hs-source-dirs: src+ exposed-modules: HaskellWorks.Data.Attoparsec.Final.IsChar+ , HaskellWorks.Data.Attoparsec.Final.Parser+ , HaskellWorks.Data.Bits+ , HaskellWorks.Data.Bits.BitLength+ , HaskellWorks.Data.Bits.BitParse+ , HaskellWorks.Data.Bits.BitRead+ , HaskellWorks.Data.Bits.BitShow+ , HaskellWorks.Data.Bits.BitShown+ , HaskellWorks.Data.Bits.BitWise+ , HaskellWorks.Data.Bits.ElemFixedBitSize+ , HaskellWorks.Data.Bits.FixedBitSize+ , HaskellWorks.Data.Bits.PopCount+ , HaskellWorks.Data.Bits.PopCount.PopCount0+ , HaskellWorks.Data.Bits.PopCount.PopCount1+ , HaskellWorks.Data.Bits.PopCount.PopCount1.Broadword+ , HaskellWorks.Data.Bits.PopCount.PopCount1.GHC+ , HaskellWorks.Data.ByteString+ , HaskellWorks.Data.FromByteString+ , HaskellWorks.Data.FromForeignRegion+ , HaskellWorks.Data.Positioning+ , HaskellWorks.Data.Search+ , HaskellWorks.Data.Vector.BoxedVectorLike+ , HaskellWorks.Data.Vector.StorableVectorLike+ , HaskellWorks.Data.Vector.VectorLike+ , HaskellWorks.Data.Word+ build-depends: base >= 4.7 && < 5+ , array+ , attoparsec >= 0.10+ , bytestring+ , conduit >= 1.1 && < 1.3+ , deepseq < 1.5+ , ghc-prim+ , lens+ , mmap+ , mono-traversable+ , parsec+ , QuickCheck+ , random+ , resourcet >= 1.1+ , safe+ , text+ , vector+ , word8++ default-language: Haskell2010+ ghc-options: -rtsopts -with-rtsopts=-N -Wall -O2 -Wall -msse4.2++test-suite hw-bits-test+ type: exitcode-stdio-1.0+ hs-source-dirs: test+ main-is: Spec.hs+ other-modules: HaskellWorks.Data.Bits.BitReadSpec+ , HaskellWorks.Data.Bits.BitWiseSpec+ build-depends: base+ , attoparsec >= 0.10+ , bytestring+ , conduit >= 1.1 && < 1.3+ , hspec >= 1.3+ , hw-bits+ , mmap+ , parsec+ , QuickCheck+ , resourcet >= 1.1+ , transformers+ , vector+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ default-language: Haskell2010++source-repository head+ type: git+ location: https://github.com/haskell-works/hw-bits++benchmark bench+ Type: exitcode-stdio-1.0+ HS-Source-Dirs: bench+ Main-Is: Main.hs+ GHC-Options: -O2 -Wall -msse4.2+ Default-Language: Haskell2010+ Build-Depends:+ base >= 4 && < 5 ,+ bytestring ,+ conduit ,+ criterion >= 1.1.0.0 && < 1.2 ,+ hw-bits ,+ mmap ,+ resourcet ,+ vector >= 0.6 && < 0.12
+ src/HaskellWorks/Data/Attoparsec/Final/IsChar.hs view
@@ -0,0 +1,15 @@+module HaskellWorks.Data.Attoparsec.Final.IsChar+ ( IsChar(..)+ ) where++import qualified Data.ByteString.Internal as BI+import Data.Word8++class IsChar c where+ toChar :: c -> Char++instance IsChar Word8 where+ toChar = BI.w2c++instance IsChar Char where+ toChar = id
+ src/HaskellWorks/Data/Attoparsec/Final/Parser.hs view
@@ -0,0 +1,42 @@+module HaskellWorks.Data.Attoparsec.Final.Parser+ ( Parser(..)+ ) where++import qualified Data.Attoparsec.ByteString as ABS+import qualified Data.Attoparsec.ByteString.Char8 as BC+import qualified Data.Attoparsec.Text as AT+import qualified Data.Attoparsec.Types as T+import Data.ByteString (ByteString)+import Data.MonoTraversable+import Data.Text (Text)+import HaskellWorks.Data.Attoparsec.Final.IsChar++class MonoTraversable t => Parser t where+ satisfy :: (Element t -> Bool) -> T.Parser t (Element t)+ satisfyWith :: (Element t -> a) -> (a -> Bool) -> T.Parser t a+ satisfyChar :: (Char -> Bool) -> T.Parser t Char+ string :: t -> T.Parser t t+ try :: T.Parser t a -> T.Parser t a+ char :: Char -> T.Parser t Char+ (<?>) :: T.Parser t Char -> String -> T.Parser t Char+ rational :: Fractional f => T.Parser t f++instance Parser ByteString where+ satisfy = ABS.satisfy+ satisfyWith = ABS.satisfyWith+ satisfyChar = ABS.satisfyWith toChar+ string = ABS.string+ try = ABS.try+ char = BC.char+ (<?>) = (BC.<?>)+ rational = BC.rational++instance Parser Text where+ satisfy = AT.satisfy+ satisfyWith = AT.satisfyWith+ satisfyChar = AT.satisfyWith toChar+ string = AT.string+ try = AT.try+ char = AT.char+ (<?>) = (AT.<?>)+ rational = AT.rational
+ src/HaskellWorks/Data/Bits.hs view
@@ -0,0 +1,16 @@+-- |+-- Copyright: 2016 John Ky+-- License: MIT+--+-- Succinct operations.+module HaskellWorks.Data.Bits+ ( module X+ ) where++import HaskellWorks.Data.Bits.BitLength as X+import HaskellWorks.Data.Bits.BitParse as X+import HaskellWorks.Data.Bits.BitRead as X+import HaskellWorks.Data.Bits.BitShow as X+import HaskellWorks.Data.Bits.BitShown as X+import HaskellWorks.Data.Bits.BitWise as X+import HaskellWorks.Data.Bits.PopCount as X
+ src/HaskellWorks/Data/Bits/BitLength.hs view
@@ -0,0 +1,112 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Copyright: 2016 John Ky+-- License: MIT+--+-- Succinct operations.+module HaskellWorks.Data.Bits.BitLength+ ( -- * Bit map+ BitLength(..)+ , elemBitLength+ , elemBitEnd+ ) where++import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.Vector.VectorLike+import Prelude as P++class BitLength v where+ bitLength :: v -> Count++ endPosition :: v -> Position+ endPosition = Position . fromIntegral . getCount . bitLength++--------------------------------------------------------------------------------+-- Functions++elemBitLength :: (VectorLike v, BitLength (Elem v)) => v -> Count+elemBitLength v = bitLength (v !!! 0)++elemBitEnd :: (VectorLike v, BitLength (Elem v)) => v -> Position+elemBitEnd v = endPosition (v !!! 0)++--------------------------------------------------------------------------------+-- Instances++instance BitLength Bool where+ bitLength _ = 1+ {-# INLINABLE bitLength #-}++instance BitLength [Bool] where+ bitLength = fromIntegral . P.length+ {-# INLINABLE bitLength #-}++instance BitLength Word8 where+ bitLength _ = 8+ {-# INLINABLE bitLength #-}++instance BitLength Word16 where+ bitLength _ = 16+ {-# INLINABLE bitLength #-}++instance BitLength Word32 where+ bitLength _ = 32+ {-# INLINABLE bitLength #-}++instance BitLength Word64 where+ bitLength _ = 64+ {-# INLINABLE bitLength #-}++instance BitLength [Word8] where+ bitLength v = fromIntegral (P.length v) * bitLength (head v)+ {-# INLINABLE bitLength #-}++instance BitLength [Word16] where+ bitLength v = fromIntegral (P.length v) * bitLength (head v)+ {-# INLINABLE bitLength #-}++instance BitLength [Word32] where+ bitLength v = fromIntegral (P.length v) * bitLength (head v)+ {-# INLINABLE bitLength #-}++instance BitLength [Word64] where+ bitLength v = fromIntegral (P.length v) * bitLength (head v)+ {-# INLINABLE bitLength #-}++instance BitLength (DV.Vector Word8) where+ bitLength v = vLength v * bitLength (v !!! 0)+ {-# INLINABLE bitLength #-}++instance BitLength (DV.Vector Word16) where+ bitLength v = vLength v * bitLength (v !!! 0)+ {-# INLINABLE bitLength #-}++instance BitLength (DV.Vector Word32) where+ bitLength v = vLength v * bitLength (v !!! 0)+ {-# INLINABLE bitLength #-}++instance BitLength (DV.Vector Word64) where+ bitLength v = vLength v * bitLength (v !!! 0)+ {-# INLINABLE bitLength #-}++instance BitLength (DVS.Vector Word8) where+ bitLength v = vLength v * bitLength (v !!! 0)+ {-# INLINABLE bitLength #-}++instance BitLength (DVS.Vector Word16) where+ bitLength v = vLength v * bitLength (v !!! 0)+ {-# INLINABLE bitLength #-}++instance BitLength (DVS.Vector Word32) where+ bitLength v = vLength v * bitLength (v !!! 0)+ {-# INLINABLE bitLength #-}++instance BitLength (DVS.Vector Word64) where+ bitLength v = vLength v * bitLength (v !!! 0)+ {-# INLINABLE bitLength #-}
+ src/HaskellWorks/Data/Bits/BitParse.hs view
@@ -0,0 +1,127 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Copyright: 2016 John Ky+-- License: MIT+--+-- Succinct operations.+module HaskellWorks.Data.Bits.BitParse+ ( BitParse(..)+ ) where++import qualified Data.ByteString as BS+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise+import Text.ParserCombinators.Parsec++class BitParse a where+ bitParse0 :: Parser a+ bitParse1 :: Parser a++p0 :: Parser Bool+p0 = char '1' >> return True++p1 :: Parser Bool+p1 = char '0' >> return False++instance BitParse Bool where+ bitParse0 = option False bitParse1+ bitParse1 = p0 <|> p1++instance BitParse Word8 where+ bitParse0 = option 0 bitParse1+ bitParse1 = do+ a :: Bool <- bitParse1+ b :: Bool <- bitParse0+ c :: Bool <- bitParse0+ d :: Bool <- bitParse0+ e :: Bool <- bitParse0+ f :: Bool <- bitParse0+ g :: Bool <- bitParse0+ h :: Bool <- bitParse0+ return $+ (if a then 0x01 else 0) .|.+ (if b then 0x02 else 0) .|.+ (if c then 0x04 else 0) .|.+ (if d then 0x08 else 0) .|.+ (if e then 0x10 else 0) .|.+ (if f then 0x20 else 0) .|.+ (if g then 0x40 else 0) .|.+ (if h then 0x80 else 0)++instance BitParse Word16 where+ bitParse0 = option 0 bitParse1+ bitParse1 = do+ (a :: Word8) <- bitParse1+ (b :: Word8) <- bitParse0+ return $ (fromIntegral b .<. bitLength a) .|. fromIntegral a++instance BitParse Word32 where+ bitParse0 = option 0 bitParse1+ bitParse1 = do+ (a :: Word16) <- bitParse1+ (b :: Word16) <- bitParse0+ return $ (fromIntegral b .<. bitLength a) .|. fromIntegral a++instance BitParse Word64 where+ bitParse0 = option 0 bitParse1+ bitParse1 = do+ (a :: Word32) <- bitParse1+ (b :: Word32) <- bitParse0+ return $ (fromIntegral b .<. bitLength a) .|. fromIntegral a++instance BitParse BS.ByteString where+ bitParse0 = fmap BS.pack bitParse0+ bitParse1 = fmap BS.pack bitParse1++instance BitParse [Word8] where+ bitParse0 = option [] bitParse1+ bitParse1 = many bitParse1++instance BitParse [Word16] where+ bitParse0 = option [] bitParse1+ bitParse1 = many bitParse1++instance BitParse [Word32] where+ bitParse0 = option [] bitParse1+ bitParse1 = many bitParse1++instance BitParse [Word64] where+ bitParse0 = option [] bitParse1+ bitParse1 = many bitParse1++instance BitParse (DV.Vector Word8) where+ bitParse0 = option DV.empty bitParse1+ bitParse1 = DV.fromList `fmap` bitParse0++instance BitParse (DV.Vector Word16) where+ bitParse0 = option DV.empty bitParse1+ bitParse1 = DV.fromList `fmap` bitParse0++instance BitParse (DV.Vector Word32) where+ bitParse0 = option DV.empty bitParse1+ bitParse1 = DV.fromList `fmap` bitParse0++instance BitParse (DV.Vector Word64) where+ bitParse0 = option DV.empty bitParse1+ bitParse1 = DV.fromList `fmap` bitParse0++instance BitParse (DVS.Vector Word8) where+ bitParse0 = option DVS.empty bitParse1+ bitParse1 = DVS.fromList `fmap` bitParse0++instance BitParse (DVS.Vector Word16) where+ bitParse0 = option DVS.empty bitParse1+ bitParse1 = DVS.fromList `fmap` bitParse0++instance BitParse (DVS.Vector Word32) where+ bitParse0 = option DVS.empty bitParse1+ bitParse1 = DVS.fromList `fmap` bitParse0++instance BitParse (DVS.Vector Word64) where+ bitParse0 = option DVS.empty bitParse1+ bitParse1 = DVS.fromList `fmap` bitParse0
+ src/HaskellWorks/Data/Bits/BitRead.hs view
@@ -0,0 +1,78 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE UndecidableInstances #-}++module HaskellWorks.Data.Bits.BitRead+ ( BitRead(..)+ ) where++import qualified Data.ByteString as BS+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitParse+import Text.ParserCombinators.Parsec++class BitRead a where+ bitRead :: String -> Maybe a++bitRead' :: BitParse a => String -> Maybe a+bitRead' = either (const Nothing) Just . parse bitParse0 "" . filter (/= ' ')++bitCharToBool :: Char -> Maybe Bool+bitCharToBool '1' = Just True+bitCharToBool '0' = Just False+bitCharToBool _ = Nothing++instance BitRead Word8 where+ bitRead = bitRead'++instance BitRead Word16 where+ bitRead = bitRead'++instance BitRead Word32 where+ bitRead = bitRead'++instance BitRead Word64 where+ bitRead = bitRead'++instance BitRead BS.ByteString where+ bitRead = bitRead'++instance BitRead [Word8] where+ bitRead = bitRead'++instance BitRead [Word16] where+ bitRead = bitRead'++instance BitRead [Word32] where+ bitRead = bitRead'++instance BitRead [Word64] where+ bitRead = bitRead'++instance BitRead (DV.Vector Word8) where+ bitRead = bitRead'++instance BitRead (DV.Vector Word16) where+ bitRead = bitRead'++instance BitRead (DV.Vector Word32) where+ bitRead = bitRead'++instance BitRead (DV.Vector Word64) where+ bitRead = bitRead'++instance BitRead (DVS.Vector Word8) where+ bitRead = bitRead'++instance BitRead (DVS.Vector Word16) where+ bitRead = bitRead'++instance BitRead (DVS.Vector Word32) where+ bitRead = bitRead'++instance BitRead (DVS.Vector Word64) where+ bitRead = bitRead'++instance BitRead [Bool] where+ bitRead = sequence . fmap bitCharToBool . filter (/= ' ')
+ src/HaskellWorks/Data/Bits/BitShow.hs view
@@ -0,0 +1,104 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Copyright: 2016 John Ky+-- License: MIT+--+-- Succinct operations.+module HaskellWorks.Data.Bits.BitShow+ ( BitShow(..)+ , bitShow+ ) where++import qualified Data.ByteString as BS+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Word++class BitShow a where+ bitShows :: a -> String -> String++instance BitShow Bool where+ bitShows a = ((if a then '1' else '0'):)++instance BitShow Word8 where+ bitShows w =+ (if w .?. 0 then ('1':) else ('0':))+ . (if w .?. 1 then ('1':) else ('0':))+ . (if w .?. 2 then ('1':) else ('0':))+ . (if w .?. 3 then ('1':) else ('0':))+ . (if w .?. 4 then ('1':) else ('0':))+ . (if w .?. 5 then ('1':) else ('0':))+ . (if w .?. 6 then ('1':) else ('0':))+ . (if w .?. 7 then ('1':) else ('0':))++instance BitShow Word16 where+ bitShows w = case leSplit w of (a, b) -> bitShows a . (' ':) . bitShows b++instance BitShow Word32 where+ bitShows w = case leSplit w of (a, b) -> bitShows a . (' ':) . bitShows b++instance BitShow Word64 where+ bitShows w = case leSplit w of (a, b) -> bitShows a . (' ':) . bitShows b++instance BitShow [Bool] where+ bitShows ws = ('\"':) . go (0 :: Int) ws . ('\"':)+ where go _ [] = id+ go _ [u] = bitShows u+ go n (u:us) = bitShows u . maybePrependSeperatorat n . go (n + 1) us+ maybePrependSeperatorat n = if n `mod` 8 == 7 then (' ':) else id++instance BitShow BS.ByteString where+ bitShows bs | BS.length bs == 0 = id+ bitShows bs | BS.length bs == 1 = bitShows (BS.head bs)+ bitShows bs = bitShows (BS.head bs) . (' ':) . bitShows (BS.tail bs)++instance BitShow [Word8] where+ bitShows [] = id+ bitShows [w] = bitShows w+ bitShows (w:ws) = bitShows w . (' ':) . bitShows ws++instance BitShow [Word16] where+ bitShows [] = id+ bitShows [w] = bitShows w+ bitShows (w:ws) = bitShows w . (' ':) . bitShows ws++instance BitShow [Word32] where+ bitShows [] = id+ bitShows [w] = bitShows w+ bitShows (w:ws) = bitShows w . (' ':) . bitShows ws++instance BitShow [Word64] where+ bitShows [] = id+ bitShows [w] = bitShows w+ bitShows (w:ws) = bitShows w . (' ':) . bitShows ws++instance BitShow (DV.Vector Word8) where+ bitShows = bitShows . DV.toList++instance BitShow (DV.Vector Word16) where+ bitShows = bitShows . DV.toList++instance BitShow (DV.Vector Word32) where+ bitShows = bitShows . DV.toList++instance BitShow (DV.Vector Word64) where+ bitShows = bitShows . DV.toList++instance BitShow (DVS.Vector Word8) where+ bitShows = bitShows . DVS.toList++instance BitShow (DVS.Vector Word16) where+ bitShows = bitShows . DVS.toList++instance BitShow (DVS.Vector Word32) where+ bitShows = bitShows . DVS.toList++instance BitShow (DVS.Vector Word64) where+ bitShows = bitShows . DVS.toList++bitShow :: BitShow a => a -> String+bitShow a = bitShows a ""
+ src/HaskellWorks/Data/Bits/BitShown.hs view
@@ -0,0 +1,46 @@+{-# LANGUAGE DeriveFunctor #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE StandaloneDeriving #-}++module HaskellWorks.Data.Bits.BitShown+ ( BitShown(..)+ , bitShown+ ) where++import qualified Data.ByteString as BS+import Data.Maybe+import Data.String+import Data.Word+import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Data.Bits.BitShow+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.FromByteString++newtype BitShown a = BitShown a deriving (Eq, BitRead, BitShow)++deriving instance Functor BitShown++instance BitRead a => IsString (BitShown a) where+ fromString = fromJust . bitRead++instance BitShow a => Show (BitShown a) where+ show a = bitShows a ""++bitShown :: BitShown a -> a+bitShown (BitShown a) = a++deriving instance TestBit a => TestBit (BitShown a)++instance FromByteString (BitShown [Bool]) where+ fromByteString = BitShown . BS.foldr gen []+ where gen :: Word8 -> [Bool] -> [Bool]+ gen w bs =+ (w .&. 0x01 /= 0) :+ (w .&. 0x02 /= 0) :+ (w .&. 0x04 /= 0) :+ (w .&. 0x08 /= 0) :+ (w .&. 0x10 /= 0) :+ (w .&. 0x20 /= 0) :+ (w .&. 0x40 /= 0) :+ (w .&. 0x80 /= 0) : bs
+ src/HaskellWorks/Data/Bits/BitWise.hs view
@@ -0,0 +1,213 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Copyright: 2016 John Ky+-- License: MIT+--+-- Succinct operations.+module HaskellWorks.Data.Bits.BitWise+ ( -- * Bit map+ BitWise(..)+ , Shift(..)+ , TestBit(..)+ ) where++import qualified Data.Bits as B+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Positioning+import HaskellWorks.Data.Vector.VectorLike as VL+import Prelude as P++-- We pervasively use precedence to avoid excessive parentheses, and we use+-- the same precedence conventions of the C programming language: arithmetic+-- operators come first, ordered in the standard way, followed by shifts,+-- followed by logical operators; ⊕ sits between | and &.+infixl 9 .?.+infixl 8 .<., .>.+infixl 7 .&. -- Bitwise AND. eg. ∧+infixl 6 .^. -- Bitwise XOR. eg. ⊕+infixl 5 .|. -- Bitwise OR. eg. ∨++class Shift a where+ (.<.) :: a -> Count -> a+ (.>.) :: a -> Count -> a++class TestBit a where+ (.?.) :: a -> Position -> Bool++class BitWise a where+ (.&.) :: a -> a -> a+ (.|.) :: a -> a -> a+ (.^.) :: a -> a -> a+ comp :: a -> a+ all0s :: a+ all1s :: a++--------------------------------------------------------------------------------+-- Instances++instance TestBit Bool where+ (.?.) w 0 = w+ (.?.) _ _ = error "Invalid bit index"+ {-# INLINABLE (.?.) #-}++instance TestBit [Bool] where+ (.?.) v p = v !! fromIntegral p+ {-# INLINABLE (.?.) #-}++instance TestBit Word8 where+ (.?.) w n = B.testBit w (fromIntegral (getPosition n))+ {-# INLINABLE (.?.) #-}++instance TestBit Word16 where+ (.?.) w n = B.testBit w (fromIntegral (getPosition n))+ {-# INLINABLE (.?.) #-}++instance TestBit Word32 where+ (.?.) w n = B.testBit w (fromIntegral (getPosition n))+ {-# INLINABLE (.?.) #-}++instance TestBit Word64 where+ (.?.) w n = B.testBit w (fromIntegral (getPosition n))+ {-# INLINABLE (.?.) #-}++instance TestBit (DV.Vector Word8) where+ (.?.) v n = let (q, r) = n `quotRem` elemBitEnd v in (v !!! q) .?. r+ {-# INLINABLE (.?.) #-}++instance TestBit (DV.Vector Word16) where+ (.?.) v n = let (q, r) = n `quotRem` elemBitEnd v in (v !!! q) .?. r+ {-# INLINABLE (.?.) #-}++instance TestBit (DV.Vector Word32) where+ (.?.) v n = let (q, r) = n `quotRem` elemBitEnd v in (v !!! q) .?. r+ {-# INLINABLE (.?.) #-}++instance TestBit (DV.Vector Word64) where+ (.?.) v n = let (q, r) = n `quotRem` elemBitEnd v in (v !!! q) .?. r+ {-# INLINABLE (.?.) #-}++instance TestBit (DVS.Vector Word8) where+ (.?.) v n = let (q, r) = n `quotRem` elemBitEnd v in (v !!! q) .?. r+ {-# INLINABLE (.?.) #-}++instance TestBit (DVS.Vector Word16) where+ (.?.) v n = let (q, r) = n `quotRem` elemBitEnd v in (v !!! q) .?. r+ {-# INLINABLE (.?.) #-}++instance TestBit (DVS.Vector Word32) where+ (.?.) v n = let (q, r) = n `quotRem` elemBitEnd v in (v !!! q) .?. r+ {-# INLINABLE (.?.) #-}++instance TestBit (DVS.Vector Word64) where+ (.?.) v n = let (q, r) = n `quotRem` elemBitEnd v in (v !!! q) .?. r+ {-# INLINABLE (.?.) #-}++instance BitWise Word8 where+ (.&.) = (B..&.)+ {-# INLINABLE (.&.) #-}++ (.|.) = (B..|.)+ {-# INLINABLE (.|.) #-}++ (.^.) = B.xor+ {-# INLINABLE (.^.) #-}++ comp = B.complement+ {-# INLINABLE comp #-}++ all0s = 0+ {-# INLINABLE all0s #-}++ all1s = 0+ {-# INLINABLE all1s #-}++instance BitWise Word16 where+ (.&.) = (B..&.)+ {-# INLINABLE (.&.) #-}++ (.|.) = (B..|.)+ {-# INLINABLE (.|.) #-}++ (.^.) = B.xor+ {-# INLINABLE (.^.) #-}++ comp = B.complement+ {-# INLINABLE comp #-}++ all0s = 0+ {-# INLINABLE all0s #-}++ all1s = 0+ {-# INLINABLE all1s #-}++instance BitWise Word32 where+ (.&.) = (B..&.)+ {-# INLINABLE (.&.) #-}++ (.|.) = (B..|.)+ {-# INLINABLE (.|.) #-}++ (.^.) = B.xor+ {-# INLINABLE (.^.) #-}++ comp = B.complement+ {-# INLINABLE comp #-}++ all0s = 0+ {-# INLINABLE all0s #-}++ all1s = 0+ {-# INLINABLE all1s #-}++instance BitWise Word64 where+ (.&.) = (B..&.)+ {-# INLINABLE (.&.) #-}++ (.|.) = (B..|.)+ {-# INLINABLE (.|.) #-}++ (.^.) = B.xor+ {-# INLINABLE (.^.) #-}++ comp = B.complement+ {-# INLINABLE comp #-}++ all0s = 0+ {-# INLINABLE all0s #-}++ all1s = 0+ {-# INLINABLE all1s #-}++instance Shift Word8 where+ (.<.) w n = B.shiftL w (fromIntegral n)+ {-# INLINABLE (.<.) #-}++ (.>.) w n = B.shiftR w (fromIntegral n)+ {-# INLINABLE (.>.) #-}++instance Shift Word16 where+ (.<.) w n = B.shiftL w (fromIntegral n)+ {-# INLINABLE (.<.) #-}++ (.>.) w n = B.shiftR w (fromIntegral n)+ {-# INLINABLE (.>.) #-}++instance Shift Word32 where+ (.<.) w n = B.shiftL w (fromIntegral n)+ {-# INLINABLE (.<.) #-}++ (.>.) w n = B.shiftR w (fromIntegral n)+ {-# INLINABLE (.>.) #-}++instance Shift Word64 where+ (.<.) w n = B.shiftL w (fromIntegral n)+ {-# INLINABLE (.<.) #-}++ (.>.) w n = B.shiftR w (fromIntegral n)+ {-# INLINABLE (.>.) #-}
+ src/HaskellWorks/Data/Bits/ElemFixedBitSize.hs view
@@ -0,0 +1,82 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Copyright: 2016 John Ky+-- License: MIT+--+-- Succinct operations.++module HaskellWorks.Data.Bits.ElemFixedBitSize+ ( ElemFixedBitSize(..)+ ) where++import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Positioning++class ElemFixedBitSize v where+ type Elem v+ elemFixedBitSize :: v -> Count++instance ElemFixedBitSize [Bool] where+ type Elem [Bool] = Bool+ elemFixedBitSize _ = 1++instance ElemFixedBitSize [Word8] where+ type Elem [Word8] = Word8+ elemFixedBitSize _ = 8++instance ElemFixedBitSize [Word16] where+ type Elem [Word16] = Word16+ elemFixedBitSize _ = 16++instance ElemFixedBitSize [Word32] where+ type Elem [Word32] = Word32+ elemFixedBitSize _ = 32++instance ElemFixedBitSize [Word64] where+ type Elem [Word64] = Word64+ elemFixedBitSize _ = 64++instance ElemFixedBitSize (DV.Vector Bool) where+ type Elem (DV.Vector Bool) = Bool+ elemFixedBitSize _ = 1++instance ElemFixedBitSize (DV.Vector Word8) where+ type Elem (DV.Vector Word8) = Word8+ elemFixedBitSize _ = 8++instance ElemFixedBitSize (DV.Vector Word16) where+ type Elem (DV.Vector Word16) = Word16+ elemFixedBitSize _ = 16++instance ElemFixedBitSize (DV.Vector Word32) where+ type Elem (DV.Vector Word32) = Word32+ elemFixedBitSize _ = 32++instance ElemFixedBitSize (DV.Vector Word64) where+ type Elem (DV.Vector Word64) = Word64+ elemFixedBitSize _ = 64++instance ElemFixedBitSize (DVS.Vector Bool) where+ type Elem (DVS.Vector Bool) = Bool+ elemFixedBitSize _ = 1++instance ElemFixedBitSize (DVS.Vector Word8) where+ type Elem (DVS.Vector Word8) = Word8+ elemFixedBitSize _ = 8++instance ElemFixedBitSize (DVS.Vector Word16) where+ type Elem (DVS.Vector Word16) = Word16+ elemFixedBitSize _ = 16++instance ElemFixedBitSize (DVS.Vector Word32) where+ type Elem (DVS.Vector Word32) = Word32+ elemFixedBitSize _ = 32++instance ElemFixedBitSize (DVS.Vector Word64) where+ type Elem (DVS.Vector Word64) = Word64+ elemFixedBitSize _ = 64+
+ src/HaskellWorks/Data/Bits/FixedBitSize.hs view
@@ -0,0 +1,30 @@+-- |+-- Copyright: 2016 John Ky+-- License: MIT+--+-- Succinct operations.++module HaskellWorks.Data.Bits.FixedBitSize+ ( FixedBitSize(..)+ ) where++import Data.Word+import HaskellWorks.Data.Positioning++class FixedBitSize a where+ fixedBitSize :: a -> Count++instance FixedBitSize Bool where+ fixedBitSize _ = 1++instance FixedBitSize Word8 where+ fixedBitSize _ = 8++instance FixedBitSize Word16 where+ fixedBitSize _ = 16++instance FixedBitSize Word32 where+ fixedBitSize _ = 32++instance FixedBitSize Word64 where+ fixedBitSize _ = 64
+ src/HaskellWorks/Data/Bits/PopCount.hs view
@@ -0,0 +1,19 @@+{-# LANGUAGE MultiParamTypeClasses #-}++-- |+-- Copyright: 2016 John Ky+-- License: MIT+--+-- Succinct operations.+module HaskellWorks.Data.Bits.PopCount+ ( -- * Bit map+ PopCount(..)+ , module X+ ) where++import HaskellWorks.Data.Bits.PopCount.PopCount0 as X+import HaskellWorks.Data.Bits.PopCount.PopCount1 as X+import HaskellWorks.Data.Positioning++class PopCount v e where+ popCount :: e -> v -> Count
+ src/HaskellWorks/Data/Bits/PopCount/PopCount0.hs view
@@ -0,0 +1,96 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Copyright: 2016 John Ky+-- License: MIT+--+-- Succinct operations.+module HaskellWorks.Data.Bits.PopCount.PopCount0+ ( PopCount0(..)+ ) where++import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.PopCount.PopCount1+import HaskellWorks.Data.Positioning+import Prelude as P++class PopCount0 v where+ popCount0 :: v -> Count++instance PopCount0 Bool where+ popCount0 True = 0+ popCount0 False = 1+ {-# INLINABLE popCount0 #-}++instance PopCount0 Word8 where+ popCount0 x0 = bitLength x0 - popCount1 x0+ {-# INLINABLE popCount0 #-}++instance PopCount0 Word16 where+ popCount0 x0 = bitLength x0 - popCount1 x0+ {-# INLINABLE popCount0 #-}++instance PopCount0 Word32 where+ popCount0 x0 = bitLength x0 - popCount1 x0+ {-# INLINABLE popCount0 #-}++instance PopCount0 Word64 where+ popCount0 x0 = bitLength x0 - popCount1 x0+ {-# INLINABLE popCount0 #-}++instance PopCount0 [Bool] where+ popCount0 = P.sum . fmap popCount0+ {-# INLINABLE popCount0 #-}++instance PopCount0 [Word8] where+ popCount0 = P.sum . fmap popCount0+ {-# INLINABLE popCount0 #-}++instance PopCount0 [Word16] where+ popCount0 = P.sum . fmap popCount0+ {-# INLINABLE popCount0 #-}++instance PopCount0 [Word32] where+ popCount0 = P.sum . fmap popCount0+ {-# INLINABLE popCount0 #-}++instance PopCount0 [Word64] where+ popCount0 = P.sum . fmap popCount0+ {-# INLINABLE popCount0 #-}++instance PopCount0 (DV.Vector Word8) where+ popCount0 = DV.foldl (\c -> (c +) . popCount0) 0+ {-# INLINABLE popCount0 #-}++instance PopCount0 (DV.Vector Word16) where+ popCount0 = DV.foldl (\c -> (c +) . popCount0) 0+ {-# INLINABLE popCount0 #-}++instance PopCount0 (DV.Vector Word32) where+ popCount0 = DV.foldl (\c -> (c +) . popCount0) 0+ {-# INLINABLE popCount0 #-}++instance PopCount0 (DV.Vector Word64) where+ popCount0 = DV.foldl (\c -> (c +) . popCount0) 0+ {-# INLINABLE popCount0 #-}++instance PopCount0 (DVS.Vector Word8) where+ popCount0 = DVS.foldl (\c -> (c +) . popCount0) 0+ {-# INLINABLE popCount0 #-}++instance PopCount0 (DVS.Vector Word16) where+ popCount0 = DVS.foldl (\c -> (c +) . popCount0) 0+ {-# INLINABLE popCount0 #-}++instance PopCount0 (DVS.Vector Word32) where+ popCount0 = DVS.foldl (\c -> (c +) . popCount0) 0+ {-# INLINABLE popCount0 #-}++instance PopCount0 (DVS.Vector Word64) where+ popCount0 = DVS.foldl (\c -> (c +) . popCount0) 0+ {-# INLINABLE popCount0 #-}
+ src/HaskellWorks/Data/Bits/PopCount/PopCount1.hs view
@@ -0,0 +1,11 @@++-- |+-- Copyright: 2016 John Ky+-- License: MIT+--+-- Succinct operations.+module HaskellWorks.Data.Bits.PopCount.PopCount1+ ( module X+ ) where++import HaskellWorks.Data.Bits.PopCount.PopCount1.Broadword as X
+ src/HaskellWorks/Data/Bits/PopCount/PopCount1/Broadword.hs view
@@ -0,0 +1,111 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Copyright: 2016 John Ky+-- License: MIT+--+-- Succinct operations.+module HaskellWorks.Data.Bits.PopCount.PopCount1.Broadword+ ( PopCount1(..)+ ) where++import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitWise+import HaskellWorks.Data.Positioning+import Prelude as P++class PopCount1 v where+ popCount1 :: v -> Count++instance PopCount1 Bool where+ popCount1 True = 1+ popCount1 False = 0+ {-# INLINABLE popCount1 #-}++instance PopCount1 Word8 where+ popCount1 x0 = Count (fromIntegral x3)+ where+ x1 = x0 - ((x0 .&. 0xaa) .>. 1)+ x2 = (x1 .&. 0x33) + ((x1 .>. 2) .&. 0x33)+ x3 = (x2 + (x2 .>. 4)) .&. 0x0f+ {-# INLINABLE popCount1 #-}++instance PopCount1 Word16 where+ popCount1 x0 = Count (fromIntegral ((x3 * 0x0101) .>. 8))+ where+ x1 = x0 - ((x0 .&. 0xaaaa) .>. 1)+ x2 = (x1 .&. 0x3333) + ((x1 .>. 2) .&. 0x3333)+ x3 = (x2 + (x2 .>. 4)) .&. 0x0f0f+ {-# INLINABLE popCount1 #-}++instance PopCount1 Word32 where+ popCount1 x0 = Count (fromIntegral ((x3 * 0x01010101) .>. 24))+ where+ x1 = x0 - ((x0 .&. 0xaaaaaaaa) .>. 1)+ x2 = (x1 .&. 0x33333333) + ((x1 .>. 2) .&. 0x33333333)+ x3 = (x2 + (x2 .>. 4)) .&. 0x0f0f0f0f+ {-# INLINABLE popCount1 #-}++instance PopCount1 Word64 where+ popCount1 x0 = Count ((x3 * 0x0101010101010101) .>. 56)+ where+ x1 = x0 - ((x0 .&. 0xaaaaaaaaaaaaaaaa) .>. 1)+ x2 = (x1 .&. 0x3333333333333333) + ((x1 .>. 2) .&. 0x3333333333333333)+ x3 = (x2 + (x2 .>. 4)) .&. 0x0f0f0f0f0f0f0f0f+ {-# INLINABLE popCount1 #-}++instance PopCount1 [Bool] where+ popCount1 = P.sum . fmap popCount1+ {-# INLINABLE popCount1 #-}++instance PopCount1 [Word8] where+ popCount1 = P.sum . fmap popCount1+ {-# INLINABLE popCount1 #-}++instance PopCount1 [Word16] where+ popCount1 = P.sum . fmap popCount1+ {-# INLINABLE popCount1 #-}++instance PopCount1 [Word32] where+ popCount1 = P.sum . fmap popCount1+ {-# INLINABLE popCount1 #-}++instance PopCount1 [Word64] where+ popCount1 = P.sum . fmap popCount1+ {-# INLINABLE popCount1 #-}++instance PopCount1 (DV.Vector Word8) where+ popCount1 = DV.foldl (\c -> (c +) . popCount1) 0+ {-# INLINABLE popCount1 #-}++instance PopCount1 (DV.Vector Word16) where+ popCount1 = DV.foldl (\c -> (c +) . popCount1) 0+ {-# INLINABLE popCount1 #-}++instance PopCount1 (DV.Vector Word32) where+ popCount1 = DV.foldl (\c -> (c +) . popCount1) 0+ {-# INLINABLE popCount1 #-}++instance PopCount1 (DV.Vector Word64) where+ popCount1 = DV.foldl (\c -> (c +) . popCount1) 0+ {-# INLINABLE popCount1 #-}++instance PopCount1 (DVS.Vector Word8) where+ popCount1 = DVS.foldl (\c -> (c +) . popCount1) 0+ {-# INLINABLE popCount1 #-}++instance PopCount1 (DVS.Vector Word16) where+ popCount1 = DVS.foldl (\c -> (c +) . popCount1) 0+ {-# INLINABLE popCount1 #-}++instance PopCount1 (DVS.Vector Word32) where+ popCount1 = DVS.foldl (\c -> (c +) . popCount1) 0+ {-# INLINABLE popCount1 #-}++instance PopCount1 (DVS.Vector Word64) where+ popCount1 = DVS.foldl (\c -> (c +) . popCount1) 0+ {-# INLINABLE popCount1 #-}
+ src/HaskellWorks/Data/Bits/PopCount/PopCount1/GHC.hs view
@@ -0,0 +1,95 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Copyright: 2016 John Ky+-- License: MIT+--+-- Succinct operations.+module HaskellWorks.Data.Bits.PopCount.PopCount1.GHC+ ( PopCount1(..)+ ) where++import qualified Data.Bits as DB+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Positioning+import Prelude as P++class PopCount1 v where+ popCount1 :: v -> Count++instance PopCount1 Bool where+ popCount1 True = 1+ popCount1 False = 0+ {-# INLINABLE popCount1 #-}++instance PopCount1 Word8 where+ popCount1 = fromIntegral . DB.popCount+ {-# INLINABLE popCount1 #-}++instance PopCount1 Word16 where+ popCount1 = fromIntegral . DB.popCount+ {-# INLINABLE popCount1 #-}++instance PopCount1 Word32 where+ popCount1 = fromIntegral . DB.popCount+ {-# INLINABLE popCount1 #-}++instance PopCount1 Word64 where+ popCount1 = fromIntegral . DB.popCount+ {-# INLINABLE popCount1 #-}++instance PopCount1 [Bool] where+ popCount1 = P.sum . fmap popCount1+ {-# INLINABLE popCount1 #-}++instance PopCount1 [Word8] where+ popCount1 = P.sum . fmap popCount1+ {-# INLINABLE popCount1 #-}++instance PopCount1 [Word16] where+ popCount1 = P.sum . fmap popCount1+ {-# INLINABLE popCount1 #-}++instance PopCount1 [Word32] where+ popCount1 = P.sum . fmap popCount1+ {-# INLINABLE popCount1 #-}++instance PopCount1 [Word64] where+ popCount1 = P.sum . fmap popCount1+ {-# INLINABLE popCount1 #-}++instance PopCount1 (DV.Vector Word8) where+ popCount1 = DV.foldl (\c -> (c +) . popCount1) 0+ {-# INLINABLE popCount1 #-}++instance PopCount1 (DV.Vector Word16) where+ popCount1 = DV.foldl (\c -> (c +) . popCount1) 0+ {-# INLINABLE popCount1 #-}++instance PopCount1 (DV.Vector Word32) where+ popCount1 = DV.foldl (\c -> (c +) . popCount1) 0+ {-# INLINABLE popCount1 #-}++instance PopCount1 (DV.Vector Word64) where+ popCount1 = DV.foldl (\c -> (c +) . popCount1) 0+ {-# INLINABLE popCount1 #-}++instance PopCount1 (DVS.Vector Word8) where+ popCount1 = DVS.foldl (\c -> (c +) . popCount1) 0+ {-# INLINABLE popCount1 #-}++instance PopCount1 (DVS.Vector Word16) where+ popCount1 = DVS.foldl (\c -> (c +) . popCount1) 0+ {-# INLINABLE popCount1 #-}++instance PopCount1 (DVS.Vector Word32) where+ popCount1 = DVS.foldl (\c -> (c +) . popCount1) 0+ {-# INLINABLE popCount1 #-}++instance PopCount1 (DVS.Vector Word64) where+ popCount1 = DVS.foldl (\c -> (c +) . popCount1) 0+ {-# INLINABLE popCount1 #-}
+ src/HaskellWorks/Data/ByteString.hs view
@@ -0,0 +1,11 @@+module HaskellWorks.Data.ByteString+ ( chunkedBy+ ) where++import qualified Data.ByteString as BS++chunkedBy :: Int -> BS.ByteString -> [BS.ByteString]+chunkedBy n bs = if BS.length bs == 0+ then []+ else case BS.splitAt n bs of+ (as, zs) -> as : chunkedBy n zs
+ src/HaskellWorks/Data/FromByteString.hs view
@@ -0,0 +1,8 @@+module HaskellWorks.Data.FromByteString+ ( FromByteString(..)+ ) where++import Data.ByteString.Internal++class FromByteString a where+ fromByteString :: ByteString -> a
+ src/HaskellWorks/Data/FromForeignRegion.hs view
@@ -0,0 +1,7 @@+module HaskellWorks.Data.FromForeignRegion where++import Data.Word+import Foreign.ForeignPtr++class FromForeignRegion a where+ fromForeignRegion :: (ForeignPtr Word8, Int, Int) -> a
+ src/HaskellWorks/Data/Positioning.hs view
@@ -0,0 +1,34 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module HaskellWorks.Data.Positioning+ ( Count(..)+ , Position(..)+ , lastPositionOf+ , toCount+ , toPosition+ ) where++import Data.Int+import Data.Word+import System.Random++newtype Count = Count { getCount :: Word64 }+ deriving (Eq, Num, Ord, Enum, Integral, Real, Random)++instance Show Count where+ show (Count w64) = show w64++newtype Position = Position { getPosition :: Int64 }+ deriving (Eq, Num, Ord, Enum, Real, Integral)++instance Show Position where+ show (Position n) = show n++toPosition :: Count -> Position+toPosition (Count n) = Position (fromIntegral n)++toCount :: Position -> Count+toCount (Position n) = Count (fromIntegral n)++lastPositionOf :: Count -> Position+lastPositionOf (Count c) = Position (fromIntegral c - 1)
+ src/HaskellWorks/Data/Search.hs view
@@ -0,0 +1,12 @@+module HaskellWorks.Data.Search+ ( binarySearch+ ) where++binarySearch :: (Ord a, Integral n) => a -> (n -> a) -> n -> n -> n+binarySearch w f p q = if p + 1 >= q+ then p+ else let m = p + q `div` 2 in+ if w <= f m+ then binarySearch w f p m+ else binarySearch w f m q+{-# INLINABLE binarySearch #-}
+ src/HaskellWorks/Data/Vector/BoxedVectorLike.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Vector.BoxedVectorLike+ ( BoxedVectorLike(..)+ ) where++import qualified Data.Vector as DV+import Data.Word+import Foreign.Storable++class BoxedVectorLike v e where+ bImap :: (Int -> a -> b) -> v a -> v b+ bMap :: (a -> b) -> v a -> v b+ bUnfoldr :: (Storable a) => (b -> Maybe (a, b)) -> b -> v a+ bUnfoldrN :: (Storable a) => Int -> (b -> Maybe (a, b)) -> b -> v a++instance BoxedVectorLike DV.Vector Word8 where+ bImap = DV.imap+ bMap = DV.map+ bUnfoldr = DV.unfoldr+ bUnfoldrN = DV.unfoldrN+ {-# INLINABLE bImap #-}+ {-# INLINABLE bMap #-}+ {-# INLINABLE bUnfoldr #-}+ {-# INLINABLE bUnfoldrN #-}++instance BoxedVectorLike DV.Vector Word16 where+ bImap = DV.imap+ bMap = DV.map+ bUnfoldr = DV.unfoldr+ bUnfoldrN = DV.unfoldrN+ {-# INLINABLE bImap #-}+ {-# INLINABLE bMap #-}+ {-# INLINABLE bUnfoldr #-}+ {-# INLINABLE bUnfoldrN #-}++instance BoxedVectorLike DV.Vector Word32 where+ bImap = DV.imap+ bMap = DV.map+ bUnfoldr = DV.unfoldr+ bUnfoldrN = DV.unfoldrN+ {-# INLINABLE bImap #-}+ {-# INLINABLE bMap #-}+ {-# INLINABLE bUnfoldr #-}+ {-# INLINABLE bUnfoldrN #-}++instance BoxedVectorLike DV.Vector Word64 where+ bImap = DV.imap+ bMap = DV.map+ bUnfoldr = DV.unfoldr+ bUnfoldrN = DV.unfoldrN+ {-# INLINABLE bImap #-}+ {-# INLINABLE bMap #-}+ {-# INLINABLE bUnfoldr #-}+ {-# INLINABLE bUnfoldrN #-}
+ src/HaskellWorks/Data/Vector/StorableVectorLike.hs view
@@ -0,0 +1,56 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}++module HaskellWorks.Data.Vector.StorableVectorLike+ ( StorableVectorLike(..)+ ) where++import qualified Data.Vector.Storable as DVS+import Data.Word+import Foreign.Storable++class StorableVectorLike v e where+ sImap :: (Storable a, Storable b) => (Int -> a -> b) -> v a -> v b+ sMap :: (Storable a, Storable b) => (a -> b) -> v a -> v b+ sUnfoldr :: (Storable a) => (b -> Maybe (a, b)) -> b -> v a+ sUnfoldrN :: (Storable a) => Int -> (b -> Maybe (a, b)) -> b -> v a++instance StorableVectorLike DVS.Vector Word8 where+ sImap = DVS.imap+ sMap = DVS.map+ sUnfoldr = DVS.unfoldr+ sUnfoldrN = DVS.unfoldrN+ {-# INLINABLE sImap #-}+ {-# INLINABLE sMap #-}+ {-# INLINABLE sUnfoldr #-}+ {-# INLINABLE sUnfoldrN #-}++instance StorableVectorLike DVS.Vector Word16 where+ sImap = DVS.imap+ sMap = DVS.map+ sUnfoldr = DVS.unfoldr+ sUnfoldrN = DVS.unfoldrN+ {-# INLINABLE sImap #-}+ {-# INLINABLE sMap #-}+ {-# INLINABLE sUnfoldr #-}+ {-# INLINABLE sUnfoldrN #-}++instance StorableVectorLike DVS.Vector Word32 where+ sImap = DVS.imap+ sMap = DVS.map+ sUnfoldr = DVS.unfoldr+ sUnfoldrN = DVS.unfoldrN+ {-# INLINABLE sImap #-}+ {-# INLINABLE sMap #-}+ {-# INLINABLE sUnfoldr #-}+ {-# INLINABLE sUnfoldrN #-}++instance StorableVectorLike DVS.Vector Word64 where+ sImap = DVS.imap+ sMap = DVS.map+ sUnfoldr = DVS.unfoldr+ sUnfoldrN = DVS.unfoldrN+ {-# INLINABLE sImap #-}+ {-# INLINABLE sMap #-}+ {-# INLINABLE sUnfoldr #-}+ {-# INLINABLE sUnfoldrN #-}
+ src/HaskellWorks/Data/Vector/VectorLike.hs view
@@ -0,0 +1,329 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.Vector.VectorLike+ ( VectorLike(..)+ ) where++import qualified Data.ByteString as BS+import qualified Data.Vector as DV+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Positioning++class VectorLike v where+ type Elem v+ vToList :: v -> [Elem v]+ vFromList :: [Elem v] -> v+ (!!!) :: v -> Position -> Elem v+ vConcat :: [v] -> v+ vEmpty :: v+ vFilter :: (Elem v -> Bool) -> v -> v+ vGenerate :: Int -> (Int -> Elem v) -> v+ vLength :: v -> Count+ vSnoc :: v -> Elem v -> v+ vDrop :: Count -> v -> v+ vTake :: Count -> v -> v+ vIndex :: v -> Position -> Elem v+ vSlice :: Position -> Position -> v -> v++instance VectorLike String where+ type Elem String = Char+ vToList = id+ vFromList = id+ (!!!) v (Position i) = v !! fromIntegral i+ vConcat = concat+ vEmpty = ""+ vFilter = filter+ vGenerate n f = f `fmap` [0 .. (n - 1)]+ vLength = Count . fromIntegral . length+ vSnoc v c = v ++ [c]+ vDrop = drop . fromIntegral+ vTake = take . fromIntegral+ vIndex v (Position i) = v !! fromIntegral i+ vSlice (Position i) (Position j) = take (fromIntegral j) . drop (fromIntegral i)+ {-# INLINABLE vToList #-}+ {-# INLINABLE vFromList #-}+ {-# INLINABLE (!!!) #-}+ {-# INLINABLE vConcat #-}+ {-# INLINABLE vEmpty #-}+ {-# INLINABLE vFilter #-}+ {-# INLINABLE vGenerate #-}+ {-# INLINABLE vLength #-}+ {-# INLINABLE vSnoc #-}+ {-# INLINABLE vDrop #-}+ {-# INLINABLE vTake #-}+ {-# INLINABLE vIndex #-}+ {-# INLINABLE vSlice #-}++instance VectorLike BS.ByteString where+ type Elem BS.ByteString = Word8++ vToList = BS.unpack+ vFromList = BS.pack+ (!!!) v (Position i) = v `BS.index` fromIntegral i+ vConcat = BS.concat+ vEmpty = BS.empty+ vFilter = BS.filter+ vGenerate n f = fst (BS.unfoldrN n go 0)+ where go i = if i /= n then Just (f i, i + 1) else Nothing+ vLength = Count . fromIntegral . BS.length+ vSnoc = BS.snoc+ vDrop = BS.drop . fromIntegral+ vTake = BS.take . fromIntegral+ vIndex v (Position i) = BS.index v (fromIntegral i)+ vSlice (Position i) (Position j) = BS.take (fromIntegral j) . BS.drop (fromIntegral i)+ {-# INLINABLE vToList #-}+ {-# INLINABLE vFromList #-}+ {-# INLINABLE (!!!) #-}+ {-# INLINABLE vConcat #-}+ {-# INLINABLE vEmpty #-}+ {-# INLINABLE vFilter #-}+ {-# INLINABLE vGenerate #-}+ {-# INLINABLE vLength #-}+ {-# INLINABLE vSnoc #-}+ {-# INLINABLE vDrop #-}+ {-# INLINABLE vTake #-}+ {-# INLINABLE vIndex #-}+ {-# INLINABLE vSlice #-}++instance VectorLike (DV.Vector Word8) where+ type Elem (DV.Vector Word8) = Word8++ vToList = DV.toList+ vFromList = DV.fromList+ (!!!) v (Position i) = v DV.! fromIntegral i+ vConcat = DV.concat+ vEmpty = DV.empty+ vFilter = DV.filter+ vGenerate = DV.generate+ vLength = Count . fromIntegral . DV.length+ vSnoc = DV.snoc+ vDrop = DV.drop . fromIntegral+ vTake = DV.take . fromIntegral+ vIndex v (Position i) = DV.unsafeIndex v (fromIntegral i)+ vSlice (Position i) (Position j) = DV.unsafeSlice (fromIntegral i) (fromIntegral j)+ {-# INLINABLE vToList #-}+ {-# INLINABLE vFromList #-}+ {-# INLINABLE (!!!) #-}+ {-# INLINABLE vConcat #-}+ {-# INLINABLE vEmpty #-}+ {-# INLINABLE vFilter #-}+ {-# INLINABLE vGenerate #-}+ {-# INLINABLE vLength #-}+ {-# INLINABLE vSnoc #-}+ {-# INLINABLE vDrop #-}+ {-# INLINABLE vTake #-}+ {-# INLINABLE vIndex #-}+ {-# INLINABLE vSlice #-}++instance VectorLike (DV.Vector Word16) where+ type Elem (DV.Vector Word16) = Word16++ vToList = DV.toList+ vFromList = DV.fromList+ (!!!) v (Position i) = v DV.! fromIntegral i+ vConcat = DV.concat+ vEmpty = DV.empty+ vFilter = DV.filter+ vGenerate = DV.generate+ vLength = Count . fromIntegral . DV.length+ vSnoc = DV.snoc+ vDrop = DV.drop . fromIntegral+ vTake = DV.take . fromIntegral+ vIndex v (Position i) = DV.unsafeIndex v (fromIntegral i)+ vSlice (Position i) (Position j) = DV.unsafeSlice (fromIntegral i) (fromIntegral j)+ {-# INLINABLE vToList #-}+ {-# INLINABLE vFromList #-}+ {-# INLINABLE (!!!) #-}+ {-# INLINABLE vConcat #-}+ {-# INLINABLE vEmpty #-}+ {-# INLINABLE vFilter #-}+ {-# INLINABLE vGenerate #-}+ {-# INLINABLE vLength #-}+ {-# INLINABLE vSnoc #-}+ {-# INLINABLE vDrop #-}+ {-# INLINABLE vTake #-}+ {-# INLINABLE vIndex #-}+ {-# INLINABLE vSlice #-}++instance VectorLike (DV.Vector Word32) where+ type Elem (DV.Vector Word32) = Word32++ vToList = DV.toList+ vFromList = DV.fromList+ (!!!) v (Position i) = v DV.! fromIntegral i+ vConcat = DV.concat+ vEmpty = DV.empty+ vFilter = DV.filter+ vGenerate = DV.generate+ vLength = Count . fromIntegral . DV.length+ vSnoc = DV.snoc+ vDrop = DV.drop . fromIntegral+ vTake = DV.take . fromIntegral+ vIndex v (Position i) = DV.unsafeIndex v (fromIntegral i)+ vSlice (Position i) (Position j) = DV.unsafeSlice (fromIntegral i) (fromIntegral j)+ {-# INLINABLE vToList #-}+ {-# INLINABLE vFromList #-}+ {-# INLINABLE (!!!) #-}+ {-# INLINABLE vConcat #-}+ {-# INLINABLE vEmpty #-}+ {-# INLINABLE vFilter #-}+ {-# INLINABLE vGenerate #-}+ {-# INLINABLE vLength #-}+ {-# INLINABLE vSnoc #-}+ {-# INLINABLE vDrop #-}+ {-# INLINABLE vTake #-}+ {-# INLINABLE vIndex #-}+ {-# INLINABLE vSlice #-}++instance VectorLike (DV.Vector Word64) where+ type Elem (DV.Vector Word64) = Word64++ vToList = DV.toList+ vFromList = DV.fromList+ (!!!) v (Position i) = v DV.! fromIntegral i+ vConcat = DV.concat+ vEmpty = DV.empty+ vFilter = DV.filter+ vGenerate = DV.generate+ vLength = Count . fromIntegral . DV.length+ vSnoc = DV.snoc+ vDrop = DV.drop . fromIntegral+ vTake = DV.take . fromIntegral+ vIndex v (Position i) = DV.unsafeIndex v (fromIntegral i)+ vSlice (Position i) (Position j) = DV.unsafeSlice (fromIntegral i) (fromIntegral j)+ {-# INLINABLE vToList #-}+ {-# INLINABLE vFromList #-}+ {-# INLINABLE (!!!) #-}+ {-# INLINABLE vConcat #-}+ {-# INLINABLE vEmpty #-}+ {-# INLINABLE vFilter #-}+ {-# INLINABLE vGenerate #-}+ {-# INLINABLE vLength #-}+ {-# INLINABLE vSnoc #-}+ {-# INLINABLE vDrop #-}+ {-# INLINABLE vTake #-}+ {-# INLINABLE vIndex #-}+ {-# INLINABLE vSlice #-}++instance VectorLike (DVS.Vector Word8) where+ type Elem (DVS.Vector Word8) = Word8++ vToList = DVS.toList+ vFromList = DVS.fromList+ (!!!) v (Position i) = v DVS.! fromIntegral i+ vConcat = DVS.concat+ vEmpty = DVS.empty+ vFilter = DVS.filter+ vGenerate = DVS.generate+ vLength = Count . fromIntegral . DVS.length+ vSnoc = DVS.snoc+ vDrop = DVS.drop . fromIntegral+ vTake = DVS.take . fromIntegral+ vIndex v (Position i) = DVS.unsafeIndex v (fromIntegral i)+ vSlice (Position i) (Position j) = DVS.unsafeSlice (fromIntegral i) (fromIntegral j)+ {-# INLINABLE vToList #-}+ {-# INLINABLE vFromList #-}+ {-# INLINABLE (!!!) #-}+ {-# INLINABLE vConcat #-}+ {-# INLINABLE vEmpty #-}+ {-# INLINABLE vFilter #-}+ {-# INLINABLE vGenerate #-}+ {-# INLINABLE vLength #-}+ {-# INLINABLE vSnoc #-}+ {-# INLINABLE vDrop #-}+ {-# INLINABLE vTake #-}+ {-# INLINABLE vIndex #-}+ {-# INLINABLE vSlice #-}++instance VectorLike (DVS.Vector Word16) where+ type Elem (DVS.Vector Word16) = Word16++ vToList = DVS.toList+ vFromList = DVS.fromList+ (!!!) v (Position i) = v DVS.! fromIntegral i+ vConcat = DVS.concat+ vEmpty = DVS.empty+ vFilter = DVS.filter+ vGenerate = DVS.generate+ vLength = Count . fromIntegral . DVS.length+ vSnoc = DVS.snoc+ vDrop = DVS.drop . fromIntegral+ vTake = DVS.take . fromIntegral+ vIndex v (Position i) = DVS.unsafeIndex v (fromIntegral i)+ vSlice (Position i) (Position j) = DVS.unsafeSlice (fromIntegral i) (fromIntegral j)+ {-# INLINABLE vToList #-}+ {-# INLINABLE vFromList #-}+ {-# INLINABLE (!!!) #-}+ {-# INLINABLE vConcat #-}+ {-# INLINABLE vEmpty #-}+ {-# INLINABLE vFilter #-}+ {-# INLINABLE vGenerate #-}+ {-# INLINABLE vLength #-}+ {-# INLINABLE vSnoc #-}+ {-# INLINABLE vDrop #-}+ {-# INLINABLE vTake #-}+ {-# INLINABLE vIndex #-}+ {-# INLINABLE vSlice #-}++instance VectorLike (DVS.Vector Word32) where+ type Elem (DVS.Vector Word32) = Word32++ vToList = DVS.toList+ vFromList = DVS.fromList+ (!!!) v (Position i) = v DVS.! fromIntegral i+ vConcat = DVS.concat+ vEmpty = DVS.empty+ vFilter = DVS.filter+ vGenerate = DVS.generate+ vLength = Count . fromIntegral . DVS.length+ vSnoc = DVS.snoc+ vDrop = DVS.drop . fromIntegral+ vTake = DVS.take . fromIntegral+ vIndex v (Position i) = DVS.unsafeIndex v (fromIntegral i)+ vSlice (Position i) (Position j) = DVS.unsafeSlice (fromIntegral i) (fromIntegral j)+ {-# INLINABLE vToList #-}+ {-# INLINABLE vFromList #-}+ {-# INLINABLE (!!!) #-}+ {-# INLINABLE vConcat #-}+ {-# INLINABLE vEmpty #-}+ {-# INLINABLE vFilter #-}+ {-# INLINABLE vGenerate #-}+ {-# INLINABLE vLength #-}+ {-# INLINABLE vSnoc #-}+ {-# INLINABLE vDrop #-}+ {-# INLINABLE vTake #-}+ {-# INLINABLE vIndex #-}+ {-# INLINABLE vSlice #-}++instance VectorLike (DVS.Vector Word64) where+ type Elem (DVS.Vector Word64) = Word64++ vToList = DVS.toList+ vFromList = DVS.fromList+ (!!!) v (Position i) = v DVS.! fromIntegral i+ vConcat = DVS.concat+ vEmpty = DVS.empty+ vFilter = DVS.filter+ vGenerate = DVS.generate+ vLength = Count . fromIntegral . DVS.length+ vSnoc = DVS.snoc+ vDrop = DVS.drop . fromIntegral+ vTake = DVS.take . fromIntegral+ vIndex v (Position i) = DVS.unsafeIndex v (fromIntegral i)+ vSlice (Position i) (Position j) = DVS.unsafeSlice (fromIntegral i) (fromIntegral j)+ {-# INLINABLE vToList #-}+ {-# INLINABLE vFromList #-}+ {-# INLINABLE (!!!) #-}+ {-# INLINABLE vConcat #-}+ {-# INLINABLE vEmpty #-}+ {-# INLINABLE vFilter #-}+ {-# INLINABLE vGenerate #-}+ {-# INLINABLE vLength #-}+ {-# INLINABLE vSnoc #-}+ {-# INLINABLE vDrop #-}+ {-# INLINABLE vTake #-}+ {-# INLINABLE vIndex #-}+ {-# INLINABLE vSlice #-}
+ src/HaskellWorks/Data/Word.hs view
@@ -0,0 +1,40 @@+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE TypeFamilies #-}++module HaskellWorks.Data.Word where++import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.BitWise++class WordConcat a where+ type DoubleWords a+ leConcat :: a -> a -> DoubleWords a++class WordSplit a where+ type HalfWords a+ leSplit :: a -> (HalfWords a, HalfWords a)++instance WordConcat Word8 where+ type DoubleWords Word8 = Word16+ leConcat a b = (fromIntegral b .<. bitLength a) .|. fromIntegral a++instance WordConcat Word16 where+ type DoubleWords Word16 = Word32+ leConcat a b = (fromIntegral b .<. bitLength a) .|. fromIntegral a++instance WordConcat Word32 where+ type DoubleWords Word32 = Word64+ leConcat a b = (fromIntegral b .<. bitLength a) .|. fromIntegral a++instance WordSplit Word64 where+ type HalfWords Word64 = Word32+ leSplit a = (fromIntegral a, fromIntegral (a .>. 32))++instance WordSplit Word32 where+ type HalfWords Word32 = Word16+ leSplit a = (fromIntegral a, fromIntegral (a .>. 16))++instance WordSplit Word16 where+ type HalfWords Word16 = Word8+ leSplit a = (fromIntegral a, fromIntegral (a .>. 8))
+ test/HaskellWorks/Data/Bits/BitReadSpec.hs view
@@ -0,0 +1,48 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Bits.BitReadSpec (spec) where++import qualified Data.Vector as DV+import Data.Word+import HaskellWorks.Data.Bits.BitRead+import HaskellWorks.Data.Bits.BitShow+import Test.Hspec++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.BitReadSpec" $ do+ it "bitRead \"10000000 101\" :: Maybe [Word8]" $+ let w = bitRead "10000000 101" :: Maybe [Bool] in+ w `shouldBe` Just [True, False, False, False, False, False, False, False, True, False, True]+ it "bitRead \"10000000 101\" :: Maybe [Word8]"$+ let w = bitRead "10000000 101" :: Maybe [Word8] in+ w `shouldBe` Just [1, 5]+ it "bitRead \"11100100 10101111 1\" :: Maybe [Word8]" $+ let ws = bitRead "11100100 10101111 1" :: Maybe [Word8] in+ ws `shouldBe` Just [39, 245, 1]+ it "bitRead \"\" :: Maybe [Word8]" $+ let ws = bitRead "" :: Maybe [Word8] in+ ws `shouldBe` Just []+ it "bitRead \"10000000 101\" :: Maybe (DV.Vector Word8)" $+ let v = bitRead "10000000 101" :: Maybe (DV.Vector Word8) in+ v `shouldBe` Just (DV.fromList [1, 5])+ it "bitRead \"11100100 10101111 1\" :: Maybe (DV.Vector Word8)" $+ let v = bitRead "11100100 10101111 1" :: Maybe (DV.Vector Word8) in+ v `shouldBe` Just (DV.fromList [39, 245, 1])+ it "bitRead \"11100100 10101111 1\" :: Maybe (DV.Vector Word16)" $+ let v = bitRead "11100100 10101111 1" :: Maybe (DV.Vector Word16) in+ v `shouldBe` Just (DV.fromList [39 + 62720, 1])+ it "bitRead \"\" :: Maybe (DV.Vector Word8)" $+ let v = bitRead "" :: Maybe (DV.Vector Word8) in+ v `shouldBe` Just (DV.fromList [])+ it "bitShow (8 :: Word8)" $+ let bs = bitShow (8 :: Word8) in+ bs `shouldBe` "00010000"+ it "bitShow (8 :: Word64)" $+ let bs = bitShow (8 :: Word64) in+ bs `shouldBe` "00010000 00000000 00000000 00000000 00000000 00000000 00000000 00000000"+ it "bitShow [0x0102040810204080 :: Word64]" $+ let bs = bitShow [0x0102040810204080 :: Word64] in+ bs `shouldBe` "00000001 00000010 00000100 00001000 00010000 00100000 01000000 10000000"
+ test/HaskellWorks/Data/Bits/BitWiseSpec.hs view
@@ -0,0 +1,68 @@+{-# OPTIONS_GHC -fno-warn-incomplete-patterns #-}+{-# LANGUAGE ScopedTypeVariables #-}++module HaskellWorks.Data.Bits.BitWiseSpec (spec) where++import qualified Data.Bits as B+import qualified Data.Vector.Storable as DVS+import Data.Word+import HaskellWorks.Data.Bits.BitLength+import HaskellWorks.Data.Bits.PopCount.PopCount0+import HaskellWorks.Data.Bits.PopCount.PopCount1+import Test.Hspec+import Test.QuickCheck++{-# ANN module ("HLint: ignore Redundant do" :: String) #-}++spec :: Spec+spec = describe "HaskellWorks.Data.SuccinctSpec" $ do+ describe "for popCount0" $ do+ it "for Word8 matches Data.Bits implementation" $ property $+ \(w :: Word8 ) -> popCount0 w == bitLength w - fromIntegral (B.popCount w)+ it "for Word16 matches Data.Bits implementation" $ property $+ \(w :: Word16) -> popCount0 w == bitLength w - fromIntegral (B.popCount w)+ it "for Word32 matches Data.Bits implementation" $ property $+ \(w :: Word32) -> popCount0 w == bitLength w - fromIntegral (B.popCount w)+ it "for Word64 matches Data.Bits implementation" $ property $+ \(w :: Word64) -> popCount0 w == bitLength w - fromIntegral (B.popCount w)+ it "for [Word8] matches Data.Bits implementation" $ property $+ \(w :: [Word8] ) -> popCount0 w == bitLength w - sum (fmap (fromIntegral . B.popCount) w)+ it "for [Word16] matches Data.Bits implementation" $ property $+ \(w :: [Word16]) -> popCount0 w == bitLength w - sum (fmap (fromIntegral . B.popCount) w)+ it "for [Word32] matches Data.Bits implementation" $ property $+ \(w :: [Word32]) -> popCount0 w == bitLength w - sum (fmap (fromIntegral . B.popCount) w)+ it "for [Word64] matches Data.Bits implementation" $ property $+ \(w :: [Word64]) -> popCount0 w == bitLength w - sum (fmap (fromIntegral . B.popCount) w)+ it "for [Word8] matches Data.Bits implementation" $ property $+ \(w :: [Word8] ) -> popCount0 w == popCount0 (DVS.fromList w)+ it "for [Word16] matches Data.Bits implementation" $ property $+ \(w :: [Word16]) -> popCount0 w == popCount0 (DVS.fromList w)+ it "for [Word32] matches Data.Bits implementation" $ property $+ \(w :: [Word32]) -> popCount0 w == popCount0 (DVS.fromList w)+ it "for [Word64] matches Data.Bits implementation" $ property $+ \(w :: [Word64]) -> popCount0 w == popCount0 (DVS.fromList w)+ describe "for popCount1" $ do+ it "for Word8 matches Data.Bits implementation" $ property $+ \(w :: Word8 ) -> popCount1 w == fromIntegral (B.popCount w)+ it "for Word16 matches Data.Bits implementation" $ property $+ \(w :: Word16) -> popCount1 w == fromIntegral (B.popCount w)+ it "for Word32 matches Data.Bits implementation" $ property $+ \(w :: Word32) -> popCount1 w == fromIntegral (B.popCount w)+ it "for Word64 matches Data.Bits implementation" $ property $+ \(w :: Word64) -> popCount1 w == fromIntegral (B.popCount w)+ it "for [Word8] matches Data.Bits implementation" $ property $+ \(w :: [Word8] ) -> popCount1 w == sum (fmap (fromIntegral . B.popCount) w)+ it "for [Word16] matches Data.Bits implementation" $ property $+ \(w :: [Word16]) -> popCount1 w == sum (fmap (fromIntegral . B.popCount) w)+ it "for [Word32] matches Data.Bits implementation" $ property $+ \(w :: [Word32]) -> popCount1 w == sum (fmap (fromIntegral . B.popCount) w)+ it "for [Word64] matches Data.Bits implementation" $ property $+ \(w :: [Word64]) -> popCount1 w == sum (fmap (fromIntegral . B.popCount) w)+ it "for [Word8] matches Data.Bits implementation" $ property $+ \(w :: [Word8] ) -> popCount1 w == popCount1 (DVS.fromList w)+ it "for [Word16] matches Data.Bits implementation" $ property $+ \(w :: [Word16]) -> popCount1 w == popCount1 (DVS.fromList w)+ it "for [Word32] matches Data.Bits implementation" $ property $+ \(w :: [Word32]) -> popCount1 w == popCount1 (DVS.fromList w)+ it "for [Word64] matches Data.Bits implementation" $ property $+ \(w :: [Word64]) -> popCount1 w == popCount1 (DVS.fromList w)
+ test/Spec.hs view
@@ -0,0 +1,1 @@+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
+ test/data/sample.json view
@@ -0,0 +1,28 @@+{+ "widget": {+ "debug": "on",+ "window": {+ "title": "Sample Konfabulator Widget",+ "name": "main_window",+ "width": 500,+ "height": 500+ },+ "image": {+ "src": "Images/Sun.png",+ "name": "sun1",+ "hOffset": 250,+ "vOffset": 250,+ "alignment": "center"+ },+ "text": {+ "data": "Click Here",+ "size": 36,+ "style": "bold",+ "name": "text1",+ "hOffset": 250,+ "vOffset": 100,+ "alignment": "center",+ "onMouseUp": "sun1.opacity = (sun1.opacity / 100) * 90;"+ }+ }+}