mkUnique c i
= MkUnique (tag `bitOrFastInt` bits)
where
- tag = fastOrd (cUnbox c) `shiftLFastInt` _ILIT(24)
- bits = iUnbox i `bitAndFastInt` _ILIT(16777215){-``0x00ffffff''-}
+ !tag = fastOrd (cUnbox c) `shiftLFastInt` _ILIT(24)
+ !bits = iUnbox i `bitAndFastInt` _ILIT(16777215){-``0x00ffffff''-}
unpkUnique (MkUnique u)
= let
#if defined(__GLASGOW_HASKELL__)
--then FastInt == Int#
chooseChar62 n = C# (indexCharOffAddr# chars62 n)
- chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
+ !chars62 = "0123456789abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"#
#else
--Haskell98 arrays are portable
chooseChar62 n = (!) chars62 n
-----------------------------------------------------------------------------
{
-{-# OPTIONS -w #-}
+{-# OPTIONS -Wwarn #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-----------------------------------------------------------------------------
{
-{-# OPTIONS -w #-}
+{-# OPTIONS -Wwarn #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
insns_arr
| n_insns > 65535 = panic "linkBCO: >= 64k insns in BCO"
| otherwise = mkInstrArray n_insns asm_insns
- insns_barr = case insns_arr of UArray _lo _hi _n barr -> barr
+ !insns_barr = case insns_arr of UArray _lo _hi _n barr -> barr
bitmap_arr = mkBitmapArray bsize bitmap
- bitmap_barr = case bitmap_arr of UArray _lo _hi _n barr -> barr
+ !bitmap_barr = case bitmap_arr of UArray _lo _hi _n barr -> barr
let ul_bco = UnlinkedBCO nm arity insns_barr bitmap_barr final_lits final_ptrs
ptrs_arr <- mkPtrsArray ie ce n_ptrs ptrs
let
- ptrs_parr = case ptrs_arr of Array _lo _hi _n parr -> parr
+ !ptrs_parr = case ptrs_arr of Array _lo _hi _n parr -> parr
literals_arr = listArray (0, n_literals-1) linked_literals
:: UArray Int Word
- literals_barr = case literals_arr of UArray _lo _hi _n barr -> barr
+ !literals_barr = case literals_arr of UArray _lo _hi _n barr -> barr
- (I# arity#) = arity
+ !(I# arity#) = arity
newBCO insns_barr literals_barr ptrs_parr arity# bitmap
{
-{-# OPTIONS -fno-warn-unused-binds -fno-warn-unused-matches -fno-warn-missing-signatures -fno-warn-incomplete-patterns #-}
+{-# OPTIONS -fno-warn-unused-binds -fno-warn-unused-matches -fno-warn-missing-signatures -fno-warn-incomplete-patterns -Wwarn #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
--
{
-{-# OPTIONS -w #-}
+{-# OPTIONS -Wwarn #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
{
-{-# OPTIONS -w #-}
+{-# OPTIONS -Wwarn #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- qualified varids.
{
-{-# OPTIONS -w #-}
+{-# OPTIONS -Wwarn #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
-- ---------------------------------------------------------------------------
{
-{-# OPTIONS -w #-}
+{-# OPTIONS -Wwarn #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
{
-{-# OPTIONS -w #-}
+{-# OPTIONS -Wwarn #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
cmpCostCentre other_1 other_2
= let
- tag1 = tag_CC other_1
- tag2 = tag_CC other_2
+ !tag1 = tag_CC other_1
+ !tag2 = tag_CC other_2
in
if tag1 <# tag2 then LT else GT
where
(strictBindErr "Recursive" unlifted mbind)
; checkTc (isSingletonBag mbind)
(strictBindErr "Multiple" unlifted mbind)
+ -- This should be a checkTc, not a warnTc, but as of GHC 6.11
+ -- the versions of alex and happy available have non-conforming
+ -- templates, so the GHC build fails if it's an error:
+ ; warnTc (not bang_pat)
+ (unliftedMustBeBang mbind)
; mapM_ check_sig infos
; return True }
| otherwise
(badStrictSig unlifted sig)
check_sig _ = return ()
+unliftedMustBeBang :: LHsBindsLR Var Var -> SDoc
+unliftedMustBeBang mbind
+ = hang (text "Bindings containing unlifted types must use an outermost bang pattern:")
+ 4 (pprLHsBinds mbind)
+
strictBindErr :: String -> Bool -> LHsBindsLR Var Var -> SDoc
strictBindErr flavour unlifted mbind
= hang (text flavour <+> msg <+> ptext (sLit "aren't allowed:"))
{-# INLINE utf8DecodeChar# #-}
utf8DecodeChar# :: Addr# -> (# Char#, Addr# #)
utf8DecodeChar# a# =
- let ch0 = word2Int# (indexWord8OffAddr# a# 0#) in
+ let !ch0 = word2Int# (indexWord8OffAddr# a# 0#) in
case () of
_ | ch0 <=# 0x7F# -> (# chr# ch0, a# `plusAddr#` 1# #)
| ch0 >=# 0xC0# && ch0 <=# 0xDF# ->
- let ch1 = word2Int# (indexWord8OffAddr# a# 1#) in
+ let !ch1 = word2Int# (indexWord8OffAddr# a# 1#) in
if ch1 <# 0x80# || ch1 >=# 0xC0# then fail 1# else
(# chr# (((ch0 -# 0xC0#) `uncheckedIShiftL#` 6#) +#
(ch1 -# 0x80#)),
a# `plusAddr#` 2# #)
| ch0 >=# 0xE0# && ch0 <=# 0xEF# ->
- let ch1 = word2Int# (indexWord8OffAddr# a# 1#) in
+ let !ch1 = word2Int# (indexWord8OffAddr# a# 1#) in
if ch1 <# 0x80# || ch1 >=# 0xC0# then fail 1# else
- let ch2 = word2Int# (indexWord8OffAddr# a# 2#) in
+ let !ch2 = word2Int# (indexWord8OffAddr# a# 2#) in
if ch2 <# 0x80# || ch2 >=# 0xC0# then fail 2# else
(# chr# (((ch0 -# 0xE0#) `uncheckedIShiftL#` 12#) +#
((ch1 -# 0x80#) `uncheckedIShiftL#` 6#) +#
a# `plusAddr#` 3# #)
| ch0 >=# 0xF0# && ch0 <=# 0xF8# ->
- let ch1 = word2Int# (indexWord8OffAddr# a# 1#) in
+ let !ch1 = word2Int# (indexWord8OffAddr# a# 1#) in
if ch1 <# 0x80# || ch1 >=# 0xC0# then fail 1# else
- let ch2 = word2Int# (indexWord8OffAddr# a# 2#) in
+ let !ch2 = word2Int# (indexWord8OffAddr# a# 2#) in
if ch2 <# 0x80# || ch2 >=# 0xC0# then fail 2# else
- let ch3 = word2Int# (indexWord8OffAddr# a# 3#) in
+ let !ch3 = word2Int# (indexWord8OffAddr# a# 3#) in
if ch3 <# 0x80# || ch3 >=# 0xC0# then fail 3# else
(# chr# (((ch0 -# 0xF0#) `uncheckedIShiftL#` 18#) +#
((ch1 -# 0x80#) `uncheckedIShiftL#` 12#) +#
utf8DecodeString (Ptr a#) (I# len#)
= unpack a#
where
- end# = addr2Int# (a# `plusAddr#` len#)
+ !end# = addr2Int# (a# `plusAddr#` len#)
unpack p#
| addr2Int# p# >=# end# = return []
newFastMutInt = IO $ \s ->
case newByteArray# size s of { (# s, arr #) ->
(# s, FastMutInt arr #) }
- where I# size = SIZEOF_HSINT
+ where !(I# size) = SIZEOF_HSINT
readFastMutInt (FastMutInt arr) = IO $ \s ->
case readIntArray# arr 0# s of { (# s, i #) ->
newFastMutPtr = IO $ \s ->
case newByteArray# size s of { (# s, arr #) ->
(# s, FastMutPtr arr #) }
- where I# size = SIZEOF_VOID_P
+ where !(I# size) = SIZEOF_VOID_P
readFastMutPtr (FastMutPtr arr) = IO $ \s ->
case readAddrArray# arr 0# s of { (# s, i #) ->
where
loop h n | n GHC.Exts.==# len# = I# h
| otherwise = loop h2 (n GHC.Exts.+# 1#)
- where c = ord# (indexCharOffAddr# a# n)
- h2 = (c GHC.Exts.+# (h GHC.Exts.*# 128#)) `remInt#`
- hASH_TBL_SIZE#
+ where !c = ord# (indexCharOffAddr# a# n)
+ !h2 = (c GHC.Exts.+# (h GHC.Exts.*# 128#)) `remInt#`
+ hASH_TBL_SIZE#
-- -----------------------------------------------------------------------------
-- Operations
aboveNest (NilAbove p) g k q = nilAbove_ (aboveNest p g k q)
aboveNest (TextBeside s sl p) g k q = textBeside_ s sl rest
where
- k1 = k -# sl
+ !k1 = k -# sl
rest = case p of
Empty -> nilAboveNest g k1 q
_ -> aboveNest p g k1 q
`mkUnion`
nilAboveNest False k (fill g (y:ys))
where
- k1 | g = k -# _ILIT(1)
- | otherwise = k
+ !k1 | g = k -# _ILIT(1)
+ | otherwise = k
fillNB g p k ys = fill1 g p k ys
\end{code}
best w_ r_ p
= get (iUnbox w_) p
where
- r = iUnbox r_
+ !r = iUnbox r_
get :: FastInt -- (Remaining) width of line
-> Doc -> Doc
get _ Empty = Empty
--LOL, in implementations where the indexing needs slow unsafePerformIO,
--this is less (not more) efficient than using the IO monad explicitly
--here.
- ptr' = pUnbox ptr
+ !ptr' = pUnbox ptr
byteOff i = cBox (indexWord8OffFastPtrAsFastChar ptr' (iUnbox (cur + i)))
go i x | i == len = x
| otherwise = case byteOff i of
| p <# p2 = getCommonNodeUFMData_ p2 (j `quotFastInt` (p2 `quotFastInt` p)) j2
| otherwise = getCommonNodeUFMData_ p j (j2 `quotFastInt` (p `quotFastInt` p2))
where
- j = i `quotFastInt` (shiftL1 p)
- j2 = i2 `quotFastInt` (shiftL1 p2)
+ !j = i `quotFastInt` (shiftL1 p)
+ !j2 = i2 `quotFastInt` (shiftL1 p2)
getCommonNodeUFMData_ :: FastInt -> FastInt -> FastInt -> NodeUFMData
{
-{-# OPTIONS -w #-}
+{-# OPTIONS -Wwarn #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See