X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fcmm%2FPprCmm.hs;h=43f39353afa8c21ead7c11ba1872febcbceefd72;hb=d76b6a05ab36066e8aeb67d58e25992d1ef83a8a;hp=c31c4de6e255a3358f27427170f5e63a19970fc4;hpb=16a2f6a8a381af31c23b6a41a851951da9bc1803;p=ghc-hetmet.git diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs index c31c4de..43f3935 100644 --- a/compiler/cmm/PprCmm.hs +++ b/compiler/cmm/PprCmm.hs @@ -40,7 +40,7 @@ -- module PprCmm - ( writeCmms, pprCmms, pprCmm, pprStmt, pprExpr, pprSection, pprStatic + ( writeCmms, pprCmms, pprCmm, pprStmt, pprExpr, pprSection, pprStatic, pprLit ) where @@ -71,8 +71,8 @@ writeCmms handle cmms = printForC handle (pprCmms cmms) ----------------------------------------------------------------------------- -instance (Outputable info, Outputable g) - => Outputable (GenCmm CmmStatic info g) where +instance (Outputable d, Outputable info, Outputable g) + => Outputable (GenCmm d info g) where ppr c = pprCmm c instance (Outputable d, Outputable info, Outputable i) @@ -110,7 +110,7 @@ instance Outputable CmmInfo where ----------------------------------------------------------------------------- -pprCmm :: (Outputable info, Outputable g) => GenCmm CmmStatic info g -> SDoc +pprCmm :: (Outputable d, Outputable info, Outputable g) => GenCmm d info g -> SDoc pprCmm (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops -- -------------------------------------------------------------------------- @@ -284,7 +284,7 @@ genCondBranch expr ident = -- -- jump foo(a, b, c); -- -genJump :: CmmExpr -> [(CmmExpr, MachHint)] -> SDoc +genJump :: CmmExpr -> [CmmHinted CmmExpr] -> SDoc genJump expr args = hcat [ ptext SLIT("jump") @@ -295,15 +295,21 @@ genJump expr args = CmmLoad (CmmReg _) _ -> pprExpr expr _ -> parens (pprExpr expr) , space - , parens ( commafy $ map ppr args ) + , parens ( commafy $ map pprHinted args ) , semi ] +pprHinted :: Outputable a => (CmmHinted a) -> SDoc +pprHinted (CmmHinted a NoHint) = ppr a +pprHinted (CmmHinted a PtrHint) = quotes(text "address") <+> ppr a +pprHinted (CmmHinted a SignedHint) = quotes(text "signed") <+> ppr a +pprHinted (CmmHinted a FloatHint) = quotes(text "float") <+> ppr a + -- -------------------------------------------------------------------------- -- Return from a function. [1], Section 6.8.2 of version 1.128 -- -- return (a, b, c); -- -genReturn :: [(CmmExpr, MachHint)] -> SDoc +genReturn :: [CmmHinted CmmExpr] -> SDoc genReturn args = hcat [ ptext SLIT("return") @@ -512,10 +518,10 @@ pprReg r pprLocalReg :: LocalReg -> SDoc pprLocalReg (LocalReg uniq rep follow) = hcat [ char '_', ppr uniq, ty ] where - ty = if rep == wordRep && follow == KindNonPtr + ty = if rep == wordRep && follow == GCKindNonPtr then empty else dcolon <> ptr <> ppr rep - ptr = if follow == KindNonPtr + ptr = if follow == GCKindNonPtr then empty else doubleQuotes (text "ptr") @@ -566,4 +572,3 @@ pprBlockId b = ppr $ getUnique b commafy :: [SDoc] -> SDoc commafy xs = hsep $ punctuate comma xs -