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