Commit 3a8892cf authored by Ian Lynagh's avatar Ian Lynagh
Browse files

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

parent 534875db
......@@ -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 #-}
......
......@@ -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# = []
......
......@@ -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'
......
......@@ -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
......
......@@ -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
......
......@@ -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_
......
......@@ -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
......
......@@ -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#))
......
......@@ -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'
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment