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, lookupRn, lookupOccRn, isUnboundName )
  30
  31 import CmdLineOpts      ( opt_SigsRequired )
  32 import Digraph          ( stronglyConnComp )
  33 import ErrUtils         ( addErrLoc, addShortErrLocLine )
  34 import Name             ( OccName(..), Provenance,
  35                           Name {- instance Eq -},
  36                           NameSet(..), emptyNameSet, mkNameSet, unionNameSets,
  37                           minusNameSet, unionManyNameSets, elemNameSet, unitNameSet, nameSetToList
  38                         )
  39 import Maybes           ( catMaybes )
  40 --import PprStyle--ToDo:rm
  41 import Pretty
  42 import Util             ( thenCmp, isIn, removeDups, panic, panic#, assertPanic )
  43 import UniqSet          ( SYN_IE(UniqSet) )
  44 import ListSetOps       ( minusList )
  45 import Bag              ( bagToList )
  46 import UniqFM           ( UniqFM )
  47 import ErrUtils         ( SYN_IE(Error) )
  48 \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@ and @rnTopMonoBinds@ assume 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 (SingleBind (RecBind bind))    = rnTopMonoBinds bind []
 169 rnTopBinds (BindWith (RecBind bind) sigs) = rnTopMonoBinds bind sigs
 170   -- The parser doesn't produce other forms
 171
 172
 173 rnTopMonoBinds :: RdrNameMonoBinds
 174                -> [RdrNameSig]
 175                -> RnMS s RenamedHsBinds
 176
 177 rnTopMonoBinds EmptyMonoBinds sigs
 178   = returnRn EmptyBinds
 179
 180 rnTopMonoBinds mbinds sigs
 181  =  mapRn lookupRn binder_rdr_names     `thenRn` \ binder_names ->
 182     let
 183         binder_set = mkNameSet binder_names
 184     in
 185     rn_mono_binds True {- top level -}
 186                   binder_set mbinds sigs                `thenRn` \ (new_binds, fv_set) ->
 187     returnRn new_binds
 188   where
 189     binder_rdr_names = map fst (bagToList (collectMonoBinders mbinds))
 190 \end{code}
 191
 192 %************************************************************************
 193 %*                                                                      *
 194 %*              Nested binds
 195 %*                                                                      *
 196 %************************************************************************
 197
 198 @rnMonoBinds@
 199         - collects up the binders for this declaration group,
 200         - checks that they form a set
 201         - extends the environment to bind them to new local names
 202         - calls @rnMonoBinds@ to do the real work
 203
 204 In contrast, @rnTopMonoBinds@ doesn't extend the environment, because that's
 205 already done in pass3.  All it does is call @rnMonoBinds@ and discards
 206 the free var info.
 207
 208 \begin{code}
 209 rnBinds       :: RdrNameHsBinds
 210               -> (RenamedHsBinds -> RnMS s (result, FreeVars))
 211               -> RnMS s (result, FreeVars)
 212
 213 rnBinds EmptyBinds                     thing_inside = thing_inside EmptyBinds
 214 rnBinds (SingleBind (RecBind bind))    thing_inside = rnMonoBinds bind []   thing_inside
 215 rnBinds (BindWith (RecBind bind) sigs) thing_inside = rnMonoBinds bind sigs thing_inside
 216   -- the parser doesn't produce other forms
 217
 218
 219 rnMonoBinds :: RdrNameMonoBinds -> [RdrNameSig]
 220             -> (RenamedHsBinds -> RnMS s (result, FreeVars))
 221             -> RnMS s (result, FreeVars)
 222
 223 rnMonoBinds EmptyMonoBinds sigs thing_inside = thing_inside EmptyBinds
 224
 225 rnMonoBinds mbinds sigs thing_inside -- Non-empty monobinds
 226   =     -- Extract all the binders in this group,
 227         -- and extend current scope, inventing new names for the new binders
 228         -- This also checks that the names form a set
 229     bindLocatedLocalsRn "binding group" mbinders_w_srclocs              $ \ new_mbinders ->
 230     let
 231         binder_set = mkNameSet new_mbinders
 232     in
 233     rn_mono_binds False {- not top level -}
 234                   binder_set mbinds sigs        `thenRn` \ (binds,bind_fvs) ->
 235
 236         -- Now do the "thing inside", and deal with the free-variable calculations
 237     thing_inside binds                                  `thenRn` \ (result,result_fvs) ->
 238     returnRn (result, (result_fvs `unionNameSets` bind_fvs) `minusNameSet` binder_set)
 239   where
 240     mbinders_w_srclocs = bagToList (collectMonoBinders mbinds)
 241 \end{code}
 242
 243
 244 %************************************************************************
 245 %*                                                                      *
 246 %*              MonoBinds -- the main work is done here
 247 %*                                                                      *
 248 %************************************************************************
 249
 250 @rnMonoBinds@ is used by *both* top-level and nested bindings.  It
 251 assumes that all variables bound in this group are already in scope.
 252 This is done *either* by pass 3 (for the top-level bindings), *or* by
 253 @rnNestedMonoBinds@ (for the nested ones).
 254
 255 \begin{code}
 256 rn_mono_binds :: Bool                   -- True <=> top level
 257               -> NameSet                -- Binders of this group
 258               -> RdrNameMonoBinds
 259               -> [RdrNameSig]           -- Signatures attached to this group
 260               -> RnMS s (RenamedHsBinds,        --
 261                          FreeVars)      -- Free variables
 262
 263 rn_mono_binds is_top_lev binders mbinds sigs
 264   =
 265          -- Rename the bindings, returning a MonoBindsInfo
 266          -- which is a list of indivisible vertices so far as
 267          -- the strongly-connected-components (SCC) analysis is concerned
 268     rnBindSigs is_top_lev binders sigs  `thenRn` \ siglist ->
 269     flattenMonoBinds 0 siglist mbinds   `thenRn` \ (_, mbinds_info) ->
 270
 271          -- Do the SCC analysis
 272     let vertices    = mkVertices mbinds_info
 273         edges       = mkEdges     mbinds_info
 274         scc_result  = stronglyConnComp (==) edges vertices
 275         final_binds = foldr1 ThenBinds (map (reconstructCycle edges mbinds_info) scc_result)
 276
 277          -- Deal with bound and free-var calculation
 278         rhs_fvs = unionManyNameSets [fvs | (_,_,fvs,_,_) <- mbinds_info]
 279     in
 280     returnRn (final_binds, rhs_fvs)
 281 \end{code}
 282
 283 @flattenMonoBinds@ is ever-so-slightly magical in that it sticks
 284 unique ``vertex tags'' on its output; minor plumbing required.
 285
 286 \begin{code}
 287 flattenMonoBinds :: Int                         -- Next free vertex tag
 288                  -> [RenamedSig]                -- Signatures
 289                  -> RdrNameMonoBinds
 290                  -> RnMS s (Int, FlatMonoBindsInfo)
 291
 292 flattenMonoBinds uniq sigs EmptyMonoBinds = returnRn (uniq, [])
 293
 294 flattenMonoBinds uniq sigs (AndMonoBinds bs1 bs2)
 295   = flattenMonoBinds uniq  sigs bs1     `thenRn` \ (uniq1, flat1) ->
 296     flattenMonoBinds uniq1 sigs bs2     `thenRn` \ (uniq2, flat2) ->
 297     returnRn (uniq2, flat1 ++ flat2)
 298
 299 flattenMonoBinds uniq sigs (PatMonoBind pat grhss_and_binds locn)
 300   = pushSrcLocRn locn                   $
 301     rnPat pat                           `thenRn` \ pat' ->
 302     rnGRHSsAndBinds grhss_and_binds     `thenRn` \ (grhss_and_binds', fvs) ->
 303
 304          -- Find which things are bound in this group
 305     let
 306         names_bound_here = mkNameSet (collectPatBinders pat')
 307         sigs_for_me      = filter ((`elemNameSet` names_bound_here) . sig_name) sigs
 308         sigs_fvs         = foldr sig_fv emptyNameSet sigs_for_me
 309     in
 310     returnRn (
 311         uniq + 1,
 312         [(uniq,
 313           names_bound_here,
 314           fvs `unionNameSets` sigs_fvs,
 315           PatMonoBind pat' grhss_and_binds' locn,
 316           sigs_for_me
 317          )]
 318     )
 319
 320 flattenMonoBinds uniq sigs (FunMonoBind name inf matches locn)
 321   = pushSrcLocRn locn                            $
 322     mapRn (checkPrecMatch inf name) matches     `thenRn_`
 323     lookupRn name                               `thenRn` \ name' ->
 324     mapAndUnzipRn rnMatch matches               `thenRn` \ (new_matches, fv_lists) ->
 325     let
 326         fvs         = unionManyNameSets fv_lists
 327         sigs_for_me = filter ((name' ==) . sig_name) sigs
 328         sigs_fvs    = foldr sig_fv emptyNameSet sigs_for_me
 329     in
 330     returnRn (
 331       uniq + 1,
 332       [(uniq,
 333         unitNameSet name',
 334         fvs `unionNameSets` sigs_fvs,
 335         FunMonoBind name' inf new_matches locn,
 336         sigs_for_me
 337         )]
 338     )
 339 \end{code}
 340
 341
 342 @rnMethodBinds@ is used for the method bindings of an instance
 343 declaration.   like @rnMonoBinds@ but without dependency analysis.
 344
 345 \begin{code}
 346 rnMethodBinds :: RdrNameMonoBinds -> RnMS s RenamedMonoBinds
 347
 348 rnMethodBinds EmptyMonoBinds = returnRn EmptyMonoBinds
 349
 350 rnMethodBinds (AndMonoBinds mb1 mb2)
 351   = andRn AndMonoBinds (rnMethodBinds mb1)
 352                        (rnMethodBinds mb2)
 353
 354 rnMethodBinds (FunMonoBind occname inf matches locn)
 355   = pushSrcLocRn locn                              $
 356     mapRn (checkPrecMatch inf occname) matches  `thenRn_`
 357     lookupRn occname                            `thenRn` \ op_name ->
 358     mapAndUnzipRn rnMatch matches               `thenRn` \ (new_matches, _) ->
 359     returnRn (FunMonoBind op_name inf new_matches locn)
 360
 361 rnMethodBinds (PatMonoBind (VarPatIn occname) grhss_and_binds locn)
 362   = pushSrcLocRn locn                   $
 363     lookupRn  occname                   `thenRn` \ op_name ->
 364     rnGRHSsAndBinds grhss_and_binds     `thenRn` \ (grhss_and_binds', _) ->
 365     returnRn (PatMonoBind (VarPatIn op_name) grhss_and_binds' locn)
 366
 367 -- Can't handle method pattern-bindings which bind multiple methods.
 368 rnMethodBinds mbind@(PatMonoBind other_pat _ locn)
 369   = pushSrcLocRn locn   $
 370     failWithRn EmptyMonoBinds (methodBindErr mbind)
 371 \end{code}
 372
 373 \begin{code}
 374 -- If a SPECIALIZE pragma is of the "... = blah" form,
 375 -- then we'd better make sure "blah" is taken into
 376 -- acct in the dependency analysis (or we get an
 377 -- unexpected out-of-scope error)! WDP 95/07
 378
 379 sig_fv (SpecSig _ _ (Just blah) _) acc = acc `unionNameSets` (unitNameSet blah)
 380 sig_fv _                           acc = acc
 381 \end{code}
 382
 383 %************************************************************************
 384 %*                                                                      *
 385 \subsection[reconstruct-deps]{Reconstructing dependencies}
 386 %*                                                                      *
 387 %************************************************************************
 388
 389 This @MonoBinds@- and @ClassDecls@-specific code is segregated here,
 390 as the two cases are similar.
 391
 392 \begin{code}
 393 reconstructCycle :: [Edge]      -- Original edges
 394                  -> FlatMonoBindsInfo
 395                  -> Cycle
 396                  -> RenamedHsBinds
 397
 398 reconstructCycle edges mbi cycle
 399   = mk_binds this_gp_binds this_gp_sigs (isCyclic edges cycle)
 400   where
 401     relevant_binds_and_sigs = [(binds,sigs) | (vertex, _, _, binds, sigs) <- mbi,
 402                                               vertex `is_elem` cycle]
 403     (binds, sig_lists) = unzip relevant_binds_and_sigs
 404     this_gp_binds      = foldr1 AndMonoBinds binds
 405     this_gp_sigs       = foldr1 (++) sig_lists
 406
 407     is_elem = isIn "reconstructRec"
 408
 409     mk_binds :: RenamedMonoBinds -> [RenamedSig] -> Bool -> RenamedHsBinds
 410     mk_binds bs [] True  = SingleBind (RecBind    bs)
 411     mk_binds bs ss True  = BindWith   (RecBind    bs) ss
 412     mk_binds bs [] False = SingleBind (NonRecBind bs)
 413     mk_binds bs ss False = BindWith   (NonRecBind bs) ss
 414
 415         -- moved from Digraph, as this is the only use here
 416         -- (avoid overloading cost).  We have to use elem
 417         -- (not FiniteMaps or whatever), because there may be
 418         -- many edges out of one vertex.  We give it its own
 419         -- "elem" just for speed.
 420
 421     isCyclic es []  = panic "isCyclic: empty component"
 422     isCyclic es [v] = (v,v) `elem` es
 423     isCyclic es vs  = True
 424
 425     elem _ []     = False
 426     elem x (y:ys) = x==y || elem x ys
 427 \end{code}
 428
 429 %************************************************************************
 430 %*                                                                      *
 431 %*      Manipulating FlatMonoBindInfo                                   *
 432 %*                                                                      *
 433 %************************************************************************
 434
 435 During analysis a @MonoBinds@ is flattened to a @FlatMonoBindsInfo@.
 436 The @RenamedMonoBinds@ is always an empty bind, a pattern binding or
 437 a function binding, and has itself been dependency-analysed and
 438 renamed.
 439
 440 \begin{code}
 441 type FlatMonoBindsInfo
 442   = [(VertexTag,                -- Identifies the vertex
 443       NameSet,                  -- Set of names defined in this vertex
 444       NameSet,                  -- Set of names used in this vertex
 445       RenamedMonoBinds,         -- Binding for this vertex (always just one binding, either fun or pat)
 446       [RenamedSig])             -- Signatures, if any, for this vertex
 447     ]
 448
 449 mkVertices :: FlatMonoBindsInfo -> [VertexTag]
 450 mkEdges    :: FlatMonoBindsInfo -> [Edge]
 451
 452 mkVertices info = [ vertex | (vertex,_,_,_,_) <- info]
 453
 454 mkEdges flat_info        -- An edge (v,v') indicates that v depends on v'
 455   = [ (source_vertex, target_vertex)
 456     | (source_vertex, _, used_names, _, _) <- flat_info,
 457       target_name   <- nameSetToList used_names,
 458       target_vertex <- vertices_defining target_name flat_info
 459     ]
 460     where
 461     -- If each name only has one binding in this group, then
 462     -- vertices_defining will always return the empty list, or a
 463     -- singleton.  The case when there is more than one binding (an
 464     -- error) needs more thought.
 465
 466     vertices_defining name flat_info2
 467      = [ vertex | (vertex, names_defined, _, _, _) <- flat_info2,
 468                   name `elemNameSet` names_defined
 469        ]
 470 \end{code}
 471
 472
 473 %************************************************************************
 474 %*                                                                      *
 475 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
 476 %*                                                                      *
 477 %************************************************************************
 478
 479 @rnBindSigs@ checks for: (a)~more than one sig for one thing;
 480 (b)~signatures given for things not bound here; (c)~with suitably
 481 flaggery, that all top-level things have type signatures.
 482
 483 \begin{code}
 484 rnBindSigs :: Bool                      -- True <=> top-level binders
 485             -> NameSet                  -- Set of names bound in this group
 486             -> [RdrNameSig]
 487             -> RnMS s [RenamedSig]               -- List of Sig constructors
 488
 489 rnBindSigs is_toplev binders sigs
 490   =      -- Rename the signatures
 491     mapRn renameSig sigs        `thenRn` \ sigs' ->
 492
 493         -- Check for (a) duplicate signatures
 494         --           (b) signatures for things not in this group
 495         --           (c) optionally, bindings with no signature
 496     let
 497         (goodies, dups) = removeDups cmp_sig (filter (not.isUnboundName.sig_name) sigs')
 498         not_this_group  = filter (\sig -> not (sig_name sig `elemNameSet` binders)) goodies
 499         type_sig_vars   = [n | Sig n _ _ <- goodies]
 500         un_sigd_binders
 501             | is_toplev && opt_SigsRequired = nameSetToList binders `minusList` type_sig_vars
 502             | otherwise                     = []
 503     in
 504     mapRn dupSigDeclErr dups                            `thenRn_`
 505     mapRn unknownSigErr not_this_group                  `thenRn_`
 506     mapRn (addErrRn.missingSigErr) un_sigd_binders      `thenRn_`
 507
 508     returnRn sigs' -- bad ones and all:
 509                    -- we need bindings of *some* sort for every name
 510
 511
 512 renameSig (Sig v ty src_loc)
 513   = pushSrcLocRn src_loc $
 514     lookupRn v                  `thenRn` \ new_v ->
 515     rnHsType ty                 `thenRn` \ new_ty ->
 516     returnRn (Sig new_v new_ty src_loc)
 517
 518 renameSig (SpecSig v ty using src_loc)
 519   = pushSrcLocRn src_loc $
 520     lookupRn v                  `thenRn` \ new_v ->
 521     rnHsType ty                 `thenRn` \ new_ty ->
 522     rn_using using              `thenRn` \ new_using ->
 523     returnRn (SpecSig new_v new_ty new_using src_loc)
 524   where
 525     rn_using Nothing  = returnRn Nothing
 526     rn_using (Just x) = lookupOccRn x `thenRn` \ new_x ->
 527                         returnRn (Just new_x)
 528
 529 renameSig (InlineSig v src_loc)
 530   = pushSrcLocRn src_loc $
 531     lookupRn v          `thenRn` \ new_v ->
 532     returnRn (InlineSig new_v src_loc)
 533
 534 renameSig (DeforestSig v src_loc)
 535   = pushSrcLocRn src_loc $
 536     lookupRn v        `thenRn` \ new_v ->
 537     returnRn (DeforestSig new_v src_loc)
 538
 539 renameSig (MagicUnfoldingSig v str src_loc)
 540   = pushSrcLocRn src_loc $
 541     lookupRn v          `thenRn` \ new_v ->
 542     returnRn (MagicUnfoldingSig new_v str src_loc)
 543 \end{code}
 544
 545 Checking for distinct signatures; oh, so boring
 546
 547 \begin{code}
 548 cmp_sig :: RenamedSig -> RenamedSig -> TAG_
 549 cmp_sig (Sig n1 _ _)               (Sig n2 _ _)           = n1 `cmp` n2
 550 cmp_sig (InlineSig n1 _)           (InlineSig n2 _)       = n1 `cmp` n2
 551 cmp_sig (MagicUnfoldingSig n1 _ _) (MagicUnfoldingSig n2 _ _) = n1 `cmp` n2
 552 cmp_sig (SpecSig n1 ty1 _ _)       (SpecSig n2 ty2 _ _)
 553   = -- may have many specialisations for one value;
 554         -- but not ones that are exactly the same...
 555         thenCmp (n1 `cmp` n2) (cmpHsType cmp ty1 ty2)
 556
 557 cmp_sig other_1 other_2                                 -- Tags *must* be different
 558   | (sig_tag other_1) _LT_ (sig_tag other_2) = LT_
 559   | otherwise                                = GT_
 560
 561 sig_tag (Sig n1 _ _)               = (ILIT(1) :: FAST_INT)
 562 sig_tag (SpecSig n1 _ _ _)         = ILIT(2)
 563 sig_tag (InlineSig n1 _)           = ILIT(3)
 564 sig_tag (MagicUnfoldingSig n1 _ _) = ILIT(4)
 565 sig_tag (DeforestSig n1 _)         = ILIT(5)
 566 sig_tag _                          = panic# "tag(RnBinds)"
 567
 568 sig_name (Sig        n _ _)        = n
 569 sig_name (ClassOpSig n _ _ _)      = n
 570 sig_name (SpecSig    n _ _ _)      = n
 571 sig_name (InlineSig  n     _)      = n
 572 sig_name (MagicUnfoldingSig n _ _) = n
 573 \end{code}
 574
 575 %************************************************************************
 576 %*                                                                      *
 577 \subsection{Error messages}
 578 %*                                                                      *
 579 %************************************************************************
 580
 581 \begin{code}
 582 dupSigDeclErr (sig:sigs)
 583   = pushSrcLocRn loc $
 584     addErrRn (\sty -> ppSep [ppStr "more than one",
 585                             ppStr what_it_is, ppStr "given for",
 586                             ppQuote (ppr sty (sig_name sig))])
 587   where
 588     (what_it_is, loc) = sig_doc sig
 589
 590 unknownSigErr sig
 591   = pushSrcLocRn loc $
 592     addErrRn (\sty -> ppSep [ppStr flavour, ppStr "but no definition for",
 593                              ppQuote (ppr sty (sig_name sig))])
 594   where
 595     (flavour, loc) = sig_doc sig
 596
 597 sig_doc (Sig        _ _ loc)        = ("type signature",loc)
 598 sig_doc (ClassOpSig _ _ _ loc)      = ("class-method type signature", loc)
 599 sig_doc (SpecSig    _ _ _ loc)      = ("SPECIALIZE pragma",loc)
 600 sig_doc (InlineSig  _     loc)      = ("INLINE pragma",loc)
 601 sig_doc (MagicUnfoldingSig _ _ loc) = ("MAGIC_UNFOLDING pragma",loc)
 602
 603 missingSigErr var sty
 604   = ppSep [ppStr "a definition but no type signature for", ppQuote (ppr sty var)]
 605
 606 methodBindErr mbind sty
 607  =  ppHang (ppStr "Can't handle multiple methods defined by one pattern binding")
 608            4 (ppr sty mbind)
 609 \end{code}