No benefit from constant shifts (#326)

* No benefit from constant shifts

Safe shifts with statically known amount of shift are optimized by GHC to unsafe shifts automatically.

* Remove Data.ByteString.Builder.Prim.Internal.UncheckedShifts

Author: Bodigrim

.hlint.yaml

@@ -2,7 +2,6 @@
     name: Use camelCase
     within:
       - Data.ByteString.Builder.Internal
-      - Data.ByteString.Builder.Prim.Internal.UncheckedShifts
       - Data.ByteString.Short.Internal
 - ignore:
     name: Use fewer imports

Data/ByteString/Builder/ASCII.hs

@@ -104,17 +104,11 @@ import           Data.Monoid (mappend)
 import           GHC.Num     (quotRemInteger)
 # endif
 
-# if __GLASGOW_HASKELL__ < 611
-import GHC.Integer.Internals
-# else
 import GHC.Integer.GMP.Internals
-# endif
 #endif
 
 #if HAS_INTEGER_CONSTR
 import qualified Data.ByteString.Builder.Prim.Internal          as P
-import           Data.ByteString.Builder.Prim.Internal.UncheckedShifts
-                   ( caseWordSize_32_64 )
 import           Foreign.C.Types
 import           GHC.Types   (Int(..))
 #endif
@@ -329,7 +323,7 @@ lazyByteStringHex = P.primMapLazyByteStringFixed P.word8HexFixed
 -- FIXME: Think about also using the MSB. For 64 bit 'Int's this makes a
 -- difference.
 maxPow10 :: Integer
-maxPow10 = toInteger $ (10 :: Int) ^ caseWordSize_32_64 (9 :: Int) 18
+maxPow10 = toInteger $ (10 :: Int) ^ P.caseWordSize_32_64 (9 :: Int) 18
 
 -- | Decimal encoding of an 'Integer' using the ASCII digits.
 integerDec :: Integer -> Builder
@@ -386,7 +380,7 @@ foreign import ccall unsafe "static _hs_bytestring_long_long_int_dec_padded18"
 
 {-# INLINE intDecPadded #-}
 intDecPadded :: P.BoundedPrim Int
-intDecPadded = P.liftFixedToBounded $ caseWordSize_32_64
+intDecPadded = P.liftFixedToBounded $ P.caseWordSize_32_64
     (P.fixedPrim  9 $ c_int_dec_padded9            . fromIntegral)
     (P.fixedPrim 18 $ c_long_long_int_dec_padded18 . fromIntegral)
 

Data/ByteString/Builder/Internal.hs

@@ -608,7 +608,6 @@ putLiftIO io = put $ \k br -> io >>= (`k` br)
 -- buffer is too small to execute one step of the 'Put' action, then
 -- it is replaced with a large enough buffer.
 hPut :: forall a. Handle -> Put a -> IO a
-#if __GLASGOW_HASKELL__ >= 611
 hPut h p = do
     fillHandle 1 (runPut p)
   where
@@ -655,12 +654,7 @@ hPut h p = do
 
               | freeSpace buf < minFree = flushWriteBuffer h_
               | otherwise               =
-#if __GLASGOW_HASKELL__ >= 613
                                           return ()
-#else
-                                          -- required for ghc-6.12
-                                          flushWriteBuffer h_
-#endif
 
             fillBuffer buf
               | freeSpace buf < minFree =
@@ -709,15 +703,6 @@ hPut h p = do
                     return $ do
                         S.hPut h bs
                         fillHandle 1 nextStep
-#else
-hPut h p =
-    go =<< buildStepToCIOS strategy (runPut p)
-  where
-    strategy = untrimmedStrategy L.smallChunkSize L.defaultChunkSize
-
-    go (Finished buf x) = S.hPut h (byteStringFromBuffer buf) >> return x
-    go (Yield1 bs io)   = S.hPut h bs >> io >>= go
-#endif
 
 -- | Execute a 'Put' and return the computed result and the bytes
 -- written during the computation as a lazy 'L.ByteString'.

Data/ByteString/Builder/Prim/ASCII.hs

@@ -84,7 +84,6 @@ import Data.ByteString.Builder.Prim.Binary
 import Data.ByteString.Builder.Prim.Internal
 import Data.ByteString.Builder.Prim.Internal.Floating
 import Data.ByteString.Builder.Prim.Internal.Base16
-import Data.ByteString.Builder.Prim.Internal.UncheckedShifts
 
 import Data.Char (ord)
 
@@ -242,20 +241,20 @@ word8HexFixed = fixedPrim 2 $
 {-# INLINE word16HexFixed #-}
 word16HexFixed :: FixedPrim Word16
 word16HexFixed =
-    (\x -> (fromIntegral $ x `shiftr_w16` 8, fromIntegral x))
+    (\x -> (fromIntegral $ x `shiftR` 8, fromIntegral x))
       >$< pairF word8HexFixed word8HexFixed
 
 -- | Encode a 'Word32' using 8 nibbles.
 {-# INLINE word32HexFixed #-}
 word32HexFixed :: FixedPrim Word32
 word32HexFixed =
-    (\x -> (fromIntegral $ x `shiftr_w32` 16, fromIntegral x))
+    (\x -> (fromIntegral $ x `shiftR` 16, fromIntegral x))
       >$< pairF word16HexFixed word16HexFixed
 -- | Encode a 'Word64' using 16 nibbles.
 {-# INLINE word64HexFixed #-}
 word64HexFixed :: FixedPrim Word64
 word64HexFixed =
-    (\x -> (fromIntegral $ x `shiftr_w64` 32, fromIntegral x))
+    (\x -> (fromIntegral $ x `shiftR` 32, fromIntegral x))
       >$< pairF word32HexFixed word32HexFixed
 
 -- | Encode a 'Int8' using 2 nibbles (hexadecimal digits).

Data/ByteString/Builder/Prim/Binary.hs

@@ -55,7 +55,6 @@ module Data.ByteString.Builder.Prim.Binary (
   ) where
 
 import Data.ByteString.Builder.Prim.Internal
-import Data.ByteString.Builder.Prim.Internal.UncheckedShifts
 import Data.ByteString.Builder.Prim.Internal.Floating
 
 import Foreign
@@ -87,7 +86,7 @@ word16BE :: FixedPrim Word16
 word16BE = word16Host
 #else
 word16BE = fixedPrim 2 $ \w p -> do
-    poke p               (fromIntegral (shiftr_w16 w 8) :: Word8)
+    poke p               (fromIntegral (shiftR w 8) :: Word8)
     poke (p `plusPtr` 1) (fromIntegral w                :: Word8)
 #endif
 
@@ -97,7 +96,7 @@ word16LE :: FixedPrim Word16
 #ifdef WORDS_BIGENDIAN
 word16LE = fixedPrim 2 $ \w p -> do
     poke p               (fromIntegral w                :: Word8)
-    poke (p `plusPtr` 1) (fromIntegral (shiftr_w16 w 8) :: Word8)
+    poke (p `plusPtr` 1) (fromIntegral (shiftR w 8) :: Word8)
 #else
 word16LE = word16Host
 #endif
@@ -109,9 +108,9 @@ word32BE :: FixedPrim Word32
 word32BE = word32Host
 #else
 word32BE = fixedPrim 4 $ \w p -> do
-    poke p               (fromIntegral (shiftr_w32 w 24) :: Word8)
-    poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 w 16) :: Word8)
-    poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 w  8) :: Word8)
+    poke p               (fromIntegral (shiftR w 24) :: Word8)
+    poke (p `plusPtr` 1) (fromIntegral (shiftR w 16) :: Word8)
+    poke (p `plusPtr` 2) (fromIntegral (shiftR w  8) :: Word8)
     poke (p `plusPtr` 3) (fromIntegral w                 :: Word8)
 #endif
 
@@ -121,9 +120,9 @@ word32LE :: FixedPrim Word32
 #ifdef WORDS_BIGENDIAN
 word32LE = fixedPrim 4 $ \w p -> do
     poke p               (fromIntegral w                 :: Word8)
-    poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 w  8) :: Word8)
-    poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 w 16) :: Word8)
-    poke (p `plusPtr` 3) (fromIntegral (shiftr_w32 w 24) :: Word8)
+    poke (p `plusPtr` 1) (fromIntegral (shiftR w  8) :: Word8)
+    poke (p `plusPtr` 2) (fromIntegral (shiftR w 16) :: Word8)
+    poke (p `plusPtr` 3) (fromIntegral (shiftR w 24) :: Word8)
 #else
 word32LE = word32Host
 #endif
