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