ghc/compiler/rename/RnBinds.lhs

   1 %
   2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
   3 %
   4 \section[RnBinds]{Renaming and dependency analysis of bindings}
   5
   6 This module does renaming and dependency analysis on value bindings in
   7 the abstract syntax.  It does {\em not} do cycle-checks on class or
   8 type-synonym declarations; those cannot be done at this stage because
   9 they may be affected by renaming (which isn't fully worked out yet).
  10
  11 \begin{code}
  12 module RnBinds (
  13         rnTopBinds, rnTopMonoBinds,
  14         rnMethodBinds, renameSigs,
  15         rnBinds, rnMonoBinds
  16    ) where
  17
  18 #include "HsVersions.h"
  19
  20 import {-# SOURCE #-} RnSource ( rnHsSigType )
  21
  22 import HsSyn
  23 import HsBinds          ( sigsForMe )
  24 import RdrHsSyn
  25 import RnHsSyn
  26 import RnMonad
  27 import RnExpr           ( rnMatch, rnGRHSsAndBinds, rnPat, checkPrecMatch )
  28 import RnEnv            ( bindLocatedLocalsRn, lookupBndrRn, lookupOccRn, lookupGlobalOccRn,
  29                           isUnboundName, warnUnusedBinds
  30                         )
  31 import CmdLineOpts      ( opt_WarnMissingSigs )
  32 import Digraph          ( stronglyConnComp, SCC(..) )
  33 import Name             ( OccName(..), Name, isExportedName )
  34 import NameSet
  35 import BasicTypes       ( RecFlag(..), TopLevelFlag(..) )
  36 import Util             ( thenCmp, removeDups, panic, panic#, assertPanic )
  37 import ListSetOps       ( minusList )
  38 import Bag              ( bagToList )
  39 import Outputable
  40 \end{code}
  41
  42 -- ToDo: Put the annotations into the monad, so that they arrive in the proper
  43 -- place and can be used when complaining.
  44
  45 The code tree received by the function @rnBinds@ contains definitions
  46 in where-clauses which are all apparently mutually recursive, but which may
  47 not really depend upon each other. For example, in the top level program
  48 \begin{verbatim}
  49 f x = y where a = x
  50               y = x
  51 \end{verbatim}
  52 the definitions of @a@ and @y@ do not depend on each other at all.
  53 Unfortunately, the typechecker cannot always check such definitions.
  54 \footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive
  55 definitions. In Proceedings of the International Symposium on Programming,
  56 Toulouse, pp. 217-39. LNCS 167. Springer Verlag.}
  57 However, the typechecker usually can check definitions in which only the
  58 strongly connected components have been collected into recursive bindings.
  59 This is precisely what the function @rnBinds@ does.
  60
  61 ToDo: deal with case where a single monobinds binds the same variable
  62 twice.
  63
  64 The vertag tag is a unique @Int@; the tags only need to be unique
  65 within one @MonoBinds@, so that unique-Int plumbing is done explicitly
  66 (heavy monad machinery not needed).
  67
  68 \begin{code}
  69 type VertexTag  = Int
  70 type Cycle      = [VertexTag]
  71 type Edge       = (VertexTag, VertexTag)
  72 \end{code}
  73
  74 %************************************************************************
  75 %*                                                                      *
  76 %* naming conventions                                                   *
  77 %*                                                                      *
  78 %************************************************************************
  79
  80 \subsection[name-conventions]{Name conventions}
  81
  82 The basic algorithm involves walking over the tree and returning a tuple
  83 containing the new tree plus its free variables. Some functions, such
  84 as those walking polymorphic bindings (HsBinds) and qualifier lists in
  85 list comprehensions (@Quals@), return the variables bound in local
  86 environments. These are then used to calculate the free variables of the
  87 expression evaluated in these environments.
  88
  89 Conventions for variable names are as follows:
  90 \begin{itemize}
  91 \item
  92 new code is given a prime to distinguish it from the old.
  93
  94 \item
  95 a set of variables defined in @Exp@ is written @dvExp@
  96
  97 \item
  98 a set of variables free in @Exp@ is written @fvExp@
  99 \end{itemize}
 100
 101 %************************************************************************
 102 %*                                                                      *
 103 %* analysing polymorphic bindings (HsBinds, Bind, MonoBinds)            *
 104 %*                                                                      *
 105 %************************************************************************
 106
 107 \subsubsection[dep-HsBinds]{Polymorphic bindings}
 108
 109 Non-recursive expressions are reconstructed without any changes at top
 110 level, although their component expressions may have to be altered.
 111 However, non-recursive expressions are currently not expected as
 112 \Haskell{} programs, and this code should not be executed.
 113
 114 Monomorphic bindings contain information that is returned in a tuple
 115 (a @FlatMonoBindsInfo@) containing:
 116
 117 \begin{enumerate}
 118 \item
 119 a unique @Int@ that serves as the ``vertex tag'' for this binding.
 120
 121 \item
 122 the name of a function or the names in a pattern. These are a set
 123 referred to as @dvLhs@, the defined variables of the left hand side.
 124
 125 \item
 126 the free variables of the body. These are referred to as @fvBody@.
 127
 128 \item
 129 the definition's actual code. This is referred to as just @code@.
 130 \end{enumerate}
 131
 132 The function @nonRecDvFv@ returns two sets of variables. The first is
 133 the set of variables defined in the set of monomorphic bindings, while the
 134 second is the set of free variables in those bindings.
 135
 136 The set of variables defined in a non-recursive binding is just the
 137 union of all of them, as @union@ removes duplicates. However, the
 138 free variables in each successive set of cumulative bindings is the
 139 union of those in the previous set plus those of the newest binding after
 140 the defined variables of the previous set have been removed.
 141
 142 @rnMethodBinds@ deals only with the declarations in class and
 143 instance declarations.  It expects only to see @FunMonoBind@s, and
 144 it expects the global environment to contain bindings for the binders
 145 (which are all class operations).
 146
 147 %************************************************************************
 148 %*                                                                      *
 149 %*              Top-level bindings
 150 %*                                                                      *
 151 %************************************************************************
 152
 153 @rnTopBinds@ assumes that the environment already
 154 contains bindings for the binders of this particular binding.
 155
 156 \begin{code}
 157 rnTopBinds    :: RdrNameHsBinds -> RnMS s RenamedHsBinds
 158
 159 rnTopBinds EmptyBinds                     = returnRn EmptyBinds
 160 rnTopBinds (MonoBind bind sigs _)         = rnTopMonoBinds bind sigs
 161   -- The parser doesn't produce other forms
 162
 163
 164 rnTopMonoBinds EmptyMonoBinds sigs
 165   = returnRn EmptyBinds
 166
 167 rnTopMonoBinds mbinds sigs
 168  =  mapRn lookupBndrRn binder_rdr_names `thenRn` \ binder_names ->
 169     let
 170         binder_set       = mkNameSet binder_names
 171         exported_binders = mkNameSet (filter isExportedName binder_names)
 172     in
 173     rn_mono_binds TopLevel
 174                   binder_set mbinds sigs                `thenRn` \ (new_binds, fv_set) ->
 175     let
 176         unused_binders = binder_set `minusNameSet` (fv_set `unionNameSets` exported_binders)
 177     in
 178     warnUnusedBinds unused_binders      `thenRn_`
 179     returnRn new_binds
 180   where
 181     binder_rdr_names = map fst (bagToList (collectMonoBinders mbinds))
 182 \end{code}
 183
 184 %************************************************************************
 185 %*                                                                      *
 186 %*              Nested binds
 187 %*                                                                      *
 188 %************************************************************************
 189
 190 @rnMonoBinds@
 191         - collects up the binders for this declaration group,
 192         - checks that they form a set
 193         - extends the environment to bind them to new local names
 194         - calls @rnMonoBinds@ to do the real work
 195
 196 \begin{code}
 197 rnBinds       :: RdrNameHsBinds
 198               -> (RenamedHsBinds -> RnMS s (result, FreeVars))
 199               -> RnMS s (result, FreeVars)
 200
 201 rnBinds EmptyBinds             thing_inside = thing_inside EmptyBinds
 202 rnBinds (MonoBind bind sigs _) thing_inside = rnMonoBinds bind sigs thing_inside
 203   -- the parser doesn't produce other forms
 204
 205
 206 rnMonoBinds :: RdrNameMonoBinds -> [RdrNameSig]
 207             -> (RenamedHsBinds -> RnMS s (result, FreeVars))
 208             -> RnMS s (result, FreeVars)
 209
 210 rnMonoBinds EmptyMonoBinds sigs thing_inside = thing_inside EmptyBinds
 211
 212 rnMonoBinds mbinds sigs thing_inside -- Non-empty monobinds
 213   =     -- Extract all the binders in this group,
 214         -- and extend current scope, inventing new names for the new binders
 215         -- This also checks that the names form a set
 216     bindLocatedLocalsRn (text "binding group") mbinders_w_srclocs               $ \ new_mbinders ->
 217     let
 218         binder_set = mkNameSet new_mbinders
 219     in
 220     rn_mono_binds NotTopLevel
 221                   binder_set mbinds sigs        `thenRn` \ (binds,bind_fvs) ->
 222
 223         -- Now do the "thing inside", and deal with the free-variable calculations
 224     thing_inside binds                                  `thenRn` \ (result,result_fvs) ->
 225     let
 226         all_fvs        = result_fvs  `unionNameSets` bind_fvs
 227         net_fvs        = all_fvs `minusNameSet` binder_set
 228         unused_binders = binder_set `minusNameSet` all_fvs
 229     in
 230     warnUnusedBinds unused_binders      `thenRn_`
 231     returnRn (result, net_fvs)
 232   where
 233     mbinders_w_srclocs = bagToList (collectMonoBinders mbinds)
 234 \end{code}
 235
 236
 237 %************************************************************************
 238 %*                                                                      *
 239 %*              MonoBinds -- the main work is done here
 240 %*                                                                      *
 241 %************************************************************************
 242
 243 @rnMonoBinds@ is used by *both* top-level and nested bindings.  It
 244 assumes that all variables bound in this group are already in scope.
 245 This is done *either* by pass 3 (for the top-level bindings), *or* by
 246 @rnNestedMonoBinds@ (for the nested ones).
 247
 248 \begin{code}
 249 rn_mono_binds :: TopLevelFlag
 250               -> NameSet                -- Binders of this group
 251               -> RdrNameMonoBinds
 252               -> [RdrNameSig]           -- Signatures attached to this group
 253               -> RnMS s (RenamedHsBinds,        --
 254                          FreeVars)      -- Free variables
 255
 256 rn_mono_binds top_lev binders mbinds sigs
 257   =
 258          -- Rename the bindings, returning a MonoBindsInfo
 259          -- which is a list of indivisible vertices so far as
 260          -- the strongly-connected-components (SCC) analysis is concerned
 261     renameSigs top_lev False binders sigs       `thenRn` \ siglist ->
 262     flattenMonoBinds siglist mbinds     `thenRn` \ mbinds_info ->
 263
 264          -- Do the SCC analysis
 265     let edges       = mkEdges (mbinds_info `zip` [(0::Int)..])
 266         scc_result  = stronglyConnComp edges
 267         final_binds = foldr1 ThenBinds (map reconstructCycle scc_result)
 268
 269          -- Deal with bound and free-var calculation
 270         rhs_fvs = unionManyNameSets [fvs | (_,fvs,_,_) <- mbinds_info]
 271     in
 272     returnRn (final_binds, rhs_fvs)
 273 \end{code}
 274
 275 @flattenMonoBinds@ is ever-so-slightly magical in that it sticks
 276 unique ``vertex tags'' on its output; minor plumbing required.
 277
 278 \begin{code}
 279 flattenMonoBinds :: [RenamedSig]                -- Signatures
 280                  -> RdrNameMonoBinds
 281                  -> RnMS s [FlatMonoBindsInfo]
 282
 283 flattenMonoBinds sigs EmptyMonoBinds = returnRn []
 284
 285 flattenMonoBinds sigs (AndMonoBinds bs1 bs2)
 286   = flattenMonoBinds sigs bs1   `thenRn` \ flat1 ->
 287     flattenMonoBinds sigs bs2   `thenRn` \ flat2 ->
 288     returnRn (flat1 ++ flat2)
 289
 290 flattenMonoBinds sigs (PatMonoBind pat grhss_and_binds locn)
 291   = pushSrcLocRn locn                   $
 292     rnPat pat                           `thenRn` \ pat' ->
 293     rnGRHSsAndBinds grhss_and_binds     `thenRn` \ (grhss_and_binds', fvs) ->
 294
 295          -- Find which things are bound in this group
 296     let
 297         names_bound_here = mkNameSet (collectPatBinders pat')
 298         sigs_for_me      = sigsForMe (`elemNameSet` names_bound_here) sigs
 299         sigs_fvs         = foldr sig_fv emptyNameSet sigs_for_me
 300     in
 301     returnRn
 302         [(names_bound_here,
 303           fvs `unionNameSets` sigs_fvs,
 304           PatMonoBind pat' grhss_and_binds' locn,
 305           sigs_for_me
 306          )]
 307
 308 flattenMonoBinds sigs (FunMonoBind name inf matches locn)
 309   = pushSrcLocRn locn                            $
 310     mapRn (checkPrecMatch inf name) matches     `thenRn_`
 311     lookupBndrRn name                           `thenRn` \ name' ->
 312     mapAndUnzipRn rnMatch matches               `thenRn` \ (new_matches, fv_lists) ->
 313     let
 314         fvs         = unionManyNameSets fv_lists
 315         sigs_for_me = sigsForMe (name' ==) sigs
 316         sigs_fvs    = foldr sig_fv emptyNameSet sigs_for_me
 317     in
 318     returnRn
 319       [(unitNameSet name',
 320         fvs `unionNameSets` sigs_fvs,
 321         FunMonoBind name' inf new_matches locn,
 322         sigs_for_me
 323         )]
 324 \end{code}
 325
 326
 327 @rnMethodBinds@ is used for the method bindings of an instance
 328 declaration.   like @rnMonoBinds@ but without dependency analysis.
 329
 330 \begin{code}
 331 rnMethodBinds :: RdrNameMonoBinds -> RnMS s RenamedMonoBinds
 332
 333 rnMethodBinds EmptyMonoBinds = returnRn EmptyMonoBinds
 334
 335 rnMethodBinds (AndMonoBinds mb1 mb2)
 336   = andRn AndMonoBinds (rnMethodBinds mb1)
 337                        (rnMethodBinds mb2)
 338
 339 rnMethodBinds (FunMonoBind name inf matches locn)
 340   = pushSrcLocRn locn                              $
 341     mapRn (checkPrecMatch inf name) matches     `thenRn_`
 342
 343     lookupGlobalOccRn name                      `thenRn` \ sel_name ->
 344         -- We use the selector name as the binder
 345
 346     mapAndUnzipRn rnMatch matches               `thenRn` \ (new_matches, _) ->
 347     returnRn (FunMonoBind sel_name inf new_matches locn)
 348
 349 rnMethodBinds (PatMonoBind (VarPatIn name) grhss_and_binds locn)
 350   = pushSrcLocRn locn                   $
 351     lookupGlobalOccRn name                      `thenRn` \ sel_name ->
 352     rnGRHSsAndBinds grhss_and_binds     `thenRn` \ (grhss_and_binds', _) ->
 353     returnRn (PatMonoBind (VarPatIn sel_name) grhss_and_binds' locn)
 354
 355 -- Can't handle method pattern-bindings which bind multiple methods.
 356 rnMethodBinds mbind@(PatMonoBind other_pat _ locn)
 357   = pushSrcLocRn locn   $
 358     failWithRn EmptyMonoBinds (methodBindErr mbind)
 359 \end{code}
 360
 361 \begin{code}
 362 -- If a SPECIALIZE pragma is of the "... = blah" form,
 363 -- then we'd better make sure "blah" is taken into
 364 -- acct in the dependency analysis (or we get an
 365 -- unexpected out-of-scope error)! WDP 95/07
 366
 367 sig_fv (SpecSig _ _ (Just blah) _) acc = acc `unionNameSets` (unitNameSet blah)
 368 sig_fv _                           acc = acc
 369 \end{code}
 370
 371 %************************************************************************
 372 %*                                                                      *
 373 \subsection[reconstruct-deps]{Reconstructing dependencies}
 374 %*                                                                      *
 375 %************************************************************************
 376
 377 This @MonoBinds@- and @ClassDecls@-specific code is segregated here,
 378 as the two cases are similar.
 379
 380 \begin{code}
 381 reconstructCycle :: SCC FlatMonoBindsInfo
 382                  -> RenamedHsBinds
 383
 384 reconstructCycle (AcyclicSCC (_, _, binds, sigs))
 385   = MonoBind binds sigs NonRecursive
 386
 387 reconstructCycle (CyclicSCC cycle)
 388   = MonoBind this_gp_binds this_gp_sigs Recursive
 389   where
 390     this_gp_binds      = foldr1 AndMonoBinds [binds | (_, _, binds, _) <- cycle]
 391     this_gp_sigs       = foldr1 (++)         [sigs  | (_, _, _, sigs) <- cycle]
 392 \end{code}
 393
 394 %************************************************************************
 395 %*                                                                      *
 396 %*      Manipulating FlatMonoBindInfo                                   *
 397 %*                                                                      *
 398 %************************************************************************
 399
 400 During analysis a @MonoBinds@ is flattened to a @FlatMonoBindsInfo@.
 401 The @RenamedMonoBinds@ is always an empty bind, a pattern binding or
 402 a function binding, and has itself been dependency-analysed and
 403 renamed.
 404
 405 \begin{code}
 406 type FlatMonoBindsInfo
 407   = (NameSet,                   -- Set of names defined in this vertex
 408      NameSet,                   -- Set of names used in this vertex
 409      RenamedMonoBinds,
 410      [RenamedSig])              -- Signatures, if any, for this vertex
 411
 412 mkEdges :: [(FlatMonoBindsInfo, VertexTag)] -> [(FlatMonoBindsInfo, VertexTag, [VertexTag])]
 413
 414 mkEdges flat_info
 415   = [ (info, tag, dest_vertices (nameSetToList names_used))
 416     | (info@(names_defined, names_used, mbind, sigs), tag) <- flat_info
 417     ]
 418   where
 419          -- An edge (v,v') indicates that v depends on v'
 420     dest_vertices src_mentions = [ target_vertex
 421                                  | ((names_defined, _, _, _), target_vertex) <- flat_info,
 422                                    mentioned_name <- src_mentions,
 423                                    mentioned_name `elemNameSet` names_defined
 424                                  ]
 425 \end{code}
 426
 427
 428 %************************************************************************
 429 %*                                                                      *
 430 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
 431 %*                                                                      *
 432 %************************************************************************
 433
 434 @renameSigs@ checks for: (a)~more than one sig for one thing;
 435 (b)~signatures given for things not bound here; (c)~with suitably
 436 flaggery, that all top-level things have type signatures.
 437
 438 \begin{code}
 439 renameSigs :: TopLevelFlag
 440             -> Bool                     -- True <-> sigs for an instance decl
 441                                         -- hence SPECIALISE instance prags ok
 442             -> NameSet                  -- Set of names bound in this group
 443             -> [RdrNameSig]
 444             -> RnMS s [RenamedSig]               -- List of Sig constructors
 445
 446 renameSigs top_lev inst_decl binders sigs
 447   =      -- Rename the signatures
 448     mapRn renameSig sigs        `thenRn` \ sigs' ->
 449
 450         -- Check for (a) duplicate signatures
 451         --           (b) signatures for things not in this group
 452         --           (c) optionally, bindings with no signature
 453     let
 454         (goodies, dups) = removeDups cmp_sig (sigsForMe (not . isUnboundName) sigs')
 455         not_this_group  = sigsForMe (not . (`elemNameSet` binders)) goodies
 456         spec_inst_sigs  = [s | s@(SpecInstSig _ _) <- goodies]
 457         type_sig_vars   = [n | Sig n _ _ <- goodies]
 458         sigs_required   = case top_lev of {TopLevel -> opt_WarnMissingSigs; NotTopLevel -> False}
 459         un_sigd_binders | sigs_required = nameSetToList binders `minusList` type_sig_vars
 460                         | otherwise     = []
 461     in
 462     mapRn dupSigDeclErr dups                            `thenRn_`
 463     mapRn unknownSigErr not_this_group                  `thenRn_`
 464     (if not inst_decl then
 465         mapRn unknownSigErr spec_inst_sigs
 466      else
 467         returnRn []
 468     )                                                   `thenRn_`
 469     mapRn (addWarnRn.missingSigWarn) un_sigd_binders    `thenRn_`
 470
 471     returnRn sigs' -- bad ones and all:
 472                    -- we need bindings of *some* sort for every name
 473
 474
 475 renameSig (Sig v ty src_loc)
 476   = pushSrcLocRn src_loc $
 477     lookupBndrRn v                              `thenRn` \ new_v ->
 478     rnHsSigType (quotes (ppr v)) ty             `thenRn` \ new_ty ->
 479     returnRn (Sig new_v new_ty src_loc)
 480
 481 renameSig (SpecInstSig ty src_loc)
 482   = pushSrcLocRn src_loc $
 483     rnHsSigType (text "A SPECIALISE instance pragma") ty                `thenRn` \ new_ty ->
 484     returnRn (SpecInstSig new_ty src_loc)
 485
 486 renameSig (SpecSig v ty using src_loc)
 487   = pushSrcLocRn src_loc $
 488     lookupBndrRn v                      `thenRn` \ new_v ->
 489     rnHsSigType (quotes (ppr v)) ty     `thenRn` \ new_ty ->
 490     rn_using using                      `thenRn` \ new_using ->
 491     returnRn (SpecSig new_v new_ty new_using src_loc)
 492   where
 493     rn_using Nothing  = returnRn Nothing
 494     rn_using (Just x) = lookupOccRn x `thenRn` \ new_x ->
 495                         returnRn (Just new_x)
 496
 497 renameSig (InlineSig v src_loc)
 498   = pushSrcLocRn src_loc $
 499     lookupBndrRn v              `thenRn` \ new_v ->
 500     returnRn (InlineSig new_v src_loc)
 501
 502 renameSig (NoInlineSig v src_loc)
 503   = pushSrcLocRn src_loc $
 504     lookupBndrRn v              `thenRn` \ new_v ->
 505     returnRn (NoInlineSig new_v src_loc)
 506 \end{code}
 507
 508 Checking for distinct signatures; oh, so boring
 509
 510 \begin{code}
 511 cmp_sig :: RenamedSig -> RenamedSig -> Ordering
 512 cmp_sig (Sig n1 _ _)         (Sig n2 _ _)         = n1 `compare` n2
 513 cmp_sig (InlineSig n1 _)     (InlineSig n2 _)     = n1 `compare` n2
 514 cmp_sig (NoInlineSig n1 _)   (NoInlineSig n2 _)   = n1 `compare` n2
 515 cmp_sig (SpecInstSig ty1 _)  (SpecInstSig ty2 _)  = cmpHsType compare ty1 ty2
 516 cmp_sig (SpecSig n1 ty1 _ _) (SpecSig n2 ty2 _ _)
 517   = -- may have many specialisations for one value;
 518         -- but not ones that are exactly the same...
 519         thenCmp (n1 `compare` n2) (cmpHsType compare ty1 ty2)
 520
 521 cmp_sig other_1 other_2                                 -- Tags *must* be different
 522   | (sig_tag other_1) _LT_ (sig_tag other_2) = LT
 523   | otherwise                                = GT
 524
 525 sig_tag (Sig n1 _ _)               = (ILIT(1) :: FAST_INT)
 526 sig_tag (SpecSig n1 _ _ _)         = ILIT(2)
 527 sig_tag (InlineSig n1 _)           = ILIT(3)
 528 sig_tag (NoInlineSig n1 _)         = ILIT(4)
 529 sig_tag (SpecInstSig _ _)          = ILIT(5)
 530 sig_tag _                          = panic# "tag(RnBinds)"
 531 \end{code}
 532
 533 %************************************************************************
 534 %*                                                                      *
 535 \subsection{Error messages}
 536 %*                                                                      *
 537 %************************************************************************
 538
 539 \begin{code}
 540 dupSigDeclErr (sig:sigs)
 541   = pushSrcLocRn loc $
 542     addErrRn (sep [ptext SLIT("Duplicate"),
 543                    ptext what_it_is <> colon,
 544                    ppr sig])
 545   where
 546     (what_it_is, loc) = sig_doc sig
 547
 548 unknownSigErr sig
 549   = pushSrcLocRn loc $
 550     addErrRn (sep [ptext SLIT("Misplaced"),
 551                    ptext what_it_is <> colon,
 552                    ppr sig])
 553   where
 554     (what_it_is, loc) = sig_doc sig
 555
 556 sig_doc (Sig        _ _ loc)        = (SLIT("type signature"),loc)
 557 sig_doc (ClassOpSig _ _ _ loc)      = (SLIT("class-method type signature"), loc)
 558 sig_doc (SpecSig    _ _ _ loc)      = (SLIT("SPECIALISE pragma"),loc)
 559 sig_doc (InlineSig  _     loc)      = (SLIT("INLINE pragma"),loc)
 560 sig_doc (NoInlineSig  _   loc)      = (SLIT("NOINLINE pragma"),loc)
 561 sig_doc (SpecInstSig _ loc)         = (SLIT("SPECIALISE instance pragma"),loc)
 562
 563 missingSigWarn var
 564   = sep [ptext SLIT("definition but no type signature for"), quotes (ppr var)]
 565
 566 methodBindErr mbind
 567  =  hang (ptext SLIT("Can't handle multiple methods defined by one pattern binding"))
 568        4 (ppr mbind)
 569 \end{code}