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, warnUnusedLocalBinds,
  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 "a 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     warnUnusedLocalBinds 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, sig_fvs) ->
 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 `plusFV` sig_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 -- This is only necessary for the dependency analysis.  The free vars
 365 -- of the types in the signatures is gotten from renameSigs
 366
 367 sig_fv (SpecSig _ _ (Just blah) _) acc = acc `plusFV` unitFV blah
 368 sig_fv _                           acc = acc
 369 \end{code}
 370
 371 %************************************************************************
 372 %*                                                                      *
 373 \subsection[reconstruct-deps]{Reconstructing dependencies}
 374 %*                                                                      *
 375 %************************************************************************
 376
 377 This @MonoBinds@- and @ClassDecls@-specific code is segregated here,
 378 as the two cases are similar.
 379
 380 \begin{code}
 381 reconstructCycle :: SCC FlatMonoBindsInfo
 382                  -> RenamedHsBinds
 383
 384 reconstructCycle (AcyclicSCC (_, _, binds, sigs))
 385   = MonoBind binds sigs NonRecursive
 386
 387 reconstructCycle (CyclicSCC cycle)
 388   = MonoBind this_gp_binds this_gp_sigs Recursive
 389   where
 390     this_gp_binds      = foldr1 AndMonoBinds [binds | (_, _, binds, _) <- cycle]
 391     this_gp_sigs       = foldr1 (++)         [sigs  | (_, _, _, sigs) <- cycle]
 392 \end{code}
 393
 394 %************************************************************************
 395 %*                                                                      *
 396 %*      Manipulating FlatMonoBindInfo                                   *
 397 %*                                                                      *
 398 %************************************************************************
 399
 400 During analysis a @MonoBinds@ is flattened to a @FlatMonoBindsInfo@.
 401 The @RenamedMonoBinds@ is always an empty bind, a pattern binding or
 402 a function binding, and has itself been dependency-analysed and
 403 renamed.
 404
 405 \begin{code}
 406 type FlatMonoBindsInfo
 407   = (NameSet,                   -- Set of names defined in this vertex
 408      NameSet,                   -- Set of names used in this vertex
 409      RenamedMonoBinds,
 410      [RenamedSig])              -- Signatures, if any, for this vertex
 411
 412 mkEdges :: [(FlatMonoBindsInfo, VertexTag)] -> [(FlatMonoBindsInfo, VertexTag, [VertexTag])]
 413
 414 mkEdges flat_info
 415   = [ (info, tag, dest_vertices (nameSetToList names_used))
 416     | (info@(names_defined, names_used, mbind, sigs), tag) <- flat_info
 417     ]
 418   where
 419          -- An edge (v,v') indicates that v depends on v'
 420     dest_vertices src_mentions = [ target_vertex
 421                                  | ((names_defined, _, _, _), target_vertex) <- flat_info,
 422                                    mentioned_name <- src_mentions,
 423                                    mentioned_name `elemNameSet` names_defined
 424                                  ]
 425 \end{code}
 426
 427
 428 %************************************************************************
 429 %*                                                                      *
 430 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
 431 %*                                                                      *
 432 %************************************************************************
 433
 434 @renameSigs@ checks for: (a)~more than one sig for one thing;
 435 (b)~signatures given for things not bound here; (c)~with suitably
 436 flaggery, that all top-level things have type signatures.
 437
 438 At the moment we don't gather free-var info from the types in
 439 sigatures.  We'd only need this if we wanted to report unused tyvars.
 440
 441 \begin{code}
 442 renameSigs :: TopLevelFlag
 443             -> Bool                     -- True <-> sigs for an instance decl
 444                                         -- hence SPECIALISE instance prags ok
 445             -> NameSet                  -- Set of names bound in this group
 446             -> [RdrNameSig]
 447             -> RnMS s ([RenamedSig], FreeVars)           -- List of Sig constructors
 448
 449 renameSigs top_lev inst_decl binders sigs
 450   =      -- Rename the signatures
 451     mapAndUnzipRn renameSig sigs        `thenRn` \ (sigs', fvs_s) ->
 452
 453         -- Check for (a) duplicate signatures
 454         --           (b) signatures for things not in this group
 455         --           (c) optionally, bindings with no signature
 456     let
 457         (goodies, dups) = removeDups cmp_sig (sigsForMe (not . isUnboundName) sigs')
 458         not_this_group  = sigsForMe (not . (`elemNameSet` binders)) goodies
 459         spec_inst_sigs  = [s | s@(SpecInstSig _ _) <- goodies]
 460         type_sig_vars   = [n | Sig n _ _     <- goodies]
 461         fixes           = [f | f@(FixSig _)  <- goodies]
 462         idecl_type_sigs = [s | s@(Sig _ _ _) <- goodies]
 463         sigs_required   = case top_lev of {TopLevel -> opt_WarnMissingSigs; 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          -- We're being strict here, outlawing the presence
 473          -- of type signatures within an instance declaration.
 474         mapRn unknownSigErr (fixes  ++ idecl_type_sigs)
 475     )                                                   `thenRn_`
 476     mapRn (addWarnRn.missingSigWarn) un_sigd_binders    `thenRn_`
 477
 478     returnRn (sigs', plusFVs fvs_s)     -- bad ones and all:
 479                                         -- we need bindings of *some* sort for every name
 480
 481 -- We use lookupOccRn in the signatures, which is a little bit unsatisfactory
 482 -- becuase this won't work for:
 483 --      instance Foo T where
 484 --        {-# INLINE op #-}
 485 --        Baz.op = ...
 486 -- We'll just rename the INLINE prag to refer to whatever other 'op'
 487 -- is in scope.  (I'm assuming that Baz.op isn't in scope unqualified.)
 488 -- Doesn't seem worth much trouble to sort this.
 489
 490 renameSig (Sig v ty src_loc)
 491   = pushSrcLocRn src_loc $
 492     lookupOccRn v                               `thenRn` \ new_v ->
 493     rnHsSigType (quotes (ppr v)) ty             `thenRn` \ (new_ty,fvs) ->
 494     returnRn (Sig new_v new_ty src_loc, fvs)
 495
 496 renameSig (SpecInstSig ty src_loc)
 497   = pushSrcLocRn src_loc $
 498     rnHsSigType (text "A SPECIALISE instance pragma") ty        `thenRn` \ (new_ty, fvs) ->
 499     returnRn (SpecInstSig new_ty src_loc, fvs)
 500
 501 renameSig (SpecSig v ty using src_loc)
 502   = pushSrcLocRn src_loc $
 503     lookupOccRn v                       `thenRn` \ new_v ->
 504     rnHsSigType (quotes (ppr v)) ty     `thenRn` \ (new_ty,fvs1) ->
 505     rn_using using                      `thenRn` \ (new_using,fvs2) ->
 506     returnRn (SpecSig new_v new_ty new_using src_loc, fvs1 `plusFV` fvs2)
 507   where
 508     rn_using Nothing  = returnRn (Nothing, emptyFVs)
 509     rn_using (Just x) = lookupOccRn x `thenRn` \ new_x ->
 510                         returnRn (Just new_x, unitFV new_x)
 511
 512 renameSig (InlineSig v src_loc)
 513   = pushSrcLocRn src_loc $
 514     lookupOccRn v               `thenRn` \ new_v ->
 515     returnRn (InlineSig new_v src_loc, emptyFVs)
 516
 517 renameSig (FixSig (FixitySig v fix src_loc))
 518   = pushSrcLocRn src_loc $
 519     lookupOccRn v               `thenRn` \ new_v ->
 520     returnRn (FixSig (FixitySig new_v fix src_loc), emptyFVs)
 521
 522 renameSig (NoInlineSig v src_loc)
 523   = pushSrcLocRn src_loc $
 524     lookupOccRn v               `thenRn` \ new_v ->
 525     returnRn (NoInlineSig new_v src_loc, emptyFVs)
 526 \end{code}
 527
 528 Checking for distinct signatures; oh, so boring
 529
 530 \begin{code}
 531 cmp_sig :: RenamedSig -> RenamedSig -> Ordering
 532 cmp_sig (Sig n1 _ _)         (Sig n2 _ _)         = n1 `compare` n2
 533 cmp_sig (InlineSig n1 _)     (InlineSig n2 _)     = n1 `compare` n2
 534 cmp_sig (NoInlineSig n1 _)   (NoInlineSig n2 _)   = n1 `compare` n2
 535 cmp_sig (SpecInstSig ty1 _)  (SpecInstSig ty2 _)  = cmpHsType compare ty1 ty2
 536 cmp_sig (SpecSig n1 ty1 _ _) (SpecSig n2 ty2 _ _)
 537   = -- may have many specialisations for one value;
 538         -- but not ones that are exactly the same...
 539         thenCmp (n1 `compare` n2) (cmpHsType compare ty1 ty2)
 540
 541 cmp_sig other_1 other_2                                 -- Tags *must* be different
 542   | (sig_tag other_1) _LT_ (sig_tag other_2) = LT
 543   | otherwise                                = GT
 544
 545 sig_tag (Sig n1 _ _)               = (ILIT(1) :: FAST_INT)
 546 sig_tag (SpecSig n1 _ _ _)         = ILIT(2)
 547 sig_tag (InlineSig n1 _)           = ILIT(3)
 548 sig_tag (NoInlineSig n1 _)         = ILIT(4)
 549 sig_tag (SpecInstSig _ _)          = ILIT(5)
 550 sig_tag (FixSig _)                 = ILIT(6)
 551 sig_tag _                          = panic# "tag(RnBinds)"
 552 \end{code}
 553
 554 %************************************************************************
 555 %*                                                                      *
 556 \subsection{Error messages}
 557 %*                                                                      *
 558 %************************************************************************
 559
 560 \begin{code}
 561 dupSigDeclErr (sig:sigs)
 562   = pushSrcLocRn loc $
 563     addErrRn (sep [ptext SLIT("Duplicate"),
 564                    ptext what_it_is <> colon,
 565                    ppr sig])
 566   where
 567     (what_it_is, loc) = sig_doc sig
 568
 569 unknownSigErr sig
 570   = pushSrcLocRn loc $
 571     addErrRn (sep [ptext SLIT("Misplaced"),
 572                    ptext what_it_is <> colon,
 573                    ppr sig])
 574   where
 575     (what_it_is, loc) = sig_doc sig
 576
 577 sig_doc (Sig        _ _ loc)         = (SLIT("type signature"),loc)
 578 sig_doc (ClassOpSig _ _ _ loc)       = (SLIT("class-method type signature"), loc)
 579 sig_doc (SpecSig    _ _ _ loc)       = (SLIT("SPECIALISE pragma"),loc)
 580 sig_doc (InlineSig  _     loc)       = (SLIT("INLINE pragma"),loc)
 581 sig_doc (NoInlineSig  _   loc)       = (SLIT("NOINLINE pragma"),loc)
 582 sig_doc (SpecInstSig _ loc)          = (SLIT("SPECIALISE instance pragma"),loc)
 583 sig_doc (FixSig (FixitySig _ _ loc)) = (SLIT("fixity declaration"), loc)
 584
 585 missingSigWarn var
 586   = sep [ptext SLIT("definition but no type signature for"), quotes (ppr var)]
 587
 588 methodBindErr mbind
 589  =  hang (ptext SLIT("Can't handle multiple methods defined by one pattern binding"))
 590        4 (ppr mbind)
 591 \end{code}