ghc/compiler/rename/RnBinds.lhs

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