[project @ 2000-10-12 15:59:34 by sewardj]

FastInt/DynFlags propagation.

diff --git a/ghc/compiler/absCSyn/AbsCUtils.lhs b/ghc/compiler/absCSyn/AbsCUtils.lhs
index 11a26f3..2dfab65 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 )
 
@@ -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)
@@ -520,8 +521,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 +530,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 ==# _ILIT(0) || s2 ==# _ILIT(0) = False -- No conflict if either is size zero
-       | s1 ==# _ILIT(1)  && s2 ==# _ILIT(1) = o1 ==# o2
+       | 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 ==# _ILIT(0) || s2 ==# _ILIT(0) = False -- No conflict if either is size zero
-       | s1 ==# _ILIT(1) && s2 ==# _ILIT(1) = o1 ==# 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)

diff --git a/ghc/compiler/prelude/PrelInfo.lhs b/ghc/compiler/prelude/PrelInfo.lhs
index 0e16ea4..0a532a1 100644 (file)
--- a/ghc/compiler/prelude/PrelInfo.lhs
+++ b/ghc/compiler/prelude/PrelInfo.lhs
@@ -38,6 +38,7 @@ import MkId           ( mkPrimOpId, wiredInIds )
 import MkId            -- All of it, for re-export
 import TysPrim         ( primTyCons )
 import TysWiredIn      ( wiredInTyCons )
+import HscTypes                ( TyThing(..) )
 
 -- others:
 import RdrName         ( RdrName )
@@ -70,7 +71,7 @@ wiredInThings
        , map AnId wiredInIds
 
                -- PrimOps
-       , map (AnId . mkPrimOpId)) allThePrimOps
+       , map (AnId . mkPrimOpId) allThePrimOps
     ]
 
 wiredInNames :: [Name]

diff --git a/ghc/compiler/typecheck/TcMonad.lhs b/ghc/compiler/typecheck/TcMonad.lhs
index 40a5937..6f151db 100644 (file)
--- a/ghc/compiler/typecheck/TcMonad.lhs
+++ b/ghc/compiler/typecheck/TcMonad.lhs
@@ -109,7 +109,7 @@ type TcKind      = TcType
 
 \begin{code}
 type NF_TcM r =  TcDown -> TcEnv -> IO r       -- Can't raise UserError
-type TcM    s r =  TcDown -> TcEnv -> IO r     -- Can raise UserError
+type TcM    r =  TcDown -> TcEnv -> IO r       -- Can raise UserError
        -- ToDo: nuke the 's' part
        -- The difference between the two is
        -- now for documentation purposes only
@@ -591,7 +591,7 @@ data TcDown
        ErrCtxt                 -- Error context
        (TcRef (Bag WarnMsg, Bag ErrMsg))
 
-type ErrCtxt = [TidyEnv -> NF_TcM Unused (TidyEnv, Message)]   
+type ErrCtxt = [TidyEnv -> NF_TcM (TidyEnv, Message)]  
                        -- Innermost first.  Monadic so that we have a chance
                        -- to deal with bound type variables just before error
                        -- message construction