X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=blobdiff_plain;f=compiler%2Fcmm%2FZipCfgCmmRep.hs;h=31c1fdff494a8702969232a471931f3813c09136;hp=135a219e8d02d714c777466ab9e5d347d8f12b84;hb=25628e2771424cae1b3366322e8ce6f8a85440f9;hpb=1241c26f3552a2037263769e5ef7fa68d9f3be36 diff --git a/compiler/cmm/ZipCfgCmmRep.hs b/compiler/cmm/ZipCfgCmmRep.hs index 135a219..31c1fdf 100644 --- a/compiler/cmm/ZipCfgCmmRep.hs +++ b/compiler/cmm/ZipCfgCmmRep.hs @@ -7,81 +7,106 @@ module ZipCfgCmmRep ( CmmZ, CmmTopZ, CmmGraph, CmmBlock, CmmAGraph, Middle(..), Last(..), Convention(..) - , ValueDirection(..) + , ValueDirection(..), CmmBackwardFixedPoint, CmmForwardFixedPoint + , insertBetween, pprCmmGraphLikeCmm ) where -#include "HsVersions.h" - import CmmExpr import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo - , CmmCallTarget(..), CmmActuals, CmmFormalsWithoutKinds, CmmFormals - , CmmStmt(CmmJump, CmmSwitch) -- imported in order to call ppr + , CmmCallTarget(..), CmmActuals, CmmFormals, CmmKinded(..) + , CmmStmt(..) -- imported in order to call ppr on Switch and to + -- implement pprCmmGraphLikeCmm + , CmmSafety(CmmSafe) -- for pprCmmGraphLikeCmm + , CmmReturnInfo(CmmMayReturn) -- for pprCmmGraphLikeCmm ) import PprCmm() import CLabel +import CmmZipUtil import ClosureInfo import FastString import ForeignCall import MachOp +import StackSlot +import qualified ZipCfg as Z import qualified ZipDataflow as DF import ZipCfg import MkZipCfg +import Util import Maybes +import Monad import Outputable import Prelude hiding (zip, unzip, last) +import UniqSet +import UniqSupply + +---------------------------------------------------------------------- +----- Type synonyms and definitions -type CmmGraph = LGraph Middle Last -type CmmAGraph = AGraph Middle Last -type CmmBlock = Block Middle Last -type CmmZ = GenCmm CmmStatic CmmInfo CmmGraph -type CmmTopZ = GenCmmTop CmmStatic CmmInfo CmmGraph +type CmmGraph = LGraph Middle Last +type CmmAGraph = AGraph Middle Last +type CmmBlock = Block Middle Last +type CmmZ = GenCmm CmmStatic CmmInfo CmmGraph +type CmmTopZ = GenCmmTop CmmStatic CmmInfo CmmGraph +type CmmBackwardFixedPoint a = DF.BackwardFixedPoint Middle Last a () +type CmmForwardFixedPoint a = DF.ForwardFixedPoint Middle Last a () data Middle - = MidNop - | MidComment FastString + = MidComment FastString | MidAssign CmmReg CmmExpr -- Assign to register - | MidStore CmmExpr CmmExpr -- Assign to memory location. Size is + | MidStore CmmExpr CmmExpr -- Assign to memory location. Size is -- given by cmmExprRep of the rhs. | MidUnsafeCall -- An "unsafe" foreign call; - CmmCallTarget -- just a fat machine instructoin + CmmCallTarget -- just a fat machine instruction CmmFormals -- zero or more results CmmActuals -- zero or more arguments - | CopyIn -- Move parameters or results from conventional locations to registers - -- Note [CopyIn invariant] + | MidAddToContext -- push a frame on the stack; + -- I will return to this frame + CmmExpr -- The frame's return address; it must be + -- preceded by an info table that describes the + -- live variables. + [CmmExpr] -- The frame's live variables, to go on the + -- stack with the first one at the young end + + | CopyIn -- Move incoming parameters or results from conventional + -- locations to registers. Note [CopyIn invariant] Convention CmmFormals -- eventually [CmmKind] will be used only for foreign -- calls and will migrate into 'Convention' (helping to - -- drain "the swamp") + -- drain "the swamp"), leaving this as [LocalReg] C_SRT -- Static things kept alive by this block + | CopyOut Convention CmmActuals + -- Move outgoing parameters or results from registers to + -- conventional locations. Every 'LastReturn', + -- 'LastJump', or 'LastCall' must be dominated by a + -- matching 'CopyOut' in the same basic block. + -- As above, '[CmmKind]' will migrate into the foreign calling + -- convention, leaving the actuals as '[CmmExpr]'. + deriving Eq data Last - = LastReturn CmmActuals -- Return from a function, - -- with these return values. - - | LastJump CmmExpr CmmActuals - -- Tail call to another procedure - - | LastBranch BlockId CmmFormalsWithoutKinds - -- To another block in the same procedure - -- The parameters are unused at present. - - | LastCall { -- A call (native or safe foreign) - cml_target :: CmmExpr, -- never a CmmPrim to a CallishMachOp! - cml_next :: Maybe BlockId } -- BlockId of continuation, if call returns + = LastBranch BlockId -- Goto another block in the same procedure | LastCondBranch { -- conditional branch cml_pred :: CmmExpr, cml_true, cml_false :: BlockId } + | LastReturn -- Return from a function; values in a previous CopyOut node + + | LastJump CmmExpr -- Tail call to another procedure; args in a CopyOut node + + | LastCall { -- A call (native or safe foreign); args in CopyOut node + cml_target :: CmmExpr, -- never a CmmPrim to a CallishMachOp! + cml_cont :: Maybe BlockId } -- BlockId of continuation, if call returns + | LastSwitch CmmExpr [Maybe BlockId] -- Table branch -- The scrutinee is zero-based; -- zero -> first block @@ -91,11 +116,12 @@ data Last data Convention = ConventionStandard CCallConv ValueDirection | ConventionPrivate - -- Used for control transfers within a (pre-CPS) procedure - -- All jump sites known, never pushed on the stack (hence no SRT) - -- You can choose whatever calling convention - -- you please (provided you make sure - -- all the call sites agree)! + -- Used for control transfers within a (pre-CPS) procedure All + -- jump sites known, never pushed on the stack (hence no SRT) + -- You can choose whatever calling convention you please + -- (provided you make sure all the call sites agree)! + -- This data type eventually to be extended to record the convention. + deriving Eq data ValueDirection = Arguments | Results @@ -106,29 +132,78 @@ data ValueDirection = Arguments | Results {- Note [CopyIn invariant] ~~~~~~~~~~~~~~~~~~~~~~~ -In principle, CopyIn ought to be a First node, but in practice, the +One might wish for CopyIn to be a First node, but in practice, the possibility raises all sorts of hairy issues with graph splicing, rewriting, and so on. In the end, NR finds it better to make the -placement of CopyIn a dynamic invariant. This change will complicate -the dataflow fact for the proc-point calculation, but it should make -things easier in many other respects. +placement of CopyIn a dynamic invariant; it should normally be the first +Middle node in the basic block in which it occurs. -} +---------------------------------------------------------------------- +----- Splicing between blocks +-- Given a middle node, a block, and a successor BlockId, +-- we can insert the middle node between the block and the successor. +-- We return the updated block and a list of new blocks that must be added +-- to the graph. +-- The semantics is a bit tricky. We consider cases on the last node: +-- o For a branch, we can just insert before the branch, +-- but sometimes the optimizer does better if we actually insert +-- a fresh basic block, enabling some common blockification. +-- o For a conditional branch, switch statement, or call, we must insert +-- a new basic block. +-- o For a jump, or return, this operation is impossible. + +insertBetween :: MonadUnique m => CmmBlock -> [Middle] -> BlockId -> m (CmmBlock, [CmmBlock]) +insertBetween b ms succId = insert $ goto_end $ unzip b + where insert (h, LastOther (LastBranch bid)) = + if bid == succId then + do (bid', bs) <- newBlocks + return (zipht h $ ZLast $ LastOther (LastBranch bid'), bs) + else panic "tried to insert between non-adjacent blocks" + insert (h, LastOther (LastCondBranch c t f)) = + do (t', tbs) <- if t == succId then newBlocks else return $ (t, []) + (f', fbs) <- if f == succId then newBlocks else return $ (f, []) + return (zipht h $ ZLast $ LastOther (LastCondBranch c t' f'), tbs ++ fbs) + insert (h, LastOther (LastCall e (Just k))) = + if k == succId then + do (id', bs) <- newBlocks + return (zipht h $ ZLast $ LastOther (LastCall e (Just id')), bs) + else panic "tried to insert between non-adjacent blocks" + insert (_, LastOther (LastCall _ Nothing)) = + panic "cannot insert after non-returning call" + insert (h, LastOther (LastSwitch e ks)) = + do (ids, bs) <- mapAndUnzipM mbNewBlocks ks + return (zipht h $ ZLast $ LastOther (LastSwitch e ids), join bs) + insert (_, LastOther LastReturn) = panic "cannot insert after return" + insert (_, LastOther (LastJump _)) = panic "cannot insert after jump" + insert (_, LastExit) = panic "cannot insert after exit" + newBlocks = do id <- liftM BlockId $ getUniqueM + return $ (id, [Block id $ + foldr ZTail (ZLast (LastOther (LastBranch succId))) ms]) + mbNewBlocks (Just k) = if k == succId then liftM lift newBlocks + else return (Just k, []) + mbNewBlocks Nothing = return (Nothing, []) + lift (id, bs) = (Just id, bs) + + +---------------------------------------------------------------------- +----- Instance declarations for control flow + instance HavingSuccessors Last where succs = cmmSuccs fold_succs = fold_cmm_succs instance LastNode Last where - mkBranchNode id = LastBranch id [] - isBranchNode (LastBranch _ []) = True + mkBranchNode id = LastBranch id + isBranchNode (LastBranch _) = True isBranchNode _ = False - branchNodeTarget (LastBranch id []) = id + branchNodeTarget (LastBranch id) = id branchNodeTarget _ = panic "asked for target of non-branch" cmmSuccs :: Last -> [BlockId] cmmSuccs (LastReturn {}) = [] cmmSuccs (LastJump {}) = [] -cmmSuccs (LastBranch id _) = [id] +cmmSuccs (LastBranch id) = [id] cmmSuccs (LastCall _ (Just id)) = [id] cmmSuccs (LastCall _ Nothing) = [] cmmSuccs (LastCondBranch _ t f) = [f, t] -- meets layout constraint @@ -137,15 +212,57 @@ cmmSuccs (LastSwitch _ edges) = catMaybes edges fold_cmm_succs :: (BlockId -> a -> a) -> Last -> a -> a fold_cmm_succs _f (LastReturn {}) z = z fold_cmm_succs _f (LastJump {}) z = z -fold_cmm_succs f (LastBranch id _) z = f id z +fold_cmm_succs f (LastBranch id) z = f id z fold_cmm_succs f (LastCall _ (Just id)) z = f id z fold_cmm_succs _f (LastCall _ Nothing) z = z fold_cmm_succs f (LastCondBranch _ te fe) z = f te (f fe z) fold_cmm_succs f (LastSwitch _ edges) z = foldl (flip f) z $ catMaybes edges - ----------------------------------------------------------------- --- prettyprinting (avoids recursive imports) +---------------------------------------------------------------------- +----- Instance declarations for register use + +instance UserOfLocalRegs Middle where + foldRegsUsed f z m = middle m + where middle (MidComment {}) = z + middle (MidAssign _lhs expr) = fold f z expr + middle (MidStore addr rval) = fold f (fold f z addr) rval + middle (MidUnsafeCall tgt _ress args) = fold f (fold f z tgt) args + middle (MidAddToContext ra args) = fold f (fold f z ra) args + middle (CopyIn _ _formals _) = z + middle (CopyOut _ actuals) = fold f z actuals + fold f z m = foldRegsUsed f z m -- avoid monomorphism restriction + +instance UserOfLocalRegs Last where + foldRegsUsed f z l = last l + where last (LastReturn) = z + last (LastJump e) = foldRegsUsed f z e + last (LastBranch _id) = z + last (LastCall tgt _) = foldRegsUsed f z tgt + last (LastCondBranch e _ _) = foldRegsUsed f z e + last (LastSwitch e _tbl) = foldRegsUsed f z e + +instance DefinerOfLocalRegs Middle where + foldRegsDefd f z m = middle m + where middle (MidComment {}) = z + middle (MidAssign _lhs _) = fold f z _lhs + middle (MidStore _ _) = z + middle (MidUnsafeCall _ _ _) = z + middle (MidAddToContext _ _) = z + middle (CopyIn _ _formals _) = fold f z _formals + middle (CopyOut _ _) = z + fold f z m = foldRegsDefd f z m -- avoid monomorphism restriction + +instance DefinerOfLocalRegs Last where + foldRegsDefd _ z l = last l + where last (LastReturn) = z + last (LastJump _) = z + last (LastBranch _) = z + last (LastCall _ _) = z + last (LastCondBranch _ _ _) = z + last (LastSwitch _ _) = z + +---------------------------------------------------------------------- +----- Instance declarations for prettyprinting (avoids recursive imports) instance Outputable Middle where ppr s = pprMiddle s @@ -158,26 +275,22 @@ instance Outputable Convention where instance DF.DebugNodes Middle Last -instance Outputable CmmGraph where - ppr = pprLgraph - debugPpr :: Bool debugPpr = debugIsOn pprMiddle :: Middle -> SDoc -pprMiddle stmt = (case stmt of - - MidNop -> semi +pprMiddle stmt = pp_stmt <+> pp_debug + where + pp_stmt = case stmt of CopyIn conv args _ -> - if null args then ptext SLIT("empty CopyIn") - else commafy (map pprHinted args) <+> equals <+> - ptext SLIT("foreign") <+> doubleQuotes(ppr conv) <+> ptext SLIT("...") + if null args then ptext (sLit "empty CopyIn") + else commafy (map pprKinded args) <+> equals <+> + ptext (sLit "foreign") <+> doubleQuotes(ppr conv) <+> ptext (sLit "...") CopyOut conv args -> - if null args then empty - else ptext SLIT("CopyOut") <+> doubleQuotes(ppr conv) <+> - parens (commafy (map pprHinted args)) + ptext (sLit "PreCopyOut: next, pass") <+> doubleQuotes(ppr conv) <+> + parens (commafy (map pprKinded args)) -- // text MidComment s -> text "//" <+> ftext s @@ -196,46 +309,53 @@ pprMiddle stmt = (case stmt of hcat [ if null results then empty else parens (commafy $ map ppr results) <> - ptext SLIT(" = "), - ptext SLIT("call"), space, + ptext (sLit " = "), + ptext (sLit "call"), space, doubleQuotes(ppr cconv), space, - target fn, parens ( commafy $ map ppr args ), + ppr_target fn, parens ( commafy $ map ppr args ), semi ] - where - target t@(CmmLit _) = ppr t - target fn' = parens (ppr fn') MidUnsafeCall (CmmPrim op) results args -> pprMiddle (MidUnsafeCall (CmmCallee (CmmLit lbl) CCallConv) results args) where lbl = CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False) - ) <> - if debugPpr then empty - else text " //" <+> - case stmt of - MidNop {} -> text "MidNop" - CopyIn {} -> text "CopyIn" - CopyOut {} -> text "CopyOut" - MidComment {} -> text "MidComment" - MidAssign {} -> text "MidAssign" - MidStore {} -> text "MidStore" - MidUnsafeCall {} -> text "MidUnsafeCall" + MidAddToContext ra args -> + hcat [ ptext (sLit "return via ") + , ppr_target ra, parens (commafy $ map ppr args), semi ] -pprHinted :: Outputable a => (a, MachHint) -> SDoc -pprHinted (a, NoHint) = ppr a -pprHinted (a, PtrHint) = doubleQuotes (text "address") <+> ppr a -pprHinted (a, SignedHint) = doubleQuotes (text "signed") <+> ppr a -pprHinted (a, FloatHint) = doubleQuotes (text "float") <+> ppr a + pp_debug = + if not debugPpr then empty + else text " //" <+> + case stmt of + CopyIn {} -> text "CopyIn" + CopyOut {} -> text "CopyOut" + MidComment {} -> text "MidComment" + MidAssign {} -> text "MidAssign" + MidStore {} -> text "MidStore" + MidUnsafeCall {} -> text "MidUnsafeCall" + MidAddToContext {} -> text "MidAddToContext" + + +ppr_target :: CmmExpr -> SDoc +ppr_target t@(CmmLit _) = ppr t +ppr_target fn' = parens (ppr fn') + + +pprKinded :: Outputable a => CmmKinded a -> SDoc +pprKinded (CmmKinded a NoHint) = ppr a +pprKinded (CmmKinded a PtrHint) = doubleQuotes (text "address") <+> ppr a +pprKinded (CmmKinded a SignedHint) = doubleQuotes (text "signed") <+> ppr a +pprKinded (CmmKinded a FloatHint) = doubleQuotes (text "float") <+> ppr a pprLast :: Last -> SDoc pprLast stmt = (case stmt of - LastBranch ident args -> genBranchWithArgs ident args + LastBranch ident -> ptext (sLit "goto") <+> ppr ident <> semi LastCondBranch expr t f -> genFullCondBranch expr t f - LastJump expr params -> ppr $ CmmJump expr params - LastReturn results -> hcat [ ptext SLIT("return"), space - , parens ( commafy $ map pprHinted results ) - , semi ] + LastJump expr -> hcat [ ptext (sLit "jump"), space, pprFun expr + , ptext (sLit "(...)"), semi] + LastReturn -> hcat [ ptext (sLit "return"), space + , ptext (sLit "(...)"), semi] LastSwitch arg ids -> ppr $ CmmSwitch arg ids LastCall tgt k -> genBareCall tgt k ) <> @@ -251,28 +371,24 @@ pprLast stmt = (case stmt of genBareCall :: CmmExpr -> Maybe BlockId -> SDoc genBareCall fn k = - hcat [ ptext SLIT("foreign"), space - , doubleQuotes(ptext SLIT("")), space - , target fn, parens ( ptext SLIT("") ), space - , case k of Nothing -> ptext SLIT("never returns") - Just k -> ptext SLIT("returns to") <+> ppr k + hcat [ ptext (sLit "call"), space + , pprFun fn, ptext (sLit "(...)"), space + , case k of Nothing -> ptext (sLit "never returns") + Just k -> ptext (sLit "returns to") <+> ppr k , semi ] where - target t@(CmmLit _) = ppr t - target fn' = parens (ppr fn') -genBranchWithArgs :: (Outputable id, Outputable arg) => id -> [arg] -> SDoc -genBranchWithArgs ident [] = ptext SLIT("goto") <+> ppr ident <> semi -genBranchWithArgs ident args = ptext SLIT("goto") <+> ppr ident <+> - parens (commafy (map ppr args)) <> semi +pprFun :: CmmExpr -> SDoc +pprFun f@(CmmLit _) = ppr f +pprFun f = parens (ppr f) genFullCondBranch :: Outputable id => CmmExpr -> id -> id -> SDoc genFullCondBranch expr t f = - hsep [ ptext SLIT("if") + hsep [ ptext (sLit "if") , parens(ppr expr) - , ptext SLIT("goto") + , ptext (sLit "goto") , ppr t <> semi - , ptext SLIT("else goto") + , ptext (sLit "else goto") , ppr f <> semi ] @@ -282,3 +398,114 @@ pprConvention (ConventionPrivate {} ) = text "" commafy :: [SDoc] -> SDoc commafy xs = hsep $ punctuate comma xs + + +---------------------------------------------------------------- +-- | The purpose of this function is to print a Cmm zipper graph "as if it were" +-- a Cmm program. The objective is dodgy, so it's unsurprising parts of the +-- code are dodgy as well. + +pprCmmGraphLikeCmm :: CmmGraph -> SDoc +pprCmmGraphLikeCmm g = vcat (swallow blocks) + where blocks = Z.postorder_dfs g + swallow :: [CmmBlock] -> [SDoc] + swallow [] = [] + swallow (Z.Block id t : rest) = tail id [] Nothing t rest + tail id prev' out (Z.ZTail (CopyOut conv args) t) rest = + if isJust out then panic "multiple CopyOut nodes in one basic block" + else + tail id (prev') (Just (conv, args)) t rest + tail id prev' out (Z.ZTail m t) rest = tail id (mid m : prev') out t rest + tail id prev' out (Z.ZLast Z.LastExit) rest = exit id prev' out rest + tail id prev' out (Z.ZLast (Z.LastOther l)) rest = last id prev' out l rest + mid (CopyIn _ [] _) = text "// proc point (no parameters)" + mid m@(CopyIn {}) = ppr m <+> text "(proc point)" + mid m = ppr m + block' id prev' + | id == Z.lg_entry g, entry_has_no_pred = + vcat (text "" : reverse prev') + | otherwise = hang (ppr id <> colon) 4 (vcat (reverse prev')) + last id prev' out l n = + let endblock stmt = block' id (stmt : prev') : swallow n in + case l of + LastBranch tgt -> + case n of + Z.Block id' t : bs + | tgt == id', unique_pred id' + -> tail id prev' out t bs -- optimize out redundant labels + _ -> endblock (ppr $ CmmBranch tgt) + l@(LastCondBranch expr tid fid) -> + let ft id = text "// fall through to " <> ppr id in + case n of + Z.Block id' t : bs + | id' == fid, isNothing out -> + tail id (ft fid : ppr (CmmCondBranch expr tid) : prev') Nothing t bs + | id' == tid, Just e' <- maybeInvertCmmExpr expr, isNothing out-> + tail id (ft tid : ppr (CmmCondBranch e' fid) : prev') Nothing t bs + _ -> endblock $ with_out out l + l@(LastJump {}) -> endblock $ with_out out l + l@(LastReturn {}) -> endblock $ with_out out l + l@(LastSwitch {}) -> endblock $ with_out out l + l@(LastCall _ Nothing) -> endblock $ with_out out l + l@(LastCall tgt (Just k)) + | Z.Block id' (Z.ZTail (CopyIn _ ress srt) t) : bs <- n, + Just (conv, args) <- out, + id' == k -> + let call = CmmCall tgt' ress args (CmmSafe srt) CmmMayReturn + tgt' = CmmCallee tgt (cconv_of_conv conv) + ppcall = ppr call <+> parens (text "ret to" <+> ppr k) + in if unique_pred k then + tail id (ppcall : prev') Nothing t bs + else + endblock (ppcall) + | Z.Block id' t : bs <- n, id' == k, unique_pred k, + Just (conv, args) <- out, + Just (ress, srt) <- findCopyIn t -> + let call = CmmCall tgt' ress args (CmmSafe srt) CmmMayReturn + tgt' = CmmCallee tgt (cconv_of_conv conv) + delayed = + ptext (sLit "// delayed CopyIn follows previous call") + in tail id (delayed : ppr call : prev') Nothing t bs + | otherwise -> endblock $ with_out out l + findCopyIn (Z.ZTail (CopyIn _ ress srt) _) = Just (ress, srt) + findCopyIn (Z.ZTail _ t) = findCopyIn t + findCopyIn (Z.ZLast _) = Nothing + exit id prev' out n = -- highly irregular (assertion violation?) + let endblock stmt = block' id (stmt : prev') : swallow n in + case out of Nothing -> endblock (text "// ") + Just (conv, args) -> endblock (ppr (CopyOut conv args) $$ + text "// ") + preds = zipPreds g + entry_has_no_pred = case lookupBlockEnv preds (Z.lg_entry g) of + Nothing -> True + Just s -> isEmptyUniqSet s + single_preds = + let add b single = + let id = Z.blockId b + in case lookupBlockEnv preds id of + Nothing -> single + Just s -> if sizeUniqSet s == 1 then + extendBlockSet single id + else single + in Z.fold_blocks add emptyBlockSet g + unique_pred id = elemBlockSet id single_preds + cconv_of_conv (ConventionStandard conv _) = conv + cconv_of_conv (ConventionPrivate {}) = CmmCallConv -- XXX totally bogus + +with_out :: Maybe (Convention, CmmActuals) -> Last -> SDoc +with_out Nothing l = ptext (sLit "??no-arguments??") <+> ppr l +with_out (Just (conv, args)) l = last l + where last (LastCall e k) = + hcat [ptext (sLit "... = foreign "), + doubleQuotes(ppr conv), space, + ppr_target e, parens ( commafy $ map ppr args ), + ptext (sLit " \"safe\""), + case k of Nothing -> ptext (sLit " never returns") + Just _ -> empty, + semi ] + last (LastReturn) = ppr (CmmReturn args) + last (LastJump e) = ppr (CmmJump e args) + last l = ppr (CopyOut conv args) $$ ppr l + ppr_target (CmmLit lit) = ppr lit + ppr_target fn' = parens (ppr fn') + commafy xs = hsep $ punctuate comma xs