[project @ 2001-03-28 11:01:19 by simonmar]

[ghc-hetmet.git] / ghc / compiler / absCSyn / AbsCUtils.lhs

diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs
index f380da9..3a1bd47 100644 (file)
--- a/ghc/compiler/absCSyn/AbsCUtils.lhs
+++ b/ghc/compiler/absCSyn/AbsCUtils.lhs
@@ -27,9 +27,10 @@ import PrimRep               ( getPrimRepSize, PrimRep(..) )
 import Unique          ( Unique{-instance Eq-} )
 import UniqSupply      ( uniqFromSupply, uniqsFromSupply, splitUniqSupply, 
                          UniqSupply )
-import CmdLineOpts      ( opt_OutputLanguage, opt_EmitCExternDecls )
+import CmdLineOpts      ( opt_EmitCExternDecls )
 import PrimOp          ( PrimOp(..), CCall(..), isDynamicTarget )
 import Panic           ( panic )
+import FastTypes
 
 import Maybe           ( isJust )
 
@@ -110,7 +111,7 @@ mkAlgAltsCSwitch scrutinee tagged_alts deflt_absc
    -- it's ok to convert one of the alts into a default if we don't already have
    -- one, because this is an algebraic case and we're guaranteed that the tag 
    -- will match one of the branches.
-   ((tag,first_alt):rest) = tagged_alts
+   ((_,first_alt):rest) = tagged_alts
 
    -- Adjust the tags in the switch to start at zero.
    -- This is the convention used by primitive ops which return algebraic
@@ -340,7 +341,7 @@ flatAbsC (CSwitch discrim alts deflt)
        returnFlt ( (tag, alt_heres), alt_tops )
 
 flatAbsC stmt@(COpStmt results (CCallOp ccall@(CCall target is_asm _ _)) args vol_regs)
-  | isCandidate && opt_OutputLanguage == Just "C"      -- Urgh
+  | isCandidate
   = returnFlt (stmt, tdef)
   | otherwise
   = returnFlt (stmt, AbsCNop)
@@ -418,8 +419,6 @@ We use the strongly-connected component algorithm, in which
 type CVertex = (Int, AbstractC)  -- Give each vertex a unique number,
                                 -- for fast comparison
 
-type CEdge = (CVertex, CVertex)
-
 doSimultaneously abs_c
   = let
        enlisted = en_list abs_c
@@ -441,7 +440,7 @@ sameAmode :: CAddrMode -> CAddrMode -> Bool
 -- At the moment we put in just enough to catch the cases we want:
 --     the second (destination) argument is always a CVal.
 sameAmode (CReg r1)                 (CReg r2)               = r1 == r2
-sameAmode (CVal (SpRel r1) _) (CVal (SpRel r2) _)           = r1 _EQ_ r2
+sameAmode (CVal (SpRel r1) _) (CVal (SpRel r2) _)           = r1 ==# r2
 sameAmode other1                    other2                  = False
 
 doSimultaneously1 :: [CVertex] -> FlatM AbstractC
@@ -520,8 +519,7 @@ other1                `conflictsWith` other2                = False
 
 regConflictsWithRR :: MagicId -> RegRelative -> Bool
 
-regConflictsWithRR (VanillaReg k ILIT(1)) (NodeRel _)  = True
-
+regConflictsWithRR (VanillaReg k n) (NodeRel _)        | n ==# (_ILIT 1)    = True
 regConflictsWithRR Sp  (SpRel _)       = True
 regConflictsWithRR Hp  (HpRel _)       = True
 regConflictsWithRR _   _               = False
@@ -530,17 +528,20 @@ rrConflictsWithRR :: Int -> Int                   -- Sizes of two things
                  -> RegRelative -> RegRelative -- The two amodes
                  -> Bool
 
-rrConflictsWithRR (I# s1) (I# s2) rr1 rr2 = rr rr1 rr2
+rrConflictsWithRR s1b s2b rr1 rr2 = rr rr1 rr2
   where
+    s1 = iUnbox s1b
+    s2 = iUnbox s2b
+
     rr (SpRel o1)    (SpRel o2)
-       | s1 _EQ_ ILIT(0) || s2 _EQ_ ILIT(0) = False -- No conflict if either is size zero
-       | s1 _EQ_ ILIT(1)  && s2 _EQ_ ILIT(1) = o1 _EQ_ o2
-       | otherwise          = (o1 _ADD_ s1) _GE_ o2  &&
-                              (o2 _ADD_ s2) _GE_ o1
+       | s1 ==# (_ILIT 0) || s2 ==# (_ILIT 0) = False -- No conflict if either is size zero
+       | s1 ==# (_ILIT 1)  && s2 ==# (_ILIT 1) = o1 ==# o2
+       | otherwise          = (o1 +# s1) >=# o2  &&
+                              (o2 +# s2) >=# o1
 
     rr (NodeRel o1)     (NodeRel o2)
-       | s1 _EQ_ ILIT(0) || s2 _EQ_ ILIT(0) = False -- No conflict if either is size zero
-       | s1 _EQ_ ILIT(1) && s2 _EQ_ ILIT(1) = o1 _EQ_ o2
+       | s1 ==# (_ILIT 0) || s2 ==# (_ILIT 0) = False -- No conflict if either is size zero
+       | s1 ==# (_ILIT 1) && s2 ==# (_ILIT 1) = o1 ==# o2
        | otherwise          = True             -- Give up
 
     rr (HpRel _)        (HpRel _)    = True    -- Give up (ToDo)