@@ -144,25 +143,25 @@ word64BE = word64Host
 --
 word64BE =
     fixedPrim 8 $ \w p -> do
-        let a = fromIntegral (shiftr_w64 w 32) :: Word32
+        let a = fromIntegral (shiftR w 32) :: Word32
             b = fromIntegral w                 :: Word32
-        poke p               (fromIntegral (shiftr_w32 a 24) :: Word8)
-        poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 a 16) :: Word8)
-        poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 a  8) :: Word8)
+        poke p               (fromIntegral (shiftR a 24) :: Word8)
+        poke (p `plusPtr` 1) (fromIntegral (shiftR a 16) :: Word8)
+        poke (p `plusPtr` 2) (fromIntegral (shiftR a  8) :: Word8)
         poke (p `plusPtr` 3) (fromIntegral a                 :: Word8)
-        poke (p `plusPtr` 4) (fromIntegral (shiftr_w32 b 24) :: Word8)
-        poke (p `plusPtr` 5) (fromIntegral (shiftr_w32 b 16) :: Word8)
-        poke (p `plusPtr` 6) (fromIntegral (shiftr_w32 b  8) :: Word8)
+        poke (p `plusPtr` 4) (fromIntegral (shiftR b 24) :: Word8)
+        poke (p `plusPtr` 5) (fromIntegral (shiftR b 16) :: Word8)
+        poke (p `plusPtr` 6) (fromIntegral (shiftR b  8) :: Word8)
         poke (p `plusPtr` 7) (fromIntegral b                 :: Word8)
 #else
 word64BE = fixedPrim 8 $ \w p -> do
