bits (empty) → 0.1

raw patch · 16 files changed

+847/−0 lines, 16 filesdep +basedep +bytesdep +directorybuild-type:Customsetup-changed

Dependencies added: base, bytes, directory, doctest, filepath, mtl, transformers

Files

• .ghci +2/−0
• .gitignore +13/−0
• .travis.yml +24/−0
• .vim.custom +31/−0
• AUTHORS.markdown +11/−0
• CHANGELOG.markdown +3/−0
• LICENSE +30/−0
• README.markdown +15/−0
• Setup.lhs +55/−0
• bits.cabal +76/−0
• cbits/debruijn.c +39/−0
• src/Data/Bits/Coding.hs +236/−0
• src/Data/Bits/Extras.hs +195/−0
• tests/doctests.hsc +74/−0
• travis/cabal-apt-install +27/−0
• travis/config +16/−0

@@ -0,0 +1,2 @@+:set -isrc -idist/build/autogen -optP-include -optPdist/build/autogen/cabal_macros.h -optP-Iincludes+:set -v0

@@ -0,0 +1,13 @@+dist+docs+wiki+TAGS+tags+wip+.DS_Store+.*.swp+.*.swo+*.o+*.hi+*~+*#

@@ -0,0 +1,24 @@+language: haskell+before_install:+  # Uncomment whenever hackage is down.+  # - mkdir -p ~/.cabal && cp travis/config ~/.cabal/config && cabal update+  - cabal update+  - travis/cabal-apt-install $mode++install:+  - cabal configure -flib-Werror $mode+  - cabal build++script:+  - $script && hlint src --cpp-define HLINT++notifications:+  irc:+    channels:+      - "irc.freenode.org#haskell-lens"+    skip_join: true+    template:+      - "\x0313bits\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}"++env:+  - mode="--enable-tests" script="cabal test --show-details=always"

@@ -0,0 +1,31 @@+" Add the following to your .vimrc to automatically load this on startup++" if filereadable(".vim.custom")+"     so .vim.custom+" endif++function StripTrailingWhitespace()+  let myline=line(".")+  let mycolumn = col(".")+  silent %s/  *$//+  call cursor(myline, mycolumn)+endfunction++" enable syntax highlighting+syntax on++" search for the tags file anywhere between here and /+set tags=TAGS;/++" highlight tabs and trailing spaces+set listchars=tab:‗‗,trail:‗+set list++" f2 runs hasktags+map <F2> :exec ":!hasktags -x -c --ignore src"<CR><CR>++" strip trailing whitespace before saving+" au BufWritePre *.hs,*.markdown silent! cal StripTrailingWhitespace()++" rebuild hasktags after saving+au BufWritePost *.hs silent! :exec ":!hasktags -x -c --ignore src"

