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 Literal          ( 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, opt_EmitCExternDecls )
  31 import Maybes           ( maybeToBool )
  32 import PrimOp           ( PrimOp(..), CCall(..), CCallTarget(..) )
  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 _ 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 lbl abs_C)
 312   = flatAbsC abs_C          `thenFlt` \ (absC_heres, absC_tops) ->
 313     returnFlt (AbsCNop, absC_tops `mkAbsCStmts` CCodeBlock lbl 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 (CCallOp ccall) args vol_regs)
 333   | isCandidate && maybeToBool opt_ProduceC
 334   = returnFlt (stmt, tdef)
 335   where
 336     (isCandidate, isDyn) =
 337       case ccall of
 338         CCall (DynamicTarget _) _ _ _      -> (True, True)
 339         CCall (StaticTarget _) is_asm _ _  -> (opt_EmitCExternDecls && not is_asm, False)
 340
 341     tdef = CCallTypedef isDyn ccall results args
 342
 343 flatAbsC stmt@(CSimultaneous abs_c)
 344   = flatAbsC abs_c              `thenFlt` \ (stmts_here, tops) ->
 345     doSimultaneously stmts_here `thenFlt` \ new_stmts_here ->
 346     returnFlt (new_stmts_here, tops)
 347
 348 flatAbsC stmt@(CCheck macro amodes code)
 349   = flatAbsC code               `thenFlt` \ (code_here, code_tops) ->
 350     returnFlt (CCheck macro amodes code_here, code_tops)
 351
 352 -- the TICKY_CTR macro always needs to be hoisted out to the top level.
 353 -- This is a HACK.
 354 flatAbsC stmt@(CCallProfCtrMacro str amodes)
 355   | str == SLIT("TICK_CTR")     = returnFlt (AbsCNop, stmt)
 356   | otherwise                   = returnFlt (stmt, AbsCNop)
 357
 358 -- Some statements need no flattening at all:
 359 flatAbsC stmt@(CMacroStmt macro amodes)         = returnFlt (stmt, AbsCNop)
 360 flatAbsC stmt@(CCallProfCCMacro str amodes)     = returnFlt (stmt, AbsCNop)
 361 flatAbsC stmt@(CAssign dest source)             = returnFlt (stmt, AbsCNop)
 362 flatAbsC stmt@(CJump target)                    = returnFlt (stmt, AbsCNop)
 363 flatAbsC stmt@(CFallThrough target)             = returnFlt (stmt, AbsCNop)
 364 flatAbsC stmt@(CReturn target return_info)      = returnFlt (stmt, AbsCNop)
 365 flatAbsC stmt@(CInitHdr a b cc)                 = returnFlt (stmt, AbsCNop)
 366 flatAbsC stmt@(COpStmt results op args vol_regs)= returnFlt (stmt, AbsCNop)
 367
 368 -- Some statements only make sense at the top level, so we always float
 369 -- them.  This probably isn't necessary.
 370 flatAbsC stmt@(CStaticClosure _ _ _ _)          = returnFlt (AbsCNop, stmt)
 371 flatAbsC stmt@(CClosureTbl _)                   = returnFlt (AbsCNop, stmt)
 372 flatAbsC stmt@(CSRT _ _)                        = returnFlt (AbsCNop, stmt)
 373 flatAbsC stmt@(CBitmap _ _)                     = returnFlt (AbsCNop, stmt)
 374 flatAbsC stmt@(CCostCentreDecl _ _)             = returnFlt (AbsCNop, stmt)
 375 flatAbsC stmt@(CCostCentreStackDecl _)          = returnFlt (AbsCNop, stmt)
 376 flatAbsC stmt@(CSplitMarker)                    = returnFlt (AbsCNop, stmt)
 377 flatAbsC stmt@(CRetVector _ _ _ _)              = returnFlt (AbsCNop, stmt)
 378 flatAbsC stmt@(CModuleInitBlock _ _)            = returnFlt (AbsCNop, stmt)
 379 \end{code}
 380
 381 \begin{code}
 382 flat_maybe :: Maybe AbstractC -> FlatM (Maybe AbstractC, AbstractC)
 383 flat_maybe Nothing      = returnFlt (Nothing, AbsCNop)
 384 flat_maybe (Just abs_c) = flatAbsC abs_c `thenFlt` \ (heres, tops) ->
 385                           returnFlt (Just heres, tops)
 386 \end{code}
 387
 388 %************************************************************************
 389 %*                                                                      *
 390 \subsection[flat-simultaneous]{Doing things simultaneously}
 391 %*                                                                      *
 392 %************************************************************************
 393
 394 \begin{code}
 395 doSimultaneously :: AbstractC -> FlatM AbstractC
 396 \end{code}
 397
 398 Generate code to perform the @CAssign@s and @COpStmt@s in the
 399 input simultaneously, using temporary variables when necessary.
 400
 401 We use the strongly-connected component algorithm, in which
 402         * the vertices are the statements
 403         * an edge goes from s1 to s2 iff
 404                 s1 assigns to something s2 uses
 405           that is, if s1 should *follow* s2 in the final order
 406
 407 \begin{code}
 408 type CVertex = (Int, AbstractC)  -- Give each vertex a unique number,
 409                                  -- for fast comparison
 410
 411 type CEdge = (CVertex, CVertex)
 412
 413 doSimultaneously abs_c
 414   = let
 415         enlisted = en_list abs_c
 416     in
 417     case enlisted of -- it's often just one stmt
 418       []  -> returnFlt AbsCNop
 419       [x] -> returnFlt x
 420       _   -> doSimultaneously1 (zip [(1::Int)..] enlisted)
 421
 422 -- en_list puts all the assignments in a list, filtering out Nops and
 423 -- assignments which do nothing
 424 en_list AbsCNop                               = []
 425 en_list (AbsCStmts a1 a2)                     = en_list a1 ++ en_list a2
 426 en_list (CAssign am1 am2) | sameAmode am1 am2 = []
 427 en_list other                                 = [other]
 428
 429 sameAmode :: CAddrMode -> CAddrMode -> Bool
 430 -- ToDo: Move this function, or make CAddrMode an instance of Eq
 431 -- At the moment we put in just enough to catch the cases we want:
 432 --      the second (destination) argument is always a CVal.
 433 sameAmode (CReg r1)                  (CReg r2)               = r1 == r2
 434 sameAmode (CVal (SpRel r1) _) (CVal (SpRel r2) _)            = r1 _EQ_ r2
 435 sameAmode other1                     other2                  = False
 436
 437 doSimultaneously1 :: [CVertex] -> FlatM AbstractC
 438 doSimultaneously1 vertices
 439   = let
 440         edges = [ (vertex, key1, edges_from stmt1)
 441                 | vertex@(key1, stmt1) <- vertices
 442                 ]
 443         edges_from stmt1 = [ key2 | (key2, stmt2) <- vertices,
 444                                     stmt1 `should_follow` stmt2
 445                            ]
 446         components = stronglyConnComp edges
 447
 448         -- do_components deal with one strongly-connected component
 449                 -- Not cyclic, or singleton?  Just do it
 450         do_component (AcyclicSCC (n,abs_c))  = returnFlt abs_c
 451         do_component (CyclicSCC [(n,abs_c)]) = returnFlt abs_c
 452
 453                 -- Cyclic?  Then go via temporaries.  Pick one to
 454                 -- break the loop and try again with the rest.
 455         do_component (CyclicSCC ((n,first_stmt) : rest))
 456           = doSimultaneously1 rest      `thenFlt` \ abs_cs ->
 457             go_via_temps first_stmt     `thenFlt` \ (to_temps, from_temps) ->
 458             returnFlt (mkAbstractCs [to_temps, abs_cs, from_temps])
 459
 460         go_via_temps (CAssign dest src)
 461           = getUniqFlt                  `thenFlt` \ uniq ->
 462             let
 463                 the_temp = CTemp uniq (getAmodeRep dest)
 464             in
 465             returnFlt (CAssign the_temp src, CAssign dest the_temp)
 466
 467         go_via_temps (COpStmt dests op srcs vol_regs)
 468           = getUniqsFlt (length dests)  `thenFlt` \ uniqs ->
 469             let
 470                 the_temps = zipWith (\ u d -> CTemp u (getAmodeRep d)) uniqs dests
 471             in
 472             returnFlt (COpStmt the_temps op srcs vol_regs,
 473                        mkAbstractCs (zipWith CAssign dests the_temps))
 474     in
 475     mapFlt do_component components `thenFlt` \ abs_cs ->
 476     returnFlt (mkAbstractCs abs_cs)
 477
 478   where
 479     should_follow :: AbstractC -> AbstractC -> Bool
 480     (CAssign dest1 _) `should_follow` (CAssign _ src2)
 481       = dest1 `conflictsWith` src2
 482     (COpStmt dests1 _ _ _) `should_follow` (CAssign _ src2)
 483       = or [dest1 `conflictsWith` src2 | dest1 <- dests1]
 484     (CAssign dest1 _)`should_follow` (COpStmt _ _ srcs2 _)
 485       = or [dest1 `conflictsWith` src2 | src2 <- srcs2]
 486     (COpStmt dests1 _ _ _) `should_follow` (COpStmt _ _ srcs2 _)
 487       = or [dest1 `conflictsWith` src2 | dest1 <- dests1, src2 <- srcs2]
 488
 489 --    (COpStmt _ _ _ _ _) `should_follow` (CCallProfCtrMacro _ _) = False
 490 --    (CCallProfCtrMacro _ _) `should_follow` (COpStmt _ _ _ _ _) = False
 491
 492
 493 \end{code}
 494
 495
 496 @conflictsWith@ tells whether an assignment to its first argument will
 497 screw up an access to its second.
 498
 499 \begin{code}
 500 conflictsWith :: CAddrMode -> CAddrMode -> Bool
 501 (CReg reg1)        `conflictsWith` (CReg reg2)          = reg1 == reg2
 502 (CReg reg)         `conflictsWith` (CVal reg_rel _)     = reg `regConflictsWithRR` reg_rel
 503 (CReg reg)         `conflictsWith` (CAddr reg_rel)      = reg `regConflictsWithRR` reg_rel
 504 (CTemp u1 _)       `conflictsWith` (CTemp u2 _)         = u1 == u2
 505 (CVal reg_rel1 k1) `conflictsWith` (CVal reg_rel2 k2)
 506   = rrConflictsWithRR (getPrimRepSize k1) (getPrimRepSize k2) reg_rel1 reg_rel2
 507
 508 other1            `conflictsWith` other2                = False
 509 -- CAddr and literals are impossible on the LHS of an assignment
 510
 511 regConflictsWithRR :: MagicId -> RegRelative -> Bool
 512
 513 regConflictsWithRR (VanillaReg k ILIT(1)) (NodeRel _)   = True
 514
 515 regConflictsWithRR Sp   (SpRel _)       = True
 516 regConflictsWithRR Hp   (HpRel _)       = True
 517 regConflictsWithRR _    _               = False
 518
 519 rrConflictsWithRR :: Int -> Int                 -- Sizes of two things
 520                   -> RegRelative -> RegRelative -- The two amodes
 521                   -> Bool
 522
 523 rrConflictsWithRR (I# s1) (I# s2) rr1 rr2 = rr rr1 rr2
 524   where
 525     rr (SpRel o1)    (SpRel o2)
 526         | s1 _EQ_ ILIT(0) || s2 _EQ_ ILIT(0) = False -- No conflict if either is size zero
 527         | s1 _EQ_ ILIT(1)  && s2 _EQ_ ILIT(1) = o1 _EQ_ o2
 528         | otherwise          = (o1 _ADD_ s1) _GE_ o2  &&
 529                                (o2 _ADD_ s2) _GE_ o1
 530
 531     rr (NodeRel o1)      (NodeRel o2)
 532         | s1 _EQ_ ILIT(0) || s2 _EQ_ ILIT(0) = False -- No conflict if either is size zero
 533         | s1 _EQ_ ILIT(1) && s2 _EQ_ ILIT(1) = o1 _EQ_ o2
 534         | otherwise          = True             -- Give up
 535
 536     rr (HpRel _)         (HpRel _)    = True    -- Give up (ToDo)
 537
 538     rr other1            other2       = False
 539 \end{code}