compiler/cmm/CmmOpt.hs

   1 -----------------------------------------------------------------------------
   2 --
   3 -- Cmm optimisation
   4 --
   5 -- (c) The University of Glasgow 2006
   6 --
   7 -----------------------------------------------------------------------------
   8
   9 module CmmOpt (
  10         cmmMiniInline,
  11         cmmMachOpFold,
  12         cmmLoopifyForC,
  13  ) where
  14
  15 #include "HsVersions.h"
  16
  17 import Cmm
  18 import CmmUtils ( hasNoGlobalRegs )
  19 import CLabel   ( entryLblToInfoLbl )
  20 import MachOp
  21 import SMRep    ( tablesNextToCode )
  22
  23 import UniqFM
  24 import Unique   ( Unique )
  25 import Panic    ( panic )
  26
  27 import Outputable
  28
  29 import Bits
  30 import Word
  31 import Int
  32 import GLAEXTS
  33
  34
  35 -- -----------------------------------------------------------------------------
  36 -- The mini-inliner
  37
  38 {-
  39 This pass inlines assignments to temporaries that are used just
  40 once.  It works as follows:
  41
  42   - count uses of each temporary
  43   - for each temporary that occurs just once:
  44         - attempt to push it forward to the statement that uses it
  45         - only push forward past assignments to other temporaries
  46           (assumes that temporaries are single-assignment)
  47         - if we reach the statement that uses it, inline the rhs
  48           and delete the original assignment.
  49
  50 Possible generalisations: here is an example from factorial
  51
  52 Fac_zdwfac_entry:
  53     cmG:
  54         _smi = R2;
  55         if (_smi != 0) goto cmK;
  56         R1 = R3;
  57         jump I64[Sp];
  58     cmK:
  59         _smn = _smi * R3;
  60         R2 = _smi + (-1);
  61         R3 = _smn;
  62         jump Fac_zdwfac_info;
  63
  64 We want to inline _smi and _smn.  To inline _smn:
  65
  66    - we must be able to push forward past assignments to global regs.
  67      We can do this if the rhs of the assignment we are pushing
  68      forward doesn't refer to the global reg being assigned to; easy
  69      to test.
  70
  71 To inline _smi:
  72
  73    - It is a trivial replacement, reg for reg, but it occurs more than
  74      once.
  75    - We can inline trivial assignments even if the temporary occurs
  76      more than once, as long as we don't eliminate the original assignment
  77      (this doesn't help much on its own).
  78    - We need to be able to propagate the assignment forward through jumps;
  79      if we did this, we would find that it can be inlined safely in all
  80      its occurrences.
  81 -}
  82
  83 cmmMiniInline :: [CmmBasicBlock] -> [CmmBasicBlock]
  84 cmmMiniInline blocks = map do_inline blocks
  85   where
  86         blockUses (BasicBlock _ stmts)
  87          = foldr (plusUFM_C (+)) emptyUFM (map getStmtUses stmts)
  88
  89         uses = foldr (plusUFM_C (+)) emptyUFM (map blockUses blocks)
  90
  91         do_inline (BasicBlock id stmts)
  92          = BasicBlock id (cmmMiniInlineStmts uses stmts)
  93
  94
  95 cmmMiniInlineStmts :: UniqFM Int -> [CmmStmt] -> [CmmStmt]
  96 cmmMiniInlineStmts uses [] = []
  97 cmmMiniInlineStmts uses (stmt@(CmmAssign (CmmLocal (LocalReg u _)) expr) : stmts)
  98   | Just 1 <- lookupUFM uses u,
  99     Just stmts' <- lookForInline u expr stmts
 100   =
 101 #ifdef NCG_DEBUG
 102      trace ("nativeGen: inlining " ++ showSDoc (pprStmt stmt)) $
 103 #endif
 104      cmmMiniInlineStmts uses stmts'
 105
 106 cmmMiniInlineStmts uses (stmt:stmts)
 107   = stmt : cmmMiniInlineStmts uses stmts
 108
 109
 110 -- Try to inline a temporary assignment.  We can skip over assignments to
 111 -- other tempoararies, because we know that expressions aren't side-effecting
 112 -- and temporaries are single-assignment.
 113 lookForInline u expr (stmt@(CmmAssign (CmmLocal (LocalReg u' _)) rhs) : rest)
 114   | u /= u'
 115   = case lookupUFM (getExprUses rhs) u of
 116         Just 1 -> Just (inlineStmt u expr stmt : rest)
 117         _other -> case lookForInline u expr rest of
 118                      Nothing    -> Nothing
 119                      Just stmts -> Just (stmt:stmts)
 120
 121 lookForInline u expr (CmmNop : rest)
 122   = lookForInline u expr rest
 123
 124 lookForInline u expr (stmt:stmts)
 125   = case lookupUFM (getStmtUses stmt) u of
 126         Just 1 | ok_to_inline -> Just (inlineStmt u expr stmt : stmts)
 127         _other -> Nothing
 128   where
 129         -- we don't inline into CmmCall if the expression refers to global
 130         -- registers.  This is a HACK to avoid global registers clashing with
 131         -- C argument-passing registers, really the back-end ought to be able
 132         -- to handle it properly, but currently neither PprC nor the NCG can
 133         -- do it.  See also CgForeignCall:load_args_into_temps.
 134     ok_to_inline = case stmt of
 135                      CmmCall{} -> hasNoGlobalRegs expr
 136                      _ -> True
 137
 138 -- -----------------------------------------------------------------------------
 139 -- Boring Cmm traversals for collecting usage info and substitutions.
 140
 141 getStmtUses :: CmmStmt -> UniqFM Int
 142 getStmtUses (CmmAssign _ e) = getExprUses e
 143 getStmtUses (CmmStore e1 e2) = plusUFM_C (+) (getExprUses e1) (getExprUses e2)
 144 getStmtUses (CmmCall target _ es _)
 145    = plusUFM_C (+) (uses target) (getExprsUses (map fst es))
 146    where uses (CmmForeignCall e _) = getExprUses e
 147          uses _ = emptyUFM
 148 getStmtUses (CmmCondBranch e _) = getExprUses e
 149 getStmtUses (CmmSwitch e _) = getExprUses e
 150 getStmtUses (CmmJump e _) = getExprUses e
 151 getStmtUses _ = emptyUFM
 152
 153 getExprUses :: CmmExpr -> UniqFM Int
 154 getExprUses (CmmReg (CmmLocal (LocalReg u _))) = unitUFM u 1
 155 getExprUses (CmmRegOff (CmmLocal (LocalReg u _)) _) = unitUFM u 1
 156 getExprUses (CmmLoad e _) = getExprUses e
 157 getExprUses (CmmMachOp _ es) = getExprsUses es
 158 getExprUses _other = emptyUFM
 159
 160 getExprsUses es = foldr (plusUFM_C (+)) emptyUFM (map getExprUses es)
 161
 162 inlineStmt :: Unique -> CmmExpr -> CmmStmt -> CmmStmt
 163 inlineStmt u a (CmmAssign r e) = CmmAssign r (inlineExpr u a e)
 164 inlineStmt u a (CmmStore e1 e2) = CmmStore (inlineExpr u a e1) (inlineExpr u a e2)
 165 inlineStmt u a (CmmCall target regs es vols)
 166    = CmmCall (infn target) regs es' vols
 167    where infn (CmmForeignCall fn cconv) = CmmForeignCall fn cconv
 168          infn (CmmPrim p) = CmmPrim p
 169          es' = [ (inlineExpr u a e, hint) | (e,hint) <- es ]
 170 inlineStmt u a (CmmCondBranch e d) = CmmCondBranch (inlineExpr u a e) d
 171 inlineStmt u a (CmmSwitch e d) = CmmSwitch (inlineExpr u a e) d
 172 inlineStmt u a (CmmJump e d) = CmmJump (inlineExpr u a e) d
 173 inlineStmt u a other_stmt = other_stmt
 174
 175 inlineExpr :: Unique -> CmmExpr -> CmmExpr -> CmmExpr
 176 inlineExpr u a e@(CmmReg (CmmLocal (LocalReg u' _)))
 177   | u == u' = a
 178   | otherwise = e
 179 inlineExpr u a e@(CmmRegOff (CmmLocal (LocalReg u' rep)) off)
 180   | u == u' = CmmMachOp (MO_Add rep) [a, CmmLit (CmmInt (fromIntegral off) rep)]
 181   | otherwise = e
 182 inlineExpr u a (CmmLoad e rep) = CmmLoad (inlineExpr u a e) rep
 183 inlineExpr u a (CmmMachOp op es) = CmmMachOp op (map (inlineExpr u a) es)
 184 inlineExpr u a other_expr = other_expr
 185
 186 -- -----------------------------------------------------------------------------
 187 -- MachOp constant folder
 188
 189 -- Now, try to constant-fold the MachOps.  The arguments have already
 190 -- been optimized and folded.
 191
 192 cmmMachOpFold
 193     :: MachOp           -- The operation from an CmmMachOp
 194     -> [CmmExpr]        -- The optimized arguments
 195     -> CmmExpr
 196
 197 cmmMachOpFold op arg@[CmmLit (CmmInt x rep)]
 198   = case op of
 199       MO_S_Neg r -> CmmLit (CmmInt (-x) rep)
 200       MO_Not r   -> CmmLit (CmmInt (complement x) rep)
 201
 202         -- these are interesting: we must first narrow to the
 203         -- "from" type, in order to truncate to the correct size.
 204         -- The final narrow/widen to the destination type
 205         -- is implicit in the CmmLit.
 206       MO_S_Conv from to
 207            | isFloatingRep to -> CmmLit (CmmFloat (fromInteger x) to)
 208            | otherwise        -> CmmLit (CmmInt (narrowS from x) to)
 209       MO_U_Conv from to -> CmmLit (CmmInt (narrowU from x) to)
 210
 211       _ -> panic "cmmMachOpFold: unknown unary op"
 212
 213
 214 -- Eliminate conversion NOPs
 215 cmmMachOpFold (MO_S_Conv rep1 rep2) [x] | rep1 == rep2 = x
 216 cmmMachOpFold (MO_U_Conv rep1 rep2) [x] | rep1 == rep2 = x
 217
 218 -- Eliminate nested conversions where possible
 219 cmmMachOpFold conv_outer args@[CmmMachOp conv_inner [x]]
 220   | Just (rep1,rep2,signed1) <- isIntConversion conv_inner,
 221     Just (_,   rep3,signed2) <- isIntConversion conv_outer
 222   = case () of
 223         -- widen then narrow to the same size is a nop
 224       _ | rep1 < rep2 && rep1 == rep3 -> x
 225         -- Widen then narrow to different size: collapse to single conversion
 226         -- but remember to use the signedness from the widening, just in case
 227         -- the final conversion is a widen.
 228         | rep1 < rep2 && rep2 > rep3 ->
 229             cmmMachOpFold (intconv signed1 rep1 rep3) [x]
 230         -- Nested widenings: collapse if the signedness is the same
 231         | rep1 < rep2 && rep2 < rep3 && signed1 == signed2 ->
 232             cmmMachOpFold (intconv signed1 rep1 rep3) [x]
 233         -- Nested narrowings: collapse
 234         | rep1 > rep2 && rep2 > rep3 ->
 235             cmmMachOpFold (MO_U_Conv rep1 rep3) [x]
 236         | otherwise ->
 237             CmmMachOp conv_outer args
 238   where
 239         isIntConversion (MO_U_Conv rep1 rep2)
 240           | not (isFloatingRep rep1) && not (isFloatingRep rep2)
 241           = Just (rep1,rep2,False)
 242         isIntConversion (MO_S_Conv rep1 rep2)
 243           | not (isFloatingRep rep1) && not (isFloatingRep rep2)
 244           = Just (rep1,rep2,True)
 245         isIntConversion _ = Nothing
 246
 247         intconv True  = MO_S_Conv
 248         intconv False = MO_U_Conv
 249
 250 -- ToDo: a narrow of a load can be collapsed into a narrow load, right?
 251 -- but what if the architecture only supports word-sized loads, should
 252 -- we do the transformation anyway?
 253
 254 cmmMachOpFold mop args@[CmmLit (CmmInt x xrep), CmmLit (CmmInt y _)]
 255   = case mop of
 256         -- for comparisons: don't forget to narrow the arguments before
 257         -- comparing, since they might be out of range.
 258         MO_Eq r   -> CmmLit (CmmInt (if x_u == y_u then 1 else 0) wordRep)
 259         MO_Ne r   -> CmmLit (CmmInt (if x_u /= y_u then 1 else 0) wordRep)
 260
 261         MO_U_Gt r -> CmmLit (CmmInt (if x_u >  y_u then 1 else 0) wordRep)
 262         MO_U_Ge r -> CmmLit (CmmInt (if x_u >= y_u then 1 else 0) wordRep)
 263         MO_U_Lt r -> CmmLit (CmmInt (if x_u <  y_u then 1 else 0) wordRep)
 264         MO_U_Le r -> CmmLit (CmmInt (if x_u <= y_u then 1 else 0) wordRep)
 265
 266         MO_S_Gt r -> CmmLit (CmmInt (if x_s >  y_s then 1 else 0) wordRep)
 267         MO_S_Ge r -> CmmLit (CmmInt (if x_s >= y_s then 1 else 0) wordRep)
 268         MO_S_Lt r -> CmmLit (CmmInt (if x_s <  y_s then 1 else 0) wordRep)
 269         MO_S_Le r -> CmmLit (CmmInt (if x_s <= y_s then 1 else 0) wordRep)
 270
 271         MO_Add r -> CmmLit (CmmInt (x + y) r)
 272         MO_Sub r -> CmmLit (CmmInt (x - y) r)
 273         MO_Mul r -> CmmLit (CmmInt (x * y) r)
 274         MO_S_Quot r | y /= 0 -> CmmLit (CmmInt (x `quot` y) r)
 275         MO_S_Rem  r | y /= 0 -> CmmLit (CmmInt (x `rem` y) r)
 276
 277         MO_And   r -> CmmLit (CmmInt (x .&. y) r)
 278         MO_Or    r -> CmmLit (CmmInt (x .|. y) r)
 279         MO_Xor   r -> CmmLit (CmmInt (x `xor` y) r)
 280
 281         MO_Shl   r -> CmmLit (CmmInt (x `shiftL` fromIntegral y) r)
 282         MO_U_Shr r -> CmmLit (CmmInt (x_u `shiftR` fromIntegral y) r)
 283         MO_S_Shr r -> CmmLit (CmmInt (x `shiftR` fromIntegral y) r)
 284
 285         other      -> CmmMachOp mop args
 286
 287    where
 288         x_u = narrowU xrep x
 289         y_u = narrowU xrep y
 290         x_s = narrowS xrep x
 291         y_s = narrowS xrep y
 292
 293
 294 -- When possible, shift the constants to the right-hand side, so that we
 295 -- can match for strength reductions.  Note that the code generator will
 296 -- also assume that constants have been shifted to the right when
 297 -- possible.
 298
 299 cmmMachOpFold op [x@(CmmLit _), y]
 300    | not (isLit y) && isCommutableMachOp op
 301    = cmmMachOpFold op [y, x]
 302
 303 -- Turn (a+b)+c into a+(b+c) where possible.  Because literals are
 304 -- moved to the right, it is more likely that we will find
 305 -- opportunities for constant folding when the expression is
 306 -- right-associated.
 307 --
 308 -- ToDo: this appears to introduce a quadratic behaviour due to the
 309 -- nested cmmMachOpFold.  Can we fix this?
 310 --
 311 -- Why do we check isLit arg1?  If arg1 is a lit, it means that arg2
 312 -- is also a lit (otherwise arg1 would be on the right).  If we
 313 -- put arg1 on the left of the rearranged expression, we'll get into a
 314 -- loop:  (x1+x2)+x3 => x1+(x2+x3)  => (x2+x3)+x1 => x2+(x3+x1) ...
 315 --
 316 cmmMachOpFold mop1 [CmmMachOp mop2 [arg1,arg2], arg3]
 317    | mop1 == mop2 && isAssociativeMachOp mop1 && not (isLit arg1)
 318    = cmmMachOpFold mop1 [arg1, cmmMachOpFold mop2 [arg2,arg3]]
 319
 320 -- Make a RegOff if we can
 321 cmmMachOpFold (MO_Add _) [CmmReg reg, CmmLit (CmmInt n rep)]
 322   = CmmRegOff reg (fromIntegral (narrowS rep n))
 323 cmmMachOpFold (MO_Add _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
 324   = CmmRegOff reg (off + fromIntegral (narrowS rep n))
 325 cmmMachOpFold (MO_Sub _) [CmmReg reg, CmmLit (CmmInt n rep)]
 326   = CmmRegOff reg (- fromIntegral (narrowS rep n))
 327 cmmMachOpFold (MO_Sub _) [CmmRegOff reg off, CmmLit (CmmInt n rep)]
 328   = CmmRegOff reg (off - fromIntegral (narrowS rep n))
 329
 330 -- Fold label(+/-)offset into a CmmLit where possible
 331
 332 cmmMachOpFold (MO_Add _) [CmmLit (CmmLabel lbl), CmmLit (CmmInt i rep)]
 333   = CmmLit (CmmLabelOff lbl (fromIntegral (narrowU rep i)))
 334 cmmMachOpFold (MO_Add _) [CmmLit (CmmInt i rep), CmmLit (CmmLabel lbl)]
 335   = CmmLit (CmmLabelOff lbl (fromIntegral (narrowU rep i)))
 336 cmmMachOpFold (MO_Sub _) [CmmLit (CmmLabel lbl), CmmLit (CmmInt i rep)]
 337   = CmmLit (CmmLabelOff lbl (fromIntegral (negate (narrowU rep i))))
 338
 339 -- We can often do something with constants of 0 and 1 ...
 340
 341 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 0 _))]
 342   = case mop of
 343         MO_Add   r -> x
 344         MO_Sub   r -> x
 345         MO_Mul   r -> y
 346         MO_And   r -> y
 347         MO_Or    r -> x
 348         MO_Xor   r -> x
 349         MO_Shl   r -> x
 350         MO_S_Shr r -> x
 351         MO_U_Shr r -> x
 352         MO_Ne    r | isComparisonExpr x -> x
 353         MO_Eq    r | Just x' <- maybeInvertConditionalExpr x -> x'
 354         MO_U_Gt  r | isComparisonExpr x -> x
 355         MO_S_Gt  r | isComparisonExpr x -> x
 356         MO_U_Lt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 357         MO_S_Lt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 358         MO_U_Ge  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 359         MO_S_Ge  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 360         MO_U_Le  r | Just x' <- maybeInvertConditionalExpr x -> x'
 361         MO_S_Le  r | Just x' <- maybeInvertConditionalExpr x -> x'
 362         other    -> CmmMachOp mop args
 363
 364 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt 1 rep))]
 365   = case mop of
 366         MO_Mul    r -> x
 367         MO_S_Quot r -> x
 368         MO_U_Quot r -> x
 369         MO_S_Rem  r -> CmmLit (CmmInt 0 rep)
 370         MO_U_Rem  r -> CmmLit (CmmInt 0 rep)
 371         MO_Ne    r | Just x' <- maybeInvertConditionalExpr x -> x'
 372         MO_Eq    r | isComparisonExpr x -> x
 373         MO_U_Lt  r | Just x' <- maybeInvertConditionalExpr x -> x'
 374         MO_S_Lt  r | Just x' <- maybeInvertConditionalExpr x -> x'
 375         MO_U_Gt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 376         MO_S_Gt  r | isComparisonExpr x -> CmmLit (CmmInt 0 wordRep)
 377         MO_U_Le  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 378         MO_S_Le  r | isComparisonExpr x -> CmmLit (CmmInt 1 wordRep)
 379         MO_U_Ge  r | isComparisonExpr x -> x
 380         MO_S_Ge  r | isComparisonExpr x -> x
 381         other       -> CmmMachOp mop args
 382
 383 -- Now look for multiplication/division by powers of 2 (integers).
 384
 385 cmmMachOpFold mop args@[x, y@(CmmLit (CmmInt n _))]
 386   = case mop of
 387         MO_Mul rep
 388            | Just p <- exactLog2 n ->
 389                  CmmMachOp (MO_Shl rep) [x, CmmLit (CmmInt p rep)]
 390         MO_S_Quot rep
 391            | Just p <- exactLog2 n,
 392              CmmReg _ <- x ->   -- We duplicate x below, hence require
 393                                 -- it is a reg.  FIXME: remove this restriction.
 394                 -- shift right is not the same as quot, because it rounds
 395                 -- to minus infinity, whereasq uot rounds toward zero.
 396                 -- To fix this up, we add one less than the divisor to the
 397                 -- dividend if it is a negative number.
 398                 --
 399                 -- to avoid a test/jump, we use the following sequence:
 400                 --      x1 = x >> word_size-1  (all 1s if -ve, all 0s if +ve)
 401                 --      x2 = y & (divisor-1)
 402                 --      result = (x+x2) >>= log2(divisor)
 403                 -- this could be done a bit more simply using conditional moves,
 404                 -- but we're processor independent here.
 405                 --
 406                 -- we optimise the divide by 2 case slightly, generating
 407                 --      x1 = x >> word_size-1  (unsigned)
 408                 --      return = (x + x1) >>= log2(divisor)
 409                 let
 410                     bits = fromIntegral (machRepBitWidth rep) - 1
 411                     shr = if p == 1 then MO_U_Shr rep else MO_S_Shr rep
 412                     x1 = CmmMachOp shr [x, CmmLit (CmmInt bits rep)]
 413                     x2 = if p == 1 then x1 else
 414                          CmmMachOp (MO_And rep) [x1, CmmLit (CmmInt (n-1) rep)]
 415                     x3 = CmmMachOp (MO_Add rep) [x, x2]
 416                 in
 417                 CmmMachOp (MO_S_Shr rep) [x3, CmmLit (CmmInt p rep)]
 418         other
 419            -> unchanged
 420     where
 421        unchanged = CmmMachOp mop args
 422
 423 -- Anything else is just too hard.
 424
 425 cmmMachOpFold mop args = CmmMachOp mop args
 426
 427 -- -----------------------------------------------------------------------------
 428 -- exactLog2
 429
 430 -- This algorithm for determining the $\log_2$ of exact powers of 2 comes
 431 -- from GCC.  It requires bit manipulation primitives, and we use GHC
 432 -- extensions.  Tough.
 433 --
 434 -- Used to be in MachInstrs --SDM.
 435 -- ToDo: remove use of unboxery --SDM.
 436
 437 w2i x = word2Int# x
 438 i2w x = int2Word# x
 439
 440 exactLog2 :: Integer -> Maybe Integer
 441 exactLog2 x
 442   = if (x <= 0 || x >= 2147483648) then
 443        Nothing
 444     else
 445        case fromInteger x of { I# x# ->
 446        if (w2i ((i2w x#) `and#` (i2w (0# -# x#))) /=# x#) then
 447           Nothing
 448        else
 449           Just (toInteger (I# (pow2 x#)))
 450        }
 451   where
 452     pow2 x# | x# ==# 1# = 0#
 453             | otherwise = 1# +# pow2 (w2i (i2w x# `shiftRL#` 1#))
 454
 455
 456 -- -----------------------------------------------------------------------------
 457 -- widening / narrowing
 458
 459 narrowU :: MachRep -> Integer -> Integer
 460 narrowU I8  x = fromIntegral (fromIntegral x :: Word8)
 461 narrowU I16 x = fromIntegral (fromIntegral x :: Word16)
 462 narrowU I32 x = fromIntegral (fromIntegral x :: Word32)
 463 narrowU I64 x = fromIntegral (fromIntegral x :: Word64)
 464 narrowU _ _ = panic "narrowTo"
 465
 466 narrowS :: MachRep -> Integer -> Integer
 467 narrowS I8  x = fromIntegral (fromIntegral x :: Int8)
 468 narrowS I16 x = fromIntegral (fromIntegral x :: Int16)
 469 narrowS I32 x = fromIntegral (fromIntegral x :: Int32)
 470 narrowS I64 x = fromIntegral (fromIntegral x :: Int64)
 471 narrowS _ _ = panic "narrowTo"
 472
 473 -- -----------------------------------------------------------------------------
 474 -- Loopify for C
 475
 476 {-
 477  This is a simple pass that replaces tail-recursive functions like this:
 478
 479    fac() {
 480      ...
 481      jump fac();
 482    }
 483
 484  with this:
 485
 486   fac() {
 487    L:
 488      ...
 489      goto L;
 490   }
 491
 492   the latter generates better C code, because the C compiler treats it
 493   like a loop, and brings full loop optimisation to bear.
 494
 495   In my measurements this makes little or no difference to anything
 496   except factorial, but what the hell.
 497 -}
 498
 499 cmmLoopifyForC :: CmmTop -> CmmTop
 500 cmmLoopifyForC p@(CmmProc info entry_lbl [] blocks@(BasicBlock top_id _ : _))
 501   | null info = p  -- only if there's an info table, ignore case alts
 502   | otherwise =
 503 --  pprTrace "jump_lbl" (ppr jump_lbl <+> ppr entry_lbl) $
 504   CmmProc info entry_lbl [] blocks'
 505   where blocks' = [ BasicBlock id (map do_stmt stmts)
 506                   | BasicBlock id stmts <- blocks ]
 507
 508         do_stmt (CmmJump (CmmLit (CmmLabel lbl)) _) | lbl == jump_lbl
 509                 = CmmBranch top_id
 510         do_stmt stmt = stmt
 511
 512         jump_lbl | tablesNextToCode = entryLblToInfoLbl entry_lbl
 513                  | otherwise        = entry_lbl
 514
 515 cmmLoopifyForC top = top
 516
 517 -- -----------------------------------------------------------------------------
 518 -- Utils
 519
 520 isLit (CmmLit _) = True
 521 isLit _          = False
 522
 523 isComparisonExpr :: CmmExpr -> Bool
 524 isComparisonExpr (CmmMachOp op _) = isComparisonMachOp op
 525 isComparisonExpr _other             = False
 526
 527 maybeInvertConditionalExpr :: CmmExpr -> Maybe CmmExpr
 528 maybeInvertConditionalExpr (CmmMachOp op args)
 529   | Just op' <- maybeInvertComparison op = Just (CmmMachOp op' args)
 530 maybeInvertConditionalExpr _ = Nothing