Another round of External Core fixes
[ghc-hetmet.git] / compiler / codeGen / CgUtils.hs
index 0a8ac41..3861ddf 100644 (file)
@@ -1,3 +1,10 @@
+{-# OPTIONS -w #-}
+-- The above warning supression flag is a temporary kludge.
+-- While working on this module you are encouraged to remove it and fix
+-- any warnings in the module. See
+--     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
+-- for details
+
 -----------------------------------------------------------------------------
 --
 -- Code generator utilities; mostly monadic
@@ -6,13 +13,6 @@
 --
 -----------------------------------------------------------------------------
 
-{-# OPTIONS -w #-}
--- The above warning supression flag is a temporary kludge.
--- While working on this module you are encouraged to remove it and fix
--- any warnings in the module. See
---     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
--- for details
-
 module CgUtils (
        addIdReps,
        cgLit,
@@ -51,7 +51,7 @@ module CgUtils (
   ) where
 
 #include "HsVersions.h"
-#include "MachRegs.h"
+#include "../includes/MachRegs.h"
 
 import CgMonad
 import TyCon
@@ -74,9 +74,7 @@ import Util
 import DynFlags
 import FastString
 import PackageConfig
-#ifdef DEBUG
 import Outputable
-#endif
 
 import Data.Char
 import Data.Bits
@@ -335,24 +333,24 @@ emitIfThenElse cond then_part else_part
        ; labelC join_id
        }
 
-emitRtsCall :: LitString -> [(CmmExpr,MachHint)] -> Bool -> Code
+emitRtsCall :: LitString -> [CmmHinted CmmExpr] -> Bool -> Code
 emitRtsCall fun args safe = emitRtsCall' [] fun args Nothing safe
    -- The 'Nothing' says "save all global registers"
 
-emitRtsCallWithVols :: LitString -> [(CmmExpr,MachHint)] -> [GlobalReg] -> Bool -> Code
+emitRtsCallWithVols :: LitString -> [CmmHinted CmmExpr] -> [GlobalReg] -> Bool -> Code
 emitRtsCallWithVols fun args vols safe
    = emitRtsCall' [] fun args (Just vols) safe
 
 emitRtsCallWithResult :: LocalReg -> MachHint -> LitString
-       -> [(CmmExpr,MachHint)] -> Bool -> Code
+       -> [CmmHinted CmmExpr] -> Bool -> Code
 emitRtsCallWithResult res hint fun args safe
-   = emitRtsCall' [(res,hint)] fun args Nothing safe
+   = emitRtsCall' [CmmHinted res hint] fun args Nothing safe
 
 -- Make a call to an RTS C procedure
 emitRtsCall'
-   :: CmmHintFormals
+   :: CmmFormals
    -> LitString
-   -> [(CmmExpr,MachHint)]
+   -> [CmmHinted CmmExpr]
    -> Maybe [GlobalReg]
    -> Bool -- True <=> CmmSafe call
    -> Code
@@ -545,10 +543,8 @@ baseRegOffset CurrentNursery         = oFFSET_StgRegTable_rCurrentNursery
 baseRegOffset HpAlloc            = oFFSET_StgRegTable_rHpAlloc
 baseRegOffset GCEnter1           = oFFSET_stgGCEnter1
 baseRegOffset GCFun              = oFFSET_stgGCFun
-#ifdef DEBUG
 baseRegOffset BaseReg            = panic "baseRegOffset:BaseReg"
 baseRegOffset _                          = panic "baseRegOffset:other"
-#endif
 
 
 -------------------------------------------------------------------------
@@ -562,7 +558,7 @@ emitDataLits :: CLabel -> [CmmLit] -> Code
 emitDataLits lbl lits
   = emitData Data (CmmDataLabel lbl : map CmmStaticLit lits)
 
-mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info stmt
+mkDataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info graph
 -- Emit a data-segment data block
 mkDataLits lbl lits
   = CmmData Data (CmmDataLabel lbl : map CmmStaticLit lits)
@@ -577,7 +573,7 @@ emitRODataLits lbl lits
         needsRelocation (CmmLabelOff _ _) = True
         needsRelocation _                 = False
 
-mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info stmt
+mkRODataLits :: CLabel -> [CmmLit] -> GenCmmTop CmmStatic info graph
 mkRODataLits lbl lits
   = CmmData section (CmmDataLabel lbl : map CmmStaticLit lits)
   where section | any needsRelocation lits = RelocatableReadOnlyData
@@ -623,10 +619,10 @@ assignPtrTemp e
                            ; return (CmmReg (CmmLocal reg)) }
 
 newNonPtrTemp :: MachRep -> FCode LocalReg
-newNonPtrTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep KindNonPtr) }
+newNonPtrTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep GCKindNonPtr) }
 
 newPtrTemp :: MachRep -> FCode LocalReg
-newPtrTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep KindPtr) }
+newPtrTemp rep = do { uniq <- newUnique; return (LocalReg uniq rep GCKindPtr) }
 
 
 -------------------------------------------------------------------------
@@ -996,6 +992,7 @@ getSRTInfo = do
     -- TODO: Should we panic in this case?
     -- Someone obviously thinks there should be an SRT
     NoSRT -> return NoC_SRT
+    SRTEntries {} -> panic "getSRTInfo: SRTEntries.  Perhaps you forgot to run SimplStg?"
     SRT off len bmp
       | len > hALF_WORD_SIZE_IN_BITS || bmp == [fromIntegral srt_escape]
       -> do id <- newUnique