compiler/hsSyn/HsBinds.lhs

   1 %
   2 % (c) The University of Glasgow 2006
   3 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   4 %
   5 \section[HsBinds]{Abstract syntax: top-level bindings and signatures}
   6
   7 Datatype for: @BindGroup@, @Bind@, @Sig@, @Bind@.
   8
   9 \begin{code}
  10 {-# OPTIONS -w #-}
  11 -- The above warning supression flag is a temporary kludge.
  12 -- While working on this module you are encouraged to remove it and fix
  13 -- any warnings in the module. See
  14 --     http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
  15 -- for details
  16
  17 module HsBinds where
  18
  19 #include "HsVersions.h"
  20
  21 import {-# SOURCE #-} HsExpr ( HsExpr, pprExpr, LHsExpr,
  22                                MatchGroup, pprFunBind,
  23                                GRHSs, pprPatBind )
  24 import {-# SOURCE #-} HsPat  ( LPat )
  25
  26 import HsTypes
  27 import PprCore ()
  28 import Coercion
  29 import Type
  30 import Name
  31 import NameSet
  32 import BasicTypes
  33 import Outputable
  34 import SrcLoc
  35 import Util
  36 import Var
  37 import Bag
  38 \end{code}
  39
  40 %************************************************************************
  41 %*                                                                      *
  42 \subsection{Bindings: @BindGroup@}
  43 %*                                                                      *
  44 %************************************************************************
  45
  46 Global bindings (where clauses)
  47
  48 \begin{code}
  49 data HsLocalBinds id    -- Bindings in a 'let' expression
  50                         -- or a 'where' clause
  51   = HsValBinds (HsValBinds id)
  52   | HsIPBinds  (HsIPBinds id)
  53
  54   | EmptyLocalBinds
  55
  56 data HsValBinds id      -- Value bindings (not implicit parameters)
  57   = ValBindsIn                          -- Before typechecking
  58         (LHsBinds id) [LSig id]         -- Not dependency analysed
  59                                         -- Recursive by default
  60
  61   | ValBindsOut                         -- After renaming
  62         [(RecFlag, LHsBinds id)]        -- Dependency analysed, later bindings
  63                                         -- in the list may depend on earlier
  64                                         -- ones.
  65         [LSig Name]
  66
  67 type LHsBinds id  = Bag (LHsBind id)
  68 type DictBinds id = LHsBinds id         -- Used for dictionary or method bindings
  69 type LHsBind  id  = Located (HsBind id)
  70
  71 data HsBind id
  72   = FunBind {   -- FunBind is used for both functions   f x = e
  73                 -- and variables                        f = \x -> e
  74 -- Reason 1: Special case for type inference: see TcBinds.tcMonoBinds
  75 --
  76 -- Reason 2: instance decls can only have FunBinds, which is convenient
  77 --           If you change this, you'll need tochange e.g. rnMethodBinds
  78
  79 -- But note that the form       f :: a->a = ...
  80 -- parses as a pattern binding, just like
  81 --                      (f :: a -> a) = ...
  82
  83         fun_id :: Located id,
  84
  85         fun_infix :: Bool,      -- True => infix declaration
  86
  87         fun_matches :: MatchGroup id,   -- The payload
  88
  89         fun_co_fn :: HsWrapper, -- Coercion from the type of the MatchGroup to the type of
  90                                 -- the Id.  Example:
  91                                 --      f :: Int -> forall a. a -> a
  92                                 --      f x y = y
  93                                 -- Then the MatchGroup will have type (Int -> a' -> a')
  94                                 -- (with a free type variable a').  The coercion will take
  95                                 -- a CoreExpr of this type and convert it to a CoreExpr of
  96                                 -- type         Int -> forall a'. a' -> a'
  97                                 -- Notice that the coercion captures the free a'.
  98
  99         bind_fvs :: NameSet,    -- After the renamer, this contains a superset of the
 100                                 -- Names of the other binders in this binding group that
 101                                 -- are free in the RHS of the defn
 102                                 -- Before renaming, and after typechecking,
 103                                 -- the field is unused; it's just an error thunk
 104
 105         fun_tick :: Maybe (Int,[id])   -- This is the (optional) module-local tick number.
 106     }
 107
 108   | PatBind {   -- The pattern is never a simple variable;
 109                 -- That case is done by FunBind
 110         pat_lhs    :: LPat id,
 111         pat_rhs    :: GRHSs id,
 112         pat_rhs_ty :: PostTcType,       -- Type of the GRHSs
 113         bind_fvs   :: NameSet           -- Same as for FunBind
 114     }
 115
 116   | VarBind {   -- Dictionary binding and suchlike
 117         var_id :: id,           -- All VarBinds are introduced by the type checker
 118         var_rhs :: LHsExpr id   -- Located only for consistency
 119     }
 120
 121   | AbsBinds {                                  -- Binds abstraction; TRANSLATION
 122         abs_tvs     :: [TyVar],
 123         abs_dicts   :: [DictId],
 124         abs_exports :: [([TyVar], id, id, [LPrag])],    -- (tvs, poly_id, mono_id, prags)
 125         abs_binds   :: LHsBinds id              -- The dictionary bindings and typechecked user bindings
 126                                                 -- mixed up together; you can tell the dict bindings because
 127                                                 -- they are all VarBinds
 128     }
 129         -- Consider (AbsBinds tvs ds [(ftvs, poly_f, mono_f) binds]
 130         --
 131         -- Creates bindings for (polymorphic, overloaded) poly_f
 132         -- in terms of monomorphic, non-overloaded mono_f
 133         --
 134         -- Invariants:
 135         --      1. 'binds' binds mono_f
 136         --      2. ftvs is a subset of tvs
 137         --      3. ftvs includes all tyvars free in ds
 138         --
 139         -- See section 9 of static semantics paper for more details.
 140         -- (You can get a PhD for explaining the True Meaning
 141         --  of this last construct.)
 142
 143 placeHolderNames :: NameSet
 144 -- Used for the NameSet in FunBind and PatBind prior to the renamer
 145 placeHolderNames = panic "placeHolderNames"
 146
 147 ------------
 148 instance OutputableBndr id => Outputable (HsLocalBinds id) where
 149   ppr (HsValBinds bs) = ppr bs
 150   ppr (HsIPBinds bs)  = ppr bs
 151   ppr EmptyLocalBinds = empty
 152
 153 instance OutputableBndr id => Outputable (HsValBinds id) where
 154   ppr (ValBindsIn binds sigs)
 155    = pprValBindsForUser binds sigs
 156
 157   ppr (ValBindsOut sccs sigs)
 158     = getPprStyle $ \ sty ->
 159       if debugStyle sty then    -- Print with sccs showing
 160         vcat (map ppr sigs) $$ vcat (map ppr_scc sccs)
 161      else
 162         pprValBindsForUser (unionManyBags (map snd sccs)) sigs
 163    where
 164      ppr_scc (rec_flag, binds) = pp_rec rec_flag <+> pprLHsBinds binds
 165      pp_rec Recursive    = ptext SLIT("rec")
 166      pp_rec NonRecursive = ptext SLIT("nonrec")
 167
 168 --  *not* pprLHsBinds because we don't want braces; 'let' and
 169 -- 'where' include a list of HsBindGroups and we don't want
 170 -- several groups of bindings each with braces around.
 171 -- Sort by location before printing
 172 pprValBindsForUser :: (OutputableBndr id1, OutputableBndr id2)
 173                    => LHsBinds id1 -> [LSig id2] -> SDoc
 174 pprValBindsForUser binds sigs
 175   = pprDeeperList vcat (map snd (sort_by_loc decls))
 176   where
 177
 178     decls :: [(SrcSpan, SDoc)]
 179     decls = [(loc, ppr sig)  | L loc sig <- sigs] ++
 180             [(loc, ppr bind) | L loc bind <- bagToList binds]
 181
 182     sort_by_loc decls = sortLe (\(l1,_) (l2,_) -> l1 <= l2) decls
 183
 184 pprLHsBinds :: OutputableBndr id => LHsBinds id -> SDoc
 185 pprLHsBinds binds
 186   | isEmptyLHsBinds binds = empty
 187   | otherwise = lbrace <+> pprDeeperList vcat (map ppr (bagToList binds)) <+> rbrace
 188
 189 ------------
 190 emptyLocalBinds :: HsLocalBinds a
 191 emptyLocalBinds = EmptyLocalBinds
 192
 193 isEmptyLocalBinds :: HsLocalBinds a -> Bool
 194 isEmptyLocalBinds (HsValBinds ds) = isEmptyValBinds ds
 195 isEmptyLocalBinds (HsIPBinds ds)  = isEmptyIPBinds ds
 196 isEmptyLocalBinds EmptyLocalBinds = True
 197
 198 isEmptyValBinds :: HsValBinds a -> Bool
 199 isEmptyValBinds (ValBindsIn ds sigs)  = isEmptyLHsBinds ds && null sigs
 200 isEmptyValBinds (ValBindsOut ds sigs) = null ds && null sigs
 201
 202 emptyValBindsIn, emptyValBindsOut :: HsValBinds a
 203 emptyValBindsIn  = ValBindsIn emptyBag []
 204 emptyValBindsOut = ValBindsOut []      []
 205
 206 emptyLHsBinds :: LHsBinds id
 207 emptyLHsBinds = emptyBag
 208
 209 isEmptyLHsBinds :: LHsBinds id -> Bool
 210 isEmptyLHsBinds = isEmptyBag
 211
 212 ------------
 213 plusHsValBinds :: HsValBinds a -> HsValBinds a -> HsValBinds a
 214 plusHsValBinds (ValBindsIn ds1 sigs1) (ValBindsIn ds2 sigs2)
 215   = ValBindsIn (ds1 `unionBags` ds2) (sigs1 ++ sigs2)
 216 plusHsValBinds (ValBindsOut ds1 sigs1) (ValBindsOut ds2 sigs2)
 217   = ValBindsOut (ds1 ++ ds2) (sigs1 ++ sigs2)
 218 \end{code}
 219
 220 What AbsBinds means
 221 ~~~~~~~~~~~~~~~~~~~
 222          AbsBinds tvs
 223                   [d1,d2]
 224                   [(tvs1, f1p, f1m),
 225                    (tvs2, f2p, f2m)]
 226                   BIND
 227 means
 228
 229         f1p = /\ tvs -> \ [d1,d2] -> letrec DBINDS and BIND
 230                                       in fm
 231
 232         gp = ...same again, with gm instead of fm
 233
 234 This is a pretty bad translation, because it duplicates all the bindings.
 235 So the desugarer tries to do a better job:
 236
 237         fp = /\ [a,b] -> \ [d1,d2] -> case tp [a,b] [d1,d2] of
 238                                         (fm,gm) -> fm
 239         ..ditto for gp..
 240
 241         tp = /\ [a,b] -> \ [d1,d2] -> letrec DBINDS and BIND
 242                                        in (fm,gm)
 243
 244 \begin{code}
 245 instance OutputableBndr id => Outputable (HsBind id) where
 246     ppr mbind = ppr_monobind mbind
 247
 248 ppr_monobind :: OutputableBndr id => HsBind id -> SDoc
 249
 250 ppr_monobind (PatBind { pat_lhs = pat, pat_rhs = grhss })      = pprPatBind pat grhss
 251 ppr_monobind (VarBind { var_id = var, var_rhs = rhs })         = ppr var <+> equals <+> pprExpr (unLoc rhs)
 252 ppr_monobind (FunBind { fun_id = fun, fun_infix = inf,
 253                         fun_matches = matches,
 254                         fun_tick = tick }) =
 255                            (case tick of
 256                               Nothing -> empty
 257                               Just t  -> text "-- tick id = " <> ppr t
 258                            ) $$ pprFunBind (unLoc fun) inf matches
 259
 260 ppr_monobind (AbsBinds { abs_tvs = tyvars, abs_dicts = dictvars,
 261                          abs_exports = exports, abs_binds = val_binds })
 262      = sep [ptext SLIT("AbsBinds"),
 263             brackets (interpp'SP tyvars),
 264             brackets (interpp'SP dictvars),
 265             brackets (sep (punctuate comma (map ppr_exp exports)))]
 266        $$
 267        nest 2 ( vcat [pprBndr LetBind x | (_,x,_,_) <- exports]
 268                         -- Print type signatures
 269                 $$ pprLHsBinds val_binds )
 270   where
 271     ppr_exp (tvs, gbl, lcl, prags)
 272         = vcat [ppr gbl <+> ptext SLIT("<=") <+> ppr tvs <+> ppr lcl,
 273                 nest 2 (vcat (map (pprPrag gbl) prags))]
 274 \end{code}
 275
 276 %************************************************************************
 277 %*                                                                      *
 278                 Implicit parameter bindings
 279 %*                                                                      *
 280 %************************************************************************
 281
 282 \begin{code}
 283 data HsIPBinds id
 284   = IPBinds
 285         [LIPBind id]
 286         (DictBinds id)  -- Only in typechecker output; binds
 287                         -- uses of the implicit parameters
 288
 289 isEmptyIPBinds :: HsIPBinds id -> Bool
 290 isEmptyIPBinds (IPBinds is ds) = null is && isEmptyBag ds
 291
 292 type LIPBind id = Located (IPBind id)
 293
 294 -- | Implicit parameter bindings.
 295 data IPBind id
 296   = IPBind
 297         (IPName id)
 298         (LHsExpr id)
 299
 300 instance (OutputableBndr id) => Outputable (HsIPBinds id) where
 301   ppr (IPBinds bs ds) = pprDeeperList vcat (map ppr bs)
 302                         $$ pprLHsBinds ds
 303
 304 instance (OutputableBndr id) => Outputable (IPBind id) where
 305   ppr (IPBind id rhs) = pprBndr LetBind id <+> equals <+> pprExpr (unLoc rhs)
 306 \end{code}
 307
 308
 309 %************************************************************************
 310 %*                                                                      *
 311 \subsection{Coercion functions}
 312 %*                                                                      *
 313 %************************************************************************
 314
 315 \begin{code}
 316 -- A HsWrapper is an expression with a hole in it
 317 -- We need coercions to have concrete form so that we can zonk them
 318
 319 data HsWrapper
 320   = WpHole                      -- The identity coercion
 321
 322   | WpCompose HsWrapper HsWrapper       -- (\a1..an. []) `WpCompose` (\x1..xn. [])
 323                                 --      = (\a1..an \x1..xn. [])
 324
 325   | WpCo Coercion               -- A cast:  [] `cast` co
 326                                 -- Guaranteedn not the identity coercion
 327
 328   | WpApp Var                   -- [] d         the 'd' is a type-class dictionary
 329   | WpTyApp Type                -- [] t         the 't' is a type or corecion
 330   | WpLam Id                    -- \d. []       the 'd' is a type-class dictionary
 331   | WpTyLam TyVar               -- \a. []       the 'a' is a type or coercion variable
 332
 333         -- Non-empty bindings, so that the identity coercion
 334         -- is always exactly WpHole
 335   | WpLet (LHsBinds Id)         -- let binds in []
 336                                 -- (would be nicer to be core bindings)
 337
 338 instance Outputable HsWrapper where
 339   ppr co_fn = pprHsWrapper (ptext SLIT("<>")) co_fn
 340
 341 pprHsWrapper :: SDoc -> HsWrapper -> SDoc
 342 pprHsWrapper it WpHole = it
 343 pprHsWrapper it (WpCompose f1 f2) = pprHsWrapper (pprHsWrapper it f2) f1
 344 pprHsWrapper it (WpCo co)     = it <+> ptext SLIT("`cast`") <+> pprParendType co
 345 pprHsWrapper it (WpApp id)    = it <+> ppr id
 346 pprHsWrapper it (WpTyApp ty)  = it <+> ptext SLIT("@") <+> pprParendType ty
 347 pprHsWrapper it (WpLam id)    = ptext SLIT("\\") <> pprBndr LambdaBind id <> dot <+> it
 348 pprHsWrapper it (WpTyLam tv)  = ptext SLIT("/\\") <> pprBndr LambdaBind tv <> dot <+> it
 349 pprHsWrapper it (WpLet binds) = sep [ptext SLIT("let") <+> braces (ppr binds), it]
 350
 351 (<.>) :: HsWrapper -> HsWrapper -> HsWrapper
 352 WpHole <.> c = c
 353 c <.> WpHole = c
 354 c1 <.> c2    = c1 `WpCompose` c2
 355
 356 mkWpTyApps :: [Type] -> HsWrapper
 357 mkWpTyApps tys = mk_co_fn WpTyApp (reverse tys)
 358
 359 mkWpApps :: [Id] -> HsWrapper
 360 mkWpApps ids = mk_co_fn WpApp (reverse ids)
 361
 362 mkWpTyLams :: [TyVar] -> HsWrapper
 363 mkWpTyLams ids = mk_co_fn WpTyLam ids
 364
 365 mkWpLams :: [Id] -> HsWrapper
 366 mkWpLams ids = mk_co_fn WpLam ids
 367
 368 mk_co_fn :: (a -> HsWrapper) -> [a] -> HsWrapper
 369 mk_co_fn f as = foldr (WpCompose . f) WpHole as
 370
 371 idHsWrapper :: HsWrapper
 372 idHsWrapper = WpHole
 373
 374 isIdHsWrapper :: HsWrapper -> Bool
 375 isIdHsWrapper WpHole = True
 376 isIdHsWrapper other  = False
 377 \end{code}
 378
 379
 380 %************************************************************************
 381 %*                                                                      *
 382 \subsection{@Sig@: type signatures and value-modifying user pragmas}
 383 %*                                                                      *
 384 %************************************************************************
 385
 386 It is convenient to lump ``value-modifying'' user-pragmas (e.g.,
 387 ``specialise this function to these four types...'') in with type
 388 signatures.  Then all the machinery to move them into place, etc.,
 389 serves for both.
 390
 391 \begin{code}
 392 type LSig name = Located (Sig name)
 393
 394 data Sig name   -- Signatures and pragmas
 395   =     -- An ordinary type signature
 396         -- f :: Num a => a -> a
 397     TypeSig     (Located name)  -- A bog-std type signature
 398                 (LHsType name)
 399
 400         -- An ordinary fixity declaration
 401         --      infixl *** 8
 402   | FixSig      (FixitySig name)        -- Fixity declaration
 403
 404         -- An inline pragma
 405         -- {#- INLINE f #-}
 406   | InlineSig   (Located name)  -- Function name
 407                 InlineSpec
 408
 409         -- A specialisation pragma
 410         -- {-# SPECIALISE f :: Int -> Int #-}
 411   | SpecSig     (Located name)  -- Specialise a function or datatype ...
 412                 (LHsType name)  -- ... to these types
 413                 InlineSpec
 414
 415         -- A specialisation pragma for instance declarations only
 416         -- {-# SPECIALISE instance Eq [Int] #-}
 417   | SpecInstSig (LHsType name)  -- (Class tys); should be a specialisation of the
 418                                 -- current instance decl
 419
 420
 421 type LFixitySig name = Located (FixitySig name)
 422 data FixitySig name = FixitySig (Located name) Fixity
 423
 424 -- A Prag conveys pragmas from the type checker to the desugarer
 425 type LPrag = Located Prag
 426 data Prag
 427   = InlinePrag
 428         InlineSpec
 429
 430   | SpecPrag
 431         (HsExpr Id)     -- An expression, of the given specialised type, which
 432         PostTcType      -- specialises the polymorphic function
 433         [Id]            -- Dicts mentioned free in the expression
 434                         --   Apr07: I think this is pretty useless
 435                         --          see Note [Const rule dicts] in DsBinds
 436         InlineSpec      -- Inlining spec for the specialised function
 437
 438 isInlinePrag (InlinePrag _) = True
 439 isInlinePrag prag           = False
 440
 441 isSpecPrag (SpecPrag {}) = True
 442 isSpecPrag prag          = False
 443 \end{code}
 444
 445 \begin{code}
 446 okBindSig :: NameSet -> LSig Name -> Bool
 447 okBindSig ns sig = sigForThisGroup ns sig
 448
 449 okHsBootSig :: LSig Name -> Bool
 450 okHsBootSig (L _ (TypeSig  _ _)) = True
 451 okHsBootSig (L _ (FixSig _))     = True
 452 okHsBootSig sig                  = False
 453
 454 okClsDclSig :: LSig Name -> Bool
 455 okClsDclSig (L _ (SpecInstSig _)) = False
 456 okClsDclSig sig                   = True        -- All others OK
 457
 458 okInstDclSig :: NameSet -> LSig Name -> Bool
 459 okInstDclSig ns lsig@(L _ sig) = ok ns sig
 460   where
 461     ok ns (TypeSig _ _)   = False
 462     ok ns (FixSig _)      = False
 463     ok ns (SpecInstSig _) = True
 464     ok ns sig             = sigForThisGroup ns lsig
 465
 466 sigForThisGroup :: NameSet -> LSig Name -> Bool
 467 sigForThisGroup ns sig
 468   = case sigName sig of
 469         Nothing -> False
 470         Just n  -> n `elemNameSet` ns
 471
 472 sigName :: LSig name -> Maybe name
 473 sigName (L _ sig) = sigNameNoLoc sig
 474
 475 sigNameNoLoc :: Sig name -> Maybe name
 476 sigNameNoLoc (TypeSig   n _)          = Just (unLoc n)
 477 sigNameNoLoc (SpecSig   n _ _)        = Just (unLoc n)
 478 sigNameNoLoc (InlineSig n _)          = Just (unLoc n)
 479 sigNameNoLoc (FixSig (FixitySig n _)) = Just (unLoc n)
 480 sigNameNoLoc other                              = Nothing
 481
 482 isFixityLSig :: LSig name -> Bool
 483 isFixityLSig (L _ (FixSig {})) = True
 484 isFixityLSig _                 = False
 485
 486 isVanillaLSig :: LSig name -> Bool
 487 isVanillaLSig (L _(TypeSig {})) = True
 488 isVanillaLSig sig               = False
 489
 490 isSpecLSig :: LSig name -> Bool
 491 isSpecLSig (L _(SpecSig {})) = True
 492 isSpecLSig sig               = False
 493
 494 isSpecInstLSig (L _ (SpecInstSig {})) = True
 495 isSpecInstLSig sig                    = False
 496
 497 isPragLSig :: LSig name -> Bool
 498         -- Identifies pragmas
 499 isPragLSig (L _ (SpecSig {}))   = True
 500 isPragLSig (L _ (InlineSig {})) = True
 501 isPragLSig other                = False
 502
 503 isInlineLSig :: LSig name -> Bool
 504         -- Identifies inline pragmas
 505 isInlineLSig (L _ (InlineSig {})) = True
 506 isInlineLSig other                = False
 507
 508 hsSigDoc (TypeSig {})           = ptext SLIT("type signature")
 509 hsSigDoc (SpecSig {})           = ptext SLIT("SPECIALISE pragma")
 510 hsSigDoc (InlineSig _ spec)     = ppr spec <+> ptext SLIT("pragma")
 511 hsSigDoc (SpecInstSig {})       = ptext SLIT("SPECIALISE instance pragma")
 512 hsSigDoc (FixSig {})            = ptext SLIT("fixity declaration")
 513 \end{code}
 514
 515 Signature equality is used when checking for duplicate signatures
 516
 517 \begin{code}
 518 eqHsSig :: LSig Name -> LSig Name -> Bool
 519 eqHsSig (L _ (FixSig (FixitySig n1 _))) (L _ (FixSig (FixitySig n2 _))) = unLoc n1 == unLoc n2
 520 eqHsSig (L _ (TypeSig n1 _))            (L _ (TypeSig n2 _))            = unLoc n1 == unLoc n2
 521 eqHsSig (L _ (InlineSig n1 s1)) (L _ (InlineSig n2 s2))                 = s1 == s2 && unLoc n1 == unLoc n2
 522         -- For specialisations, we don't have equality over
 523         -- HsType, so it's not convenient to spot duplicate
 524         -- specialisations here.  Check for this later, when we're in Type land
 525 eqHsSig _other1 _other2 = False
 526 \end{code}
 527
 528 \begin{code}
 529 instance (OutputableBndr name) => Outputable (Sig name) where
 530     ppr sig = ppr_sig sig
 531
 532 ppr_sig :: OutputableBndr name => Sig name -> SDoc
 533 ppr_sig (TypeSig var ty)          = pprVarSig (unLoc var) ty
 534 ppr_sig (FixSig fix_sig)          = ppr fix_sig
 535 ppr_sig (SpecSig var ty inl)      = pragBrackets (pprSpec var ty inl)
 536 ppr_sig (InlineSig var inl)       = pragBrackets (ppr inl <+> ppr var)
 537 ppr_sig (SpecInstSig ty)          = pragBrackets (ptext SLIT("SPECIALIZE instance") <+> ppr ty)
 538
 539 instance Outputable name => Outputable (FixitySig name) where
 540   ppr (FixitySig name fixity) = sep [ppr fixity, ppr name]
 541
 542 pragBrackets :: SDoc -> SDoc
 543 pragBrackets doc = ptext SLIT("{-#") <+> doc <+> ptext SLIT("#-}")
 544
 545 pprVarSig :: (Outputable id, Outputable ty) => id -> ty -> SDoc
 546 pprVarSig var ty = sep [ppr var <+> dcolon, nest 2 (ppr ty)]
 547
 548 pprSpec :: (Outputable id, Outputable ty) => id -> ty -> InlineSpec -> SDoc
 549 pprSpec var ty inl = sep [ptext SLIT("SPECIALIZE") <+> ppr inl <+> pprVarSig var ty]
 550
 551 pprPrag :: Outputable id => id -> LPrag -> SDoc
 552 pprPrag var (L _ (InlinePrag inl))         = ppr inl <+> ppr var
 553 pprPrag var (L _ (SpecPrag expr ty _ inl)) = pprSpec var ty inl
 554 \end{code}
 555