ghc/compiler/rename/RnBinds.lhs

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