From: Ian Lynagh <igloo@earth.li>
Date: Fri, 24 Apr 2009 12:53:20 +0000 (+0000)
Subject: Use a bang pattern when we where/let-bind values with unlifted types
X-Git-Tag: 2009-06-25~37
X-Git-Url: http://git.megacz.com/?a=commitdiff_plain;h=73c4a36a4f5140f4444feacfdafb466c6f940b26;p=ghc-base.git

Use a bang pattern when we where/let-bind values with unlifted types
---

diff --git a/Data/Bits.hs b/Data/Bits.hs
index 18c1f6d..46f009a 100644
--- a/Data/Bits.hs
+++ b/Data/Bits.hs
@@ -218,9 +218,9 @@ instance Bits Int where
         I# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
                        (x'# `uncheckedShiftRL#` (wsib -# i'#))))
       where
-        x'# = int2Word# x#
-        i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
-        wsib = WORD_SIZE_IN_BITS#   {- work around preprocessor problem (??) -}
+        !x'# = int2Word# x#
+        !i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
+        !wsib = WORD_SIZE_IN_BITS#   {- work around preprocessor problem (??) -}
     bitSize  _             = WORD_SIZE_IN_BITS
 
     {-# INLINE shiftR #-}
diff --git a/GHC/Base.lhs b/GHC/Base.lhs
index 3d6140f..4c47992 100644
--- a/GHC/Base.lhs
+++ b/GHC/Base.lhs
@@ -753,7 +753,7 @@ x# `modInt#` y#
       (x# <# 0#) && (y# ># 0#)    = if r# /=# 0# then r# +# y# else 0#
     | otherwise                   = r#
     where
-    r# = x# `remInt#` y#
+    !r# = x# `remInt#` y#
 \end{code}
 
 Definitions of the boxed PrimOps; these will be
@@ -801,8 +801,8 @@ gcdInt (I# a) (I# b) = g a b
 
          absInt x = if x <# 0# then negateInt# x else x
 
-         absA     = absInt a
-         absB     = absInt b
+         !absA     = absInt a
+         !absB     = absInt b
 
 negateInt :: Int -> Int
 negateInt (I# x) = I# (negateInt# x)
@@ -935,7 +935,7 @@ unpackCString# addr
       | ch `eqChar#` '\0'# = []
       | otherwise          = C# ch : unpack (nh +# 1#)
       where
-        ch = indexCharOffAddr# addr nh
+        !ch = indexCharOffAddr# addr nh
 
 unpackAppendCString# :: Addr# -> [Char] -> [Char]
 {-# NOINLINE unpackAppendCString# #-}
@@ -947,7 +947,7 @@ unpackAppendCString# addr rest
       | ch `eqChar#` '\0'# = rest
       | otherwise          = C# ch : unpack (nh +# 1#)
       where
-        ch = indexCharOffAddr# addr nh
+        !ch = indexCharOffAddr# addr nh
 
 unpackFoldrCString# :: Addr# -> (Char  -> a -> a) -> a -> a 
 {-# NOINLINE [0] unpackFoldrCString# #-}
@@ -965,7 +965,7 @@ unpackFoldrCString# addr f z
       | ch `eqChar#` '\0'# = z
       | otherwise          = C# ch `f` unpack (nh +# 1#)
       where
-        ch = indexCharOffAddr# addr nh
+        !ch = indexCharOffAddr# addr nh
 
 unpackCStringUtf8# :: Addr# -> [Char]
 unpackCStringUtf8# addr 
@@ -990,7 +990,7 @@ unpackCStringUtf8# addr
                      (ord# (indexCharOffAddr# addr (nh +# 3#)) -# 0x80#))) :
           unpack (nh +# 4#)
       where
-        ch = indexCharOffAddr# addr nh
+        !ch = indexCharOffAddr# addr nh
 
 unpackNBytes# :: Addr# -> Int# -> [Char]
 unpackNBytes# _addr 0#   = []
diff --git a/GHC/Conc.lhs b/GHC/Conc.lhs
index d6622dd..b53bf54 100644
--- a/GHC/Conc.lhs
+++ b/GHC/Conc.lhs
@@ -351,8 +351,8 @@ Other applications like the graphical Concurrent Haskell Debugger
 
 labelThread :: ThreadId -> String -> IO ()
 labelThread (ThreadId t) str = IO $ \ s ->
-   let ps  = packCString# str
-       adr = byteArrayContents# ps in
+   let !ps  = packCString# str
+       !adr = byteArrayContents# ps in
      case (labelThread# t adr s) of s1 -> (# s1, () #)
 
 --      Nota Bene: 'pseq' used to be 'seq'
diff --git a/GHC/Enum.lhs b/GHC/Enum.lhs
index 7dfaa02..28f44f0 100644
--- a/GHC/Enum.lhs
+++ b/GHC/Enum.lhs
@@ -368,14 +368,14 @@ efdCharFB c n x1 x2
   | delta >=# 0# = go_up_char_fb c n x1 delta 0x10FFFF#
   | otherwise    = go_dn_char_fb c n x1 delta 0#
   where
-    delta = x2 -# x1
+    !delta = x2 -# x1
 
 efdChar :: Int# -> Int# -> String
 efdChar x1 x2
   | delta >=# 0# = go_up_char_list x1 delta 0x10FFFF#
   | otherwise    = go_dn_char_list x1 delta 0#
   where
-    delta = x2 -# x1
+    !delta = x2 -# x1
 
 {-# NOINLINE [0] efdtCharFB #-}
 efdtCharFB :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
@@ -383,14 +383,14 @@ efdtCharFB c n x1 x2 lim
   | delta >=# 0# = go_up_char_fb c n x1 delta lim
   | otherwise    = go_dn_char_fb c n x1 delta lim
   where
-    delta = x2 -# x1
+    !delta = x2 -# x1
 
 efdtChar :: Int# -> Int# -> Int# -> String
 efdtChar x1 x2 lim
   | delta >=# 0# = go_up_char_list x1 delta lim
   | otherwise    = go_dn_char_list x1 delta lim
   where
-    delta = x2 -# x1
+    !delta = x2 -# x1
 
 go_up_char_fb :: (Char -> a -> a) -> a -> Int# -> Int# -> Int# -> a
 go_up_char_fb c n x0 delta lim
@@ -453,7 +453,7 @@ instance  Enum Int  where
 
     {-# INLINE enumFrom #-}
     enumFrom (I# x) = eftInt x maxInt#
-        where I# maxInt# = maxInt
+        where !(I# maxInt#) = maxInt
         -- Blarg: technically I guess enumFrom isn't strict!
 
     {-# INLINE enumFromTo #-}
@@ -528,8 +528,8 @@ efdtIntUp :: Int# -> Int# -> Int# -> [Int]
 efdtIntUp x1 x2 y    -- Be careful about overflow!
  | y <# x2   = if y <# x1 then [] else [I# x1]
  | otherwise = -- Common case: x1 <= x2 <= y
-               let delta = x2 -# x1 -- >= 0
-                   y' = y -# delta  -- x1 <= y' <= y; hence y' is representable
+               let !delta = x2 -# x1 -- >= 0
+                   !y' = y -# delta  -- x1 <= y' <= y; hence y' is representable
 
                    -- Invariant: x <= y
                    -- Note that: z <= y' => z + delta won't overflow
@@ -543,8 +543,8 @@ efdtIntUpFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
 efdtIntUpFB c n x1 x2 y    -- Be careful about overflow!
  | y <# x2   = if y <# x1 then n else I# x1 `c` n
  | otherwise = -- Common case: x1 <= x2 <= y
-               let delta = x2 -# x1 -- >= 0
-                   y' = y -# delta  -- x1 <= y' <= y; hence y' is representable
+               let !delta = x2 -# x1 -- >= 0
+                   !y' = y -# delta  -- x1 <= y' <= y; hence y' is representable
 
                    -- Invariant: x <= y
                    -- Note that: z <= y' => z + delta won't overflow
@@ -558,8 +558,8 @@ efdtIntDn :: Int# -> Int# -> Int# -> [Int]
 efdtIntDn x1 x2 y    -- Be careful about underflow!
  | y ># x2   = if y ># x1 then [] else [I# x1]
  | otherwise = -- Common case: x1 >= x2 >= y
-               let delta = x2 -# x1 -- <= 0
-                   y' = y -# delta  -- y <= y' <= x1; hence y' is representable
+               let !delta = x2 -# x1 -- <= 0
+                   !y' = y -# delta  -- y <= y' <= x1; hence y' is representable
 
                    -- Invariant: x >= y
                    -- Note that: z >= y' => z + delta won't underflow
@@ -573,8 +573,8 @@ efdtIntDnFB :: (Int -> r -> r) -> r -> Int# -> Int# -> Int# -> r
 efdtIntDnFB c n x1 x2 y    -- Be careful about underflow!
  | y ># x2 = if y ># x1 then n else I# x1 `c` n
  | otherwise = -- Common case: x1 >= x2 >= y
-               let delta = x2 -# x1 -- <= 0
-                   y' = y -# delta  -- y <= y' <= x1; hence y' is representable
+               let !delta = x2 -# x1 -- <= 0
+                   !y' = y -# delta  -- y <= y' <= x1; hence y' is representable
 
                    -- Invariant: x >= y
                    -- Note that: z >= y' => z + delta won't underflow
diff --git a/GHC/ForeignPtr.hs b/GHC/ForeignPtr.hs
index 9868942..25dc0fa 100644
--- a/GHC/ForeignPtr.hs
+++ b/GHC/ForeignPtr.hs
@@ -156,8 +156,8 @@ mallocForeignPtr = doMalloc undefined
              (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
                                (MallocPtr mbarr# r) #)
             }
-            where (I# size)  = sizeOf a
-                  (I# align) = alignment a
+            where !(I# size)  = sizeOf a
+                  !(I# align) = alignment a
 
 -- | This function is similar to 'mallocForeignPtr', except that the
 -- size of the memory required is given explicitly as a number of bytes.
@@ -191,8 +191,8 @@ mallocPlainForeignPtr = doMalloc undefined
              (# s', ForeignPtr (byteArrayContents# (unsafeCoerce# mbarr#))
                                (PlainPtr mbarr#) #)
             }
-            where (I# size)  = sizeOf a
-                  (I# align) = alignment a
+            where !(I# size)  = sizeOf a
+                  !(I# align) = alignment a
 
 -- | This function is similar to 'mallocForeignPtrBytes', except that
 -- the internally an optimised ForeignPtr representation with no
diff --git a/GHC/IO.hs b/GHC/IO.hs
index a17714f..231244b 100644
--- a/GHC/IO.hs
+++ b/GHC/IO.hs
@@ -138,7 +138,7 @@ hGetChar handle =
         hGetcBuffered fd ref new_buf
     NoBuffering -> do
         -- make use of the minimal buffer we already have
-        let raw = bufBuf buf
+        let !raw = bufBuf buf
         r <- readRawBuffer "hGetChar" fd (haIsStream handle_) raw 0 1
         if r == 0
            then ioe_EOF
@@ -358,7 +358,7 @@ lazyRead' h handle_ = do
   case haBufferMode handle_ of
      NoBuffering      -> do
         -- make use of the minimal buffer we already have
-        let raw = bufBuf buf
+        let !raw = bufBuf buf
         r <- readRawBuffer "lazyRead" fd (haIsStream handle_) raw 0 1
         if r == 0
            then do (handle_', _) <- hClose_help handle_ 
diff --git a/GHC/Int.hs b/GHC/Int.hs
index ae49806..8b1f4e4 100644
--- a/GHC/Int.hs
+++ b/GHC/Int.hs
@@ -142,8 +142,8 @@ instance Bits Int8 where
         = I8# (narrow8Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
                                        (x'# `uncheckedShiftRL#` (8# -# i'#)))))
         where
-        x'# = narrow8Word# (int2Word# x#)
-        i'# = word2Int# (int2Word# i# `and#` int2Word# 7#)
+        !x'# = narrow8Word# (int2Word# x#)
+        !i'# = word2Int# (int2Word# i# `and#` int2Word# 7#)
     bitSize  _                = 8
     isSigned _                = True
 
@@ -258,8 +258,8 @@ instance Bits Int16 where
         = I16# (narrow16Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
                                          (x'# `uncheckedShiftRL#` (16# -# i'#)))))
         where
-        x'# = narrow16Word# (int2Word# x#)
-        i'# = word2Int# (int2Word# i# `and#` int2Word# 15#)
+        !x'# = narrow16Word# (int2Word# x#)
+        !i'# = word2Int# (int2Word# i# `and#` int2Word# 15#)
     bitSize  _                 = 16
     isSigned _                 = True
 
@@ -507,8 +507,8 @@ instance Bits Int32 where
         = I32# (narrow32Int# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
                                          (x'# `uncheckedShiftRL#` (32# -# i'#)))))
         where
-        x'# = narrow32Word# (int2Word# x#)
-        i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
+        !x'# = narrow32Word# (int2Word# x#)
+        !i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
     bitSize  _                 = 32
     isSigned _                 = True
 
@@ -774,8 +774,8 @@ instance Bits Int64 where
         = I64# (word2Int# ((x'# `uncheckedShiftL#` i'#) `or#`
                            (x'# `uncheckedShiftRL#` (64# -# i'#))))
         where
-        x'# = int2Word# x#
-        i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
+        !x'# = int2Word# x#
+        !i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
     bitSize  _                 = 64
     isSigned _                 = True
 
diff --git a/GHC/Show.lhs b/GHC/Show.lhs
index 11dd7e1..dc19d87 100644
--- a/GHC/Show.lhs
+++ b/GHC/Show.lhs
@@ -388,7 +388,7 @@ showSignedInt (I# p) (I# n) r
 itos :: Int# -> String -> String
 itos n# cs
     | n# <# 0# =
-        let I# minInt# = minInt in
+        let !(I# minInt#) = minInt in
         if n# ==# minInt#
                 -- negateInt# minInt overflows, so we can't do that:
            then '-' : itos' (negateInt# (n# `quotInt#` 10#))
diff --git a/GHC/Weak.lhs b/GHC/Weak.lhs
index 6db5b5c..2d9163e 100644
--- a/GHC/Weak.lhs
+++ b/GHC/Weak.lhs
@@ -123,7 +123,7 @@ runFinalizerBatch (I# n) arr =
    let  go m  = IO $ \s ->
                   case m of 
                   0# -> (# s, () #)
-                  _  -> let m' = m -# 1# in
+                  _  -> let !m' = m -# 1# in
                         case indexArray# arr m' of { (# io #) -> 
                         case unIO io s of          { (# s', _ #) -> 
                         unIO (go m') s'
diff --git a/GHC/Word.hs b/GHC/Word.hs
index 8d63e11..a56c2de 100644
--- a/GHC/Word.hs
+++ b/GHC/Word.hs
@@ -138,7 +138,7 @@ instance Integral Word where
         | i# >=# 0#             = smallInteger i#
         | otherwise             = wordToInteger x#
         where
-        i# = word2Int# x#
+        !i# = word2Int# x#
 
 instance Bounded Word where
     minBound = 0
@@ -167,7 +167,8 @@ instance Bits Word where
     (W# x#) .&.   (W# y#)    = W# (x# `and#` y#)
     (W# x#) .|.   (W# y#)    = W# (x# `or#`  y#)
     (W# x#) `xor` (W# y#)    = W# (x# `xor#` y#)
-    complement (W# x#)       = W# (x# `xor#` mb#) where W# mb# = maxBound
+    complement (W# x#)       = W# (x# `xor#` mb#)
+        where !(W# mb#) = maxBound
     (W# x#) `shift` (I# i#)
         | i# >=# 0#          = W# (x# `shiftL#` i#)
         | otherwise          = W# (x# `shiftRL#` negateInt# i#)
@@ -175,8 +176,8 @@ instance Bits Word where
         | i'# ==# 0# = W# x#
         | otherwise  = W# ((x# `uncheckedShiftL#` i'#) `or#` (x# `uncheckedShiftRL#` (wsib -# i'#)))
         where
-        i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
-        wsib = WORD_SIZE_IN_BITS#  {- work around preprocessor problem (??) -}
+        !i'# = word2Int# (int2Word# i# `and#` int2Word# (wsib -# 1#))
+        !wsib = WORD_SIZE_IN_BITS#  {- work around preprocessor problem (??) -}
     bitSize  _               = WORD_SIZE_IN_BITS
     isSigned _               = False
 
@@ -270,7 +271,8 @@ instance Bits Word8 where
     (W8# x#) .&.   (W8# y#)   = W8# (x# `and#` y#)
     (W8# x#) .|.   (W8# y#)   = W8# (x# `or#`  y#)
     (W8# x#) `xor` (W8# y#)   = W8# (x# `xor#` y#)
-    complement (W8# x#)       = W8# (x# `xor#` mb#) where W8# mb# = maxBound
+    complement (W8# x#)       = W8# (x# `xor#` mb#)
+        where !(W8# mb#) = maxBound
     (W8# x#) `shift` (I# i#)
         | i# >=# 0#           = W8# (narrow8Word# (x# `shiftL#` i#))
         | otherwise           = W8# (x# `shiftRL#` negateInt# i#)
@@ -279,7 +281,7 @@ instance Bits Word8 where
         | otherwise  = W8# (narrow8Word# ((x# `uncheckedShiftL#` i'#) `or#`
                                           (x# `uncheckedShiftRL#` (8# -# i'#))))
         where
-        i'# = word2Int# (int2Word# i# `and#` int2Word# 7#)
+        !i'# = word2Int# (int2Word# i# `and#` int2Word# 7#)
     bitSize  _                = 8
     isSigned _                = False
 
@@ -374,7 +376,8 @@ instance Bits Word16 where
     (W16# x#) .&.   (W16# y#)  = W16# (x# `and#` y#)
     (W16# x#) .|.   (W16# y#)  = W16# (x# `or#`  y#)
     (W16# x#) `xor` (W16# y#)  = W16# (x# `xor#` y#)
-    complement (W16# x#)       = W16# (x# `xor#` mb#) where W16# mb# = maxBound
+    complement (W16# x#)       = W16# (x# `xor#` mb#)
+        where !(W16# mb#) = maxBound
     (W16# x#) `shift` (I# i#)
         | i# >=# 0#            = W16# (narrow16Word# (x# `shiftL#` i#))
         | otherwise            = W16# (x# `shiftRL#` negateInt# i#)
@@ -383,7 +386,7 @@ instance Bits Word16 where
         | otherwise  = W16# (narrow16Word# ((x# `uncheckedShiftL#` i'#) `or#`
                                             (x# `uncheckedShiftRL#` (16# -# i'#))))
         where
-        i'# = word2Int# (int2Word# i# `and#` int2Word# 15#)
+        !i'# = word2Int# (int2Word# i# `and#` int2Word# 15#)
     bitSize  _                = 16
     isSigned _                = False
 
@@ -587,7 +590,8 @@ instance Bits Word32 where
     (W32# x#) .&.   (W32# y#)  = W32# (x# `and#` y#)
     (W32# x#) .|.   (W32# y#)  = W32# (x# `or#`  y#)
     (W32# x#) `xor` (W32# y#)  = W32# (x# `xor#` y#)
-    complement (W32# x#)       = W32# (x# `xor#` mb#) where W32# mb# = maxBound
+    complement (W32# x#)       = W32# (x# `xor#` mb#)
+        where !(W32# mb#) = maxBound
     (W32# x#) `shift` (I# i#)
         | i# >=# 0#            = W32# (narrow32Word# (x# `shiftL#` i#))
         | otherwise            = W32# (x# `shiftRL#` negateInt# i#)
@@ -596,7 +600,7 @@ instance Bits Word32 where
         | otherwise  = W32# (narrow32Word# ((x# `uncheckedShiftL#` i'#) `or#`
                                             (x# `uncheckedShiftRL#` (32# -# i'#))))
         where
-        i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
+        !i'# = word2Int# (int2Word# i# `and#` int2Word# 31#)
     bitSize  _                = 32
     isSigned _                = False
 
@@ -816,7 +820,7 @@ instance Integral Word64 where
         | i# >=# 0#                 = smallInteger i#
         | otherwise                 = wordToInteger x#
         where
-        i# = word2Int# x#
+        !i# = word2Int# x#
 
 instance Bits Word64 where
     {-# INLINE shift #-}
@@ -824,7 +828,8 @@ instance Bits Word64 where
     (W64# x#) .&.   (W64# y#)  = W64# (x# `and#` y#)
     (W64# x#) .|.   (W64# y#)  = W64# (x# `or#`  y#)
     (W64# x#) `xor` (W64# y#)  = W64# (x# `xor#` y#)
-    complement (W64# x#)       = W64# (x# `xor#` mb#) where W64# mb# = maxBound
+    complement (W64# x#)       = W64# (x# `xor#` mb#)
+        where !(W64# mb#) = maxBound
     (W64# x#) `shift` (I# i#)
         | i# >=# 0#            = W64# (x# `shiftL#` i#)
         | otherwise            = W64# (x# `shiftRL#` negateInt# i#)
@@ -833,7 +838,7 @@ instance Bits Word64 where
         | otherwise  = W64# ((x# `uncheckedShiftL#` i'#) `or#`
                              (x# `uncheckedShiftRL#` (64# -# i'#)))
         where
-        i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
+        !i'# = word2Int# (int2Word# i# `and#` int2Word# 63#)
     bitSize  _                = 64
     isSigned _                = False