diff --git a/.gitignore b/.gitignore --- a/.gitignore +++ b/.gitignore @@ -12,3 +12,21 @@ *.hi *~ *# +.stack-work/ +cabal-dev +*.chi +*.chs.h +*.dyn_o +*.dyn_hi +.hpc +.hsenv +.cabal-sandbox/ +cabal.sandbox.config +*.prof +*.aux +*.hp +*.eventlog +cabal.project.local +cabal.project.local~ +.HTF/ +.ghc.environment.* diff --git a/.hlint.yaml b/.hlint.yaml new file mode 100644 --- /dev/null +++ b/.hlint.yaml @@ -0,0 +1,3 @@ +- arguments: [--cpp-define=HLINT, --cpp-ansi] + +- ignore: {name: Reduce duplication} diff --git a/.travis.yml b/.travis.yml deleted file mode 100644 --- a/.travis.yml +++ /dev/null @@ -1,110 +0,0 @@ -# This file has been generated -- see https://github.com/hvr/multi-ghc-travis -language: c -sudo: false - -cache: - directories: - - $HOME/.cabsnap - - $HOME/.cabal/packages - -before_cache: - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log - - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.tar - -matrix: - include: - - env: CABALVER=1.18 GHCVER=7.8.4 - compiler: ": #GHC 7.8.4" - addons: {apt: {packages: [cabal-install-1.18,ghc-7.8.4,hlint], sources: [hvr-ghc]}} - - env: CABALVER=1.22 GHCVER=7.10.3 - compiler: ": #GHC 7.10.3" - addons: {apt: {packages: [cabal-install-1.22,ghc-7.10.3,hlint], sources: [hvr-ghc]}} - - env: CABALVER=1.24 GHCVER=8.0.2 - compiler: ": #GHC 8.0.2" - addons: {apt: {packages: [cabal-install-1.24,ghc-8.0.2,hlint], sources: [hvr-ghc]}} - - env: CABALVER=1.24 GHCVER=8.2.1 - compiler: ": #GHC 8.2.1" - addons: {apt: {packages: [cabal-install-1.24,ghc-8.2.1,hlint], sources: [hvr-ghc]}} - - env: CABALVER=1.24 GHCVER=head - compiler: ": #GHC head" - addons: {apt: {packages: [cabal-install-1.24,ghc-head,hlint], sources: [hvr-ghc]}} - - allow_failures: - - env: CABALVER=1.24 GHCVER=head - -before_install: - - unset CC - - export PATH=/opt/ghc/$GHCVER/bin:/opt/cabal/$CABALVER/bin:$PATH - -install: - - cabal --version - - echo "$(ghc --version) [$(ghc --print-project-git-commit-id 2> /dev/null || echo '?')]" - - if [ -f $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz ]; - then - zcat $HOME/.cabal/packages/hackage.haskell.org/00-index.tar.gz > - $HOME/.cabal/packages/hackage.haskell.org/00-index.tar; - fi - - travis_retry cabal update -v - - sed -i 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config - - cabal install --only-dependencies --enable-tests --dry -v > installplan.txt - - sed -i -e '1,/^Resolving /d' installplan.txt; cat installplan.txt - -# check whether current requested install-plan matches cached package-db snapshot - - if diff -u installplan.txt $HOME/.cabsnap/installplan.txt; - then - echo "cabal build-cache HIT"; - rm -rfv .ghc; - cp -a $HOME/.cabsnap/ghc $HOME/.ghc; - cp -a $HOME/.cabsnap/lib $HOME/.cabsnap/share $HOME/.cabsnap/bin $HOME/.cabal/; - else - echo "cabal build-cache MISS"; - rm -rf $HOME/.cabsnap; - mkdir -p $HOME/.ghc $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin; - cabal install -j --only-dependencies --enable-tests; - if [ "$GHCVER" = "7.10.3" ]; then cabal install Cabal-1.22.4.0; fi; - fi - -# snapshot package-db on cache miss - - if [ ! -d $HOME/.cabsnap ]; - then - echo "snapshotting package-db to build-cache"; - mkdir $HOME/.cabsnap; - cp -a $HOME/.ghc $HOME/.cabsnap/ghc; - cp -a $HOME/.cabal/lib $HOME/.cabal/share $HOME/.cabal/bin installplan.txt $HOME/.cabsnap/; - fi - -# Here starts the actual work to be performed for the package under -# test; any command which exits with a non-zero exit code causes the -# build to fail. -script: - # -v2 provides useful information for debugging - - cabal configure --enable-tests -v2 - - # this builds all libraries and executables - # (including tests/benchmarks) - - cabal build - - cabal test --show-details=always - - # tests that a source-distribution can be generated - - cabal sdist - - hlint src --cpp-define HLINT - - # check that the generated source-distribution can be built & installed - - export SRC_TGZ=$(cabal info . | awk '{print $2 ".tar.gz";exit}') ; - cd dist/; - if [ -f "$SRC_TGZ" ]; then - cabal install --force-reinstalls "$SRC_TGZ"; - else - echo "expected '$SRC_TGZ' not found"; - exit 1; - fi - -notifications: - irc: - channels: - - "irc.freenode.org#haskell-lens" - skip_join: true - template: - - "\x0313bits\x03/\x0306%{branch}\x03 \x0314%{commit}\x03 %{build_url} %{message}" - -# EOF diff --git a/CHANGELOG.markdown b/CHANGELOG.markdown --- a/CHANGELOG.markdown +++ b/CHANGELOG.markdown @@ -1,3 +1,26 @@ +0.6 [2021.11.07] +---------------- +* Allow building with GHC 9.2.1. +* The `Data.Bits.Extras.oneBits` function now matches the implementation of the + `oneBits` function from `base`'s `Data.Bits` module. This is a breaking + change since the constraint has been strengthened from `Bits` to + `FiniteBits`. If you need to invoke `oneBits` on a data type that does not + have a `FiniteBits` instance (e.g., `Integer`), use the newly added + `unsafeOneBits` function instead. +* Generalize `log2` to all `Integral` types with `base` >= 4.15 (GHC >= 9.0). + +0.5.3 [2021.02.17] +------------------ +* The build-type has been changed from `Custom` to `Simple`. + To achieve this, the `doctests` test suite has been removed in favor of using + [`cabal-docspec`](https://github.com/phadej/cabal-extras/tree/master/cabal-docspec) + to run the doctests. + +0.5.2 [2019.05.02] +------------------ +* Support building with `base-4.13` (GHC 8.8). +* Add a `MonadFail` instance for `Coding`. + 0.5.1 ----- * Fix off-by-one error in `putUnaligned` diff --git a/README.markdown b/README.markdown --- a/README.markdown +++ b/README.markdown @@ -1,7 +1,7 @@ bits ===== -[![Hackage](https://img.shields.io/hackage/v/bits.svg)](https://hackage.haskell.org/package/bits) [![Build Status](https://secure.travis-ci.org/ekmett/bits.png)](http://travis-ci.org/ekmett/bits) +[![Hackage](https://img.shields.io/hackage/v/bits.svg)](https://hackage.haskell.org/package/bits) [![Build Status](https://github.com/ekmett/bits/workflows/Haskell-CI/badge.svg)](https://github.com/ekmett/bits/actions?query=workflow%3AHaskell-CI) This package provides a number of tools that are useful for dealing with files or data on a bitwise basis. diff --git a/Setup.lhs b/Setup.lhs --- a/Setup.lhs +++ b/Setup.lhs @@ -1,182 +1,7 @@ -\begin{code} -{-# LANGUAGE CPP #-} -{-# LANGUAGE OverloadedStrings #-} -module Main (main) where - -#ifndef MIN_VERSION_cabal_doctest -#define MIN_VERSION_cabal_doctest(x,y,z) 0 -#endif - - -#if MIN_VERSION_cabal_doctest(1,0,0) -import Distribution.Extra.Doctest ( defaultMainWithDoctests ) -#else - --- Otherwise we provide a shim - -#ifndef MIN_VERSION_Cabal -#define MIN_VERSION_Cabal(x,y,z) 0 -#endif -#ifndef MIN_VERSION_directory -#define MIN_VERSION_directory(x,y,z) 0 -#endif -#if MIN_VERSION_Cabal(1,24,0) -#define InstalledPackageId UnitId -#endif - -import Control.Monad ( when ) -import Data.List ( nub ) -import Data.String ( fromString ) -import Distribution.Package ( InstalledPackageId ) -import Distribution.Package ( PackageId, Package (..), packageVersion ) -import Distribution.PackageDescription ( PackageDescription(), TestSuite(..) , Library (..), BuildInfo (..)) -import Distribution.Simple ( defaultMainWithHooks, UserHooks(..), simpleUserHooks ) -import Distribution.Simple.Utils ( rewriteFile, createDirectoryIfMissingVerbose ) -import Distribution.Simple.BuildPaths ( autogenModulesDir ) -import Distribution.Simple.Setup ( BuildFlags(buildDistPref, buildVerbosity), fromFlag) -import Distribution.Simple.LocalBuildInfo ( withPackageDB, withLibLBI, withTestLBI, LocalBuildInfo(), ComponentLocalBuildInfo(componentPackageDeps), compiler ) -import Distribution.Simple.Compiler ( showCompilerId , PackageDB (..)) -import Distribution.Text ( display , simpleParse ) -import System.FilePath ( () ) - -#if MIN_VERSION_Cabal(1,25,0) -import Distribution.Simple.BuildPaths ( autogenComponentModulesDir ) -#endif - -#if MIN_VERSION_directory(1,2,2) -import System.Directory (makeAbsolute) -#else -import System.Directory (getCurrentDirectory) -import System.FilePath (isAbsolute) - -makeAbsolute :: FilePath -> IO FilePath -makeAbsolute p | isAbsolute p = return p - | otherwise = do - cwd <- getCurrentDirectory - return $ cwd p -#endif - -generateBuildModule :: String -> BuildFlags -> PackageDescription -> LocalBuildInfo -> IO () -generateBuildModule testsuiteName flags pkg lbi = do - let verbosity = fromFlag (buildVerbosity flags) - let distPref = fromFlag (buildDistPref flags) - - -- Package DBs - let dbStack = withPackageDB lbi ++ [ SpecificPackageDB $ distPref "package.conf.inplace" ] - let dbFlags = "-hide-all-packages" : packageDbArgs dbStack - - withLibLBI pkg lbi $ \lib libcfg -> do - let libBI = libBuildInfo lib - - -- modules - let modules = exposedModules lib ++ otherModules libBI - -- it seems that doctest is happy to take in module names, not actual files! - let module_sources = modules - - -- We need the directory with library's cabal_macros.h! -#if MIN_VERSION_Cabal(1,25,0) - let libAutogenDir = autogenComponentModulesDir lbi libcfg -#else - let libAutogenDir = autogenModulesDir lbi -#endif - - -- Lib sources and includes - iArgs <- mapM (fmap ("-i"++) . makeAbsolute) $ libAutogenDir : hsSourceDirs libBI - includeArgs <- mapM (fmap ("-I"++) . makeAbsolute) $ includeDirs libBI - - -- CPP includes, i.e. include cabal_macros.h - let cppFlags = map ("-optP"++) $ - [ "-include", libAutogenDir ++ "/cabal_macros.h" ] - ++ cppOptions libBI - - withTestLBI pkg lbi $ \suite suitecfg -> when (testName suite == fromString testsuiteName) $ do - - -- get and create autogen dir -#if MIN_VERSION_Cabal(1,25,0) - let testAutogenDir = autogenComponentModulesDir lbi suitecfg -#else - let testAutogenDir = autogenModulesDir lbi -#endif - createDirectoryIfMissingVerbose verbosity True testAutogenDir - - -- write autogen'd file - rewriteFile (testAutogenDir "Build_doctests.hs") $ unlines - [ "module Build_doctests where" - , "" - -- -package-id etc. flags - , "pkgs :: [String]" - , "pkgs = " ++ (show $ formatDeps $ testDeps libcfg suitecfg) - , "" - , "flags :: [String]" - , "flags = " ++ show (iArgs ++ includeArgs ++ dbFlags ++ cppFlags) - , "" - , "module_sources :: [String]" - , "module_sources = " ++ show (map display module_sources) - ] - where - -- we do this check in Setup, as then doctests don't need to depend on Cabal - isOldCompiler = maybe False id $ do - a <- simpleParse $ showCompilerId $ compiler lbi - b <- simpleParse "7.5" - return $ packageVersion (a :: PackageId) < b - - formatDeps = map formatOne - formatOne (installedPkgId, pkgId) - -- The problem is how different cabal executables handle package databases - -- when doctests depend on the library - | packageId pkg == pkgId = "-package=" ++ display pkgId - | otherwise = "-package-id=" ++ display installedPkgId - - -- From Distribution.Simple.Program.GHC - packageDbArgs :: [PackageDB] -> [String] - packageDbArgs | isOldCompiler = packageDbArgsConf - | otherwise = packageDbArgsDb - - -- GHC <7.6 uses '-package-conf' instead of '-package-db'. - packageDbArgsConf :: [PackageDB] -> [String] - packageDbArgsConf dbstack = case dbstack of - (GlobalPackageDB:UserPackageDB:dbs) -> concatMap specific dbs - (GlobalPackageDB:dbs) -> ("-no-user-package-conf") - : concatMap specific dbs - _ -> ierror - where - specific (SpecificPackageDB db) = [ "-package-conf=" ++ db ] - specific _ = ierror - ierror = error $ "internal error: unexpected package db stack: " - ++ show dbstack - - -- GHC >= 7.6 uses the '-package-db' flag. See - -- https://ghc.haskell.org/trac/ghc/ticket/5977. - packageDbArgsDb :: [PackageDB] -> [String] - -- special cases to make arguments prettier in common scenarios - packageDbArgsDb dbstack = case dbstack of - (GlobalPackageDB:UserPackageDB:dbs) - | all isSpecific dbs -> concatMap single dbs - (GlobalPackageDB:dbs) - | all isSpecific dbs -> "-no-user-package-db" - : concatMap single dbs - dbs -> "-clear-package-db" - : concatMap single dbs - where - single (SpecificPackageDB db) = [ "-package-db=" ++ db ] - single GlobalPackageDB = [ "-global-package-db" ] - single UserPackageDB = [ "-user-package-db" ] - isSpecific (SpecificPackageDB _) = True - isSpecific _ = False - -testDeps :: ComponentLocalBuildInfo -> ComponentLocalBuildInfo -> [(InstalledPackageId, PackageId)] -testDeps xs ys = nub $ componentPackageDeps xs ++ componentPackageDeps ys - -defaultMainWithDoctests :: String -> IO () -defaultMainWithDoctests testSuiteName = defaultMainWithHooks simpleUserHooks - { buildHook = \pkg lbi hooks flags -> do - generateBuildModule testSuiteName flags pkg lbi - buildHook simpleUserHooks pkg lbi hooks flags - } - -#endif +#!/usr/bin/runhaskell +> module Main (main) where -main :: IO () -main = defaultMainWithDoctests "doctests" +> import Distribution.Simple -\end{code} +> main :: IO () +> main = defaultMain diff --git a/bits.cabal b/bits.cabal --- a/bits.cabal +++ b/bits.cabal @@ -1,8 +1,8 @@ name: bits category: Data, Serialization -version: 0.5.1 +version: 0.6 license: BSD3 -cabal-version: >= 1.8 +cabal-version: >= 1.10 license-file: LICENSE author: Edward A. Kmett maintainer: Edward A. Kmett @@ -10,18 +10,25 @@ homepage: http://github.com/ekmett/bits bug-reports: http://github.com/ekmett/bits/issues copyright: Copyright (C) 2013 Edward A. Kmett -build-type: Custom -tested-with: GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2, GHC == 8.2.1 +build-type: Simple +tested-with: GHC == 7.8.4 + , GHC == 7.10.3 + , GHC == 8.0.2 + , GHC == 8.2.2 + , GHC == 8.4.4 + , GHC == 8.6.5 + , GHC == 8.8.4 + , GHC == 8.10.7 + , GHC == 9.0.1 + , GHC == 9.2.1 synopsis: Various bit twiddling and bitwise serialization primitives -description: Various bit twiddling and bitwise serialization primitives +description: Various bit twiddling and bitwise serialization primitives. extra-source-files: - .travis.yml .ghci .gitignore + .hlint.yaml .vim.custom - travis/cabal-apt-install - travis/config AUTHORS.markdown README.markdown CHANGELOG.markdown @@ -30,17 +37,6 @@ type: git location: git://github.com/ekmett/bits.git -custom-setup - setup-depends: - base >= 4 && < 5, - Cabal, - cabal-doctest >= 1 && < 1.1 - --- You can disable the doctests test suite with -f-test-doctests -flag test-doctests - default: True - manual: True - library build-depends: base >= 4.7 && < 5, @@ -48,6 +44,9 @@ mtl >= 2.0 && < 2.3, transformers >= 0.2 && < 0.6 + if !impl(ghc >= 8.0) + build-depends: fail == 4.9.* + exposed-modules: Data.Bits.Coding Data.Bits.Coded @@ -56,18 +55,4 @@ 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 - c-sources: cbits/debruijn.c - - if !flag(test-doctests) - buildable: False - else - build-depends: - base, - bits, - doctest >= 0.11.1 && < 0.12 + default-language: Haskell2010 diff --git a/src/Data/Bits/Coded.hs b/src/Data/Bits/Coded.hs --- a/src/Data/Bits/Coded.hs +++ b/src/Data/Bits/Coded.hs @@ -25,6 +25,9 @@ import Data.Bytes.Put import Data.Foldable +-- $setup +-- >>> import Data.Bytes.Put + -- | Unaligned codes class Coded c where encode :: MonadPut m => c -> Coding m () @@ -43,7 +46,7 @@ } deriving (Eq, Ord, Read, Show, Num, Integral, Real, Enum) ones :: Integer -ones = oneBits `unsafeShiftL` 1 +ones = unsafeOneBits `unsafeShiftL` 1 instance Integral n => Coded (Unary n) where encode (Unary n) = putBitsFrom (fromIntegral n) ones decode = do b <- getBit diff --git a/src/Data/Bits/Coding.hs b/src/Data/Bits/Coding.hs --- a/src/Data/Bits/Coding.hs +++ b/src/Data/Bits/Coding.hs @@ -1,8 +1,5 @@ {-# LANGUAGE CPP #-} -{-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE Rank2Types #-} -{-# LANGUAGE UnboxedTuples #-} -{-# LANGUAGE BangPatterns #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} @@ -26,6 +23,7 @@ import Control.Applicative import Control.Monad +import qualified Control.Monad.Fail as Fail import Control.Monad.State.Class import Control.Monad.Reader.Class import Control.Monad.Trans @@ -60,9 +58,15 @@ {-# INLINE return #-} Coding m >>= f = Coding $ \ k -> m $ \a -> runCoding (f a) k {-# INLINE (>>=) #-} +#if !(MIN_VERSION_base(4,13,0)) fail e = Coding $ \_ _ _ -> fail e {-# INLINE fail #-} +#endif +instance Fail.MonadFail m => Fail.MonadFail (Coding m) where + fail e = Coding $ \_ _ _ -> Fail.fail e + {-# INLINE fail #-} + -- Binary.Get is strangely missing MonadPlus instance (Monad m, Alternative m) => Alternative (Coding m) where empty = Coding $ \_ _ _ -> empty @@ -129,7 +133,7 @@ {-# INLINE getBits #-} getBitsFrom :: (MonadGet m, Bits b) => Int -> b -> Coding m b -getBitsFrom from bits = getBits from 0 bits +getBitsFrom from = getBits from 0 {-# INLINE getBitsFrom #-} instance MonadGet m => MonadGet (Coding m) where @@ -141,7 +145,7 @@ {-# INLINE lookAhead #-} lookAheadM (Coding m) = Coding $ \k i b -> lookAheadE (m (distribute k) i b) >>= factor where - distribute k Nothing i' b' = return $ Left $ k (Nothing) i' b' + distribute k Nothing i' b' = return $ Left $ k Nothing i' b' distribute k (Just a) i' b' = return $ Right $ k (Just a) i' b' factor = either id id {-# INLINE lookAheadM #-} @@ -231,7 +235,7 @@ -- | @putBitsFrom from b = putBits from 0 b@ putBitsFrom :: (MonadPut m, Bits b) => Int -> b -> Coding m () -putBitsFrom from b = putBits from 0 b +putBitsFrom from = putBits from 0 {-# INLINE putBitsFrom #-} instance MonadPut m => MonadPut (Coding m) where diff --git a/src/Data/Bits/Extras.hs b/src/Data/Bits/Extras.hs --- a/src/Data/Bits/Extras.hs +++ b/src/Data/Bits/Extras.hs @@ -1,7 +1,11 @@ -{-# LANGUAGE CPP, ForeignFunctionInterface, MagicHash, UnboxedTuples, BangPatterns #-} +{-# LANGUAGE CPP, ForeignFunctionInterface, BangPatterns #-} #if __GLASGOW_HASKELL__ >= 702 {-# LANGUAGE Trustworthy #-} #endif +#ifndef HLINT +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE UnboxedTuples #-} +#endif -------------------------------------------------------------------- -- | -- Copyright : (c) Edward Kmett 2013-2014 @@ -16,6 +20,11 @@ module Data.Bits.Extras ( Ranked(..) , log2 +#if __GLASGOW_HASKELL__ >= 900 + , integerLog2 + , wordLog2 +#endif + , word32Log2 , msb , w8 , w16 @@ -24,6 +33,7 @@ , assignBit , zeroBits , oneBits + , unsafeOneBits , srl ) where @@ -33,10 +43,49 @@ import Foreign.Ptr import Foreign.Storable import GHC.Base +#if __GLASGOW_HASKELL__ >= 900 +import Control.Exception +import GHC.Integer.Logarithms +#endif --- TODO: generalize to 64 bits, etc. +-- $setup +-- >>> import Data.Bits (Bits(..)) +-- >>> import Data.Word (Word) + +#if __GLASGOW_HASKELL__ >= 900 + +-- | Calculate the integer base 2 logarithm. The argument must be strictly +-- positive. On GHC 9.0 or later, the argument type is generalized from +-- 'Word32' to any 'Integral' type. +log2 :: Integral a => a -> Int +log2 = integerLog2 . toInteger +{-# NOINLINE [1] log2 #-} +{-# RULES +"log2/Integer->Int" log2 = integerLog2 :: Integer -> Int +"log2/Word->Int" log2 = wordLog2 :: Word -> Int +"log2/Word32->Int" log2 = word32Log2 :: Word32 -> Int + #-} + +integerLog2 :: Integer -> Int +integerLog2 n + | n > 0 = I# (integerLog2# n) + | otherwise = throw Overflow +{-# INLINE integerLog2 #-} + +wordLog2 :: Word -> Int +wordLog2 (W# n) = I# (wordLog2# n) +{-# INLINE wordLog2 #-} + +#else + log2 :: Word32 -> Int -log2 !n0 = fromIntegral $ go (unsafeShiftR (n5 * 0x7C4ACDD) 27) where +log2 = word32Log2 +{-# INLINE log2 #-} + +#endif + +word32Log2 :: Word32 -> Int +word32Log2 !n0 = fromIntegral $ go (unsafeShiftR (n5 * 0x7C4ACDD) 27) where go :: Word32 -> Word8 go !i = inlinePerformIO $ peekElemOff debruijn_log32 (fromIntegral i) !n1 = n0 .|. unsafeShiftR n0 1 @@ -44,7 +93,7 @@ !n3 = n2 .|. unsafeShiftR n2 4 !n4 = n3 .|. unsafeShiftR n3 8 !n5 = n4 .|. unsafeShiftR n4 16 -{-# INLINE log2 #-} +{-# INLINE word32Log2 #-} class (Num t, FiniteBits t) => Ranked t where -- | Calculate the least significant set bit using a debruijn multiplication table. @@ -196,14 +245,38 @@ assignBit b n False = b `clearBit` n {-# INLINE assignBit #-} -oneBits :: Bits b => b -oneBits = complement zeroBits +#if !(MIN_VERSION_base(4,16,0)) +-- | A more concise version of @complement zeroBits@. +-- +-- >>> complement (zeroBits :: Word) == (oneBits :: Word) +-- True +-- +-- >>> complement (oneBits :: Word) == (zeroBits :: Word) +-- True +-- +-- = Note +-- +-- The constraint on 'oneBits' is arguably too strong. However, as some types +-- (such as 'Natural') have undefined 'complement', this is the only safe +-- choice. +oneBits :: FiniteBits b => b +oneBits = unsafeOneBits +#endif +-- | A version of 'oneBits' that weakens the context from 'FiniteBits' to +-- 'Bits'. This is unsafe because there are some data types with 'Bits' +-- instances that have undefined 'complement', such as 'Natural'. Nevertheless, +-- it is sometimes useful to call this function on data types without +-- 'FiniteBits' instances (e.g., 'Integer'), so this function is provided as a +-- convenience. +unsafeOneBits :: Bits b => b +unsafeOneBits = complement zeroBits + -- | Shift Right Logical (i.e., without sign extension) -- -- /NB:/ When used on negative 'Integer's, hilarity may ensue. srl :: Bits b => b -> Int -> b -srl b n = (b `shiftR` n) .&. rotateR (oneBits `shiftL` n) n +srl b n = (b `shiftR` n) .&. rotateR (unsafeOneBits `shiftL` n) n {-# INLINE srl #-} ------------------------------------------------------------------------------ diff --git a/tests/doctests.hs b/tests/doctests.hs deleted file mode 100644 --- a/tests/doctests.hs +++ /dev/null @@ -1,25 +0,0 @@ ------------------------------------------------------------------------------ --- | --- Module : Main (doctests) --- Copyright : (C) 2012-14 Edward Kmett --- License : BSD-style (see the file LICENSE) --- Maintainer : Edward Kmett --- 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 (flags, pkgs, module_sources) -import Data.Foldable (traverse_) -import Test.DocTest - -main :: IO () -main = do - traverse_ putStrLn args - doctest args - where - args = flags ++ pkgs ++ module_sources diff --git a/travis/cabal-apt-install b/travis/cabal-apt-install deleted file mode 100644 --- a/travis/cabal-apt-install +++ /dev/null @@ -1,27 +0,0 @@ -#! /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 - diff --git a/travis/config b/travis/config deleted file mode 100644 --- a/travis/config +++ /dev/null @@ -1,16 +0,0 @@ --- 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