X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FPprCmm.hs;h=f5c5a49b926804e36579b00f4f1f9913326423ae;hp=0c79f6f419f0b000bfe41c0951930cb436e9aeb1;hb=83d563cb9ede0ba792836e529b1e2929db926355;hpb=418175d3c36ca51495d9dfb085fb01711e4c38f9 diff --git a/compiler/cmm/PprCmm.hs b/compiler/cmm/PprCmm.hs index 0c79f6f..f5c5a49 100644 --- a/compiler/cmm/PprCmm.hs +++ b/compiler/cmm/PprCmm.hs @@ -32,19 +32,20 @@ -- A useful example pass over Cmm is in nativeGen/MachCodeGen.hs -- -module PprCmm ( - writeCmms, pprCmms, pprCmm, pprStmt, pprExpr - ) where - -#include "HsVersions.h" +module PprCmm + ( writeCmms, pprCmms, pprCmm, pprStmt, pprExpr, + pprSection, pprStatic, pprLit + ) +where +import BlockId import Cmm import CmmUtils -import MachOp import CLabel +import BasicTypes + import ForeignCall -import Unique import Outputable import FastString @@ -52,23 +53,34 @@ import Data.List import System.IO import Data.Maybe -pprCmms :: [Cmm] -> SDoc +-- Temp Jan08 +import SMRep +import ClosureInfo +#include "../includes/rts/storage/FunTypes.h" + + +pprCmms :: (Outputable info, Outputable g) => [GenCmm CmmStatic info g] -> SDoc pprCmms cmms = pprCode CStyle (vcat (intersperse separator $ map ppr cmms)) where - separator = space $$ ptext SLIT("-------------------") $$ space + separator = space $$ ptext (sLit "-------------------") $$ space writeCmms :: Handle -> [Cmm] -> IO () writeCmms handle cmms = printForC handle (pprCmms cmms) ----------------------------------------------------------------------------- -instance Outputable Cmm where +instance (Outputable d, Outputable info, Outputable g) + => Outputable (GenCmm d info g) where ppr c = pprCmm c -instance Outputable CmmTop where +instance (Outputable d, Outputable info, Outputable i) + => Outputable (GenCmmTop d info i) where ppr t = pprTop t -instance Outputable CmmBasicBlock where +instance (Outputable instr) => Outputable (ListGraph instr) where + ppr (ListGraph blocks) = vcat (map ppr blocks) + +instance (Outputable instr) => Outputable (GenBasicBlock instr) where ppr b = pprBBlock b instance Outputable CmmStmt where @@ -80,36 +92,43 @@ instance Outputable CmmExpr where instance Outputable CmmReg where ppr e = pprReg e +instance Outputable CmmLit where + ppr l = pprLit l + instance Outputable LocalReg where ppr e = pprLocalReg e +instance Outputable Area where + ppr e = pprArea e + instance Outputable GlobalReg where ppr e = pprGlobalReg e +instance Outputable CmmStatic where + ppr e = pprStatic e + +instance Outputable CmmInfo where + ppr e = pprInfo e + + + ----------------------------------------------------------------------------- -pprCmm :: Cmm -> SDoc -pprCmm (Cmm tops) = vcat $ intersperse (text "") $ map pprTop tops +pprCmm :: (Outputable d, Outputable info, Outputable g) => GenCmm d info g -> SDoc +pprCmm (Cmm tops) = vcat $ intersperse blankLine $ map pprTop tops -- -------------------------------------------------------------------------- --- Top level `procedure' blocks. The info tables, if not null, are --- printed in the style of C--'s 'stackdata' declaration, just inside --- the proc body, and are labelled with the procedure name ++ "_info". +-- Top level `procedure' blocks. -- -pprTop :: CmmTop -> SDoc -pprTop (CmmProc info lbl params blocks ) +pprTop :: (Outputable d, Outputable info, Outputable i) + => GenCmmTop d info i -> SDoc - = vcat [ pprCLabel lbl <> parens (commafy $ map ppr params) <+> lbrace - , nest 8 $ pprInfo info lbl - , nest 4 $ vcat (map ppr blocks) - , rbrace ] +pprTop (CmmProc info lbl params graph ) - where - pprInfo [] _ = empty - pprInfo i label = - (hang (pprCLabel (entryLblToInfoLbl label) <+> lbrace ) - 4 $ vcat (map pprStatic i)) - $$ rbrace + = vcat [ pprCLabel lbl <> parens (commafy $ map ppr params) + , nest 8 $ lbrace <+> ppr info $$ rbrace + , nest 4 $ ppr graph + , rbrace ] -- -------------------------------------------------------------------------- -- We follow [1], 4.5 @@ -117,16 +136,101 @@ pprTop (CmmProc info lbl params blocks ) -- section "data" { ... } -- pprTop (CmmData section ds) = - (hang (pprSection section <+> lbrace) 4 (vcat (map pprStatic ds))) + (hang (pprSection section <+> lbrace) 4 (vcat (map ppr ds))) $$ rbrace +-- -------------------------------------------------------------------------- +instance Outputable CmmSafety where + ppr CmmUnsafe = ptext (sLit "_unsafe_call_") + ppr (CmmSafe srt) = ppr srt + ppr CmmInterruptible = ptext (sLit "_interruptible_call_") + +-- -------------------------------------------------------------------------- +-- Info tables. The current pretty printer needs refinement +-- but will work for now. +-- +-- For ideas on how to refine it, they used to be printed in the +-- style of C--'s 'stackdata' declaration, just inside the proc body, +-- and were labelled with the procedure name ++ "_info". +pprInfo :: CmmInfo -> SDoc +pprInfo (CmmInfo _gc_target update_frame CmmNonInfoTable) = + vcat [{-ptext (sLit "gc_target: ") <> + maybe (ptext (sLit "")) ppr gc_target,-} + ptext (sLit "update_frame: ") <> + maybe (ptext (sLit "")) pprUpdateFrame update_frame] +pprInfo (CmmInfo _gc_target update_frame + (CmmInfoTable stat_clos (ProfilingInfo closure_type closure_desc) tag info)) = + vcat [{-ptext (sLit "gc_target: ") <> + maybe (ptext (sLit "")) ppr gc_target,-} + ptext (sLit "has static closure: ") <> ppr stat_clos <+> + ptext (sLit "update_frame: ") <> + maybe (ptext (sLit "")) pprUpdateFrame update_frame, + ptext (sLit "type: ") <> pprLit closure_type, + ptext (sLit "desc: ") <> pprLit closure_desc, + ptext (sLit "tag: ") <> integer (toInteger tag), + pprTypeInfo info] + +pprTypeInfo :: ClosureTypeInfo -> SDoc +pprTypeInfo (ConstrInfo layout constr descr) = + vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)), + ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)), + ptext (sLit "constructor: ") <> integer (toInteger constr), + pprLit descr] +pprTypeInfo (FunInfo layout srt arity _args slow_entry) = + vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)), + ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)), + ptext (sLit "srt: ") <> ppr srt, +-- Temp Jan08 + ptext (sLit ("fun_type: ")) <> integer (toInteger (argDescrType _args)), + + ptext (sLit "arity: ") <> integer (toInteger arity), + --ptext (sLit "args: ") <> ppr args, -- TODO: needs to be printed + ptext (sLit "slow: ") <> pprLit slow_entry + ] +pprTypeInfo (ThunkInfo layout srt) = + vcat [ptext (sLit "ptrs: ") <> integer (toInteger (fst layout)), + ptext (sLit "nptrs: ") <> integer (toInteger (snd layout)), + ptext (sLit "srt: ") <> ppr srt] +pprTypeInfo (ThunkSelectorInfo offset srt) = + vcat [ptext (sLit "ptrs: ") <> integer (toInteger offset), + ptext (sLit "srt: ") <> ppr srt] +pprTypeInfo (ContInfo stack srt) = + vcat [ptext (sLit "stack: ") <> ppr stack, + ptext (sLit "srt: ") <> ppr srt] + +-- Temp Jan08 +argDescrType :: ArgDescr -> StgHalfWord +-- The "argument type" RTS field type +argDescrType (ArgSpec n) = n +argDescrType (ArgGen liveness) + | isBigLiveness liveness = ARG_GEN_BIG + | otherwise = ARG_GEN + +-- Temp Jan08 +isBigLiveness :: Liveness -> Bool +isBigLiveness (BigLiveness _) = True +isBigLiveness (SmallLiveness _) = False + + +pprUpdateFrame :: UpdateFrame -> SDoc +pprUpdateFrame (UpdateFrame expr args) = + hcat [ ptext (sLit "jump") + , space + , if isTrivialCmmExpr expr + then pprExpr expr + else case expr of + CmmLoad (CmmReg _) _ -> pprExpr expr + _ -> parens (pprExpr expr) + , space + , parens ( commafy $ map ppr args ) ] + -- -------------------------------------------------------------------------- -- Basic blocks look like assembly blocks. -- lbl: stmt ; stmt ; .. -pprBBlock :: CmmBasicBlock -> SDoc +pprBBlock :: Outputable stmt => GenBasicBlock stmt -> SDoc pprBBlock (BasicBlock ident stmts) = - hang (pprBlockId ident <> colon) 4 (vcat (map ppr stmts)) + hang (ppr ident <> colon) 4 (vcat (map ppr stmts)) -- -------------------------------------------------------------------------- -- Statements. C-- usually, exceptions to this should be obvious. @@ -146,26 +250,41 @@ pprStmt stmt = case stmt of -- rep[lv] = expr; CmmStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi where - rep = ppr ( cmmExprRep expr ) + rep = ppr ( cmmExprType expr ) -- call "ccall" foo(x, y)[r1, r2]; -- ToDo ppr volatile - CmmCall (CmmForeignCall fn cconv) results args _volatile -> - hcat [ ptext SLIT("call"), space, - doubleQuotes(ppr cconv), space, - target fn, parens ( commafy $ map ppr args ), - (if null results - then empty - else brackets( commafy $ map ppr results)), semi ] + CmmCall (CmmCallee fn cconv) results args safety ret -> + sep [ pp_lhs <+> pp_conv + , nest 2 (pprExpr9 fn <> + parens (commafy (map ppr_ar args))) + <> brackets (ppr safety) + , case ret of CmmMayReturn -> empty + CmmNeverReturns -> ptext $ sLit (" never returns") + ] <> semi where - target (CmmLit lit) = pprLit lit - target fn' = parens (ppr fn') - - CmmCall (CmmPrim op) results args volatile -> - pprStmt (CmmCall (CmmForeignCall (CmmLit lbl) CCallConv) - results args volatile) + pp_lhs | null results = empty + | otherwise = commafy (map ppr_ar results) <+> equals + -- Don't print the hints on a native C-- call + + ppr_ar :: Outputable a => CmmHinted a -> SDoc + ppr_ar (CmmHinted ar k) = case cconv of + CmmCallConv -> ppr ar + _ -> ppr (ar,k) + pp_conv = case cconv of + CmmCallConv -> empty + _ -> ptext (sLit("foreign")) <+> doubleQuotes (ppr cconv) + + -- Call a CallishMachOp, like sin or cos that might be implemented as a library call. + CmmCall (CmmPrim op) results args safety ret -> + pprStmt (CmmCall (CmmCallee (CmmLit lbl) CCallConv) + results args safety ret) where - lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False) + -- HACK: A CallishMachOp doesn't really correspond to a ForeignLabel, but we + -- use one to get the label printed. + lbl = CmmLabel (mkForeignLabel + (mkFastString (show op)) + Nothing ForeignLabelInThisPackage IsFunction) CmmBranch ident -> genBranch ident CmmCondBranch expr ident -> genCondBranch expr ident @@ -173,6 +292,18 @@ pprStmt stmt = case stmt of CmmReturn params -> genReturn params CmmSwitch arg ids -> genSwitch arg ids +instance Outputable ForeignHint where + ppr NoHint = empty + ppr SignedHint = quotes(text "signed") +-- ppr AddrHint = quotes(text "address") +-- Temp Jan08 + ppr AddrHint = (text "PtrHint") + +-- Just look like a tuple, since it was a tuple before +-- ... is that a good idea? --Isaac Dupree +instance (Outputable a) => Outputable (CmmHinted a) where + ppr (CmmHinted a k) = ppr (a, k) + -- -------------------------------------------------------------------------- -- goto local label. [1], section 6.6 -- @@ -180,7 +311,7 @@ pprStmt stmt = case stmt of -- genBranch :: BlockId -> SDoc genBranch ident = - ptext SLIT("goto") <+> pprBlockId ident <> semi + ptext (sLit "goto") <+> ppr ident <> semi -- -------------------------------------------------------------------------- -- Conditional. [1], section 6.4 @@ -189,20 +320,19 @@ genBranch ident = -- genCondBranch :: CmmExpr -> BlockId -> SDoc genCondBranch expr ident = - hsep [ ptext SLIT("if") + hsep [ ptext (sLit "if") , parens(ppr expr) - , ptext SLIT("goto") - , pprBlockId ident <> semi ] + , ptext (sLit "goto") + , ppr ident <> semi ] -- -------------------------------------------------------------------------- -- A tail call. [1], Section 6.9 -- -- jump foo(a, b, c); -- -genJump :: CmmExpr -> [(CmmExpr, MachHint)] -> SDoc +genJump :: CmmExpr -> [CmmHinted CmmExpr] -> SDoc genJump expr args = - - hcat [ ptext SLIT("jump") + hcat [ ptext (sLit "jump") , space , if isTrivialCmmExpr expr then pprExpr expr @@ -213,15 +343,15 @@ genJump expr args = , parens ( commafy $ map ppr args ) , semi ] + -- -------------------------------------------------------------------------- -- 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") + hcat [ ptext (sLit "return") , space , parens ( commafy $ map ppr args ) , semi ] @@ -238,13 +368,13 @@ genSwitch expr maybe_ids = let pairs = groupBy snds (zip [0 .. ] maybe_ids ) - in hang (hcat [ ptext SLIT("switch [0 .. ") + in hang (hcat [ ptext (sLit "switch [0 .. ") , int (length maybe_ids - 1) - , ptext SLIT("] ") + , ptext (sLit "] ") , if isTrivialCmmExpr expr then pprExpr expr else parens (pprExpr expr) - , ptext SLIT(" {") + , ptext (sLit " {") ]) 4 (vcat ( map caseify pairs )) $$ rbrace @@ -252,15 +382,15 @@ genSwitch expr maybe_ids snds a b = (snd a) == (snd b) caseify :: [(Int,Maybe BlockId)] -> SDoc - caseify ixs@((i,Nothing):_) - = ptext SLIT("/* impossible: ") <> hcat (intersperse comma (map (int.fst) ixs)) - <> ptext SLIT(" */") + caseify ixs@((_,Nothing):_) + = ptext (sLit "/* impossible: ") <> hcat (intersperse comma (map (int.fst) ixs)) + <> ptext (sLit " */") caseify as = let (is,ids) = unzip as - in hsep [ ptext SLIT("case") + in hsep [ ptext (sLit "case") , hcat (punctuate comma (map int is)) - , ptext SLIT(": goto") - , pprBlockId (head [ id | Just id <- ids]) <> semi ] + , ptext (sLit ": goto") + , ppr (head [ id | Just id <- ids]) <> semi ] -- -------------------------------------------------------------------------- -- Expressions @@ -272,7 +402,7 @@ pprExpr e CmmRegOff reg i -> pprExpr (CmmMachOp (MO_Add rep) [CmmReg reg, CmmLit (CmmInt (fromIntegral i) rep)]) - where rep = cmmRegRep reg + where rep = typeWidth (cmmRegType reg) CmmLit lit -> pprLit lit _other -> pprExpr1 e @@ -290,16 +420,19 @@ pprExpr e -- a default conservative behaviour. -- %nonassoc '>=' '>' '<=' '<' '!=' '==' +pprExpr1, pprExpr7, pprExpr8 :: CmmExpr -> SDoc pprExpr1 (CmmMachOp op [x,y]) | Just doc <- infixMachOp1 op = pprExpr7 x <+> doc <+> pprExpr7 y pprExpr1 e = pprExpr7 e -infixMachOp1 (MO_Eq _) = Just (ptext SLIT("==")) -infixMachOp1 (MO_Ne _) = Just (ptext SLIT("!=")) -infixMachOp1 (MO_Shl _) = Just (ptext SLIT("<<")) -infixMachOp1 (MO_U_Shr _) = Just (ptext SLIT(">>")) -infixMachOp1 (MO_U_Ge _) = Just (ptext SLIT(">=")) -infixMachOp1 (MO_U_Le _) = Just (ptext SLIT("<=")) +infixMachOp1, infixMachOp7, infixMachOp8 :: MachOp -> Maybe SDoc + +infixMachOp1 (MO_Eq _) = Just (ptext (sLit "==")) +infixMachOp1 (MO_Ne _) = Just (ptext (sLit "!=")) +infixMachOp1 (MO_Shl _) = Just (ptext (sLit "<<")) +infixMachOp1 (MO_U_Shr _) = Just (ptext (sLit ">>")) +infixMachOp1 (MO_U_Ge _) = Just (ptext (sLit ">=")) +infixMachOp1 (MO_U_Le _) = Just (ptext (sLit "<=")) infixMachOp1 (MO_U_Gt _) = Just (char '>') infixMachOp1 (MO_U_Lt _) = Just (char '<') infixMachOp1 _ = Nothing @@ -331,7 +464,8 @@ pprExpr9 e = CmmLit lit -> pprLit1 lit CmmLoad expr rep -> ppr rep <> brackets( ppr expr ) CmmReg reg -> ppr reg - CmmRegOff reg off -> parens (ppr reg <+> char '+' <+> int off) + CmmRegOff reg off -> parens (ppr reg <+> char '+' <+> int off) + CmmStackSlot a off -> parens (ppr a <+> char '+' <+> int off) CmmMachOp mop args -> genMachOp mop args genMachOp :: MachOp -> [CmmExpr] -> SDoc @@ -380,18 +514,20 @@ pprLit :: CmmLit -> SDoc pprLit lit = case lit of CmmInt i rep -> hcat [ (if i < 0 then parens else id)(integer i) - , (if rep == wordRep - then empty - else space <> dcolon <+> ppr rep) ] + , ppUnless (rep == wordWidth) $ + space <> dcolon <+> ppr rep ] CmmFloat f rep -> hsep [ rational f, dcolon, ppr rep ] CmmLabel clbl -> pprCLabel clbl CmmLabelOff clbl i -> pprCLabel clbl <> ppr_offset i CmmLabelDiffOff clbl1 clbl2 i -> pprCLabel clbl1 <> char '-' <> pprCLabel clbl2 <> ppr_offset i + CmmBlock id -> ppr id + CmmHighStackMark -> text "" -pprLit1 lit@(CmmLabelOff clbl i) = parens (pprLit lit) -pprLit1 lit = pprLit lit +pprLit1 :: CmmLit -> SDoc +pprLit1 lit@(CmmLabelOff {}) = parens (pprLit lit) +pprLit1 lit = pprLit lit ppr_offset :: Int -> SDoc ppr_offset i @@ -406,7 +542,7 @@ ppr_offset i -- pprStatic :: CmmStatic -> SDoc pprStatic s = case s of - CmmStaticLit lit -> nest 4 $ ptext SLIT("const") <+> pprLit lit <> semi + CmmStaticLit lit -> nest 4 $ ptext (sLit "const") <+> pprLit lit <> semi CmmUninitialised i -> nest 4 $ text "I8" <> brackets (int i) CmmAlign i -> nest 4 $ text "align" <+> int i CmmDataLabel clbl -> pprCLabel clbl <> colon @@ -418,7 +554,7 @@ pprStatic s = case s of pprReg :: CmmReg -> SDoc pprReg r = case r of - CmmLocal local -> pprLocalReg local + CmmLocal local -> pprLocalReg local CmmGlobal global -> pprGlobalReg global -- @@ -426,54 +562,69 @@ pprReg r -- pprLocalReg :: LocalReg -> SDoc pprLocalReg (LocalReg uniq rep) - = hcat [ char '_', ppr uniq, - (if rep == wordRep - then empty else dcolon <> ppr rep) ] +-- = ppr rep <> char '_' <> ppr uniq +-- Temp Jan08 + = char '_' <> ppr uniq <> + (if isWord32 rep -- && not (isGcPtrType rep) -- Temp Jan08 -- sigh + then dcolon <> ptr <> ppr rep + else dcolon <> ptr <> ppr rep) + where + ptr = empty + --if isGcPtrType rep + -- then doubleQuotes (text "ptr") + -- else empty + +-- Stack areas +pprArea :: Area -> SDoc +pprArea (RegSlot r) = hcat [ text "slot<", ppr r, text ">" ] +pprArea (CallArea id) = pprAreaId id + +pprAreaId :: AreaId -> SDoc +pprAreaId Old = text "old" +pprAreaId (Young id) = hcat [ text "young<", ppr id, text ">" ] -- needs to be kept in syn with Cmm.hs.GlobalReg -- pprGlobalReg :: GlobalReg -> SDoc pprGlobalReg gr = case gr of - VanillaReg n -> char 'R' <> int n + VanillaReg n _ -> char 'R' <> int n +-- Temp Jan08 +-- VanillaReg n VNonGcPtr -> char 'R' <> int n +-- VanillaReg n VGcPtr -> char 'P' <> int n FloatReg n -> char 'F' <> int n DoubleReg n -> char 'D' <> int n LongReg n -> char 'L' <> int n - Sp -> ptext SLIT("Sp") - SpLim -> ptext SLIT("SpLim") - Hp -> ptext SLIT("Hp") - HpLim -> ptext SLIT("HpLim") - CurrentTSO -> ptext SLIT("CurrentTSO") - CurrentNursery -> ptext SLIT("CurrentNursery") - HpAlloc -> ptext SLIT("HpAlloc") - GCEnter1 -> ptext SLIT("stg_gc_enter_1") - GCFun -> ptext SLIT("stg_gc_fun") - BaseReg -> ptext SLIT("BaseReg") - PicBaseReg -> ptext SLIT("PicBaseReg") + Sp -> ptext (sLit "Sp") + SpLim -> ptext (sLit "SpLim") + Hp -> ptext (sLit "Hp") + HpLim -> ptext (sLit "HpLim") + CurrentTSO -> ptext (sLit "CurrentTSO") + CurrentNursery -> ptext (sLit "CurrentNursery") + HpAlloc -> ptext (sLit "HpAlloc") + EagerBlackholeInfo -> ptext (sLit "stg_EAGER_BLACKHOLE_info") + GCEnter1 -> ptext (sLit "stg_gc_enter_1") + GCFun -> ptext (sLit "stg_gc_fun") + BaseReg -> ptext (sLit "BaseReg") + PicBaseReg -> ptext (sLit "PicBaseReg") -- -------------------------------------------------------------------------- -- data sections -- pprSection :: Section -> SDoc pprSection s = case s of - Text -> section <+> doubleQuotes (ptext SLIT("text")) - Data -> section <+> doubleQuotes (ptext SLIT("data")) - ReadOnlyData -> section <+> doubleQuotes (ptext SLIT("readonly")) + Text -> section <+> doubleQuotes (ptext (sLit "text")) + Data -> section <+> doubleQuotes (ptext (sLit "data")) + ReadOnlyData -> section <+> doubleQuotes (ptext (sLit "readonly")) + ReadOnlyData16 -> section <+> doubleQuotes (ptext (sLit "readonly16")) RelocatableReadOnlyData - -> section <+> doubleQuotes (ptext SLIT("relreadonly")) - UninitialisedData -> section <+> doubleQuotes (ptext SLIT("uninitialised")) + -> section <+> doubleQuotes (ptext (sLit "relreadonly")) + UninitialisedData -> section <+> doubleQuotes (ptext (sLit "uninitialised")) OtherSection s' -> section <+> doubleQuotes (text s') where - section = ptext SLIT("section") - --- -------------------------------------------------------------------------- --- Basic block ids --- -pprBlockId :: BlockId -> SDoc -pprBlockId b = ppr $ getUnique b + section = ptext (sLit "section") ----------------------------------------------------------------------------- commafy :: [SDoc] -> SDoc -commafy xs = hsep $ punctuate comma xs - +commafy xs = fsep $ punctuate comma xs