ghc/compiler/absCSyn/AbsCUtils.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1993-1998
   3 %
   4 \section[AbsCUtils]{Help functions for Abstract~C datatype}
   5
   6 \begin{code}
   7 module AbsCUtils (
   8         nonemptyAbsC,
   9         mkAbstractCs, mkAbsCStmts,
  10         mkAlgAltsCSwitch,
  11         magicIdPrimRep,
  12         getAmodeRep,
  13         mixedTypeLocn, mixedPtrLocn,
  14         flattenAbsC,
  15         mkAbsCStmtList
  16
  17         -- printing/forcing stuff comes from PprAbsC
  18     ) where
  19
  20 #include "HsVersions.h"
  21
  22 import AbsCSyn
  23 import Digraph          ( stronglyConnComp, SCC(..) )
  24 import DataCon          ( fIRST_TAG, ConTag )
  25 import Const            ( literalPrimRep, mkMachWord )
  26 import PrimRep          ( getPrimRepSize, PrimRep(..) )
  27 import Unique           ( Unique{-instance Eq-} )
  28 import UniqSupply       ( uniqFromSupply, uniqsFromSupply, splitUniqSupply,
  29                           UniqSupply )
  30 import CmdLineOpts      ( opt_ProduceC )
  31 import Maybes           ( maybeToBool )
  32 import PrimOp           ( PrimOp(..) )
  33 import Panic            ( panic )
  34
  35 infixr 9 `thenFlt`
  36 \end{code}
  37
  38 Check if there is any real code in some Abstract~C.  If so, return it
  39 (@Just ...@); otherwise, return @Nothing@.  Don't be too strict!
  40
  41 It returns the "reduced" code in the Just part so that the work of
  42 discarding AbsCNops isn't lost, and so that if the caller uses
  43 the reduced version there's less danger of a big tree of AbsCNops getting
  44 materialised and causing a space leak.
  45
  46 \begin{code}
  47 nonemptyAbsC :: AbstractC -> Maybe AbstractC
  48 nonemptyAbsC  AbsCNop           = Nothing
  49 nonemptyAbsC (AbsCStmts s1 s2)  = case (nonemptyAbsC s1) of
  50                                     Nothing -> nonemptyAbsC s2
  51                                     Just x  -> Just (AbsCStmts x s2)
  52 nonemptyAbsC s@(CSimultaneous c) = case (nonemptyAbsC c) of
  53                                     Nothing -> Nothing
  54                                     Just x  -> Just s
  55 nonemptyAbsC other              = Just other
  56 \end{code}
  57
  58 \begin{code}
  59 mkAbstractCs :: [AbstractC] -> AbstractC
  60 mkAbstractCs [] = AbsCNop
  61 mkAbstractCs cs = foldr1 mkAbsCStmts cs
  62
  63 -- for fiddling around w/ killing off AbsCNops ... (ToDo)
  64 mkAbsCStmts :: AbstractC -> AbstractC -> AbstractC
  65 mkAbsCStmts AbsCNop c = c
  66 mkAbsCStmts c AbsCNop = c
  67 mkAbsCStmts c1 c2     = c1 `AbsCStmts` c2
  68
  69 {- Discarded SLPJ June 95; it calls nonemptyAbsC too much!
  70   = case (case (nonemptyAbsC abc2) of
  71             Nothing -> AbsCNop
  72             Just d2 -> d2)      of { abc2b ->
  73
  74     case (nonemptyAbsC abc1) of {
  75       Nothing -> abc2b;
  76       Just d1 -> AbsCStmts d1 abc2b
  77     } }
  78 -}
  79 \end{code}
  80
  81 Get the sho' 'nuff statements out of an @AbstractC@.
  82 \begin{code}
  83 mkAbsCStmtList :: AbstractC -> [AbstractC]
  84
  85 mkAbsCStmtList absC = mkAbsCStmtList' absC []
  86
  87 -- Optimised a la foldr/build!
  88
  89 mkAbsCStmtList'  AbsCNop r = r
  90
  91 mkAbsCStmtList' (AbsCStmts s1 s2) r
  92   = mkAbsCStmtList' s1 (mkAbsCStmtList' s2 r)
  93
  94 mkAbsCStmtList' s@(CSimultaneous c) r
  95   = if null (mkAbsCStmtList c) then r else s : r
  96
  97 mkAbsCStmtList' other r = other : r
  98 \end{code}
  99
 100 \begin{code}
 101 mkAlgAltsCSwitch :: CAddrMode -> [(ConTag, AbstractC)] -> AbstractC -> AbstractC
 102
 103 mkAlgAltsCSwitch scrutinee tagged_alts deflt_absc
 104  = CSwitch scrutinee (adjust tagged_alts) deflt_absc
 105  where
 106    -- Adjust the tags in the switch to start at zero.
 107    -- This is the convention used by primitive ops which return algebraic
 108    -- data types.  Why?  Because for two-constructor types, zero is faster
 109    -- to create and distinguish from 1 than are 1 and 2.
 110
 111    -- We also need to convert to Literals to keep the CSwitch happy
 112    adjust tagged_alts
 113      = [ (mkMachWord (toInteger (tag - fIRST_TAG)), abs_c)
 114        | (tag, abs_c) <- tagged_alts ]
 115 \end{code}
 116
 117 %************************************************************************
 118 %*                                                                      *
 119 \subsubsection[AbsCUtils-kinds-from-MagicIds]{Kinds from MagicIds}
 120 %*                                                                      *
 121 %************************************************************************
 122
 123 \begin{code}
 124 magicIdPrimRep BaseReg              = PtrRep
 125 magicIdPrimRep (VanillaReg kind _) = kind
 126 magicIdPrimRep (FloatReg _)         = FloatRep
 127 magicIdPrimRep (DoubleReg _)        = DoubleRep
 128 magicIdPrimRep (LongReg kind _)     = kind
 129 magicIdPrimRep Sp                   = PtrRep
 130 magicIdPrimRep Su                   = PtrRep
 131 magicIdPrimRep SpLim                = PtrRep
 132 magicIdPrimRep Hp                   = PtrRep
 133 magicIdPrimRep HpLim                = PtrRep
 134 magicIdPrimRep CurCostCentre        = CostCentreRep
 135 magicIdPrimRep VoidReg              = VoidRep
 136 \end{code}
 137
 138 %************************************************************************
 139 %*                                                                      *
 140 \subsection[AbsCUtils-amode-kinds]{Finding @PrimitiveKinds@ of amodes}
 141 %*                                                                      *
 142 %************************************************************************
 143
 144 See also the return conventions for unboxed things; currently living
 145 in @CgCon@ (next to the constructor return conventions).
 146
 147 ToDo: tiny tweaking may be in order
 148 \begin{code}
 149 getAmodeRep :: CAddrMode -> PrimRep
 150
 151 getAmodeRep (CVal _ kind)                   = kind
 152 getAmodeRep (CAddr _)                       = PtrRep
 153 getAmodeRep (CReg magic_id)                 = magicIdPrimRep magic_id
 154 getAmodeRep (CTemp uniq kind)               = kind
 155 getAmodeRep (CLbl label kind)               = kind
 156 getAmodeRep (CCharLike _)                   = PtrRep
 157 getAmodeRep (CIntLike _)                    = PtrRep
 158 getAmodeRep (CLit lit)                      = literalPrimRep lit
 159 getAmodeRep (CLitLit _ kind)                = kind
 160 getAmodeRep (CMacroExpr kind _ _)           = kind
 161 getAmodeRep (CJoinPoint _)                  = panic "getAmodeRep:CJoinPoint"
 162 \end{code}
 163
 164 @mixedTypeLocn@ tells whether an amode identifies an ``StgWord''
 165 location; that is, one which can contain values of various types.
 166
 167 \begin{code}
 168 mixedTypeLocn :: CAddrMode -> Bool
 169
 170 mixedTypeLocn (CVal (NodeRel _) _)      = True
 171 mixedTypeLocn (CVal (SpRel _)   _)      = True
 172 mixedTypeLocn (CVal (HpRel _)   _)      = True
 173 mixedTypeLocn other                     = False -- All the rest
 174 \end{code}
 175
 176 @mixedPtrLocn@ tells whether an amode identifies a
 177 location which can contain values of various pointer types.
 178
 179 \begin{code}
 180 mixedPtrLocn :: CAddrMode -> Bool
 181
 182 mixedPtrLocn (CVal (SpRel _)  _)        = True
 183 mixedPtrLocn other                      = False -- All the rest
 184 \end{code}
 185
 186 %************************************************************************
 187 %*                                                                      *
 188 \subsection[AbsCUtils-flattening]{Flatten Abstract~C}
 189 %*                                                                      *
 190 %************************************************************************
 191
 192 The following bits take ``raw'' Abstract~C, which may have all sorts of
 193 nesting, and flattens it into one long @AbsCStmtList@.  Mainly,
 194 @CClosureInfos@ and code for switches are pulled out to the top level.
 195
 196 The various functions herein tend to produce
 197 \begin{enumerate}
 198 \item
 199 A {\em flattened} \tr{<something>} of interest for ``here'', and
 200 \item
 201 Some {\em unflattened} Abstract~C statements to be carried up to the
 202 top-level.  The only real reason (now) that it is unflattened is
 203 because it means the recursive flattening can be done in just one
 204 place rather than having to remember lots of places.
 205 \end{enumerate}
 206
 207 Care is taken to reduce the occurrence of forward references, while still
 208 keeping laziness a much as possible.  Essentially, this means that:
 209 \begin{itemize}
 210 \item
 211 {\em All} the top-level C statements resulting from flattening a
 212 particular AbsC statement (whether the latter is nested or not) appear
 213 before {\em any} of the code for a subsequent AbsC statement;
 214 \item
 215 but stuff nested within any AbsC statement comes
 216 out before the code for the statement itself.
 217 \end{itemize}
 218
 219 The ``stuff to be carried up'' always includes a label: a
 220 @CStaticClosure@, @CRetDirect@, @CFlatRetVector@, or
 221 @CCodeBlock@.  The latter turns into a C function, and is never
 222 actually produced by the code generator.  Rather it always starts life
 223 as a @CCodeBlock@ addressing mode; when such an addr mode is
 224 flattened, the ``tops'' stuff is a @CCodeBlock@.
 225
 226 \begin{code}
 227 flattenAbsC :: UniqSupply -> AbstractC -> AbstractC
 228
 229 flattenAbsC us abs_C
 230   = case (initFlt us (flatAbsC abs_C)) of { (here, tops) ->
 231     here `mkAbsCStmts` tops }
 232 \end{code}
 233
 234 %************************************************************************
 235 %*                                                                      *
 236 \subsubsection{Flattening monadery}
 237 %*                                                                      *
 238 %************************************************************************
 239
 240 The flattener is monadised.  It's just a @UniqueSupply@.
 241
 242 \begin{code}
 243 type FlatM result =  UniqSupply -> result
 244
 245 initFlt :: UniqSupply -> FlatM a -> a
 246
 247 initFlt init_us m = m init_us
 248
 249 {-# INLINE thenFlt #-}
 250 {-# INLINE returnFlt #-}
 251
 252 thenFlt :: FlatM a -> (a -> FlatM b) -> FlatM b
 253
 254 thenFlt expr cont us
 255   = case (splitUniqSupply us)   of { (s1, s2) ->
 256     case (expr s1)              of { result ->
 257     cont result s2 }}
 258
 259 returnFlt :: a -> FlatM a
 260 returnFlt result us = result
 261
 262 mapFlt :: (a -> FlatM b) -> [a] -> FlatM [b]
 263
 264 mapFlt f []     = returnFlt []
 265 mapFlt f (x:xs)
 266   = f x         `thenFlt` \ r  ->
 267     mapFlt f xs `thenFlt` \ rs ->
 268     returnFlt (r:rs)
 269
 270 mapAndUnzipFlt  :: (a -> FlatM (b,c))   -> [a] -> FlatM ([b],[c])
 271
 272 mapAndUnzipFlt f [] = returnFlt ([],[])
 273 mapAndUnzipFlt f (x:xs)
 274   = f x                 `thenFlt` \ (r1,  r2)  ->
 275     mapAndUnzipFlt f xs `thenFlt` \ (rs1, rs2) ->
 276     returnFlt (r1:rs1, r2:rs2)
 277
 278 getUniqFlt :: FlatM Unique
 279 getUniqFlt us = uniqFromSupply us
 280
 281 getUniqsFlt :: Int -> FlatM [Unique]
 282 getUniqsFlt i us = uniqsFromSupply i us
 283 \end{code}
 284
 285 %************************************************************************
 286 %*                                                                      *
 287 \subsubsection{Flattening the top level}
 288 %*                                                                      *
 289 %************************************************************************
 290
 291 \begin{code}
 292 flatAbsC :: AbstractC
 293          -> FlatM (AbstractC,   -- Stuff to put inline          [Both are fully
 294                    AbstractC)   -- Stuff to put at top level     flattened]
 295
 296 flatAbsC AbsCNop = returnFlt (AbsCNop, AbsCNop)
 297
 298 flatAbsC (AbsCStmts s1 s2)
 299   = flatAbsC s1 `thenFlt` \ (inline_s1, top_s1) ->
 300     flatAbsC s2 `thenFlt` \ (inline_s2, top_s2) ->
 301     returnFlt (mkAbsCStmts inline_s1 inline_s2,
 302                mkAbsCStmts top_s1    top_s2)
 303
 304 flatAbsC (CClosureInfoAndCode cl_info slow maybe_fast descr)
 305   = flatAbsC slow               `thenFlt` \ (slow_heres, slow_tops) ->
 306     flat_maybe maybe_fast       `thenFlt` \ (fast_heres, fast_tops) ->
 307     returnFlt (AbsCNop, mkAbstractCs [slow_tops, fast_tops,
 308        CClosureInfoAndCode cl_info slow_heres fast_heres descr]
 309     )
 310
 311 flatAbsC (CCodeBlock label abs_C)
 312   = flatAbsC abs_C          `thenFlt` \ (absC_heres, absC_tops) ->
 313     returnFlt (AbsCNop, absC_tops `mkAbsCStmts` CCodeBlock label absC_heres)
 314
 315 flatAbsC (CRetDirect uniq slow_code srt liveness)
 316   = flatAbsC slow_code          `thenFlt` \ (heres, tops) ->
 317     returnFlt (AbsCNop,
 318                 mkAbstractCs [ tops, CRetDirect uniq heres srt liveness ])
 319
 320 flatAbsC (CSwitch discrim alts deflt)
 321   = mapAndUnzipFlt flat_alt alts `thenFlt` \ (flat_alts, flat_alts_tops) ->
 322     flatAbsC deflt               `thenFlt` \ (flat_def_alt, def_tops) ->
 323     returnFlt (
 324       CSwitch discrim flat_alts flat_def_alt,
 325       mkAbstractCs (def_tops : flat_alts_tops)
 326     )
 327   where
 328     flat_alt (tag, absC)
 329       = flatAbsC absC   `thenFlt` \ (alt_heres, alt_tops) ->
 330         returnFlt ( (tag, alt_heres), alt_tops )
 331
 332 flatAbsC stmt@(COpStmt results td@(CCallOp (Right _) _ _ _) args vol_regs)
 333   | maybeToBool opt_ProduceC
 334   = returnFlt (stmt, tdef)
 335   where
 336     tdef = CCallTypedef td results args
 337
 338 flatAbsC stmt@(CSimultaneous abs_c)
 339   = flatAbsC abs_c              `thenFlt` \ (stmts_here, tops) ->
 340     doSimultaneously stmts_here `thenFlt` \ new_stmts_here ->
 341     returnFlt (new_stmts_here, tops)
 342
 343 flatAbsC stmt@(CCheck macro amodes code)
 344   = flatAbsC code               `thenFlt` \ (code_here, code_tops) ->
 345     returnFlt (CCheck macro amodes code_here, code_tops)
 346
 347 -- Some statements need no flattening at all:
 348 flatAbsC stmt@(CMacroStmt macro amodes)         = returnFlt (stmt, AbsCNop)
 349 flatAbsC stmt@(CCallProfCtrMacro str amodes)    = returnFlt (stmt, AbsCNop)
 350 flatAbsC stmt@(CCallProfCCMacro str amodes)     = returnFlt (stmt, AbsCNop)
 351 flatAbsC stmt@(CAssign dest source)             = returnFlt (stmt, AbsCNop)
 352 flatAbsC stmt@(CJump target)                    = returnFlt (stmt, AbsCNop)
 353 flatAbsC stmt@(CFallThrough target)             = returnFlt (stmt, AbsCNop)
 354 flatAbsC stmt@(CReturn target return_info)      = returnFlt (stmt, AbsCNop)
 355 flatAbsC stmt@(CInitHdr a b cc)                 = returnFlt (stmt, AbsCNop)
 356 flatAbsC stmt@(COpStmt results op args vol_regs)= returnFlt (stmt, AbsCNop)
 357
 358 -- Some statements only make sense at the top level, so we always float
 359 -- them.  This probably isn't necessary.
 360 flatAbsC stmt@(CStaticClosure _ _ _ _)          = returnFlt (AbsCNop, stmt)
 361 flatAbsC stmt@(CClosureTbl _)                   = returnFlt (AbsCNop, stmt)
 362 flatAbsC stmt@(CSRT _ _)                        = returnFlt (AbsCNop, stmt)
 363 flatAbsC stmt@(CBitmap _ _)                     = returnFlt (AbsCNop, stmt)
 364 flatAbsC stmt@(CCostCentreDecl _ _)             = returnFlt (AbsCNop, stmt)
 365 flatAbsC stmt@(CCostCentreStackDecl _)          = returnFlt (AbsCNop, stmt)
 366 flatAbsC stmt@(CSplitMarker)                    = returnFlt (AbsCNop, stmt)
 367 flatAbsC stmt@(CRetVector _ _ _ _)              = returnFlt (AbsCNop, stmt)
 368 \end{code}
 369
 370 \begin{code}
 371 flat_maybe :: Maybe AbstractC -> FlatM (Maybe AbstractC, AbstractC)
 372 flat_maybe Nothing      = returnFlt (Nothing, AbsCNop)
 373 flat_maybe (Just abs_c) = flatAbsC abs_c `thenFlt` \ (heres, tops) ->
 374                           returnFlt (Just heres, tops)
 375 \end{code}
 376
 377 %************************************************************************
 378 %*                                                                      *
 379 \subsection[flat-simultaneous]{Doing things simultaneously}
 380 %*                                                                      *
 381 %************************************************************************
 382
 383 \begin{code}
 384 doSimultaneously :: AbstractC -> FlatM AbstractC
 385 \end{code}
 386
 387 Generate code to perform the @CAssign@s and @COpStmt@s in the
 388 input simultaneously, using temporary variables when necessary.
 389
 390 We use the strongly-connected component algorithm, in which
 391         * the vertices are the statements
 392         * an edge goes from s1 to s2 iff
 393                 s1 assigns to something s2 uses
 394           that is, if s1 should *follow* s2 in the final order
 395
 396 \begin{code}
 397 type CVertex = (Int, AbstractC)  -- Give each vertex a unique number,
 398                                  -- for fast comparison
 399
 400 type CEdge = (CVertex, CVertex)
 401
 402 doSimultaneously abs_c
 403   = let
 404         enlisted = en_list abs_c
 405     in
 406     case enlisted of -- it's often just one stmt
 407       []  -> returnFlt AbsCNop
 408       [x] -> returnFlt x
 409       _   -> doSimultaneously1 (zip [(1::Int)..] enlisted)
 410
 411 -- en_list puts all the assignments in a list, filtering out Nops and
 412 -- assignments which do nothing
 413 en_list AbsCNop                               = []
 414 en_list (AbsCStmts a1 a2)                     = en_list a1 ++ en_list a2
 415 en_list (CAssign am1 am2) | sameAmode am1 am2 = []
 416 en_list other                                 = [other]
 417
 418 sameAmode :: CAddrMode -> CAddrMode -> Bool
 419 -- ToDo: Move this function, or make CAddrMode an instance of Eq
 420 -- At the moment we put in just enough to catch the cases we want:
 421 --      the second (destination) argument is always a CVal.
 422 sameAmode (CReg r1)                  (CReg r2)               = r1 == r2
 423 sameAmode (CVal (SpRel r1) _) (CVal (SpRel r2) _)            = r1 _EQ_ r2
 424 sameAmode other1                     other2                  = False
 425
 426 doSimultaneously1 :: [CVertex] -> FlatM AbstractC
 427 doSimultaneously1 vertices
 428   = let
 429         edges = [ (vertex, key1, edges_from stmt1)
 430                 | vertex@(key1, stmt1) <- vertices
 431                 ]
 432         edges_from stmt1 = [ key2 | (key2, stmt2) <- vertices,
 433                                     stmt1 `should_follow` stmt2
 434                            ]
 435         components = stronglyConnComp edges
 436
 437         -- do_components deal with one strongly-connected component
 438                 -- Not cyclic, or singleton?  Just do it
 439         do_component (AcyclicSCC (n,abs_c))  = returnFlt abs_c
 440         do_component (CyclicSCC [(n,abs_c)]) = returnFlt abs_c
 441
 442                 -- Cyclic?  Then go via temporaries.  Pick one to
 443                 -- break the loop and try again with the rest.
 444         do_component (CyclicSCC ((n,first_stmt) : rest))
 445           = doSimultaneously1 rest      `thenFlt` \ abs_cs ->
 446             go_via_temps first_stmt     `thenFlt` \ (to_temps, from_temps) ->
 447             returnFlt (mkAbstractCs [to_temps, abs_cs, from_temps])
 448
 449         go_via_temps (CAssign dest src)
 450           = getUniqFlt                  `thenFlt` \ uniq ->
 451             let
 452                 the_temp = CTemp uniq (getAmodeRep dest)
 453             in
 454             returnFlt (CAssign the_temp src, CAssign dest the_temp)
 455
 456         go_via_temps (COpStmt dests op srcs vol_regs)
 457           = getUniqsFlt (length dests)  `thenFlt` \ uniqs ->
 458             let
 459                 the_temps = zipWith (\ u d -> CTemp u (getAmodeRep d)) uniqs dests
 460             in
 461             returnFlt (COpStmt the_temps op srcs vol_regs,
 462                        mkAbstractCs (zipWith CAssign dests the_temps))
 463     in
 464     mapFlt do_component components `thenFlt` \ abs_cs ->
 465     returnFlt (mkAbstractCs abs_cs)
 466
 467   where
 468     should_follow :: AbstractC -> AbstractC -> Bool
 469     (CAssign dest1 _) `should_follow` (CAssign _ src2)
 470       = dest1 `conflictsWith` src2
 471     (COpStmt dests1 _ _ _) `should_follow` (CAssign _ src2)
 472       = or [dest1 `conflictsWith` src2 | dest1 <- dests1]
 473     (CAssign dest1 _)`should_follow` (COpStmt _ _ srcs2 _)
 474       = or [dest1 `conflictsWith` src2 | src2 <- srcs2]
 475     (COpStmt dests1 _ _ _) `should_follow` (COpStmt _ _ srcs2 _)
 476       = or [dest1 `conflictsWith` src2 | dest1 <- dests1, src2 <- srcs2]
 477
 478 --    (COpStmt _ _ _ _ _) `should_follow` (CCallProfCtrMacro _ _) = False
 479 --    (CCallProfCtrMacro _ _) `should_follow` (COpStmt _ _ _ _ _) = False
 480
 481
 482 \end{code}
 483
 484
 485 @conflictsWith@ tells whether an assignment to its first argument will
 486 screw up an access to its second.
 487
 488 \begin{code}
 489 conflictsWith :: CAddrMode -> CAddrMode -> Bool
 490 (CReg reg1)        `conflictsWith` (CReg reg2)          = reg1 == reg2
 491 (CReg reg)         `conflictsWith` (CVal reg_rel _)     = reg `regConflictsWithRR` reg_rel
 492 (CReg reg)         `conflictsWith` (CAddr reg_rel)      = reg `regConflictsWithRR` reg_rel
 493 (CTemp u1 _)       `conflictsWith` (CTemp u2 _)         = u1 == u2
 494 (CVal reg_rel1 k1) `conflictsWith` (CVal reg_rel2 k2)
 495   = rrConflictsWithRR (getPrimRepSize k1) (getPrimRepSize k2) reg_rel1 reg_rel2
 496
 497 other1            `conflictsWith` other2                = False
 498 -- CAddr and literals are impossible on the LHS of an assignment
 499
 500 regConflictsWithRR :: MagicId -> RegRelative -> Bool
 501
 502 regConflictsWithRR (VanillaReg k ILIT(1)) (NodeRel _)   = True
 503
 504 regConflictsWithRR Sp   (SpRel _)       = True
 505 regConflictsWithRR Hp   (HpRel _)       = True
 506 regConflictsWithRR _    _               = False
 507
 508 rrConflictsWithRR :: Int -> Int                 -- Sizes of two things
 509                   -> RegRelative -> RegRelative -- The two amodes
 510                   -> Bool
 511
 512 rrConflictsWithRR (I# s1) (I# s2) rr1 rr2 = rr rr1 rr2
 513   where
 514     rr (SpRel o1)    (SpRel o2)
 515         | s1 _EQ_ ILIT(0) || s2 _EQ_ ILIT(0) = False -- No conflict if either is size zero
 516         | s1 _EQ_ ILIT(1)  && s2 _EQ_ ILIT(1) = o1 _EQ_ o2
 517         | otherwise          = (o1 _ADD_ s1) _GE_ o2  &&
 518                                (o2 _ADD_ s2) _GE_ o1
 519
 520     rr (NodeRel o1)      (NodeRel o2)
 521         | s1 _EQ_ ILIT(0) || s2 _EQ_ ILIT(0) = False -- No conflict if either is size zero
 522         | s1 _EQ_ ILIT(1) && s2 _EQ_ ILIT(1) = o1 _EQ_ o2
 523         | otherwise          = True             -- Give up
 524
 525     rr (HpRel _)         (HpRel _)    = True    -- Give up (ToDo)
 526
 527     rr other1            other2       = False
 528 \end{code}