-    poke p               (fromIntegral (shiftr_w64 w 56) :: Word8)
-    poke (p `plusPtr` 1) (fromIntegral (shiftr_w64 w 48) :: Word8)
-    poke (p `plusPtr` 2) (fromIntegral (shiftr_w64 w 40) :: Word8)
-    poke (p `plusPtr` 3) (fromIntegral (shiftr_w64 w 32) :: Word8)
-    poke (p `plusPtr` 4) (fromIntegral (shiftr_w64 w 24) :: Word8)
-    poke (p `plusPtr` 5) (fromIntegral (shiftr_w64 w 16) :: Word8)
-    poke (p `plusPtr` 6) (fromIntegral (shiftr_w64 w  8) :: Word8)
+    poke p               (fromIntegral (shiftR w 56) :: Word8)
+    poke (p `plusPtr` 1) (fromIntegral (shiftR w 48) :: Word8)
+    poke (p `plusPtr` 2) (fromIntegral (shiftR w 40) :: Word8)
+    poke (p `plusPtr` 3) (fromIntegral (shiftR w 32) :: Word8)
+    poke (p `plusPtr` 4) (fromIntegral (shiftR w 24) :: Word8)
+    poke (p `plusPtr` 5) (fromIntegral (shiftR w 16) :: Word8)
+    poke (p `plusPtr` 6) (fromIntegral (shiftR w  8) :: Word8)
     poke (p `plusPtr` 7) (fromIntegral w                 :: Word8)
 #endif
 #endif
@@ -174,26 +173,26 @@ word64LE :: FixedPrim Word64
 #if WORD_SIZE_IN_BITS < 64
 word64LE =
     fixedPrim 8 $ \w p -> do
-        let b = fromIntegral (shiftr_w64 w 32) :: Word32
+        let b = fromIntegral (shiftR w 32) :: Word32
             a = fromIntegral w                 :: Word32
         poke (p)             (fromIntegral a                 :: Word8)