@@ -0,0 +1,11 @@+Analytics was started by [Edward Kmett](https://github.com/ekmett) in response to a question by [Alec Heller](https://github.com/deviant-logic) about if he should use `bound` to implement datalog. It has since somewhat expanded in scope.++`bits` was spun out of work that was being done on the `analytics` repository in bitwise encodings for compression schemes.++You can watch contributors carry on the quest for bragging rights in the [contributors graph](https://github.com/analytics/bits/graphs/contributors).++Omission from this list is by no means an attempt to discount your contribution.++Thank you for all of your help!++-Edward Kmett

@@ -0,0 +1,3 @@+0.1+---+* Repository initialized

@@ -0,0 +1,30 @@+Copyright 2013 Edward Kmett++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions+are met:++1. Redistributions of source code must retain the above copyright+   notice, this list of conditions and the following disclaimer.++2. 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.++3. Neither the name of the author nor the names of his contributors+   may be used to endorse or promote products derived from this software+   without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE AUTHORS ``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 AUTHORS 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.

@@ -0,0 +1,15 @@+bits+=====++[![Build Status](https://secure.travis-ci.org/analytics/bits.png)](http://travis-ci.org/analytics/bits)++This package provides a number of tools that are useful for dealing with files or data on a bitwise basis.++Contact Information+-------------------++Contributions and bug reports are welcome!++Please feel free to contact me through github or on the #haskell IRC channel on irc.freenode.net.++-Edward Kmett

@@ -0,0 +1,55 @@+#!/usr/bin/runhaskell+\begin{code}+{-# OPTIONS_GHC -Wall #-}+module Main (main) where++import Data.List ( nub )+import Data.Version ( showVersion )+import Distribution.Package ( PackageName(PackageName), Package, PackageId, InstalledPackageId, packageVersion, packageName )+import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) )+import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks )+import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose, copyFiles )+import Distribution.Simple.BuildPaths ( autogenModulesDir )+import Distribution.Simple.Setup ( BuildFlags(buildVerbosity), Flag(..), fromFlag, HaddockFlags(haddockDistPref))+import Distribution.Simple.LocalBuildInfo ( withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps) )+import Distribution.Text ( display )+import Distribution.Verbosity ( Verbosity, normal )+import System.FilePath ( (</>) )++main :: IO ()+main = defaultMainWithHooks simpleUserHooks+  { buildHook = \pkg lbi hooks flags -> do+     generateBuildModule (fromFlag (buildVerbosity flags)) pkg lbi+     buildHook simpleUserHooks pkg lbi hooks flags+  , postHaddock = \args flags pkg lbi -> do+     copyFiles normal (haddockOutputDir flags pkg) []+     postHaddock simpleUserHooks args flags pkg lbi+  }++haddockOutputDir :: Package p => HaddockFlags -> p -> FilePath+haddockOutputDir flags pkg = destDir where+  baseDir = case haddockDistPref flags of+    NoFlag -> "."+    Flag x -> x+  destDir = baseDir </> "doc" </> "html" </> display (packageName pkg)++generateBuildModule :: Verbosity -> PackageDescription -> LocalBuildInfo -> IO ()+generateBuildModule verbosity pkg lbi = do+  let dir = autogenModulesDir lbi+  createDirectoryIfMissingVerbose verbosity True dir+  withLibLBI pkg lbi $ \_ libcfg -> do+    withTestLBI pkg lbi $ \suite suitecfg -> do+      rewriteFile (dir </> "Build_" ++ testName suite ++ ".hs") $ unlines+        [ "module Build_" ++ testName suite ++ " where"+        , "deps :: [String]"+        , "deps = " ++ (show $ formatdeps (testDeps libcfg suitecfg))+        ]+  where+    formatdeps = map (formatone . snd)+    formatone p = case packageName p of+      PackageName n -> n ++ "-" ++ showVersion (packageVersion p)++testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)]+testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys++\end{code}

@@ -0,0 +1,76 @@+name:          bits+category:      Data, Serialization+version:       0.1+license:       BSD3+cabal-version: >= 1.8+license-file:  LICENSE+author:        Edward A. Kmett+maintainer:    Edward A. Kmett <ekmett@gmail.com>+stability:     experimental+homepage:      http://github.com/analytics/bits+bug-reports:   http://github.com/analytics/bits/issues+copyright:     Copyright (C) 2013 Edward A. Kmett+build-type:    Custom+tested-with:   GHC == 7.4.1, GHC == 7.6.1+synopsis:      Various bit twiddling and bitwise serialization primitives+description:   Various bit twiddling and bitwise serialization primitives++extra-source-files:+  .travis.yml+  .ghci+  .gitignore+  .vim.custom+  travis/cabal-apt-install+  travis/config+  AUTHORS.markdown+  README.markdown+  CHANGELOG.markdown++source-repository head+  type: git+  location: git://github.com/analytics/bits.git++-- You can disable the doctests test suite with -f-test-doctests+flag test-doctests+  default: True+  manual: True++flag lib-Werror+  default: False+  manual: True++library+  build-depends:+    base         >= 4.3      && < 5,+    bytes        >= 0.1      && < 1,+    mtl          >= 2.0      && < 2.2,+    transformers >= 0.2      && < 0.4++  exposed-modules:+    Data.Bits.Coding+    Data.Bits.Extras++  if flag(lib-Werror)+    ghc-options: -Werror++  c-sources: cbits/debruijn.c+  ghc-options: -Wall -fwarn-tabs -O2+  hs-source-dirs: src++test-suite doctests+  type:           exitcode-stdio-1.0+  main-is:        doctests.hs+  ghc-options:    -Wall -threaded+  hs-source-dirs: tests++  if !flag(test-doctests)+    buildable: False+  else+    build-depends:+      base,+      directory      >= 1.0,+      doctest        >= 0.9.1,+      filepath       >= 1.2++  if impl(ghc<7.6.1)+    ghc-options: -Werror

@@ -0,0 +1,39 @@+// A 64 bit deBruijn multiplication table for calculating the the value of a single bit in a word64+const unsigned char debruijn_lsb64[] = {+ 63,  0, 58,  1, 59, 47, 53,  2,+ 60, 39, 48, 27, 54, 33, 42,  3,+ 61, 51, 37, 40, 49, 18, 28, 20,+ 55, 30, 34, 11, 43, 14, 22,  4,+ 62, 57, 46, 52, 38, 26, 32, 41,+ 50, 36, 17, 19, 29, 10, 13, 21,+ 56, 45, 25, 31, 35, 16,  9, 12,+ 44, 24, 15,  8, 23,  7,  6,  5+};++// A 32 bit deBruijn multiplication table for (n * 0x077CB531U) >> 27+const unsigned char debruijn_lsb32[] = {+   0,  1, 28,  2, 29, 14, 24, 3,+  30, 22, 20, 15, 25, 17,  4, 8,+  31, 27, 13, 23, 21, 19, 16, 7,+  26, 12, 18,  6, 11,  5, 10, 9+};++// Frigo's algorithm from http://stackoverflow.com/questions/7365562/de-bruijn-like-sequence-for-2n-1-how-is-it-constructed+const unsigned char debruijn_rank32[] = {+  32, -1,  2, -1,  3, -1, -1, -1,+  -1,  4, -1, 17, 13, -1, -1,  7,+   0, -1, -1,  5, -1, -1, 27, 18,+  29, 14, 24, -1, -1, 20,  8, -1,+  31,  1, -1, -1, -1, 16, 12,  6,+  -1, -1, -1, 26, 28, 23, 19, -1,+  30, -1, 15, 11, -1, 25, 22, -1,+  -1, 10, -1, 21,  9, -1, -1, -1+};++// A 32 bit deBruijn multiplication table for calculating log_2 based on first rounding down to 1 less than a power of 2+const unsigned char debruijn_log32[] = {+   0,  9,  1, 10, 13, 21,  2, 29,+  11, 14, 16, 18, 22, 25,  3, 30,+   8, 12, 20, 28, 15, 17, 24,  7,+  19, 27, 23,  6, 26,  5,  4, 31+};

@@ -0,0 +1,236 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE DeriveDataTypeable #-}+{-# LANGUAGE Rank2Types #-}+{-# LANGUAGE UnboxedTuples #-}+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE UndecidableInstances #-}+--------------------------------------------------------------------+-- |+-- Copyright :  (c) Edward Kmett 2013+-- License   :  BSD3+-- Maintainer:  Edward Kmett <ekmett@gmail.com>+-- Stability :  experimental+-- Portability: non-portable+--+--------------------------------------------------------------------+module Data.Bits.Coding+  ( Coding(..)+  -- * Get+  , getAligned, getBit+  -- * Put+  , putAligned, putBit+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.State.Class+import Control.Monad.Reader.Class+import Control.Monad.Trans+import Data.Bits+import Data.Bytes.Get+import Data.Bytes.Put+import Data.Word++{-# ANN module "hlint: ignore Redundant $!" #-}++------------------------------------------------------------------------------+-- Coding+------------------------------------------------------------------------------++newtype Coding m a = Coding+  { runCoding :: forall r. (a -> Int -> Word8 -> m r) -> Int -> Word8 -> m r+  }++instance Functor (Coding m) where+  fmap f (Coding m) = Coding $ \ k -> m (k . f)+  {-# INLINE fmap #-}++instance Monad m => Applicative (Coding m) where+  pure a = Coding $ \k -> k a+  {-# INLINE pure #-}+  (<*>) = ap+  {-# INLINE (<*>) #-}++instance Monad m => Monad (Coding m) where+  return a = Coding $ \ k -> k a+  {-# INLINE return #-}+  Coding m >>= f = Coding $ \ k -> m $ \a -> runCoding (f a) k+  {-# INLINE (>>=) #-}+  fail e = Coding $ \_ _ _ -> fail e+  {-# INLINE fail #-}++-- Binary.Get is strangely missing MonadPlus+instance (Monad m, Alternative m) => Alternative (Coding m) where+  empty = Coding $ \_ _ _ -> empty+  {-# INLINE empty #-}+  Coding m <|> Coding n = Coding $ \k i b -> do+    (a,i',b') <- m (\a i' b' -> pure (a,i',b')) i b <|> n (\a i' b' -> pure (a,i',b')) i b+    k a i' b'+  {-# INLINE (<|>) #-}++instance MonadPlus m => MonadPlus (Coding m) where+  mzero = Coding $ \_ _ _ -> mzero+  {-# INLINE mzero #-}+  mplus (Coding m) (Coding n) = Coding $ \k i b -> do+    (a,i',b') <- m (\a i' b' -> return (a,i',b')) i b `mplus` n (\a i' b' -> return (a,i',b')) i b+    k a i' b'+  {-# INLINE mplus #-}+++instance MonadTrans Coding where+  lift m = Coding $ \k i w -> do+    a <- m+    k a i w+  {-# INLINE lift #-}++instance MonadState s m => MonadState s (Coding m) where+  get = lift get+  {-# INLINE get #-}+  put = lift . put+  {-# INLINE put #-}++instance MonadReader e m => MonadReader e (Coding m) where+  ask = lift ask+  {-# INLINE ask #-}+  local f (Coding m) = Coding $ \k i b -> do+    (a,i',b') <- local f $ m (\a i' b' -> return (a, i', b')) i b+    k a i' b'+  {-# INLINE local #-}++------------------------------------------------------------------------------+-- Get+------------------------------------------------------------------------------++-- | 'Get' something from byte-aligned storage, starting on the next byte+-- and discarding any left over bits in the buffer.+--+-- /NB:/ Using any operation from 'MonadGet' other than checking 'remaining' or+-- 'isEmpty' will implicitly perform this operation.+getAligned :: MonadGet m => m a -> Coding m a+getAligned m = Coding $ \k _ _ -> m >>= \ a -> k a 0 0+{-# INLINE getAligned #-}++-- | 'Get' a single bit, consuming an entire 'byte' if the bit buffer is empty+getBit :: MonadGet m => Coding m Bool+getBit = Coding $ \ k i b ->+  if i == 0+  then getWord8 >>= \b' -> ((k $! testBit b' 7) $! 7) $! shiftR b' 1+  else ((k $! testBit b 7) $! i - 1) $! shiftR b 1+{-# INLINE getBit #-}++instance MonadGet m => MonadGet (Coding m) where+  type Unchecked (Coding m) = Unchecked m+  type Bytes (Coding m) = Bytes m+  skip = getAligned . skip+  {-# INLINE skip #-}+  uncheckedSkip = getAligned . uncheckedSkip+  {-# INLINE uncheckedSkip #-}+  lookAhead (Coding m) = Coding $ \k i b -> lookAhead (m k i b)+  {-# INLINE lookAhead #-}+  lookAheadM (Coding m) = Coding $ \k i b -> do+    emm <- lookAheadE $ m (\ma i' b' -> return $ maybe (Left (k Nothing i b)) (\a -> Right (k (Just a) i' b')) ma) i b+    either id id emm+  {-# INLINE lookAheadM #-}+  lookAheadE (Coding m) = Coding $ \k i b -> do+    emm <- lookAheadE $ m (\ea i' b' -> return $ either (\a -> Left (k (Left a) i b)) (\a -> Right (k (Right a) i' b')) ea) i b+    either id id emm+  {-# INLINE lookAheadE #-}+  uncheckedLookAhead = getAligned . uncheckedLookAhead+  {-# INLINE uncheckedLookAhead #-}+  getBytes  = getAligned . getBytes+  {-# INLINE getBytes #-}+  remaining = lift remaining+  {-# INLINE remaining #-}+  isEmpty   = lift isEmpty+  {-# INLINE isEmpty #-}+  getWord8  = getAligned getWord8+  {-# INLINE getWord8 #-}+  getByteString = getAligned . getByteString+  {-# INLINE getByteString #-}+  getLazyByteString = getAligned . getLazyByteString+  {-# INLINE getLazyByteString #-}+  getWord16le = getAligned getWord16le+  {-# INLINE getWord16le #-}+  getWord32le = getAligned getWord32le+  {-# INLINE getWord32le #-}+  getWord64le = getAligned getWord64le+  {-# INLINE getWord64le #-}+  getWord16be = getAligned getWord16be+  {-# INLINE getWord16be #-}+  getWord32be = getAligned getWord32be+  {-# INLINE getWord32be #-}+  getWord64be = getAligned getWord64be+  {-# INLINE getWord64be #-}+  getWord16host = getAligned getWord16host+  {-# INLINE getWord16host #-}+  getWord32host = getAligned getWord32host+  {-# INLINE getWord32host #-}+  getWord64host = getAligned getWord64host+  {-# INLINE getWord64host #-}+  getWordhost = getAligned getWordhost+  {-# INLINE getWordhost #-}++------------------------------------------------------------------------------+-- Put+------------------------------------------------------------------------------++-- | Emit any remaining contents from the bit buffer.+--+-- Any use of the combinators from 'MonadPut' (including 'flush') will cause+-- this to happen.+putAligned :: MonadPut m => m a -> Coding m a+putAligned m = Coding $ \ k i b ->+ if i == 0+ then do+   a <- m+   k a 0 0+ else do+   putWord8 b+   a <- m+   k a 0 0++-- | 'Put' a single bit, emitting an entire 'byte' if the bit buffer is full+putBit :: MonadPut m => Bool -> Coding m ()+putBit v = Coding $ \k i b ->+  if i == 7+  then do+    putWord8 (pushBit b v)+    k () 0 0+  else (k () $! i + 1) $! pushBit b v+  where+    pushBit w False = shiftL w 1+    pushBit w True  = shiftL w 1 .|. 1+{-# INLINE putBit #-}++instance MonadPut m => MonadPut (Coding m) where+  putWord8 = putAligned . putWord8+  {-# INLINE putWord8 #-}+  putByteString = putAligned . putByteString+  {-# INLINE putByteString #-}+  putLazyByteString = putAligned . putLazyByteString+  {-# INLINE putLazyByteString #-}+  flush = putAligned flush+  {-# INLINE flush #-}+  putWord16le = putAligned . putWord16le+  {-# INLINE putWord16le #-}+  putWord32le = putAligned . putWord32le+  {-# INLINE putWord32le #-}+  putWord64le = putAligned . putWord64le+  {-# INLINE putWord64le #-}+  putWord16be = putAligned . putWord16be+  {-# INLINE putWord16be #-}+  putWord32be = putAligned . putWord32be+  {-# INLINE putWord32be #-}+  putWord64be = putAligned . putWord64be+  {-# INLINE putWord64be #-}+  putWord16host = putAligned . putWord16host+  {-# INLINE putWord16host #-}+  putWord32host = putAligned . putWord32host+  {-# INLINE putWord32host #-}+  putWord64host = putAligned . putWord64host+  {-# INLINE putWord64host #-}+  putWordhost = putAligned . putWordhost+  {-# INLINE putWordhost #-}

@@ -0,0 +1,195 @@+{-# LANGUAGE CPP, ForeignFunctionInterface, MagicHash, UnboxedTuples, BangPatterns #-}+--------------------------------------------------------------------+-- |+-- Copyright :  (c) Edward Kmett 2013+-- License   :  BSD3+-- Maintainer:  Edward Kmett <ekmett@gmail.com>+-- Stability :  experimental+-- Portability: non-portable+--+-- Calculate a number of fiddly bit operations using fast de Bruijn+-- multiplication tables.+--------------------------------------------------------------------+module Data.Bits.Extras+  ( Ranked(..)+  , log2+  , w8+  , w16+  , w32+  , w64+  ) where++import Data.Bits+import Data.Int+import Data.Word+import Foreign.Ptr+import Foreign.Storable+import GHC.Base++-- TODO: generalize to 64 bits, etc.+log2 :: Word32 -> Int+log2 !n0 = fromIntegral $ go (shiftR (n5 * 0x7C4ACDD) 27) where+  go :: Word32 -> Word8+  go !i = inlinePerformIO $ peekElemOff debruijn_log32 (fromIntegral i)+  !n1 = n0 .|. shiftR n0 1+  !n2 = n1 .|. shiftR n1 2+  !n3 = n2 .|. shiftR n2 4+  !n4 = n3 .|. shiftR n3 8+  !n5 = n4 .|. shiftR n4 16+{-# INLINE log2 #-}++class (Num t, Bits t) => Ranked t where+  -- | Calculate the least significant set bit using a debruijn multiplication table.+  -- /NB:/ The result of this function is undefined when given 0.+  lsb :: t -> Int+  lsb n = rank n - 1+  {-# INLINE lsb #-}++  -- | Calculate the number of trailing 0 bits.+  rank :: t -> Int+  rank 0 = 0+  rank n = lsb n + 1+  {-# INLINE rank #-}++  -- | Calculate the number of leading zeros.+  nlz :: t -> Int++instance Ranked Word64 where+  lsb n = fromIntegral $ go (shiftR ((n .&. (-n)) * 0x07EDD5E59A4E28C2) 58) where+    go :: Word64 -> Word8+    go i = inlinePerformIO $ peekElemOff debruijn_lsb64 (fromIntegral i)+  {-# INLINE lsb #-}++  nlz x0 = popCount (complement x6) where+     x1 = x0 .|. shiftR x0 1+     x2 = x1 .|. shiftR x1 2+     x3 = x2 .|. shiftR x2 4+     x4 = x3 .|. shiftR x3 8+     x5 = x4 .|. shiftR x4 16+     x6 = x5 .|. shiftR x5 32+  {-# INLINE nlz #-}++instance Ranked Word32 where+  lsb n = fromIntegral $ go (shiftR ((n .&. (-n)) * 0x077CB531) 27) where+    go :: Word32 -> Word8+    go i = inlinePerformIO $ peekElemOff debruijn_lsb32 (fromIntegral i)+  {-# INLINE lsb #-}++{-+  rank n = fromIntegral $ go (shiftR ((n .&. (-n)) * 0x4279976B) 26) where+    go :: Word32 -> Word8+    go i = inlinePerformIO $ peekElemOff debruijn_rank32 (fromIntegral i)+  {-# INLINE rank #-}+-}++  nlz x0 = popCount (complement x5) where+     x1 = x0 .|. shiftR x0 1+     x2 = x1 .|. shiftR x1 2+     x3 = x2 .|. shiftR x2 4+     x4 = x3 .|. shiftR x3 8+     x5 = x4 .|. shiftR x4 16+  {-# INLINE nlz #-}+++instance Ranked Word16 where+  lsb = lsb . w32+  {-# INLINE lsb #-}++  rank = rank . w32+  {-# INLINE rank #-}++  nlz x0 = popCount (complement x4) where+     x1 = x0 .|. shiftR x0 1+     x2 = x1 .|. shiftR x1 2+     x3 = x2 .|. shiftR x2 4+     x4 = x3 .|. shiftR x3 8+  {-# INLINE nlz #-}++instance Ranked Word8 where+  lsb = lsb . w32+  {-# INLINE lsb #-}++  rank = rank . w32+  {-# INLINE rank #-}++  nlz x0 = popCount (complement x3) where+     x1 = x0 .|. shiftR x0 1+     x2 = x1 .|. shiftR x1 2+     x3 = x2 .|. shiftR x2 4+  {-# INLINE nlz #-}++instance Ranked Int64 where+  lsb = lsb . w64+  {-# INLINE lsb #-}++  rank = rank . w64+  {-# INLINE rank #-}++  nlz = nlz . w64+  {-# INLINE nlz #-}++instance Ranked Int32 where+  lsb = lsb . w32+  {-# INLINE lsb #-}++  rank = rank . w32+  {-# INLINE rank #-}++  nlz = nlz . w32+  {-# INLINE nlz #-}++instance Ranked Int16 where+  lsb = lsb . w32+  {-# INLINE lsb #-}++  rank = rank . w32+  {-# INLINE rank #-}++  nlz = nlz . w16+  {-# INLINE nlz #-}++instance Ranked Int8 where+  lsb = lsb . w32+  {-# INLINE lsb #-}++  rank = rank . w32+  {-# INLINE rank #-}++  nlz = nlz . w8+  {-# INLINE nlz #-}++------------------------------------------------------------------------------+-- Util+------------------------------------------------------------------------------++w8 :: Integral a => a -> Word8+w8 = fromIntegral+{-# INLINE w8 #-}++w16 :: Integral a => a -> Word16+w16 = fromIntegral+{-# INLINE w16 #-}++w32 :: Integral a => a -> Word32+w32 = fromIntegral+{-# INLINE w32 #-}++w64 :: Integral a => a -> Word64+w64 = fromIntegral+{-# INLINE w64 #-}++------------------------------------------------------------------------------+-- de Bruijn Multiplication Tables+------------------------------------------------------------------------------++foreign import ccall "static &debruijn_lsb64"  debruijn_lsb64  :: Ptr Word8+foreign import ccall "static &debruijn_lsb32"  debruijn_lsb32  :: Ptr Word8+-- foreign import ccall "static &debruijn_rank32" debruijn_rank32 :: Ptr Word8+foreign import ccall "static &debruijn_log32"  debruijn_log32  :: Ptr Word8++#ifndef HLINT+inlinePerformIO :: IO a -> a+inlinePerformIO (IO m) = case m realWorld# of+  (# _, r #) -> r+{-# INLINE inlinePerformIO #-}+#endif

@@ -0,0 +1,74 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-}+-----------------------------------------------------------------------------+-- |+-- Module      :  Main (doctests)+-- Copyright   :  (C) 2012-13 Edward Kmett+-- License     :  BSD-style (see the file LICENSE)+-- Maintainer  :  Edward Kmett <ekmett@gmail.com>+-- Stability   :  provisional+-- Portability :  portable+--+-- This module provides doctests for a project based on the actual versions+-- of the packages it was built with. It requires a corresponding Setup.lhs+-- to be added to the project+-----------------------------------------------------------------------------+module Main where++import Build_doctests (deps)+import Control.Applicative+import Control.Monad+import Data.List+import System.Directory+import System.FilePath+import Test.DocTest++##if defined(mingw32_HOST_OS)+##if defined(i386_HOST_ARCH)+##define USE_CP+import Control.Applicative+import Control.Exception+import Foreign.C.Types+foreign import stdcall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool+foreign import stdcall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt+##elif defined(x86_64_HOST_ARCH)+##define USE_CP+import Control.Applicative+import Control.Exception+import Foreign.C.Types+foreign import ccall "windows.h SetConsoleCP" c_SetConsoleCP :: CUInt -> IO Bool+foreign import ccall "windows.h GetConsoleCP" c_GetConsoleCP :: IO CUInt+##endif+##endif++-- | Run in a modified codepage where we can print UTF-8 values on Windows.+withUnicode :: IO a -> IO a+##ifdef USE_CP+withUnicode m = do+  cp <- c_GetConsoleCP+  (c_SetConsoleCP 65001 >> m) `finally` c_SetConsoleCP cp+##else+withUnicode m = m+##endif++main :: IO ()+main = withUnicode $ getSources >>= \sources -> doctest $+    "-isrc"+  : "-idist/build/autogen"+  : "-optP-include"+  : "-optPdist/build/autogen/cabal_macros.h"+  : "-hide-all-packages"+  : "-Iincludes"+  : map ("-package="++) deps ++ sources++getSources :: IO [FilePath]+getSources = filter (isSuffixOf ".hs") <$> go "src"+  where+    go dir = do+      (dirs, files) <- getFilesAndDirectories dir+      (files ++) . concat <$> mapM go dirs++getFilesAndDirectories :: FilePath -> IO ([FilePath], [FilePath])+getFilesAndDirectories dir = do+  c <- map (dir </>) . filter (`notElem` ["..", "."]) <$> getDirectoryContents dir+  (,) <$> filterM doesDirectoryExist c <*> filterM doesFileExist c

@@ -0,0 +1,27 @@+#! /bin/bash+set -eu++APT="sudo apt-get -q -y"+CABAL_INSTALL_DEPS="cabal install --only-dependencies --force-reinstall"++$APT update+$APT install dctrl-tools++# Find potential system packages to satisfy cabal dependencies+deps()+{+	local M='^\([^ ]\+\)-[0-9.]\+ (.*$'+	local G=' -o ( -FPackage -X libghc-\L\1\E-dev )'+	local E="$($CABAL_INSTALL_DEPS "$@" --dry-run -v 2> /dev/null \+		| sed -ne "s/$M/$G/p" | sort -u)"+	grep-aptavail -n -sPackage \( -FNone -X None \) $E | sort -u+}++$APT install $(deps "$@") libghc-quickcheck2-dev # QuickCheck is special+$CABAL_INSTALL_DEPS "$@" # Install the rest via Hackage++if ! $APT install hlint ; then+	$APT install $(deps hlint)+	cabal install hlint+fi+

@@ -0,0 +1,16 @@+-- This provides a custom ~/.cabal/config file for use when hackage is down that should work on unix+--+-- This is particularly useful for travis-ci to get it to stop complaining+-- about a broken build when everything is still correct on our end.+--+-- This uses Luite Stegeman's mirror of hackage provided by his 'hdiff' site instead+--+-- To enable this, uncomment the before_script in .travis.yml++remote-repo: hdiff.luite.com:http://hdiff.luite.com/packages/archive+remote-repo-cache: ~/.cabal/packages+world-file: ~/.cabal/world+build-summary: ~/.cabal/logs/build.log+remote-build-reporting: anonymous+install-dirs user+install-dirs global