compiler/cmm/ZipCfgCmmRep.hs

   1 -- This module is pure representation and should be imported only by
   2 -- clients that need to manipulate representation and know what
   3 -- they're doing.  Clients that need to create flow graphs should
   4 -- instead import MkZipCfgCmm.
   5
   6 module ZipCfgCmmRep
   7   ( CmmZ, CmmTopZ, CmmGraph, CmmBlock, CmmAGraph
   8   , Middle(..), Last(..), MidCallTarget(..), UpdFrameOffset
   9   , Convention(..), ForeignConvention(..), ForeignSafety(..)
  10   , ValueDirection(..), ForeignHint(..)
  11   , CmmBackwardFixedPoint, CmmForwardFixedPoint, pprHinted
  12   , insertBetween, mapExpMiddle, mapExpLast, mapExpDeepMiddle, mapExpDeepLast
  13   , foldExpMiddle, foldExpLast, foldExpDeepMiddle, foldExpDeepLast, joinOuts
  14   )
  15 where
  16
  17 import BlockId
  18 import CmmExpr
  19 import Cmm ( GenCmm(..), GenCmmTop(..), CmmStatic, CmmInfo
  20            , CallishMachOp(..), ForeignHint(..)
  21            , CmmActuals, CmmFormals, CmmHinted(..)
  22            , CmmStmt(..) -- imported in order to call ppr on Switch and to
  23                          -- implement pprCmmGraphLikeCmm
  24            )
  25 import DFMonad
  26 import PprCmm()
  27 import CmmTx
  28
  29 import CLabel
  30 import FastString
  31 import ForeignCall
  32 import qualified ZipCfg as Z
  33 import qualified ZipDataflow as DF
  34 import ZipCfg
  35 import MkZipCfg
  36 import Util
  37
  38 import Maybes
  39 import Monad
  40 import Outputable
  41 import Prelude hiding (zip, unzip, last)
  42 import qualified Data.List as L
  43 import SMRep (ByteOff)
  44 import UniqSupply
  45
  46 ----------------------------------------------------------------------
  47 ----- Type synonyms and definitions
  48
  49 type CmmGraph                = LGraph Middle Last
  50 type CmmAGraph               = AGraph Middle Last
  51 type CmmBlock                = Block  Middle Last
  52 type CmmZ                    = GenCmm    CmmStatic CmmInfo CmmGraph
  53 type CmmTopZ                 = GenCmmTop CmmStatic CmmInfo CmmGraph
  54 type CmmBackwardFixedPoint a = DF.BackwardFixedPoint Middle Last a ()
  55 type CmmForwardFixedPoint  a = DF.ForwardFixedPoint  Middle Last a ()
  56
  57 type UpdFrameOffset = ByteOff
  58
  59 data Middle
  60   = MidComment FastString
  61
  62   | MidAssign CmmReg CmmExpr     -- Assign to register
  63
  64   | MidStore  CmmExpr CmmExpr    -- Assign to memory location.  Size is
  65                                  -- given by cmmExprType of the rhs.
  66
  67   | MidForeignCall               -- A foreign call;
  68      ForeignSafety               -- Is it a safe or unsafe call?
  69      MidCallTarget               -- call target and convention
  70      CmmFormals                  -- zero or more results
  71      CmmActuals                  -- zero or more arguments
  72   deriving Eq
  73
  74 data Last
  75   = LastBranch BlockId  -- Goto another block in the same procedure
  76
  77   | LastCondBranch {            -- conditional branch
  78         cml_pred :: CmmExpr,
  79         cml_true, cml_false :: BlockId
  80     }
  81   | LastSwitch CmmExpr [Maybe BlockId]   -- Table branch
  82         -- The scrutinee is zero-based;
  83         --      zero -> first block
  84         --      one  -> second block etc
  85         -- Undefined outside range, and when there's a Nothing
  86   | LastCall {                   -- A call (native or safe foreign)
  87         cml_target  :: CmmExpr,  -- never a CmmPrim to a CallishMachOp!
  88         cml_cont    :: Maybe BlockId,
  89             -- BlockId of continuation (Nothing for return or tail call)
  90         cml_args    :: ByteOff,  -- byte offset for youngest outgoing arg
  91                                  -- (includes update frame, which must be younger)
  92         cml_ret_off :: Maybe UpdFrameOffset}
  93           -- stack offset for return (update frames);
  94           -- The return offset should be Nothing only if we have to create
  95           -- a new call, e.g. for a procpoint, in which case it's an invariant
  96           -- that the call does not stand for a return or a tail call,
  97           -- and the successor does not need an info table.
  98
  99 data MidCallTarget      -- The target of a MidUnsafeCall
 100   = ForeignTarget       -- A foreign procedure
 101         CmmExpr                 -- Its address
 102         ForeignConvention       -- Its calling convention
 103
 104   | PrimTarget          -- A possibly-side-effecting machine operation
 105         CallishMachOp           -- Which one
 106   deriving Eq
 107
 108 data Convention
 109   = Native              -- Native C-- call/return
 110
 111   | Slow                -- Slow entry points: all args pushed on the stack
 112
 113   | GC                  -- Entry to the garbage collector: uses the node reg!
 114
 115   | PrimOp              -- Calling prim ops
 116
 117   | Foreign             -- Foreign call/return
 118         ForeignConvention
 119
 120   | Private
 121         -- Used for control transfers within a (pre-CPS) procedure All
 122         -- jump sites known, never pushed on the stack (hence no SRT)
 123         -- You can choose whatever calling convention you please
 124         -- (provided you make sure all the call sites agree)!
 125         -- This data type eventually to be extended to record the convention.
 126   deriving( Eq )
 127
 128 data ForeignConvention
 129   = ForeignConvention
 130         CCallConv               -- Which foreign-call convention
 131         [ForeignHint]           -- Extra info about the args
 132         [ForeignHint]           -- Extra info about the result
 133   deriving Eq
 134
 135 data ForeignSafety
 136   = Unsafe              -- unsafe call
 137   | Safe BlockId        -- making infotable requires: 1. label
 138          UpdFrameOffset --                            2. where the upd frame is
 139   deriving Eq
 140
 141 data ValueDirection = Arguments | Results
 142   -- Arguments go with procedure definitions, jumps, and arguments to calls
 143   -- Results go with returns and with results of calls.
 144   deriving Eq
 145
 146 ----------------------------------------------------------------------
 147 ----- Splicing between blocks
 148 -- Given a middle node, a block, and a successor BlockId,
 149 -- we can insert the middle node between the block and the successor.
 150 -- We return the updated block and a list of new blocks that must be added
 151 -- to the graph.
 152 -- The semantics is a bit tricky. We consider cases on the last node:
 153 -- o For a branch, we can just insert before the branch,
 154 --   but sometimes the optimizer does better if we actually insert
 155 --   a fresh basic block, enabling some common blockification.
 156 -- o For a conditional branch, switch statement, or call, we must insert
 157 --   a new basic block.
 158 -- o For a jump or return, this operation is impossible.
 159
 160 insertBetween :: MonadUnique m => CmmBlock -> [Middle] -> BlockId -> m (CmmBlock, [CmmBlock])
 161 insertBetween b ms succId = insert $ goto_end $ unzip b
 162   where insert (h, LastOther (LastBranch bid)) =
 163           if bid == succId then
 164             do (bid', bs) <- newBlocks
 165                return (zipht h (ZLast (LastOther (LastBranch bid'))), bs)
 166           else panic "tried invalid block insertBetween"
 167         insert (h, LastOther (LastCondBranch c t f)) =
 168           do (t', tbs) <- if t == succId then newBlocks else return $ (t, [])
 169              (f', fbs) <- if f == succId then newBlocks else return $ (f, [])
 170              return (zipht h $ ZLast $ LastOther (LastCondBranch c t' f'), tbs ++ fbs)
 171         insert (h, LastOther (LastSwitch e ks)) =
 172           do (ids, bs) <- mapAndUnzipM mbNewBlocks ks
 173              return (zipht h $ ZLast $ LastOther (LastSwitch e ids), join bs)
 174         insert (_, LastOther (LastCall {})) =
 175           panic "unimp: insertBetween after a call -- probably not a good idea"
 176         insert (_, LastExit) = panic "cannot insert after exit"
 177         newBlocks = do id <- liftM BlockId $ getUniqueM
 178                        return $ (id, [Block id emptyStackInfo $
 179                                    foldr ZTail (ZLast (LastOther (LastBranch succId))) ms])
 180         mbNewBlocks (Just k) = if k == succId then liftM lift newBlocks
 181                                else return (Just k, [])
 182         mbNewBlocks Nothing  = return (Nothing, [])
 183         lift (id, bs) = (Just id, bs)
 184
 185 ----------------------------------------------------------------------
 186 ----- Instance declarations for control flow
 187
 188 instance HavingSuccessors Last where
 189     succs = cmmSuccs
 190     fold_succs = fold_cmm_succs
 191
 192 instance LastNode Last where
 193     mkBranchNode id = LastBranch id
 194     isBranchNode (LastBranch _) = True
 195     isBranchNode _ = False
 196     branchNodeTarget (LastBranch id) = id
 197     branchNodeTarget _ = panic "asked for target of non-branch"
 198
 199 cmmSuccs :: Last -> [BlockId]
 200 cmmSuccs (LastBranch id)            = [id]
 201 cmmSuccs (LastCall _ Nothing _ _)   = []
 202 cmmSuccs (LastCall _ (Just id) _ _) = [id]
 203 cmmSuccs (LastCondBranch _ t f)     = [f, t]  -- meets layout constraint
 204 cmmSuccs (LastSwitch _ edges)       = catMaybes edges
 205
 206 fold_cmm_succs :: (BlockId -> a -> a) -> Last -> a -> a
 207 fold_cmm_succs  f (LastBranch id)            z = f id z
 208 fold_cmm_succs  _ (LastCall _ Nothing _ _)   z = z
 209 fold_cmm_succs  f (LastCall _ (Just id) _ _) z = f id z
 210 fold_cmm_succs  f (LastCondBranch _ te fe)   z = f te (f fe z)
 211 fold_cmm_succs  f (LastSwitch _ edges)       z = foldl (flip f) z $ catMaybes edges
 212
 213 ----------------------------------------------------------------------
 214 ----- Instance declarations for register use
 215
 216 instance UserOfLocalRegs Middle where
 217     foldRegsUsed f z m = middle m
 218       where middle (MidComment {})               = z
 219             middle (MidAssign _lhs expr)         = fold f z expr
 220             middle (MidStore addr rval)          = fold f (fold f z addr) rval
 221             middle (MidForeignCall _ tgt _ args) = fold f (fold f z tgt) args
 222             fold f z m = foldRegsUsed f z m  -- avoid monomorphism restriction
 223
 224 instance UserOfLocalRegs MidCallTarget where
 225   foldRegsUsed _f z (PrimTarget _)      = z
 226   foldRegsUsed f  z (ForeignTarget e _) = foldRegsUsed f z e
 227
 228 instance UserOfSlots MidCallTarget where
 229   foldSlotsUsed _f z (PrimTarget _)      = z
 230   foldSlotsUsed f  z (ForeignTarget e _) = foldSlotsUsed f z e
 231
 232 instance (UserOfLocalRegs a) => UserOfLocalRegs (Maybe a) where
 233   foldRegsUsed f z (Just x) = foldRegsUsed f z x
 234   foldRegsUsed _ z Nothing  = z
 235
 236 instance (UserOfSlots a) => UserOfSlots (Maybe a) where
 237   foldSlotsUsed f z (Just x) = foldSlotsUsed f z x
 238   foldSlotsUsed _ z Nothing  = z
 239
 240 instance UserOfLocalRegs Last where
 241     foldRegsUsed f z l = last l
 242       where last (LastBranch _id)       = z
 243             last (LastCall tgt _ _ _)   = foldRegsUsed f z tgt
 244             last (LastCondBranch e _ _) = foldRegsUsed f z e
 245             last (LastSwitch e _tbl)    = foldRegsUsed f z e
 246
 247 instance DefinerOfLocalRegs Middle where
 248     foldRegsDefd f z m = middle m
 249       where middle (MidComment {})            = z
 250             middle (MidAssign _lhs _)         = fold f z _lhs
 251             middle (MidStore _ _)             = z
 252             middle (MidForeignCall _ _ fs _)  = fold f z fs
 253             fold f z m = foldRegsDefd f z m  -- avoid monomorphism restriction
 254
 255 instance DefinerOfLocalRegs Last where
 256     foldRegsDefd _ z _ = z
 257
 258
 259 ----------------------------------------------------------------------
 260 ----- Instance declarations for stack slot use
 261
 262 instance UserOfSlots Middle where
 263     foldSlotsUsed f z m = middle m
 264       where middle (MidComment {})                   = z
 265             middle (MidAssign _lhs expr)             = fold f z expr
 266             middle (MidStore addr rval)              = fold f (fold f z addr) rval
 267             middle (MidForeignCall _ tgt _ress args) = fold f (fold f z tgt) args
 268             fold f z e = foldSlotsUsed f z e  -- avoid monomorphism restriction
 269
 270 instance UserOfSlots Last where
 271     foldSlotsUsed f z l = last l
 272       where last (LastBranch _id)       = z
 273             last (LastCall tgt _ _ _)   = foldSlotsUsed f z tgt
 274             last (LastCondBranch e _ _) = foldSlotsUsed f z e
 275             last (LastSwitch e _tbl)    = foldSlotsUsed f z e
 276
 277 instance UserOfSlots l => UserOfSlots (ZLast l) where
 278     foldSlotsUsed f z (LastOther l) = foldSlotsUsed f z l
 279     foldSlotsUsed _ z LastExit      = z
 280
 281 instance DefinerOfSlots Middle where
 282     foldSlotsDefd f z m = middle m
 283       where middle (MidComment {})    = z
 284             middle (MidAssign _ _)    = z
 285             middle (MidForeignCall {}) = z
 286             middle (MidStore (CmmStackSlot a i) e) =
 287               f z (a, i, widthInBytes $ typeWidth $ cmmExprType e)
 288             middle (MidStore _ _)     = z
 289
 290 instance DefinerOfSlots Last where
 291     foldSlotsDefd _ z _ = z
 292
 293 instance DefinerOfSlots l => DefinerOfSlots (ZLast l) where
 294     foldSlotsDefd f z (LastOther l) = foldSlotsDefd f z l
 295     foldSlotsDefd _ z LastExit      = z
 296
 297 ----------------------------------------------------------------------
 298 ----- Code for manipulating Middle and Last nodes
 299
 300 mapExpMiddle :: (CmmExpr -> CmmExpr) -> Middle -> Middle
 301 mapExpMiddle _   m@(MidComment _)            = m
 302 mapExpMiddle exp   (MidAssign r e)           = MidAssign r (exp e)
 303 mapExpMiddle exp   (MidStore addr e)         = MidStore (exp addr) (exp e)
 304 mapExpMiddle exp   (MidForeignCall s tgt fs as) =
 305   MidForeignCall s (mapExpMidcall exp tgt) fs (map exp as)
 306
 307 foldExpMiddle :: (CmmExpr -> z -> z) -> Middle -> z -> z
 308 foldExpMiddle _   (MidComment _)              z = z
 309 foldExpMiddle exp (MidAssign _ e)             z = exp e z
 310 foldExpMiddle exp (MidStore addr e)           z = exp addr $ exp e z
 311 foldExpMiddle exp (MidForeignCall _ tgt _ as) z = foldExpMidcall exp tgt $ foldr exp z as
 312
 313 mapExpLast :: (CmmExpr -> CmmExpr) -> Last -> Last
 314 mapExpLast _   l@(LastBranch _)           = l
 315 mapExpLast exp (LastCondBranch e ti fi)   = LastCondBranch (exp e) ti fi
 316 mapExpLast exp (LastSwitch e tbl)         = LastSwitch (exp e) tbl
 317 mapExpLast exp (LastCall tgt mb_id u s) = LastCall (exp tgt) mb_id u s
 318
 319 foldExpLast :: (CmmExpr -> z -> z) -> Last -> z -> z
 320 foldExpLast _   (LastBranch _)         z = z
 321 foldExpLast exp (LastCondBranch e _ _) z = exp e z
 322 foldExpLast exp (LastSwitch e _)       z = exp e z
 323 foldExpLast exp (LastCall tgt _ _ _)   z = exp tgt z
 324
 325 mapExpMidcall :: (CmmExpr -> CmmExpr) -> MidCallTarget -> MidCallTarget
 326 mapExpMidcall exp   (ForeignTarget e c) = ForeignTarget (exp e) c
 327 mapExpMidcall _   m@(PrimTarget _)      = m
 328
 329 foldExpMidcall :: (CmmExpr -> z -> z) -> MidCallTarget -> z -> z
 330 foldExpMidcall exp (ForeignTarget e _) z = exp e z
 331 foldExpMidcall _   (PrimTarget _)      z = z
 332
 333 -- Take a transformer on expressions and apply it recursively.
 334 wrapRecExp :: (CmmExpr -> CmmExpr) -> CmmExpr -> CmmExpr
 335 wrapRecExp f (CmmMachOp op es)    = f (CmmMachOp op $ map (wrapRecExp f) es)
 336 wrapRecExp f (CmmLoad addr ty)    = f (CmmLoad (wrapRecExp f addr) ty)
 337 wrapRecExp f e                    = f e
 338
 339 mapExpDeepMiddle :: (CmmExpr -> CmmExpr) -> Middle -> Middle
 340 mapExpDeepLast   :: (CmmExpr -> CmmExpr) -> Last   -> Last
 341 mapExpDeepMiddle f = mapExpMiddle $ wrapRecExp f
 342 mapExpDeepLast   f = mapExpLast   $ wrapRecExp f
 343
 344 -- Take a folder on expressions and apply it recursively.
 345 wrapRecExpf :: (CmmExpr -> z -> z) -> CmmExpr -> z -> z
 346 wrapRecExpf f e@(CmmMachOp _ es) z = foldr (wrapRecExpf f) (f e z) es
 347 wrapRecExpf f e@(CmmLoad addr _) z = wrapRecExpf f addr (f e z)
 348 wrapRecExpf f e                  z = f e z
 349
 350 foldExpDeepMiddle :: (CmmExpr -> z -> z) -> Middle -> z -> z
 351 foldExpDeepLast   :: (CmmExpr -> z -> z) -> Last   -> z -> z
 352 foldExpDeepMiddle f = foldExpMiddle $ wrapRecExpf f
 353 foldExpDeepLast   f = foldExpLast   $ wrapRecExpf f
 354
 355 ----------------------------------------------------------------------
 356 -- Compute the join of facts live out of a Last node. Useful for most backward
 357 -- analyses.
 358 joinOuts :: DataflowLattice a -> (BlockId -> a) -> Last -> a
 359 joinOuts lattice env l =
 360   let bot  = fact_bot lattice
 361       join x y = txVal $ fact_add_to lattice x y
 362   in case l of
 363        (LastBranch id)           -> env id
 364        (LastCall _ Nothing _ _)  -> bot
 365        (LastCall _ (Just k) _ _) -> env k
 366        (LastCondBranch _ t f)    -> join (env t) (env f)
 367        (LastSwitch _ tbl)        -> foldr join bot (map env $ catMaybes tbl)
 368
 369 ----------------------------------------------------------------------
 370 ----- Instance declarations for prettyprinting (avoids recursive imports)
 371
 372 instance Outputable Middle where
 373     ppr s = pprMiddle s
 374
 375 instance Outputable Last where
 376     ppr s = pprLast s
 377
 378 instance Outputable Convention where
 379     ppr = pprConvention
 380
 381 instance Outputable ForeignConvention where
 382     ppr = pprForeignConvention
 383
 384 instance Outputable ValueDirection where
 385     ppr Arguments = ptext $ sLit "args"
 386     ppr Results   = ptext $ sLit "results"
 387
 388 instance DF.DebugNodes Middle Last
 389
 390 debugPpr :: Bool
 391 debugPpr = debugIsOn
 392
 393 pprMiddle :: Middle -> SDoc
 394 pprMiddle stmt = pp_stmt <+> pp_debug
 395   where
 396     pp_stmt = case stmt of
 397         --  // text
 398         MidComment s -> text "//" <+> ftext s
 399
 400         -- reg = expr;
 401         MidAssign reg expr -> ppr reg <+> equals <+> ppr expr <> semi
 402
 403         -- rep[lv] = expr;
 404         MidStore lv expr -> rep <> brackets(ppr lv) <+> equals <+> ppr expr <> semi
 405             where
 406               rep = ppr ( cmmExprType expr )
 407
 408         -- call "ccall" foo(x, y)[r1, r2];
 409         -- ToDo ppr volatile
 410         MidForeignCall safety target results args ->
 411             hsep [ if null results
 412                       then empty
 413                       else parens (commafy $ map ppr results) <+> equals,
 414                       ppr_safety safety,
 415                    ptext $ sLit "call",
 416                    ppr_call_target target <> parens (commafy $ map ppr args) <> semi]
 417
 418     pp_debug =
 419       if not debugPpr then empty
 420       else text " //" <+>
 421            case stmt of
 422              MidComment     {} -> text "MidComment"
 423              MidAssign      {} -> text "MidAssign"
 424              MidStore       {} -> text "MidStore"
 425              MidForeignCall {} -> text "MidForeignCall"
 426
 427 ppr_fc :: ForeignConvention -> SDoc
 428 ppr_fc (ForeignConvention c _ _) = doubleQuotes (ppr c)
 429
 430 ppr_safety :: ForeignSafety -> SDoc
 431 ppr_safety (Safe bid upd) = text "safe<" <> ppr bid <> text ", " <> ppr upd <> text ">"
 432 ppr_safety Unsafe         = text "unsafe"
 433
 434 ppr_call_target :: MidCallTarget -> SDoc
 435 ppr_call_target (ForeignTarget fn c) = ppr_fc c <+> ppr_target fn
 436 ppr_call_target (PrimTarget op)      = ppr (CmmLabel (mkForeignLabel (mkFastString (show op)) Nothing False))
 437
 438 ppr_target :: CmmExpr -> SDoc
 439 ppr_target t@(CmmLit _) = ppr t
 440 ppr_target fn'          = parens (ppr fn')
 441
 442 pprHinted :: Outputable a => CmmHinted a -> SDoc
 443 pprHinted (CmmHinted a NoHint)     = ppr a
 444 pprHinted (CmmHinted a AddrHint)   = doubleQuotes (text "address") <+> ppr a
 445 pprHinted (CmmHinted a SignedHint) = doubleQuotes (text "signed")  <+> ppr a
 446
 447 pprLast :: Last -> SDoc
 448 pprLast stmt = pp_stmt <+> pp_debug
 449   where
 450     pp_stmt = case stmt of
 451        LastBranch ident             -> ptext (sLit "goto") <+> ppr ident <> semi
 452        LastCondBranch expr t f      -> genFullCondBranch expr t f
 453        LastSwitch arg ids           -> ppr $ CmmSwitch arg ids
 454        LastCall tgt k off updfr_off -> genBareCall tgt k off updfr_off
 455
 456     pp_debug = text " //" <+> case stmt of
 457            LastBranch {} -> text "LastBranch"
 458            LastCondBranch {} -> text "LastCondBranch"
 459            LastSwitch {} -> text "LastSwitch"
 460            LastCall {} -> text "LastCall"
 461
 462 genBareCall :: CmmExpr -> Maybe BlockId -> Int -> Maybe UpdFrameOffset -> SDoc
 463 genBareCall fn k off updfr_off =
 464         hcat [ ptext (sLit "call"), space
 465              , pprFun fn, ptext (sLit "(...)"), space
 466              , ptext (sLit "returns to") <+> ppr k <+> parens (ppr off)
 467              , ptext (sLit " with update frame") <+> ppr updfr_off
 468              , semi ]
 469
 470 pprFun :: CmmExpr -> SDoc
 471 pprFun f@(CmmLit _) = ppr f
 472 pprFun f = parens (ppr f)
 473
 474 genFullCondBranch :: Outputable id => CmmExpr -> id -> id -> SDoc
 475 genFullCondBranch expr t f =
 476     hsep [ ptext (sLit "if")
 477          , parens(ppr expr)
 478          , ptext (sLit "goto")
 479          , ppr t <> semi
 480          , ptext (sLit "else goto")
 481          , ppr f <> semi
 482          ]
 483
 484 pprConvention :: Convention -> SDoc
 485 pprConvention (Native {})  = text "<native-convention>"
 486 pprConvention  Slow        = text "<slow-convention>"
 487 pprConvention  GC          = text "<gc-convention>"
 488 pprConvention  PrimOp      = text "<primop-convention>"
 489 pprConvention (Foreign c)  = ppr c
 490 pprConvention (Private {}) = text "<private-convention>"
 491
 492 pprForeignConvention :: ForeignConvention -> SDoc
 493 pprForeignConvention (ForeignConvention c as rs) = ppr c <> ppr as <> ppr rs
 494
 495 commafy :: [SDoc] -> SDoc
 496 commafy xs = hsep $ punctuate comma xs