-        poke (p `plusPtr` 1) (fromIntegral (shiftr_w32 a  8) :: Word8)
-        poke (p `plusPtr` 2) (fromIntegral (shiftr_w32 a 16) :: Word8)
-        poke (p `plusPtr` 3) (fromIntegral (shiftr_w32 a 24) :: Word8)
+        poke (p `plusPtr` 1) (fromIntegral (shiftR a  8) :: Word8)
+        poke (p `plusPtr` 2) (fromIntegral (shiftR a 16) :: Word8)
+        poke (p `plusPtr` 3) (fromIntegral (shiftR a 24) :: Word8)
         poke (p `plusPtr` 4) (fromIntegral b                 :: Word8)
-        poke (p `plusPtr` 5) (fromIntegral (shiftr_w32 b  8) :: Word8)
-        poke (p `plusPtr` 6) (fromIntegral (shiftr_w32 b 16) :: Word8)
-        poke (p `plusPtr` 7) (fromIntegral (shiftr_w32 b 24) :: Word8)
+        poke (p `plusPtr` 5) (fromIntegral (shiftR b  8) :: Word8)
+        poke (p `plusPtr` 6) (fromIntegral (shiftR b 16) :: Word8)
+        poke (p `plusPtr` 7) (fromIntegral (shiftR b 24) :: Word8)
 #else
 word64LE = fixedPrim 8 $ \w p -> do
     poke p               (fromIntegral w                 :: Word8)
-    poke (p `plusPtr` 1) (fromIntegral (shiftr_w64 w  8) :: Word8)
-    poke (p `plusPtr` 2) (fromIntegral (shiftr_w64 w 16) :: Word8)
-    poke (p `plusPtr` 3) (fromIntegral (shiftr_w64 w 24) :: Word8)
-    poke (p `plusPtr` 4) (fromIntegral (shiftr_w64 w 32) :: Word8)
-    poke (p `plusPtr` 5) (fromIntegral (shiftr_w64 w 40) :: Word8)
-    poke (p `plusPtr` 6) (fromIntegral (shiftr_w64 w 48) :: Word8)
-    poke (p `plusPtr` 7) (fromIntegral (shiftr_w64 w 56) :: Word8)
+    poke (p `plusPtr` 1) (fromIntegral (shiftR w  8) :: Word8)
+    poke (p `plusPtr` 2) (fromIntegral (shiftR w 16) :: Word8)
+    poke (p `plusPtr` 3) (fromIntegral (shiftR w 24) :: Word8)
+    poke (p `plusPtr` 4) (fromIntegral (shiftR w 32) :: Word8)
+    poke (p `plusPtr` 5) (fromIntegral (shiftR w 40) :: Word8)
+    poke (p `plusPtr` 6) (fromIntegral (shiftR w 48) :: Word8)
+    poke (p `plusPtr` 7) (fromIntegral (shiftR w 56) :: Word8)
 #endif
 #else
 word64LE = word64Host

Data/ByteString/Builder/Prim/Internal.hs

@@ -64,17 +64,17 @@ module Data.ByteString.Builder.Prim.Internal (
   , (>$<)
   , (>*<)
 
+  -- * Helpers
+  , caseWordSize_32_64
+
   -- * Deprecated
   , boudedPrim
   ) where
 
 import Foreign
 import Prelude hiding (maxBound)
 
-#if !(__GLASGOW_HASKELL__ >= 612)
--- ghc-6.10 and older do not support {-# INLINE CONLIKE #-}
-#define CONLIKE
-#endif
+#include "MachDeps.h"
 
 ------------------------------------------------------------------------------
 -- Supporting infrastructure
@@ -298,3 +298,17 @@ eitherB (BP b1 io1) (BP b2 io2) =
 condB :: (a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
 condB p be1 be2 =
     contramapB (\x -> if p x then Left x else Right x) (eitherB be1 be2)
+
+-- | Select an implementation depending on bitness.
+-- Throw a compile time error if bitness is neither 32 nor 64.
+{-# INLINE caseWordSize_32_64 #-}
+caseWordSize_32_64
+  :: a -- Value for 32-bit architecture
+  -> a -- Value for 64-bit architecture
+  -> a
+#if WORD_SIZE_IN_BITS == 32
+caseWordSize_32_64 = const
+#endif
+#if WORD_SIZE_IN_BITS == 64
+caseWordSize_32_64 = const id
+#endif