2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[RnBinds4]{Renaming and dependency analysis of bindings}
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).
12 #include "HsVersions.h"
15 rnTopBinds, rnMethodBinds,
17 FreeVars(..), DefinedVars(..)
19 -- and to make the interface self-sufficient...
23 import RnLoop -- break the RnPass4/RnExpr4/RnBinds4 loops
28 import HsPragmas ( noGenPragmas )
32 import CmdLineOpts ( opt_SigsRequired )
33 import Digraph ( stronglyConnComp )
34 import ErrUtils ( addErrLoc, addShortErrLocLine )
35 import Maybes ( catMaybes )
36 import Name ( isUnboundName, Name{-instances-} )
38 import ProtoName ( elemByLocalNames, eqByLocalName, ProtoName{-instances-} )
39 import RnExpr4 -- OK to look here; but not the other way 'round
40 import UniqSet ( emptyUniqSet, singletonUniqSet, mkUniqSet,
41 unionUniqSets, unionManyUniqSets,
46 import Util ( isIn, removeDups, panic, panic# )
49 -- ToDo: Put the annotations into the monad, so that they arrive in the proper
50 -- place and can be used when complaining.
52 The code tree received by the function @rnBinds@ contains definitions
53 in where-clauses which are all apparently mutually recursive, but which may
54 not really depend upon each other. For example, in the top level program
59 the definitions of @a@ and @y@ do not depend on each other at all.
60 Unfortunately, the typechecker cannot always check such definitions.
61 \footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive
62 definitions. In Proceedings of the International Symposium on Programming,
63 Toulouse, pp. 217-39. LNCS 167. Springer Verlag.}
64 However, the typechecker usually can check definitions in which only the
65 strongly connected components have been collected into recursive bindings.
66 This is precisely what the function @rnBinds@ does.
68 ToDo: deal with case where a single monobinds binds the same variable
71 Sets of variable names are represented as sets explicitly, rather than lists.
74 type DefinedVars = UniqSet Name
75 type FreeVars = UniqSet Name
80 The vertag tag is a unique @Int@; the tags only need to be unique
81 within one @MonoBinds@, so that unique-Int plumbing is done explicitly
82 (heavy monad machinery not needed).
86 type Cycle = [VertexTag]
87 type Edge = (VertexTag, VertexTag)
90 %************************************************************************
92 %* naming conventions *
94 %************************************************************************
95 \subsection[name-conventions]{Name conventions}
97 The basic algorithm involves walking over the tree and returning a tuple
98 containing the new tree plus its free variables. Some functions, such
99 as those walking polymorphic bindings (HsBinds) and qualifier lists in
100 list comprehensions (@Quals@), return the variables bound in local
101 environments. These are then used to calculate the free variables of the
102 expression evaluated in these environments.
104 Conventions for variable names are as follows:
107 new code is given a prime to distinguish it from the old.
110 a set of variables defined in @Exp@ is written @dvExp@
113 a set of variables free in @Exp@ is written @fvExp@
116 %************************************************************************
118 %* analysing polymorphic bindings (HsBinds, Bind, MonoBinds) *
120 %************************************************************************
121 \subsubsection[dep-HsBinds]{Polymorphic bindings}
123 Non-recursive expressions are reconstructed without any changes at top
124 level, although their component expressions may have to be altered.
125 However, non-recursive expressions are currently not expected as
126 \Haskell{} programs, and this code should not be executed.
128 Monomorphic bindings contain information that is returned in a tuple
129 (a @FlatMonoBindsInfo@) containing:
133 a unique @Int@ that serves as the ``vertex tag'' for this binding.
136 the name of a function or the names in a pattern. These are a set
137 referred to as @dvLhs@, the defined variables of the left hand side.
140 the free variables of the body. These are referred to as @fvBody@.
143 the definition's actual code. This is referred to as just @code@.
146 The function @nonRecDvFv@ returns two sets of variables. The first is
147 the set of variables defined in the set of monomorphic bindings, while the
148 second is the set of free variables in those bindings.
150 The set of variables defined in a non-recursive binding is just the
151 union of all of them, as @union@ removes duplicates. However, the
152 free variables in each successive set of cumulative bindings is the
153 union of those in the previous set plus those of the newest binding after
154 the defined variables of the previous set have been removed.
156 @rnMethodBinds@ deals only with the declarations in class and
157 instance declarations. It expects only to see @FunMonoBind@s, and
158 it expects the global environment to contain bindings for the binders
159 (which are all class operations).
162 rnTopBinds :: ProtoNameHsBinds -> Rn4M RenamedHsBinds
163 rnMethodBinds :: Name{-class-} -> ProtoNameMonoBinds -> Rn4M RenamedMonoBinds
164 rnBinds :: ProtoNameHsBinds -> Rn4M (RenamedHsBinds, FreeVars, [Name])
166 rnTopBinds EmptyBinds = returnRn4 EmptyBinds
167 rnTopBinds (SingleBind (RecBind bind)) = rnTopMonoBinds bind []
168 rnTopBinds (BindWith (RecBind bind) sigs) = rnTopMonoBinds bind sigs
169 -- the parser doesn't produce other forms
171 -- ********************************************************************
173 rnMethodBinds class_name EmptyMonoBinds = returnRn4 EmptyMonoBinds
175 rnMethodBinds class_name (AndMonoBinds mb1 mb2)
176 = andRn4 AndMonoBinds (rnMethodBinds class_name mb1)
177 (rnMethodBinds class_name mb2)
179 rnMethodBinds class_name (FunMonoBind pname matches locn)
180 = pushSrcLocRn4 locn (
181 lookupClassOp class_name pname `thenRn4` \ op_name ->
182 mapAndUnzipRn4 rnMatch matches `thenRn4` \ (new_matches, _) ->
183 returnRn4 (FunMonoBind op_name new_matches locn)
186 rnMethodBinds class_name (PatMonoBind (VarPatIn pname) grhss_and_binds locn)
187 = pushSrcLocRn4 locn (
188 lookupClassOp class_name pname `thenRn4` \ op_name ->
189 rnGRHSsAndBinds grhss_and_binds `thenRn4` \ (grhss_and_binds', _) ->
190 returnRn4 (PatMonoBind (VarPatIn op_name) grhss_and_binds' locn)
193 -- Can't handle method pattern-bindings which bind multiple methods.
194 rnMethodBinds _ mbind@(PatMonoBind other_pat _ locn)
195 = failButContinueRn4 EmptyMonoBinds (methodBindErr mbind locn)
197 -- ********************************************************************
199 rnBinds EmptyBinds = returnRn4 (EmptyBinds,emptyUniqSet,[])
200 rnBinds (SingleBind (RecBind bind)) = rnNestedMonoBinds bind []
201 rnBinds (BindWith (RecBind bind) sigs) = rnNestedMonoBinds bind sigs
202 -- the parser doesn't produce other forms
206 - collects up the binders for this declaration group,
207 - checkes that they form a set
208 - extends the environment to bind them to new local names
209 - calls @rnMonoBinds@ to do the real work
211 In contrast, @rnTopMonoBinds@ doesn't extend the environment, because that's
212 already done in pass3. All it does is call @rnMonoBinds@ and discards
216 rnTopMonoBinds :: ProtoNameMonoBinds -> [ProtoNameSig] -> Rn4M RenamedHsBinds
218 rnTopMonoBinds EmptyMonoBinds sigs = returnRn4 EmptyBinds
220 rnTopMonoBinds mbs sigs
221 = rnBindSigs True{-top-level-} (collectMonoBinders mbs) sigs `thenRn4` \ siglist ->
222 rnMonoBinds mbs siglist `thenRn4` \ (new_binds, fv_set) ->
226 rnNestedMonoBinds :: ProtoNameMonoBinds -> [ProtoNameSig]
227 -> Rn4M (RenamedHsBinds, FreeVars, [Name])
229 rnNestedMonoBinds EmptyMonoBinds sigs
230 = returnRn4 (EmptyBinds, emptyUniqSet, [])
232 rnNestedMonoBinds mbinds sigs -- Non-empty monobinds
234 -- Extract all the binders in this group,
235 -- and extend current scope, inventing new names for the new binders
236 -- This also checks that the names form a set
238 mbinders_w_srclocs = collectMonoBindersAndLocs mbinds
239 mbinders = map fst mbinders_w_srclocs
242 "variable" -- in binding group
243 mbinders_w_srclocs `thenRn4` \ new_mbinders ->
245 extendSS2 new_mbinders (
246 rnBindSigs False{-not top- level-} mbinders sigs `thenRn4` \ siglist ->
247 rnMonoBinds mbinds siglist
248 ) `thenRn4` \ (new_binds, fv_set) ->
249 returnRn4 (new_binds, fv_set, new_mbinders)
252 @rnMonoBinds@ is used by *both* top-level and nested bindings. It
253 assumes that all variables bound in this group are already in scope.
254 This is done *either* by pass 3 (for the top-level bindings),
255 *or* by @rnNestedMonoBinds@ (for the nested ones).
258 rnMonoBinds :: ProtoNameMonoBinds
259 -> [RenamedSig] -- Signatures attached to this group
260 -> Rn4M (RenamedHsBinds, FreeVars)
262 rnMonoBinds mbinds siglist
264 -- Rename the bindings, returning a MonoBindsInfo
265 -- which is a list of indivisible vertices so far as
266 -- the strongly-connected-components (SCC) analysis is concerned
267 flattenMonoBinds 0 siglist mbinds `thenRn4` \ (_, mbinds_info) ->
269 -- Do the SCC analysis
270 let vertices = mkVertices mbinds_info
271 edges = mkEdges vertices mbinds_info
273 scc_result = stronglyConnComp (==) edges vertices
275 -- Deal with bound and free-var calculation
276 rhs_free_vars = foldr f emptyUniqSet mbinds_info
278 final_binds = reconstructRec scc_result edges mbinds_info
280 happy_answer = returnRn4 (final_binds, rhs_free_vars)
282 case (inline_sigs_in_recursive_binds final_binds) of
283 Nothing -> happy_answer
284 Just names_n_locns ->
285 -- SLPJ: sometimes want recursive INLINE for worker wrapper style stuff
286 -- addErrRn4 (inlineInRecursiveBindsErr names_n_locns) `thenRn4_`
287 {-not so-}happy_answer
289 f :: (a,b, FreeVars, c,d) -> FreeVars -> FreeVars
291 f (_, _, fvs_body, _, _) fvs_sofar = fvs_sofar `unionUniqSets` fvs_body
293 inline_sigs_in_recursive_binds (BindWith (RecBind _) sigs)
294 = case [(n, locn) | (InlineSig n locn) <- sigs ] of
300 -- Allow INLINEd recursive functions if they are
301 -- designated DEFORESTable too.
302 case [(n, locn) | (DeforestSig n locn) <- sigs ] of
307 inline_sigs_in_recursive_binds (ThenBinds b1 b2)
308 = case (inline_sigs_in_recursive_binds b1) of
309 Nothing -> inline_sigs_in_recursive_binds b2
310 Just x -> Just x -- NB: won't report error(s) in b2
312 inline_sigs_in_recursive_binds anything_else = Nothing
315 @flattenMonoBinds@ is ever-so-slightly magical in that it sticks
316 unique ``vertex tags'' on its output; minor plumbing required.
319 flattenMonoBinds :: Int -- Next free vertex tag
320 -> [RenamedSig] -- Signatures
321 -> ProtoNameMonoBinds
322 -> Rn4M (Int, FlatMonoBindsInfo)
324 flattenMonoBinds uniq sigs EmptyMonoBinds = returnRn4 (uniq, [])
326 flattenMonoBinds uniq sigs (AndMonoBinds mB1 mB2)
327 = flattenMonoBinds uniq sigs mB1 `thenRn4` \ (uniq1, flat1) ->
328 flattenMonoBinds uniq1 sigs mB2 `thenRn4` \ (uniq2, flat2) ->
329 returnRn4 (uniq2, flat1 ++ flat2)
331 flattenMonoBinds uniq sigs (PatMonoBind pat grhss_and_binds locn)
332 = pushSrcLocRn4 locn (
333 rnPat pat `thenRn4` \ pat' ->
334 rnGRHSsAndBinds grhss_and_binds `thenRn4` \ (grhss_and_binds', fvs) ->
336 -- Find which things are bound in this group
338 names_bound_here = collectPatBinders pat'
340 sigs_etc_for_here = foldl (sig_for_here (\ n -> n `is_elem` names_bound_here))
343 sigs_fvs = foldr sig_fv emptyUniqSet sigs_etc_for_here
345 is_elem = isIn "flattenMonoBinds"
350 mkUniqSet names_bound_here,
351 fvs `unionUniqSets` sigs_fvs,
352 PatMonoBind pat' grhss_and_binds' locn,
357 flattenMonoBinds uniq sigs (FunMonoBind name matches locn)
358 = pushSrcLocRn4 locn (
359 lookupValue name `thenRn4` \ name' ->
360 mapAndUnzipRn4 rnMatch matches `thenRn4` \ (new_matches, fv_lists) ->
362 fvs = unionManyUniqSets fv_lists
364 sigs_for_me = foldl (sig_for_here (\ n -> n == name')) [] sigs
366 sigs_fvs = foldr sig_fv emptyUniqSet sigs_for_me
371 singletonUniqSet name',
372 fvs `unionUniqSets` sigs_fvs,
373 FunMonoBind name' new_matches locn,
379 Grab type-signatures/user-pragmas of interest:
381 sig_for_here want_me acc s@(Sig n _ _ _) | want_me n = s:acc
382 sig_for_here want_me acc s@(InlineSig n _) | want_me n = s:acc
383 sig_for_here want_me acc s@(DeforestSig n _) | want_me n = s:acc
384 sig_for_here want_me acc s@(SpecSig n _ _ _) | want_me n = s:acc
385 sig_for_here want_me acc s@(MagicUnfoldingSig n _ _)
387 sig_for_here want_me acc other_wise = acc
389 -- If a SPECIALIZE pragma is of the "... = blah" form,
390 -- then we'd better make sure "blah" is taken into
391 -- acct in the dependency analysis (or we get an
392 -- unexpected out-of-scope error)! WDP 95/07
394 sig_fv (SpecSig _ _ (Just blah) _) acc = acc `unionUniqSets` singletonUniqSet blah
398 %************************************************************************
400 \subsection[reconstruct-deps]{Reconstructing dependencies}
402 %************************************************************************
404 This @MonoBinds@- and @ClassDecls@-specific code is segregated here,
405 as the two cases are similar.
408 reconstructRec :: [Cycle] -- Result of SCC analysis; at least one
409 -> [Edge] -- Original edges
413 reconstructRec cycles edges mbi
414 = foldr1 ThenBinds (map (reconstructCycle mbi) cycles)
416 reconstructCycle :: FlatMonoBindsInfo -> Cycle -> RenamedHsBinds
418 reconstructCycle mbi2 cycle
419 = BIND [(binds,sigs) | (vertex, _, _, binds, sigs) <- mbi2, vertex `is_elem` cycle]
420 _TO_ relevant_binds_and_sigs ->
422 BIND (unzip relevant_binds_and_sigs) _TO_ (binds, sig_lists) ->
424 BIND (foldr AndMonoBinds EmptyMonoBinds binds) _TO_ this_gp_binds ->
426 this_gp_sigs = foldr1 (++) sig_lists
427 have_sigs = not (null sig_lists)
428 -- ToDo: this might not be the right
429 -- thing to call this predicate;
430 -- e.g. "have_sigs [[], [], []]" ???????????
432 mk_binds this_gp_binds this_gp_sigs (isCyclic edges cycle) have_sigs
435 is_elem = isIn "reconstructRec"
437 mk_binds :: RenamedMonoBinds -> [RenamedSig]
438 -> Bool -> Bool -> RenamedHsBinds
440 mk_binds bs ss True False = SingleBind (RecBind bs)
441 mk_binds bs ss True True{-have sigs-} = BindWith (RecBind bs) ss
442 mk_binds bs ss False False = SingleBind (NonRecBind bs)
443 mk_binds bs ss False True{-have sigs-} = BindWith (NonRecBind bs) ss
445 -- moved from Digraph, as this is the only use here
446 -- (avoid overloading cost). We have to use elem
447 -- (not FiniteMaps or whatever), because there may be
448 -- many edges out of one vertex. We give it its own
449 -- "elem" just for speed.
451 isCyclic es [] = panic "isCyclic: empty component"
452 isCyclic es [v] = (v,v) `elem` es
453 isCyclic es vs = True
456 elem x (y:ys) = x==y || elem x ys
459 %************************************************************************
461 %* Manipulating FlatMonoBindInfo *
463 %************************************************************************
465 During analysis a @MonoBinds@ is flattened to a @FlatMonoBindsInfo@.
466 The @RenamedMonoBinds@ is always an empty bind, a pattern binding or
467 a function binding, and has itself been dependency-analysed and
471 type FlatMonoBindsInfo
472 = [(VertexTag, -- Identifies the vertex
473 UniqSet Name, -- Set of names defined in this vertex
474 UniqSet Name, -- Set of names used in this vertex
475 RenamedMonoBinds, -- Binding for this vertex (always just one binding, either fun or pat)
476 [RenamedSig]) -- Signatures, if any, for this vertex
479 mkVertices :: FlatMonoBindsInfo -> [VertexTag]
480 mkVertices info = [ vertex | (vertex,_,_,_,_) <- info]
482 mkEdges :: [VertexTag] -> FlatMonoBindsInfo -> [Edge]
484 mkEdges vertices flat_info
485 -- An edge (v,v') indicates that v depends on v'
486 = [ (source_vertex, target_vertex)
487 | (source_vertex, _, used_names, _, _) <- flat_info,
488 target_name <- uniqSetToList used_names,
489 target_vertex <- vertices_defining target_name flat_info
492 -- If each name only has one binding in this group, then
493 -- vertices_defining will always return the empty list, or a
494 -- singleton. The case when there is more than one binding (an
495 -- error) needs more thought.
497 vertices_defining name flat_info2
498 = [ vertex | (vertex, names_defined, _, _, _) <- flat_info2,
499 name `elementOfUniqSet` names_defined
504 %************************************************************************
506 \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}
508 %************************************************************************
510 @rnBindSigs@ checks for: (a)~more than one sig for one thing;
511 (b)~signatures given for things not bound here; (c)~with suitably
512 flaggery, that all top-level things have type signatures.
515 rnBindSigs :: Bool -- True <=> top-level binders
516 -> [ProtoName] -- Binders for this decl group
518 -> Rn4M [RenamedSig] -- List of Sig constructors
520 rnBindSigs is_toplev binder_pnames sigs
522 -- Rename the signatures
523 -- Will complain about sigs for variables not in this group
524 mapRn4 rename_sig sigs `thenRn4` \ sigs_maybe ->
526 sigs' = catMaybes sigs_maybe
528 -- Discard unbound ones we've already complained about, so we
529 -- complain about duplicate ones.
531 (goodies, dups) = removeDups compare (filter not_unbound sigs')
533 mapRn4 (addErrRn4 . dupSigDeclErr) dups `thenRn4_`
535 getSrcLocRn4 `thenRn4` \ locn ->
537 (if (is_toplev && opt_SigsRequired) then
539 sig_frees = catMaybes (map (sig_free sigs) binder_pnames)
541 mapRn4 (addErrRn4 . missingSigErr locn) sig_frees
546 returnRn4 sigs' -- bad ones and all:
547 -- we need bindings of *some* sort for every name
549 rename_sig (Sig v ty pragma src_loc)
550 = pushSrcLocRn4 src_loc (
552 if not (v `elemByLocalNames` binder_pnames) then
553 addErrRn4 (unknownSigDeclErr "type signature" v src_loc) `thenRn4_`
556 lookupValue v `thenRn4` \ new_v ->
557 rnPolyType False nullTyVarNamesEnv ty `thenRn4` \ new_ty ->
558 recoverQuietlyRn4 noGenPragmas (
560 ) `thenRn4` \ new_pragma ->
561 returnRn4 (Just (Sig new_v new_ty new_pragma src_loc))
564 -- and now, the various flavours of value-modifying user-pragmas:
566 rename_sig (SpecSig v ty using src_loc)
567 = pushSrcLocRn4 src_loc (
569 if not (v `elemByLocalNames` binder_pnames) then
570 addErrRn4 (unknownSigDeclErr "SPECIALIZE pragma" v src_loc) `thenRn4_`
573 lookupValue v `thenRn4` \ new_v ->
574 rnPolyType False nullTyVarNamesEnv ty `thenRn4` \ new_ty ->
575 rn_using using `thenRn4` \ new_using ->
576 returnRn4 (Just (SpecSig new_v new_ty new_using src_loc))
579 rn_using Nothing = returnRn4 Nothing
580 rn_using (Just x) = lookupValue x `thenRn4` \ new_x ->
581 returnRn4 (Just new_x)
583 rename_sig (InlineSig v src_loc)
584 = pushSrcLocRn4 src_loc (
586 if not (v `elemByLocalNames` binder_pnames) then
587 addErrRn4 (unknownSigDeclErr "INLINE pragma" v src_loc) `thenRn4_`
590 lookupValue v `thenRn4` \ new_v ->
591 returnRn4 (Just (InlineSig new_v src_loc))
594 rename_sig (DeforestSig v src_loc)
595 = pushSrcLocRn4 src_loc (
597 if not (v `elemByLocalNames` binder_pnames) then
598 addErrRn4 (unknownSigDeclErr "DEFOREST pragma" v src_loc) `thenRn4_`
601 lookupValue v `thenRn4` \ new_v ->
602 returnRn4 (Just (DeforestSig new_v src_loc))
605 rename_sig (MagicUnfoldingSig v str src_loc)
606 = pushSrcLocRn4 src_loc (
608 if not (v `elemByLocalNames` binder_pnames) then
609 addErrRn4 (unknownSigDeclErr "MAGIC_UNFOLDING pragma" v src_loc) `thenRn4_`
612 lookupValue v `thenRn4` \ new_v ->
613 returnRn4 (Just (MagicUnfoldingSig new_v str src_loc))
616 not_unbound :: RenamedSig -> Bool
618 not_unbound (Sig n _ _ _) = not (isUnboundName n)
619 not_unbound (SpecSig n _ _ _) = not (isUnboundName n)
620 not_unbound (InlineSig n _) = not (isUnboundName n)
621 not_unbound (DeforestSig n _) = not (isUnboundName n)
622 not_unbound (MagicUnfoldingSig n _ _) = not (isUnboundName n)
624 -------------------------------------
625 sig_free :: [ProtoNameSig] -> ProtoName -> Maybe ProtoName
626 -- Return "Just x" if "x" has no type signature in
627 -- sigs. Nothing, otherwise.
629 sig_free [] ny = Just ny
630 sig_free (Sig nx _ _ _ : rest) ny
631 = if (nx `eqByLocalName` ny) then Nothing else sig_free rest ny
632 sig_free (_ : rest) ny = sig_free rest ny
634 -------------------------------------
635 compare :: RenamedSig -> RenamedSig -> TAG_
638 c (Sig n1 _ _ _) (Sig n2 _ _ _) = n1 `cmp` n2
639 c (InlineSig n1 _) (InlineSig n2 _) = n1 `cmp` n2
640 c (MagicUnfoldingSig n1 _ _) (MagicUnfoldingSig n2 _ _) = n1 `cmp` n2
641 c (SpecSig n1 ty1 _ _) (SpecSig n2 ty2 _ _)
642 = -- may have many specialisations for one value;
643 -- but not ones that are exactly the same...
644 case (n1 `cmp` n2) of
645 EQ_ -> cmpPolyType cmp ty1 ty2
648 c other_1 other_2 -- tags *must* be different
649 = let tag1 = tag other_1
652 if tag1 _LT_ tag2 then LT_ else GT_
654 tag (Sig n1 _ _ _) = (ILIT(1) :: FAST_INT)
655 tag (SpecSig n1 _ _ _) = ILIT(2)
656 tag (InlineSig n1 _) = ILIT(3)
657 tag (MagicUnfoldingSig n1 _ _) = ILIT(4)
658 tag (DeforestSig n1 _) = ILIT(5)
659 tag _ = panic# "tag(RnBinds4)"
662 %************************************************************************
664 \subsection{Error messages}
666 %************************************************************************
671 undup_sigs = fst (removeDups cmp_sig sigs)
674 ("more than one "++what_it_is++"\n\thas been given for these variables") ( \ sty ->
675 ppAboves (map (ppr sty) undup_sigs) )
678 = case (head sigs) of
679 Sig _ _ _ loc -> ("type signature",loc)
680 ClassOpSig _ _ _ loc -> ("class-method type signature", loc)
681 SpecSig _ _ _ loc -> ("SPECIALIZE pragma",loc)
682 InlineSig _ loc -> ("INLINE pragma",loc)
683 MagicUnfoldingSig _ _ loc -> ("MAGIC_UNFOLDING pragma",loc)
685 cmp_sig a b = get_name a `cmp` get_name b
687 get_name (Sig n _ _ _) = n
688 get_name (ClassOpSig n _ _ _) = n
689 get_name (SpecSig n _ _ _) = n
690 get_name (InlineSig n _) = n
691 get_name (MagicUnfoldingSig n _ _) = n
693 ------------------------
694 methodBindErr mbind locn
695 = addErrLoc locn "Can't handle multiple methods defined by one pattern binding"
696 (\ sty -> ppr sty mbind)
698 --------------------------
699 missingSigErr locn var
700 = addShortErrLocLine locn ( \ sty ->
701 ppBesides [ppStr "a definition but no type signature for `",
705 --------------------------------
706 unknownSigDeclErr flavor var locn
707 = addShortErrLocLine locn ( \ sty ->
708 ppBesides [ppStr flavor, ppStr " but no definition for `",