X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fcmm%2FPprC.hs;h=10c9f183103dda1c671eeb66930a4872a64a435e;hb=889c084e943779e76d19f2ef5e970ff655f511eb;hp=3ee3738e7b9bb8e5e4cc47b9eb4236ee5c7e1143;hpb=8fd6a1efca90be81dc97a679bf430aaffecc568d;p=ghc-hetmet.git diff --git a/compiler/cmm/PprC.hs b/compiler/cmm/PprC.hs index 3ee3738..10c9f18 100644 --- a/compiler/cmm/PprC.hs +++ b/compiler/cmm/PprC.hs @@ -34,8 +34,8 @@ module PprC ( -- Cmm stuff import BlockId -import Cmm -import PprCmm () -- Instances only +import OldCmm +import OldPprCmm () -- Instances only import CLabel import ForeignCall import ClosureInfo @@ -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,13 +93,13 @@ 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 -- pprTop :: RawCmmTop -> SDoc -pprTop (CmmProc info clbl _params (ListGraph blocks)) = +pprTop (CmmProc info clbl (ListGraph blocks)) = (if not (null info) then pprDataExterns info $$ pprWordArray (entryLblToInfoLbl clbl) info @@ -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, @@ -679,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 - -- --------------------------------------------------------------------- -- @@ -876,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 @@ -912,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 @@ -920,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