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