Remove unnecessary Int-Word conversions

Author: meooow25

containers/src/Data/IntMap/Internal.hs

@@ -267,8 +267,6 @@ module Data.IntMap.Internal (
     , Nat
 
     -- * Utility
-    , natFromInt
-    , intFromNat
     , link
     , linkKey
     , linkWithMask
@@ -313,8 +311,9 @@ import Data.IntSet.Internal.IntTreeCommons
   , branchMask
   , TreeTreeBranch(..)
   , treeTreeBranch
+  , i2w
   )
-import Utils.Containers.Internal.BitUtil
+import Utils.Containers.Internal.BitUtil (shiftLL, shiftRL, iShiftRL)
 import Utils.Containers.Internal.StrictPair
 
 #ifdef __GLASGOW_HASKELL__
@@ -337,14 +336,6 @@ import qualified Control.Category as Category
 -- A "Nat" is a natural machine word (an unsigned Int)
 type Nat = Word
 
-natFromInt :: Key -> Nat
-natFromInt = fromIntegral
-{-# INLINE natFromInt #-}
-
-intFromNat :: Nat -> Key
-intFromNat = fromIntegral
-{-# INLINE intFromNat #-}
-
 {--------------------------------------------------------------------
   Types
 --------------------------------------------------------------------}
@@ -2146,7 +2137,7 @@ mergeA
         -> Int -> f (IntMap a)
         -> f (IntMap a)
     linkA k1 t1 k2 t2
-      | natFromInt k1 < natFromInt k2 = binA p t1 t2
+      | i2w k1 < i2w k2 = binA p t1 t2
       | otherwise = binA p t2 t1
       where
         m = branchMask k1 k2
@@ -3178,7 +3169,7 @@ fromSet f (IntSet.Tip kx bm) = buildTree f kx bm (IntSet.suffixBitMask + 1)
     -- and we construct the IntMap from that half.
     buildTree g !prefix !bmask bits = case bits of
       0 -> Tip prefix (g prefix)
-      _ -> case intFromNat ((natFromInt bits) `shiftRL` 1) of
+      _ -> case bits `iShiftRL` 1 of
         bits2
           | bmask .&. ((1 `shiftLL` bits2) - 1) == 0 ->
               buildTree g (prefix + bits2) (bmask `shiftRL` bits2) bits2
@@ -3552,7 +3543,7 @@ link k1 t1 k2 t2 = linkWithMask (branchMask k1 k2) k1 t1 k2 t2
 -- `linkWithMask` is useful when the `branchMask` has already been computed
 linkWithMask :: Int -> Key -> IntMap a -> Key -> IntMap a -> IntMap a
 linkWithMask m k1 t1 k2 t2
-  | natFromInt k1 < natFromInt k2 = Bin p t1 t2
+  | i2w k1 < i2w k2 = Bin p t1 t2
   | otherwise = Bin p t2 t1
   where
     p = Prefix (mask k1 m .|. m)

containers/src/Data/IntMap/Strict/Internal.hs

@@ -266,8 +266,6 @@ import Data.IntSet.Internal.IntTreeCommons
   (Key, Prefix(..), nomatch, left, signBranch, mask, branchMask)
 import Data.IntMap.Internal
   ( IntMap (..)
-  , natFromInt
-  , intFromNat
   , bin
   , binCheckLeft
   , binCheckRight
@@ -346,7 +344,7 @@ import Data.IntMap.Internal
   , withoutKeys
   )
 import qualified Data.IntSet.Internal as IntSet
-import Utils.Containers.Internal.BitUtil
+import Utils.Containers.Internal.BitUtil (iShiftRL, shiftLL, shiftRL)
 import Utils.Containers.Internal.StrictPair
 import qualified Data.Foldable as Foldable
 
@@ -1056,7 +1054,7 @@ fromSet f (IntSet.Tip kx bm) = buildTree f kx bm (IntSet.suffixBitMask + 1)
         -- one of them is nonempty and we construct the IntMap from that half.
         buildTree g !prefix !bmask bits = case bits of
           0 -> Tip prefix $! g prefix
-          _ -> case intFromNat ((natFromInt bits) `shiftRL` 1) of
+          _ -> case bits `iShiftRL` 1 of
                  bits2 | bmask .&. ((1 `shiftLL` bits2) - 1) == 0 ->
                            buildTree g (prefix + bits2) (bmask `shiftRL` bits2) bits2
                        | (bmask `shiftRL` bits2) .&. ((1 `shiftLL` bits2) - 1) == 0 ->

containers/src/Data/IntSet/Internal.hs

@@ -217,6 +217,7 @@ import Data.IntSet.Internal.IntTreeCommons
   , branchMask
   , TreeTreeBranch(..)
   , treeTreeBranch
+  , i2w
   )
 
 #if __GLASGOW_HASKELL__
@@ -243,14 +244,6 @@ infixl 9 \\{-This comment teaches CPP correct behaviour -}
 -- A "Nat" is a natural machine word (an unsigned Int)
 type Nat = Word
 
-natFromInt :: Int -> Nat
-natFromInt i = fromIntegral i
-{-# INLINE natFromInt #-}
-
-intFromNat :: Nat -> Int
-intFromNat w = fromIntegral w
-{-# INLINE intFromNat #-}
-
 {--------------------------------------------------------------------
   Operators
 --------------------------------------------------------------------}
@@ -1388,10 +1381,10 @@ fromRange (lx,rx)
       | m < suffixBitMask = Tip p (complement 0)
       | otherwise         = Bin (Prefix (p .|. m)) (goFull p (shr1 m)) (goFull (p .|. m) (shr1 m))
     lbm :: Int -> Int
-    lbm p = intFromNat (lowestBitMask (natFromInt p))
+    lbm p = p .&. negate p -- lowest bit mask
     {-# INLINE lbm #-}
     shr1 :: Int -> Int
-    shr1 m = intFromNat (natFromInt m `shiftRL` 1)
+    shr1 m = m `iShiftRL` 1
     {-# INLINE shr1 #-}
 
 -- | \(O(n)\). Build a set from an ascending list of elements.
@@ -1621,7 +1614,7 @@ link k1 t1 k2 t2 = linkWithMask (branchMask k1 k2) k1 t1 k2 t2
 -- `linkWithMask` is useful when the `branchMask` has already been computed
 linkWithMask :: Int -> Key -> IntSet -> Key -> IntSet -> IntSet
 linkWithMask m k1 t1 k2 t2
-  | natFromInt k1 < natFromInt k2 = Bin p t1 t2
+  | i2w k1 < i2w k2 = Bin p t1 t2
   | otherwise = Bin p t2 t1
   where
     p = Prefix (mask k1 m .|. m)
@@ -1707,12 +1700,12 @@ takeWhileAntitoneBits :: Int -> (Int -> Bool) -> Nat -> Nat
 {-# INLINE foldMapBits #-}
 {-# INLINE takeWhileAntitoneBits #-}
 
+#if defined(__GLASGOW_HASKELL__)
+
 lowestBitMask :: Nat -> Nat
 lowestBitMask x = x .&. negate x
 {-# INLINE lowestBitMask #-}
 
-#if defined(__GLASGOW_HASKELL__)
-
 lowestBitSet x = countTrailingZeros x
 
 highestBitSet x = WORD_SIZE_IN_BITS - 1 - countLeadingZeros x

containers/src/Data/IntSet/Internal/IntTreeCommons.hs

@@ -35,6 +35,7 @@ module Data.IntSet.Internal.IntTreeCommons
   , treeTreeBranch
   , mask
   , branchMask
+  , i2w
   ) where
 
 import Data.Bits (Bits(..))

containers/src/Utils/Containers/Internal/BitUtil.hs

@@ -1,6 +1,7 @@
 {-# LANGUAGE CPP #-}
-#if !defined(TESTING) && defined(__GLASGOW_HASKELL__)
-{-# LANGUAGE Safe #-}
+#ifdef __GLASGOW_HASKELL__
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE Trustworthy #-}
 #endif
 
 #include "containers.h"
@@ -32,11 +33,15 @@ module Utils.Containers.Internal.BitUtil
     , shiftLL
     , shiftRL
     , wordSize
+    , iShiftRL
     ) where
 
 import Data.Bits (unsafeShiftL, unsafeShiftR
     , countLeadingZeros, finiteBitSize
     )
+#ifdef __GLASGOW_HASKELL__
+import GHC.Exts (Int(..), uncheckedIShiftRL#)
+#endif
 
 -- | Return a word where only the highest bit is set.
 highestBitMask :: Word -> Word
@@ -51,3 +56,11 @@ shiftLL = unsafeShiftL
 {-# INLINE wordSize #-}
 wordSize :: Int
 wordSize = finiteBitSize (0 :: Word)
+
+-- Right logical shift.
+iShiftRL :: Int -> Int -> Int
+#ifdef __GLASGOW_HASKELL__
+iShiftRL (I# x#) (I# sh#) = I# (uncheckedIShiftRL# x# sh#)
+#else
+iShiftRL x sh = fromIntegral (unsafeShiftR (fromIntegral x :: Word) sh)
+#endif