RnBinds.lhs 20.1 KB
 simonmar committed Jun 17, 1999 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 % % (c) The GRASP/AQUA Project, Glasgow University, 1992-1998 % \section[RnBinds]{Renaming and dependency analysis of bindings} This module does renaming and dependency analysis on value bindings in the abstract syntax. It does {\em not} do cycle-checks on class or type-synonym declarations; those cannot be done at this stage because they may be affected by renaming (which isn't fully worked out yet). \begin{code} module RnBinds ( rnTopBinds, rnTopMonoBinds, rnMethodBinds, renameSigs, rnBinds, unknownSigErr ) where #include "HsVersions.h"  simonpj committed Oct 25, 2000 21 import {-# SOURCE #-} RnSource ( rnHsSigType, rnHsType )  simonmar committed Jun 17, 1999 22 23  import HsSyn  simonpj committed May 25, 2000 24 import HsBinds ( eqHsSig, sigName, hsSigDoc )  simonmar committed Jun 17, 1999 25 26 27 28 import RdrHsSyn import RnHsSyn import RnMonad import RnExpr ( rnMatch, rnGRHSs, rnPat, checkPrecMatch )  simonpj committed May 25, 2000 29 import RnEnv ( bindLocatedLocalsRn, lookupBndrRn,  simonpj committed Sep 22, 2000 30  lookupGlobalOccRn, lookupSigOccRn,  simonpj committed Oct 03, 2000 31  warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,  simonpj committed Sep 22, 2000 32  FreeVars, emptyFVs, plusFV, plusFVs, unitFV, addOneFV  simonmar committed Jun 17, 1999 33  )  sewardj committed Oct 17, 2000 34 import CmdLineOpts ( DynFlag(..) )  simonmar committed Jun 17, 1999 35 import Digraph ( stronglyConnComp, SCC(..) )  sewardj committed Oct 17, 2000 36 import Name ( OccName, Name, nameOccName )  simonmar committed Jun 17, 1999 37 import NameSet  simonpj committed Oct 03, 2000 38 import RdrName ( RdrName, rdrNameOcc )  simonpj committed Sep 22, 2000 39 import BasicTypes ( RecFlag(..) )  simonmar committed Jun 17, 1999 40 41 import List ( partition ) import Outputable  simonpj committed Oct 24, 2000 42 import PrelNames ( isUnboundName )  simonmar committed Jun 17, 1999 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 \end{code} -- ToDo: Put the annotations into the monad, so that they arrive in the proper -- place and can be used when complaining. The code tree received by the function @rnBinds@ contains definitions in where-clauses which are all apparently mutually recursive, but which may not really depend upon each other. For example, in the top level program \begin{verbatim} f x = y where a = x y = x \end{verbatim} the definitions of @a@ and @y@ do not depend on each other at all. Unfortunately, the typechecker cannot always check such definitions. \footnote{Mycroft, A. 1984. Polymorphic type schemes and recursive definitions. In Proceedings of the International Symposium on Programming, Toulouse, pp. 217-39. LNCS 167. Springer Verlag.} However, the typechecker usually can check definitions in which only the strongly connected components have been collected into recursive bindings. This is precisely what the function @rnBinds@ does. ToDo: deal with case where a single monobinds binds the same variable twice. The vertag tag is a unique @Int@; the tags only need to be unique within one @MonoBinds@, so that unique-Int plumbing is done explicitly (heavy monad machinery not needed). \begin{code} type VertexTag = Int type Cycle = [VertexTag] type Edge = (VertexTag, VertexTag) \end{code} %************************************************************************ %* * %* naming conventions * %* * %************************************************************************ \subsection[name-conventions]{Name conventions} The basic algorithm involves walking over the tree and returning a tuple containing the new tree plus its free variables. Some functions, such as those walking polymorphic bindings (HsBinds) and qualifier lists in list comprehensions (@Quals@), return the variables bound in local environments. These are then used to calculate the free variables of the expression evaluated in these environments. Conventions for variable names are as follows: \begin{itemize} \item new code is given a prime to distinguish it from the old. \item a set of variables defined in @Exp@ is written @dvExp@ \item a set of variables free in @Exp@ is written @fvExp@ \end{itemize} %************************************************************************ %* * %* analysing polymorphic bindings (HsBinds, Bind, MonoBinds) * %* * %************************************************************************ \subsubsection[dep-HsBinds]{Polymorphic bindings} Non-recursive expressions are reconstructed without any changes at top level, although their component expressions may have to be altered. However, non-recursive expressions are currently not expected as \Haskell{} programs, and this code should not be executed. Monomorphic bindings contain information that is returned in a tuple (a @FlatMonoBindsInfo@) containing: \begin{enumerate} \item a unique @Int@ that serves as the vertex tag'' for this binding. \item the name of a function or the names in a pattern. These are a set referred to as @dvLhs@, the defined variables of the left hand side. \item the free variables of the body. These are referred to as @fvBody@. \item the definition's actual code. This is referred to as just @code@. \end{enumerate} The function @nonRecDvFv@ returns two sets of variables. The first is the set of variables defined in the set of monomorphic bindings, while the second is the set of free variables in those bindings. The set of variables defined in a non-recursive binding is just the union of all of them, as @union@ removes duplicates. However, the free variables in each successive set of cumulative bindings is the union of those in the previous set plus those of the newest binding after the defined variables of the previous set have been removed. @rnMethodBinds@ deals only with the declarations in class and instance declarations. It expects only to see @FunMonoBind@s, and it expects the global environment to contain bindings for the binders (which are all class operations). %************************************************************************ %* * \subsubsection{ Top-level bindings} %* * %************************************************************************ @rnTopBinds@ assumes that the environment already contains bindings for the binders of this particular binding. \begin{code} rnTopBinds :: RdrNameHsBinds -> RnMS (RenamedHsBinds, FreeVars) rnTopBinds EmptyBinds = returnRn (EmptyBinds, emptyFVs) rnTopBinds (MonoBind bind sigs _) = rnTopMonoBinds bind sigs -- The parser doesn't produce other forms rnTopMonoBinds mbinds sigs  simonpj committed May 25, 2000 168 169 170 171  = mapRn lookupBndrRn binder_rdr_names thenRn \ binder_names -> let bndr_name_set = mkNameSet binder_names in  sewardj committed Oct 17, 2000 172 173  renameSigs (okBindSig bndr_name_set) sigs thenRn \ (siglist, sig_fvs) -> doptRn Opt_WarnMissingSigs thenRn \ warnMissing ->  simonmar committed Jun 17, 1999 174  let  simonpj committed Apr 03, 2000 175  type_sig_vars = [n | Sig n _ _ <- siglist]  sewardj committed Oct 17, 2000 176 177 178  un_sigd_binders | warnMissing = nameSetToList (delListFromNameSet bndr_name_set type_sig_vars) | otherwise = []  simonmar committed Jun 17, 1999 179  in  simonpj committed Apr 03, 2000 180 181  mapRn_ (addWarnRn.missingSigWarn) un_sigd_binders thenRn_  simonmar committed Jun 17, 1999 182 183 184  rn_mono_binds siglist mbinds thenRn \ (final_binds, bind_fvs) -> returnRn (final_binds, bind_fvs plusFV sig_fvs) where  simonpj committed Oct 03, 2000 185  binder_rdr_names = collectMonoBinders mbinds  simonmar committed Jun 17, 1999 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 \end{code} %************************************************************************ %* * %* Nested binds %* * %************************************************************************ \subsubsection{Nested binds} @rnMonoBinds@ \begin{itemize} \item collects up the binders for this declaration group, \item checks that they form a set \item extends the environment to bind them to new local names \item calls @rnMonoBinds@ to do the real work \end{itemize} % \begin{code} rnBinds :: RdrNameHsBinds -> (RenamedHsBinds -> RnMS (result, FreeVars)) -> RnMS (result, FreeVars) rnBinds EmptyBinds thing_inside = thing_inside EmptyBinds rnBinds (MonoBind bind sigs _) thing_inside = rnMonoBinds bind sigs thing_inside -- the parser doesn't produce other forms rnMonoBinds :: RdrNameMonoBinds -> [RdrNameSig] -> (RenamedHsBinds -> RnMS (result, FreeVars)) -> RnMS (result, FreeVars) rnMonoBinds mbinds sigs thing_inside -- Non-empty monobinds = -- Extract all the binders in this group, -- and extend current scope, inventing new names for the new binders -- This also checks that the names form a set  simonpj committed Jul 14, 2000 223 224  bindLocatedLocalsRn (text "a binding group") mbinders_w_srclocs $\ new_mbinders ->  simonmar committed Jun 17, 1999 225  let  simonpj committed Apr 03, 2000 226  binder_set = mkNameSet new_mbinders  simonmar committed Jun 17, 1999 227  in  simonpj committed Mar 09, 2000 228  -- Rename the signatures  simonpj committed Apr 03, 2000 229  renameSigs (okBindSig binder_set) sigs thenRn \ (siglist, sig_fvs) ->  simonpj committed Mar 09, 2000 230 231 232 233 234  -- Report the fixity declarations in this group that -- don't refer to any of the group's binders. -- Then install the fixity declarations that do apply here -- Notice that they scope over thing_inside too  simonmar committed Jun 17, 1999 235 236 237  let fixity_sigs = [(name,sig) | FixSig sig@(FixitySig name _ _) <- siglist ] in  simonpj committed Mar 09, 2000 238 239 240  extendFixityEnv fixity_sigs$ rn_mono_binds siglist mbinds thenRn \ (binds, bind_fvs) ->  simonmar committed Jun 17, 1999 241 242 243 244 245 246 247 248 249 250  -- Now do the "thing inside", and deal with the free-variable calculations thing_inside binds thenRn \ (result,result_fvs) -> let all_fvs = result_fvs plusFV bind_fvs plusFV sig_fvs unused_binders = nameSetToList (binder_set minusNameSet all_fvs) in warnUnusedLocalBinds unused_binders thenRn_ returnRn (result, delListFromNameSet all_fvs new_mbinders) where  simonpj committed Oct 03, 2000 251  mbinders_w_srclocs = collectLocatedMonoBinders mbinds  simonmar committed Jun 17, 1999 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 \end{code} %************************************************************************ %* * \subsubsection{ MonoBinds -- the main work is done here} %* * %************************************************************************ @rn_mono_binds@ is used by {\em both} top-level and nested bindings. It assumes that all variables bound in this group are already in scope. This is done {\em either} by pass 3 (for the top-level bindings), {\em or} by @rnMonoBinds@ (for the nested ones). \begin{code} rn_mono_binds :: [RenamedSig] -- Signatures attached to this group -> RdrNameMonoBinds -> RnMS (RenamedHsBinds, -- FreeVars) -- Free variables rn_mono_binds siglist mbinds = -- Rename the bindings, returning a MonoBindsInfo -- which is a list of indivisible vertices so far as -- the strongly-connected-components (SCC) analysis is concerned flattenMonoBinds siglist mbinds thenRn \ mbinds_info -> -- Do the SCC analysis let edges = mkEdges (mbinds_info zip [(0::Int)..]) scc_result = stronglyConnComp edges  simonpj committed Jul 18, 2000 283  final_binds = foldr (ThenBinds . reconstructCycle) EmptyBinds scc_result  simonmar committed Jun 17, 1999 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313 314 315 316  -- Deal with bound and free-var calculation rhs_fvs = plusFVs [fvs | (_,fvs,_,_) <- mbinds_info] in returnRn (final_binds, rhs_fvs) \end{code} @flattenMonoBinds@ is ever-so-slightly magical in that it sticks unique vertex tags'' on its output; minor plumbing required. Sigh --- need to pass along the signatures for the group of bindings, in case any of them \fbox{\ ???\ } \begin{code} flattenMonoBinds :: [RenamedSig] -- Signatures -> RdrNameMonoBinds -> RnMS [FlatMonoBindsInfo] flattenMonoBinds sigs EmptyMonoBinds = returnRn [] flattenMonoBinds sigs (AndMonoBinds bs1 bs2) = flattenMonoBinds sigs bs1 thenRn \ flat1 -> flattenMonoBinds sigs bs2 thenRn \ flat2 -> returnRn (flat1 ++ flat2) flattenMonoBinds sigs (PatMonoBind pat grhss locn) = pushSrcLocRn locn $rnPat pat thenRn \ (pat', pat_fvs) -> -- Find which things are bound in this group let names_bound_here = mkNameSet (collectPatBinders pat') in  simonpj committed May 25, 2000 317  sigsForMe names_bound_here sigs thenRn \ sigs_for_me ->  simonmar committed Jun 17, 1999 318 319 320 321 322 323 324 325 326 327 328 329  rnGRHSs grhss thenRn \ (grhss', fvs) -> returnRn [(names_bound_here, fvs plusFV pat_fvs, PatMonoBind pat' grhss' locn, sigs_for_me )] flattenMonoBinds sigs (FunMonoBind name inf matches locn) = pushSrcLocRn locn$ lookupBndrRn name thenRn \ new_name -> let  simonpj committed May 25, 2000 330  names_bound_here = unitNameSet new_name  simonmar committed Jun 17, 1999 331  in  simonpj committed May 25, 2000 332  sigsForMe names_bound_here sigs thenRn \ sigs_for_me ->  simonmar committed Jun 17, 1999 333 334 335 336 337 338 339 340  mapFvRn rnMatch matches thenRn \ (new_matches, fvs) -> mapRn_ (checkPrecMatch inf new_name) new_matches thenRn_ returnRn [(unitNameSet new_name, fvs, FunMonoBind new_name inf new_matches locn, sigs_for_me )]  simonpj committed May 25, 2000 341 342 343 344 345 346 347 348 349  sigsForMe names_bound_here sigs = foldlRn check [] (filter (sigForThisGroup names_bound_here) sigs) where check sigs sig = case filter (eqHsSig sig) sigs of [] -> returnRn (sig:sigs) other -> dupSigDeclErr sig thenRn_ returnRn sigs  simonmar committed Jun 17, 1999 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367 368 \end{code} @rnMethodBinds@ is used for the method bindings of a class and an instance declaration. Like @rnMonoBinds@ but without dependency analysis. NOTA BENE: we record each {\em binder} of a method-bind group as a free variable. That's crucial when dealing with an instance decl: \begin{verbatim} instance Foo (T a) where op x = ... \end{verbatim} This might be the {\em sole} occurrence of @op@ for an imported class @Foo@, and unless @op@ occurs we won't treat the type signature of @op@ in the class decl for @Foo@ as a source of instance-decl gates. But we should! Indeed, in many ways the @op@ in an instance decl is just like an occurrence, not a binder. \begin{code}  simonpj committed Oct 03, 2000 369 370 371 rnMethodBinds :: [Name] -- Names for generic type variables -> RdrNameMonoBinds -> RnMS (RenamedMonoBinds, FreeVars)  simonmar committed Jun 17, 1999 372   simonpj committed Oct 03, 2000 373 rnMethodBinds gen_tyvars EmptyMonoBinds = returnRn (EmptyMonoBinds, emptyFVs)  simonmar committed Jun 17, 1999 374   simonpj committed Oct 03, 2000 375 376 377 rnMethodBinds gen_tyvars (AndMonoBinds mb1 mb2) = rnMethodBinds gen_tyvars mb1 thenRn \ (mb1', fvs1) -> rnMethodBinds gen_tyvars mb2 thenRn \ (mb2', fvs2) ->  simonmar committed Jun 17, 1999 378 379  returnRn (mb1' AndMonoBinds mb2', fvs1 plusFV fvs2)  simonpj committed Oct 03, 2000 380 rnMethodBinds gen_tyvars (FunMonoBind name inf matches locn)  simonmar committed Jun 17, 1999 381 382 383 384 385  = pushSrcLocRn locn $lookupGlobalOccRn name thenRn \ sel_name -> -- We use the selector name as the binder  simonpj committed Oct 03, 2000 386  mapFvRn rn_match matches thenRn \ (new_matches, fvs) ->  simonmar committed Jun 17, 1999 387 388  mapRn_ (checkPrecMatch inf sel_name) new_matches thenRn_ returnRn (FunMonoBind sel_name inf new_matches locn, fvs addOneFV sel_name)  simonpj committed Oct 03, 2000 389 390 391 392 393 394 395 396 397 398 399  where -- Gruesome; bring into scope the correct members of the generic type variables -- See comments in RnSource.rnDecl(ClassDecl) rn_match match@(Match _ (TypePatIn ty : _) _ _) = extendTyVarEnvFVRn gen_tvs (rnMatch match) where tvs = map rdrNameOcc (extractHsTyRdrNames ty) gen_tvs = [tv | tv <- gen_tyvars, nameOccName tv elem tvs] rn_match match = rnMatch match  simonmar committed Jun 17, 1999 400 401  -- Can't handle method pattern-bindings which bind multiple methods.  simonpj committed Oct 03, 2000 402 rnMethodBinds gen_tyvars mbind@(PatMonoBind other_pat _ locn)  simonmar committed Jun 17, 1999 403 404 405 406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429 430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481  = pushSrcLocRn locn$ failWithRn (EmptyMonoBinds, emptyFVs) (methodBindErr mbind) \end{code} %************************************************************************ %* * \subsection[reconstruct-deps]{Reconstructing dependencies} %* * %************************************************************************ This @MonoBinds@- and @ClassDecls@-specific code is segregated here, as the two cases are similar. \begin{code} reconstructCycle :: SCC FlatMonoBindsInfo -> RenamedHsBinds reconstructCycle (AcyclicSCC (_, _, binds, sigs)) = MonoBind binds sigs NonRecursive reconstructCycle (CyclicSCC cycle) = MonoBind this_gp_binds this_gp_sigs Recursive where this_gp_binds = foldr1 AndMonoBinds [binds | (_, _, binds, _) <- cycle] this_gp_sigs = foldr1 (++) [sigs | (_, _, _, sigs) <- cycle] \end{code} %************************************************************************ %* * \subsubsection{ Manipulating FlatMonoBindInfo} %* * %************************************************************************ During analysis a @MonoBinds@ is flattened to a @FlatMonoBindsInfo@. The @RenamedMonoBinds@ is always an empty bind, a pattern binding or a function binding, and has itself been dependency-analysed and renamed. \begin{code} type FlatMonoBindsInfo = (NameSet, -- Set of names defined in this vertex NameSet, -- Set of names used in this vertex RenamedMonoBinds, [RenamedSig]) -- Signatures, if any, for this vertex mkEdges :: [(FlatMonoBindsInfo, VertexTag)] -> [(FlatMonoBindsInfo, VertexTag, [VertexTag])] mkEdges flat_info = [ (info, tag, dest_vertices (nameSetToList names_used)) | (info@(names_defined, names_used, mbind, sigs), tag) <- flat_info ] where -- An edge (v,v') indicates that v depends on v' dest_vertices src_mentions = [ target_vertex | ((names_defined, _, _, _), target_vertex) <- flat_info, mentioned_name <- src_mentions, mentioned_name elemNameSet names_defined ] \end{code} %************************************************************************ %* * \subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)} %* * %************************************************************************ @renameSigs@ checks for: \begin{enumerate} \item more than one sig for one thing; \item signatures given for things not bound here; \item with suitably flaggery, that all top-level things have type signatures. \end{enumerate} % At the moment we don't gather free-var info from the types in signatures. We'd only need this if we wanted to report unused tyvars. \begin{code}  simonpj committed Apr 03, 2000 482 renameSigs :: (RenamedSig -> Bool) -- OK-sig predicate  simonmar committed Jun 17, 1999 483  -> [RdrNameSig]  simonpj committed Apr 03, 2000 484 485  -> RnMS ([RenamedSig], FreeVars)  simonpj committed Oct 25, 2000 486 487 renameSigs ok_sig [] = returnRn ([], emptyFVs) -- Common shortcut  simonmar committed Jun 17, 1999 488   simonpj committed Apr 03, 2000 489 renameSigs ok_sig sigs  simonmar committed Jun 17, 1999 490  = -- Rename the signatures  simonpj committed Oct 25, 2000 491  mapRn renameSig sigs thenRn \ sigs' ->  simonmar committed Jun 17, 1999 492 493 494 495  -- Check for (a) duplicate signatures -- (b) signatures for things not in this group let  simonpj committed Apr 03, 2000 496 497 498 499  in_scope = filter is_in_scope sigs' is_in_scope sig = case sigName sig of Just n -> not (isUnboundName n) Nothing -> True  simonpj committed May 25, 2000 500  (goods, bads) = partition ok_sig in_scope  simonmar committed Jun 17, 1999 501  in  simonpj committed Apr 03, 2000 502  mapRn_ unknownSigErr bads thenRn_  simonpj committed Oct 25, 2000 503  returnRn (goods, hsSigFVs goods)  simonmar committed Jun 17, 1999 504   simonpj committed May 25, 2000 505 -- We use lookupSigOccRn in the signatures, which is a little bit unsatisfactory  simonmar committed Jun 17, 1999 506 507 508 509 510 511 512 513 -- because this won't work for: -- instance Foo T where -- {-# INLINE op #-} -- Baz.op = ... -- We'll just rename the INLINE prag to refer to whatever other 'op' -- is in scope. (I'm assuming that Baz.op isn't in scope unqualified.) -- Doesn't seem worth much trouble to sort this.  simonpj committed Oct 25, 2000 514 renameSig :: Sig RdrName -> RnMS (Sig Name)  simonpj committed Oct 03, 2000 515 -- ClassOpSig is renamed elsewhere.  simonpj committed Apr 03, 2000 516 renameSig (Sig v ty src_loc)  simonmar committed Jun 17, 1999 517  = pushSrcLocRn src_loc $ simonpj committed May 25, 2000 518  lookupSigOccRn v thenRn \ new_v ->  simonpj committed Oct 25, 2000 519 520  rnHsSigType (quotes (ppr v)) ty thenRn \ new_ty -> returnRn (Sig new_v new_ty src_loc)  simonmar committed Jun 17, 1999 521   simonpj committed Apr 03, 2000 522 renameSig (SpecInstSig ty src_loc)  simonmar committed Jun 17, 1999 523  = pushSrcLocRn src_loc$  simonpj committed Oct 25, 2000 524 525  rnHsType (text "A SPECIALISE instance pragma") ty thenRn \ new_ty -> returnRn (SpecInstSig new_ty src_loc)  simonmar committed Jun 17, 1999 526   simonpj committed Apr 03, 2000 527 renameSig (SpecSig v ty src_loc)  simonmar committed Jun 17, 1999 528  = pushSrcLocRn src_loc $ simonpj committed May 25, 2000 529  lookupSigOccRn v thenRn \ new_v ->  simonpj committed Oct 25, 2000 530 531  rnHsSigType (quotes (ppr v)) ty thenRn \ new_ty -> returnRn (SpecSig new_v new_ty src_loc)  simonmar committed Jun 17, 1999 532   simonpj committed Apr 03, 2000 533 renameSig (FixSig (FixitySig v fix src_loc))  simonmar committed Jun 17, 1999 534  = pushSrcLocRn src_loc$  simonpj committed May 25, 2000 535  lookupSigOccRn v thenRn \ new_v ->  simonpj committed Oct 25, 2000 536  returnRn (FixSig (FixitySig new_v fix src_loc))  simonmar committed Jun 17, 1999 537   simonpj committed Apr 03, 2000 538 renameSig (InlineSig v p src_loc)  simonmar committed Jun 17, 1999 539  = pushSrcLocRn src_loc $ simonpj committed May 25, 2000 540  lookupSigOccRn v thenRn \ new_v ->  simonpj committed Oct 25, 2000 541  returnRn (InlineSig new_v p src_loc)  simonmar committed Jun 17, 1999 542   simonpj committed Apr 03, 2000 543 renameSig (NoInlineSig v p src_loc)  simonmar committed Jun 17, 1999 544  = pushSrcLocRn src_loc$  simonpj committed May 25, 2000 545  lookupSigOccRn v thenRn \ new_v ->  simonpj committed Oct 25, 2000 546  returnRn (NoInlineSig new_v p src_loc)  simonmar committed Jun 17, 1999 547 548 \end{code}  panne committed Mar 02, 2000 549 550 551 552 553 554 555 556 557 558 559 560 561 562 563 564 565 566 567 568 569 570 571 \begin{code} renameIE :: (RdrName -> RnMS Name) -> IE RdrName -> RnMS (IE Name, FreeVars) renameIE lookup_occ_nm (IEVar v) = lookup_occ_nm v thenRn \ new_v -> returnRn (IEVar new_v, unitFV new_v) renameIE lookup_occ_nm (IEThingAbs v) = lookup_occ_nm v thenRn \ new_v -> returnRn (IEThingAbs new_v, unitFV new_v) renameIE lookup_occ_nm (IEThingAll v) = lookup_occ_nm v thenRn \ new_v -> returnRn (IEThingAll new_v, unitFV new_v) renameIE lookup_occ_nm (IEThingWith v vs) = lookup_occ_nm v thenRn \ new_v -> mapRn lookup_occ_nm vs thenRn \ new_vs -> returnRn (IEThingWith new_v new_vs, plusFVs [ unitFV x | x <- new_v:new_vs ]) renameIE lookup_occ_nm (IEModuleContents m) = returnRn (IEModuleContents m, emptyFVs) \end{code}  simonmar committed Jun 17, 1999 572 573 574 575 576 577 578 579  %************************************************************************ %* * \subsection{Error messages} %* * %************************************************************************ \begin{code}  simonpj committed May 25, 2000 580 dupSigDeclErr sig  simonmar committed Jun 17, 1999 581 582 583 584  = pushSrcLocRn loc $addErrRn (sep [ptext SLIT("Duplicate") <+> ptext what_it_is <> colon, ppr sig]) where  simonpj committed Apr 03, 2000 585  (what_it_is, loc) = hsSigDoc sig  simonmar committed Jun 17, 1999 586 587 588  unknownSigErr sig = pushSrcLocRn loc$  simonpj committed Apr 03, 2000 589  addErrRn (sep [ptext SLIT("Misplaced") <+> ptext what_it_is <> colon,  simonmar committed Jun 17, 1999 590 591  ppr sig]) where  simonpj committed Apr 03, 2000 592  (what_it_is, loc) = hsSigDoc sig  simonmar committed Jun 17, 1999 593 594 595 596 597 598 599 600  missingSigWarn var = sep [ptext SLIT("definition but no type signature for"), quotes (ppr var)] methodBindErr mbind = hang (ptext SLIT("Can't handle multiple methods defined by one pattern binding")) 4 (ppr mbind) \end{code}