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