Remove (most of) the FiniteMap wrapper

[ghc-hetmet.git] / compiler / cmm / PprC.hs

diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs
index 04aa9e9..a36a356 100644 (file)
--- a/compiler/cmm/PprC.hs
+++ b/compiler/cmm/PprC.hs
@@ -44,7 +44,6 @@ import ClosureInfo
 import DynFlags
 import Unique
 import UniqSet
-import FiniteMap
 import UniqFM
 import FastString
 import Outputable
@@ -57,6 +56,8 @@ import Data.List
 import Data.Bits
 import Data.Char
 import System.IO
+import Data.Map (Map)
+import qualified Data.Map as Map
 import Data.Word
 
 import Data.Array.ST
@@ -92,7 +93,7 @@ writeCs dflags handle cmms
 --
 
 pprC :: RawCmm -> SDoc
-pprC (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops
+pprC (Cmm tops) = vcat $ intersperse blankLine $ map pprTop tops
 
 --
 -- top level procs
@@ -107,7 +108,7 @@ pprTop (CmmProc info clbl _params (ListGraph blocks)) =
         [] -> empty
          -- the first block doesn't get a label:
         (BasicBlock _ stmts : rest) -> vcat [
-          text "",
+          blankLine,
           extern_decls,
            (if (externallyVisibleCLabel clbl)
                     then mkFN_ else mkIF_) (pprCLabel clbl) <+> lbrace,
@@ -253,7 +254,8 @@ pprStmt stmt = case stmt of
                                  )
                     in (fun_proto lbl, myCall)
              _ -> 
-                   (empty {- no proto -}, cast_fn)
+                   (empty {- no proto -},
+                    pprCall cast_fn cconv results args safety <> semi)
                        -- for a dynamic call, no declaration is necessary.
 
     CmmCall (CmmPrim op) results args safety _ret ->
@@ -678,22 +680,11 @@ mkFE_ = ptext (sLit "FE_") -- function code end
 
 -- from includes/Stg.h
 --
-mkC_,mkW_,mkP_,mkPP_,mkI_,mkA_,mkD_,mkF_,mkB_,mkL_,mkLI_,mkLW_ :: SDoc
+mkC_,mkW_,mkP_ :: SDoc
 
 mkC_  = ptext (sLit "(C_)")        -- StgChar
 mkW_  = ptext (sLit "(W_)")        -- StgWord
 mkP_  = ptext (sLit "(P_)")        -- StgWord*
-mkPP_ = ptext (sLit "(PP_)")       -- P_*
-mkI_  = ptext (sLit "(I_)")        -- StgInt
-mkA_  = ptext (sLit "(A_)")        -- StgAddr
-mkD_  = ptext (sLit "(D_)")        -- const StgWord*
-mkF_  = ptext (sLit "(F_)")        -- StgFunPtr
-mkB_  = ptext (sLit "(B_)")        -- StgByteArray
-mkL_  = ptext (sLit "(L_)")        -- StgClosurePtr
-
-mkLI_ = ptext (sLit "(LI_)")       -- StgInt64
-mkLW_ = ptext (sLit "(LW_)")       -- StgWord64
-
 
 -- ---------------------------------------------------------------------
 --
@@ -875,12 +866,12 @@ is_cish StdCallConv = True
 pprTempAndExternDecls :: [CmmBasicBlock] -> (SDoc{-temps-}, SDoc{-externs-})
 pprTempAndExternDecls stmts 
   = (vcat (map pprTempDecl (uniqSetToList temps)), 
-     vcat (map (pprExternDecl False{-ToDo-}) (keysFM lbls)))
+     vcat (map (pprExternDecl False{-ToDo-}) (Map.keys lbls)))
   where (temps, lbls) = runTE (mapM_ te_BB stmts)
 
 pprDataExterns :: [CmmStatic] -> SDoc
 pprDataExterns statics
-  = vcat (map (pprExternDecl False{-ToDo-}) (keysFM lbls))
+  = vcat (map (pprExternDecl False{-ToDo-}) (Map.keys lbls))
   where (_, lbls) = runTE (mapM_ te_Static statics)
 
 pprTempDecl :: LocalReg -> SDoc
@@ -911,7 +902,7 @@ pprExternDecl in_srt lbl
         <> parens (commafy (replicate (sz `quot` wORD_SIZE) (machRep_U_CType wordWidth)))
         <> semi
 
-type TEState = (UniqSet LocalReg, FiniteMap CLabel ())
+type TEState = (UniqSet LocalReg, Map CLabel ())
 newtype TE a = TE { unTE :: TEState -> (a, TEState) }
 
 instance Monad TE where
@@ -919,13 +910,13 @@ instance Monad TE where
    return a    = TE $ \s -> (a, s)
 
 te_lbl :: CLabel -> TE ()
-te_lbl lbl = TE $ \(temps,lbls) -> ((), (temps, addToFM lbls lbl ()))
+te_lbl lbl = TE $ \(temps,lbls) -> ((), (temps, Map.insert lbl () lbls))
 
 te_temp :: LocalReg -> TE ()
 te_temp r = TE $ \(temps,lbls) -> ((), (addOneToUniqSet temps r, lbls))
 
 runTE :: TE () -> TEState
-runTE (TE m) = snd (m (emptyUniqSet, emptyFM))
+runTE (TE m) = snd (m (emptyUniqSet, Map.empty))
 
 te_Static :: CmmStatic -> TE ()
 te_Static (CmmStaticLit lit) = te_Lit lit