+{-# OPTIONS -w #-}
+-- 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
+-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
-----------------------------------------------------------------------------
--
-- Cmm optimisation
--
-----------------------------------------------------------------------------
-{-# OPTIONS -w #-}
--- 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
--- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
module CmmOpt (
cmmMiniInline,
cmmMachOpFold,
import UniqFM
import Unique
-
+import FastTypes
import Outputable
import Data.Bits
import Data.Word
import Data.Int
-import GHC.Exts
-- -----------------------------------------------------------------------------
-- The mini-inliner
cmmMiniInlineStmts :: UniqFM Int -> [CmmStmt] -> [CmmStmt]
cmmMiniInlineStmts uses [] = []
cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _ _)) expr) : stmts)
+ -- not used at all: just discard this assignment
+ | Nothing <- lookupUFM uses u
+ = cmmMiniInlineStmts uses stmts
+
+ -- used once: try to inline at the use site
| Just 1 <- lookupUFM uses u,
Just stmts' <- lookForInline u expr stmts
=
= CmmCall (infn target) regs es' srt ret
where infn (CmmCallee fn cconv) = CmmCallee fn cconv
infn (CmmPrim p) = CmmPrim p
- es' = [ (inlineExpr u a e, hint) | (e,hint) <- es ]
+ es' = [ (CmmHinted (inlineExpr u a e) hint) | (CmmHinted e hint) <- es ]
inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d
inlineStmt u a (CmmSwitch e d) = CmmSwitch (inlineExpr u a e) d
inlineStmt u a (CmmJump e d) = CmmJump (inlineExpr u a e) d
= cmmMachOpFold narrow_cmp [x, CmmLit (CmmInt narrow_i rep)]
where
maybe_conversion (MO_U_Conv from _) = Just (from, narrowU)
- maybe_conversion (MO_S_Conv from _) = Just (from, narrowS)
+ maybe_conversion (MO_S_Conv from _)
+ | not (isFloatingRep from) = Just (from, narrowS)
+ -- don't attempt to apply this optimisation when the source
+ -- is a float; see #1916
maybe_conversion _ = Nothing
maybe_comparison (MO_U_Gt _) rep = Just (MO_U_Gt rep)
-- Used to be in MachInstrs --SDM.
-- ToDo: remove use of unboxery --SDM.
-w2i x = word2Int# x
-i2w x = int2Word# x
+-- Unboxery removed in favor of FastInt; but is the function supposed to fail
+-- on inputs >= 2147483648, or was that just an implementation artifact?
+-- And is this speed-critical, or can we just use Integer operations
+-- (including Data.Bits)?
+-- --Isaac Dupree
exactLog2 :: Integer -> Maybe Integer
-exactLog2 x
- = if (x <= 0 || x >= 2147483648) then
+exactLog2 x_
+ = if (x_ <= 0 || x_ >= 2147483648) then
Nothing
else
- case fromInteger x of { I# x# ->
- if (w2i ((i2w x#) `and#` (i2w (0# -# x#))) /=# x#) then
+ case iUnbox (fromInteger x_) of { x ->
+ if (x `bitAndFastInt` negateFastInt x) /=# x then
Nothing
else
- Just (toInteger (I# (pow2 x#)))
+ Just (toInteger (iBox (pow2 x)))
}
where
- pow2 x# | x# ==# 1# = 0#
- | otherwise = 1# +# pow2 (w2i (i2w x# `shiftRL#` 1#))
+ pow2 x | x ==# _ILIT(1) = _ILIT(0)
+ | otherwise = _ILIT(1) +# pow2 (x `shiftR_FastInt` _ILIT(1))
-- -----------------------------------------------------------------------------